2 files changed, 41 insertions, 8 deletions
diff --git a/src/Language/Fiddle/Compiler/ConsistencyCheck.hs b/src/Language/Fiddle/Compiler/ConsistencyCheck.hs
index 5c7b399..908db52 100644
--- a/src/Language/Fiddle/Compiler/ConsistencyCheck.hs
+++ b/src/Language/Fiddle/Compiler/ConsistencyCheck.hs
@@ -33,12 +33,15 @@ import GHC.TypeLits
 import Language.Fiddle.Ast
 import Language.Fiddle.Compiler
 import Language.Fiddle.Internal.Scopes
+import Language.Fiddle.Internal.UnitInterface
 import Language.Fiddle.Types (Commented (unCommented), SourceSpan)
 import Text.Printf (printf)
 import Prelude hiding (unzip)
 
-newtype GlobalState = GlobalState
-  { globalScope :: Scope String (Either SizeBits SizeBytes)
+data GlobalState = GlobalState
+  { globalScope :: Scope String (Either SizeBits SizeBytes),
+    fileDependencies :: [FilePath],
+    unitInterface :: UnitInterface
   }
 
 newtype LocalState = LocalState (ScopePath String)
@@ -61,7 +64,7 @@ checkConsistency ::
   Compile () (FiddleUnit Checked I Annot)
 checkConsistency =
   fmap snd
-    . subCompile (GlobalState mempty)
+    . subCompile (GlobalState mempty mempty)
     . advanceStage (LocalState mempty)
 
 instance CompilationStage Checked where
@@ -78,7 +81,11 @@ instance CompilationStage Expanded where
   type StageFunctor Expanded = Identity
   type StageAnnotation Expanded = Commented SourceSpan
 
-deriving instance AdvanceStage Expanded FiddleUnit
+instance AdvanceStage Expanded FiddleUnit
+
+-- advanceStage localState (FiddleUnit decls _ annot) = do
+
+--   decls' <- mapM (advanceStage localState) decls
 
 deriving instance AdvanceStage Expanded Expression
 
@@ -528,7 +535,7 @@ insertTypeSize ::
   Compile GlobalState ()
 insertTypeSize (LocalState scopePath) (Identifier s annot) size = do
   modifyM $
-    \(GlobalState globalScope) ->
+    \state@GlobalState {globalScope = globalScope} ->
       let fullName =
             NonEmpty.prependList
               (currentScope scopePath)
@@ -537,7 +544,7 @@ insertTypeSize (LocalState scopePath) (Identifier s annot) size = do
             (Just _, _) -> do
               diagnosticError (printf "Duplicate type %s" s) annot
               compilationFailure
-            (Nothing, n) -> return $ GlobalState n
+            (Nothing, n) -> return $ state {globalScope = n}
   where
     modifyM fn = do
       s <- get
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