1 files changed, 28 insertions, 2 deletions
diff --git a/src/Language/Fiddle/Compiler/ImportResolution.hs b/src/Language/Fiddle/Compiler/ImportResolution.hs
index 90a11d5..47eec72 100644
--- a/src/Language/Fiddle/Compiler/ImportResolution.hs
+++ b/src/Language/Fiddle/Compiler/ImportResolution.hs
@@ -1,3 +1,6 @@
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE GeneralisedNewtypeDeriving #-}
+
 module Language.Fiddle.Compiler.ImportResolution
   ( resolveImports,
     getImportResolutionState,
@@ -6,11 +9,12 @@ module Language.Fiddle.Compiler.ImportResolution
 where
 
 import Control.Monad.Identity (Identity)
-import Control.Monad.Writer.Lazy (MonadWriter (tell))
+import Control.Monad.Writer.Lazy (MonadTrans (lift), MonadWriter (tell), WriterT (WriterT), execWriterT)
 import Data.Map (Map)
 import qualified Data.Map as Map
 import Data.Text (Text)
 import qualified Data.Text as Text
+import Data.Typeable
 import Language.Fiddle.Ast
 import Language.Fiddle.Ast.FileInterface (ResolvedImport)
 import Language.Fiddle.Compiler
@@ -18,6 +22,7 @@ import Language.Fiddle.Compiler.Expansion
 import Language.Fiddle.Internal.UnitInterface
 import Language.Fiddle.Types
 import Options.Applicative
+import System.IO (hPutStrLn, stderr)
 import Text.Printf (printf)
 
 newtype Flags = Flags
@@ -55,6 +60,7 @@ data ImportError = ImportError Text (Maybe SourceSpan)
 newtype ResolvedImports = ResolvedImports
   { importMap :: Map Text (Either ImportError UnitInterface)
   }
+  deriving newtype (Semigroup, Monoid)
 
 type CurrentStage = Parsed
 
@@ -129,4 +135,24 @@ getImportResolutionState ::
   Flags ->
   FiddleUnit CurrentStage Identity Annot ->
   IO ResolvedImports
-getImportResolutionState _ _ = return (ResolvedImports mempty)
+getImportResolutionState flags unit =
+  execWriterT $
+    walk doWalk unit ()
+  where
+    -- doWalk :: forall t'. (Walk t', Typeable t') => t' Identity Annot -> () -> WriterT ResolvedImports IO ()
+    doWalk u () =
+      case () of
+        () | Just (ImportStatement {importPath = path}) <- castTS u -> do
+          lift $ hPutStrLn stderr $ "Import path: " ++ show path
+          (return () :: WriterT ResolvedImports IO ())
+        _ -> return ()
+
+    castTS ::
+      ( Typeable t',
+        Typeable t,
+        Typeable f,
+        Typeable a
+      ) =>
+      t' f a ->
+      Maybe (t CurrentStage f a)
+    castTS = cast