Prefer GADT's over typ families for some SyntaxTree elements.

11 files changed, 214 insertions, 53 deletions

diff --git a/src/Language/Fiddle/Ast.hs b/src/Language/Fiddle/Ast.hs
index f5fbafe..24e172a 100644
--- a/src/Language/Fiddle/Ast.hs
+++ b/src/Language/Fiddle/Ast.hs
@@ -9,3 +9,4 @@ import Language.Fiddle.Ast.Internal.Kinds as X
 import Language.Fiddle.Ast.Internal.Stage as X
 import Language.Fiddle.Ast.Internal.SyntaxTree as X
 import Language.Fiddle.Ast.Internal.Util as X
+import Language.Fiddle.Ast.Internal.MetaTypes as X
diff --git a/src/Language/Fiddle/Ast/Internal/Instances.hs b/src/Language/Fiddle/Ast/Internal/Instances.hs
index aaa20b8..8222174 100644
--- a/src/Language/Fiddle/Ast/Internal/Instances.hs
+++ b/src/Language/Fiddle/Ast/Internal/Instances.hs
@@ -84,10 +84,15 @@ class
   (CompilationStage stage) =>
   StageConvertible stage from to
   where
-  convertInStage :: proxy stage -> StageState stage -> from -> StageMonad stage to
+  convertInStage ::
+    proxy stage ->
+    StageAnnotation stage ->
+    StageState stage ->
+    from ->
+    StageMonad stage to
 
 instance (CompilationStage s, Applicative (StageMonad s)) => StageConvertible s a a where
-  convertInStage _ _ = pure
+  convertInStage _ _ _ = pure
 
 -- | 'AdvanceStage' defines how to transform an Abstract Syntax Tree (AST) node
 --   from one stage to the next in the compiler pipeline. This transformation
@@ -143,6 +148,7 @@ class
         (StageMonad stage) -- The monadic context of this stage
         (Rep (TreeType t stage)) -- Generic representation of the current tree type
         (Rep (t (StageAfter stage) (StageFunctor stage) (StageAnnotation stage))), -- Generic representation of the next stage's tree type
+      Annotated (t stage),
       Generic (TreeType t stage), -- The current tree type must be an instance of 'Generic'
       Generic
         ( t
@@ -168,7 +174,7 @@ class
     case specific of
       Nothing ->
         -- Perform the generic transformation using 'gAdvanceStage'
-        to <$> gAdvanceStage (Proxy :: Proxy stage) s' (from t)
+        to <$> gAdvanceStage (Proxy :: Proxy stage) (annot t) s' (from t)
       Just ast -> return ast
 
   -- | 'modifyState' allows for changes to the local state ('StageState') before
@@ -238,7 +244,7 @@ class
 --   default implementation of 'advanceStage' to traverse and modify nodes
 --   automatically.
 class GAdvanceStage (stage :: Stage) s m from to where
-  gAdvanceStage :: Proxy stage -> s -> from x -> m (to x)
+  gAdvanceStage :: Proxy stage -> StageAnnotation stage -> s -> from x -> m (to x)
 
 -- A syntax tree object is annotated if it has an annotation 'a' as the last
 -- element.
@@ -378,7 +384,7 @@ instance
   (Monad m, GAdvanceStage stage s m s1 s2) =>
   GAdvanceStage stage s m (M1 i c s1) (M1 i c s2)
   where
-  gAdvanceStage pxy s (M1 a) = M1 <$> gAdvanceStage pxy s a
+  gAdvanceStage pxy ant s (M1 a) = M1 <$> gAdvanceStage pxy ant s a
 
 -- | 'GAdvanceStage' instance for sum types (':+:'). This handles the case
 --   where the generic representation of a type is a sum (i.e., an 'Either'-like
@@ -389,8 +395,8 @@ instance
   (Monad m, GAdvanceStage stage s m l1 l2, GAdvanceStage stage s m r1 r2) =>
   GAdvanceStage stage s m (l1 :+: r1) (l2 :+: r2)
   where
-  gAdvanceStage pxy s (R1 r) = R1 <$> gAdvanceStage pxy s r
-  gAdvanceStage pxy s (L1 l) = L1 <$> gAdvanceStage pxy s l
+  gAdvanceStage pxy ant s (R1 r) = R1 <$> gAdvanceStage pxy ant s r
+  gAdvanceStage pxy ant s (L1 l) = L1 <$> gAdvanceStage pxy ant s l
 
 -- | 'GAdvanceStage' instance for product types (':*:'). This handles cases
 --   where the generic representation of a type is a product (i.e., a tuple of
@@ -400,8 +406,8 @@ instance
   (Monad m, GAdvanceStage stage s m l1 l2, GAdvanceStage stage s m r1 r2) =>
   GAdvanceStage stage s m (l1 :*: r1) (l2 :*: r2)
   where
-  gAdvanceStage pxy s (l :*: r) =
-    (:*:) <$> gAdvanceStage pxy s l <*> gAdvanceStage pxy s r
+  gAdvanceStage pxy ant s (l :*: r) =
+    (:*:) <$> gAdvanceStage pxy ant s l <*> gAdvanceStage pxy ant s r
 
 -- | 'GAdvanceStage' instance for record fields ('Rec0') containing a single
 --   AST element ('t') to be advanced. This instance covers the case where the
@@ -419,7 +425,7 @@ instance
   ) =>
   GAdvanceStage stage s m (Rec0 (t' stage f a)) (Rec0 (t' stage' f a))
   where
-  gAdvanceStage _ st (K1 val) = K1 <$> advanceStage st val
+  gAdvanceStage _ _ st (K1 val) = K1 <$> advanceStage st val
 
 -- | 'GAdvanceStage' instance for record fields ('Rec0') containing a functor
 --   ('func') of AST elements ('t'). This handles cases where the field is a
@@ -438,7 +444,7 @@ instance
   ) =>
   GAdvanceStage stage s m (Rec0 (func (t' stage f a))) (Rec0 (func (t' stage' f a)))
   where
-  gAdvanceStage _ st (K1 val) = K1 <$> mapM (advanceStage st) val
+  gAdvanceStage _ _ st (K1 val) = K1 <$> mapM (advanceStage st) val
 
 -- | 'GAdvanceStage' instance for record fields ('Rec0') containing a
 --   functor ('f') wrapping an AST element. This handles cases where the field
@@ -456,14 +462,14 @@ instance
   ) =>
   GAdvanceStage stage s m (Rec0 (f (t' stage f a))) (Rec0 (f (t' stage' f a)))
   where
-  gAdvanceStage _ st (K1 val) = K1 <$> mapM (advanceStage st) val
+  gAdvanceStage _ _ st (K1 val) = K1 <$> mapM (advanceStage st) val
 
 -- | 'GAdvanceStage' instance for simple record fields ('Rec0') that do not
 --   need to change between stages. This is used for fields that are not AST
 --   nodes and remain the same when advancing the stage (e.g., primitive
 --   types like 'Int', 'Bool', etc.).
 instance (Monad m) => GAdvanceStage stage s m (Rec0 a) (Rec0 a) where
-  gAdvanceStage _ _ (K1 val) = return (K1 val)
+  gAdvanceStage _ _ _ (K1 val) = return (K1 val)
 
 -- | 'GAdvanceStage' instance for records which can be converted to eathother
 -- for the current stage..
@@ -475,4 +481,4 @@ instance
   ) =>
   GAdvanceStage stage s m (Rec0 a) (Rec0 b)
   where
-  gAdvanceStage pxy s (K1 val) = K1 <$> convertInStage pxy s val
+  gAdvanceStage pxy ant s (K1 val) = K1 <$> convertInStage pxy ant s val
diff --git a/src/Language/Fiddle/Ast/Internal/MetaTypes.hs b/src/Language/Fiddle/Ast/Internal/MetaTypes.hs
new file mode 100644
index 0000000..7e5e9da
--- /dev/null
+++ b/src/Language/Fiddle/Ast/Internal/MetaTypes.hs
@@ -0,0 +1,152 @@
+-- | This module provides various types and typeclasses useful for
+-- type-level meta-programming on the AST (Abstract Syntax Tree).
+-- These types enable conditional compilation and transformations
+-- based on type-level booleans, typically reflecting different stages
+-- of the compilation pipeline.
+module Language.Fiddle.Ast.Internal.MetaTypes
+  ( When (..), -- Conditional type based on a type-level boolean
+    Witness (..), -- Type constructible if a condition holds
+    IsIdentity (..), -- Typeclass for unwrapping values from certain functors
+    toMaybe, -- Function for converting a 'When' to a 'Maybe'
+    module X, -- Re-exporting some commonly used modules
+    Guaranteed(..),
+    guarantee,
+  )
+where
+
+import Data.Functor.Identity as X
+import Data.List.NonEmpty as X (NonEmpty (..))
+import Data.Maybe (fromMaybe)
+
+-- | 'IsMaybe' is a typeclass for converting a general functor into a Maybe.
+class IsMaybe f where
+  toMaybe :: f a -> Maybe a
+
+-- | 'IsIdentity' is a typeclass for extracting a value from
+-- a functor that guarantees to contain something.
+--
+-- This is used to abstract over different functors where
+-- the wrapped value can always be accessed directly.
+class (Functor f) => IsIdentity f where
+  unwrap :: f a -> a
+  wrap :: a -> f a
+
+-- | An instance of 'IsIdentity' for 'Identity', which simply
+-- unwraps the contained value using 'runIdentity'.
+instance IsIdentity Identity where
+  unwrap = runIdentity
+  wrap = Identity
+
+-- | An instance of 'IsIdentity' for 'NonEmpty', which unwraps
+-- the first element of the non-empty list.
+instance IsIdentity NonEmpty where
+  unwrap (a :| _) = a
+  wrap = (:|[])
+
+-- | 'Witness' is a type that can only be constructed if the
+-- type-level condition 's' is 'True'. It serves as a proof
+-- that the condition holds.
+--
+-- This is typically used for enabling or disabling parts of
+-- the syntax tree based on type-level booleans (e.g., a compilation stage).
+data Witness (s :: Bool) where
+  Witness :: Witness True
+
+-- | 'When' is a type that either holds nothing (if the type-level
+-- condition 's' is 'False') or contains a value of type 't' (if 's' is 'True').
+--
+-- This type is useful for representing optional values at the type level,
+-- where the presence of a value is determined by a type-level boolean.
+data When (s :: Bool) t where
+  Vacant :: When False t -- No value present
+  Present :: t -> When True t -- Value is present
+
+-- | Instance for converting a 'When' type to a 'Maybe', erasing type-level
+-- information about the presence of the value.
+instance IsMaybe (When s) where
+  toMaybe (Present t) = Just t
+  toMaybe _ = Nothing
+
+-- | 'Functor' instance for 'When'. If 'When' is 'Present', the function
+-- is applied to the value; otherwise, the result is 'Vacant'.
+instance Functor (When s) where
+  fmap _ Vacant = Vacant
+  fmap fn (Present t) = Present (fn t)
+
+-- | 'Semigroup' instance for 'When'. If both operands are 'Present',
+-- their values are combined using the 'Semigroup' instance of 't'.
+-- If both are 'Vacant', the result is 'Vacant'.
+instance (Semigroup t) => Semigroup (When s t) where
+  (<>) (Present t) (Present u) = Present (t <> u)
+  (<>) Vacant Vacant = Vacant
+
+-- | 'Foldable' instance for 'When'. If 'When' is 'Present', the
+-- contained value is folded using the provided function; otherwise,
+-- the result is 'mempty'.
+instance Foldable (When s) where
+  foldMap _ Vacant = mempty
+  foldMap fn (Present t) = fn t
+
+-- | 'Traversable' instance for 'When'. If 'When' is 'Present', the
+-- function is applied to the contained value, wrapped in an applicative;
+-- otherwise, the result is 'pure Vacant'.
+instance Traversable (When s) where
+  traverse _ Vacant = pure Vacant
+  traverse fn (Present t) = Present <$> fn t
+
+-- | 'IsIdentity' instance for 'When True', which allows unwrapping the
+-- contained value when the type-level condition is 'True'.
+instance IsIdentity (When True) where
+  unwrap (Present t) = t
+  wrap = Present
+
+-- | 'Guaranteed' is a type that represents a value of type 't' that may or may
+--   not be present, depending on the type-level boolean 's'. When 's' is 'False',
+--   the value is optional and represented by a 'Maybe'. When 's' is 'True', the
+--   value is guaranteed to be present.
+--
+--   This type is useful for expressing conditions where a value is required to
+--   exist only when certain compile-time conditions are met. It allows encoding
+--   optionality at the type level and transitioning from a potentially missing
+--   value to a guaranteed value based on type-level information.
+data Guaranteed (s :: Bool) t where
+  -- | Represents a potentially absent value when the condition 's' is 'False'.
+  --   The value is wrapped in a 'Maybe', indicating that it may be 'Nothing'.
+  Perhaps :: Maybe t -> Guaranteed False t
+  -- | Represents a guaranteed value of type 't' when the condition 's' is 'True'.
+  --   In this case, the value is always present, and thus 't' is not wrapped
+  --   in a 'Maybe'.
+  Guaranteed :: t -> Guaranteed True t
+
+guarantee :: t -> Guaranteed s t -> Guaranteed True t
+guarantee v = Guaranteed . fromMaybe v . toMaybe
+
+instance Functor (Guaranteed s) where
+  fmap _ (Perhaps Nothing) = Perhaps Nothing
+  fmap f (Perhaps (Just t)) = Perhaps (Just (f t))
+  fmap f (Guaranteed t) = Guaranteed (f t)
+
+instance Foldable (Guaranteed s) where
+  foldMap f (Perhaps m) = foldMap f m
+  foldMap f (Guaranteed t) = f t
+
+  foldr f acc (Perhaps m) = foldr f acc m
+  foldr f acc (Guaranteed t) = f t acc
+
+instance Traversable (Guaranteed s) where
+  traverse f (Perhaps m) = Perhaps <$> traverse f m
+  traverse f (Guaranteed t) = Guaranteed <$> f t
+
+instance (Semigroup t) => Semigroup (Guaranteed s t) where
+  (Perhaps a) <> (Perhaps b) = Perhaps (a <> b)
+  (Guaranteed t) <> (Guaranteed u) = Guaranteed (t <> u)
+
+instance IsMaybe (Guaranteed s) where
+  toMaybe (Perhaps m) = m
+  toMaybe (Guaranteed t) = Just t
+
+-- | 'IsIdentity' instance for 'Guaranteed True' to allow unwrapping the value
+--   when it is guaranteed to be present.
+instance IsIdentity (Guaranteed True) where
+  unwrap (Guaranteed t) = t
+  wrap = Guaranteed
diff --git a/src/Language/Fiddle/Ast/Internal/Stage.hs b/src/Language/Fiddle/Ast/Internal/Stage.hs
index 985dfae..65459a0 100644
--- a/src/Language/Fiddle/Ast/Internal/Stage.hs
+++ b/src/Language/Fiddle/Ast/Internal/Stage.hs
@@ -3,11 +3,13 @@
 {-# LANGUAGE IncoherentInstances #-}
 {-# LANGUAGE TypeOperators #-}
 {-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE StandaloneKindSignatures #-}
 
 module Language.Fiddle.Ast.Internal.Stage where
 
 import Data.Type.Equality
 import Data.Typeable
+import Data.Type.Bool
 import GHC.TypeLits
 
 -- | Represents the different stages of the compilation process.
@@ -40,15 +42,20 @@ type family StageToNumber (s :: Stage) :: Natural where
 type StagePreceeds stage1 stage2 =
   (CmpStage stage1 stage2 == LT)
 
-type (<) a b = StagePreceeds a b
+type (.<) a b = StagePreceeds a b
+type (.<=) a b = StagePreceeds a b || (a == b)
+
 
 -- | A type-level constraint that checks if one compilation stage succeeds another.
 --   Similar to 'StagePreceeds', it compares the numeric values of stages.
 --   Returns 'True' if 'stage1' comes after 'stage2'.
 type StageSucceeds stage1 stage2 =
-  (CmpStage stage1 stage2 == LT)
+  (CmpStage stage1 stage2 == GT)
+
+type (.>) a b = StageSucceeds a b
 
-type (>) a b = StageSucceeds a b
+type (.>=) :: Stage -> Stage -> Bool
+type (.>=) a b = StageSucceeds a b || (a == b)
 
 -- | A type-level function that compares two stages and returns a comparison
 --   result ('LT', 'EQ', or 'GT'). This function is a generalized way to compare
diff --git a/src/Language/Fiddle/Ast/Internal/SyntaxTree.hs b/src/Language/Fiddle/Ast/Internal/SyntaxTree.hs
index 9566ab5..66b8e42 100644
--- a/src/Language/Fiddle/Ast/Internal/SyntaxTree.hs
+++ b/src/Language/Fiddle/Ast/Internal/SyntaxTree.hs
@@ -9,7 +9,6 @@
 module Language.Fiddle.Ast.Internal.SyntaxTree
   ( -- Type Families
     NumberType,
-    ImportInterface,
     FiddleUnitInterface,
     QualificationMetadata,
     CommonQualificationData (..),
@@ -64,7 +63,11 @@ import GHC.Generics
 import Language.Fiddle.Ast.Internal.Instances
 import Language.Fiddle.Ast.Internal.Kinds
 import Language.Fiddle.Ast.Internal.Stage
+import Language.Fiddle.Ast.Internal.MetaTypes
 import Language.Fiddle.Internal.UnitInterface
+import Data.Type.Equality
+import GHC.TypeError as TypeError
+import GHC.TypeLits
 
 -- | Common data for each qualified element.
 newtype CommonQualificationData
@@ -80,37 +83,24 @@ type BitsOffset stage = RegisterOffset stage
 -- stage, which will attach the appropriate offset to the register. This helps
 -- backends so they don't have to recalculate this offset.
 type family RegisterOffset stage where
-  RegisterOffset stage = If (stage < Checked) () Word32
+  RegisterOffset stage = If (stage .< Checked) () Word32
 
 -- | Type which stores metadata after qualification. Before qualification, this
 -- metadata has not been calculated and so is unset.
 type family QualificationMetadata stage t where
   QualificationMetadata stage t =
-    If (stage < Qualified) () t
+    If (stage .< Qualified) () t
 
 -- | The type attached to import statements which describe the imported file's
 -- unit interface
 type family FiddleUnitInterface (s :: Stage) :: Type where
-  FiddleUnitInterface s = If (s < Checked) () UnitInterface
+  FiddleUnitInterface s = If (s .< Checked) () UnitInterface
 
 -- | The Type of number during each stage of compilation. When in the first stage,
 -- numbers are just strings like anything else. In later stages, numbers get
 -- parsed into actual integers. This makes it easier to process later.
 type family NumberType (a :: Stage) :: Type where
-  NumberType s = If (s < Expanded) Text Integer
-
--- | The type used for ImportInterfaces attached to ImportStatements. Before import
--- resolution, this type is just '()', but when imports are resolved, it turns
--- into a 'UnitInterface'.
-type family ImportInterface (stage :: Stage) :: Type where
-  ImportInterface s = If (s < ImportsResolved) () UnitInterface
-
--- | A type which is only constructible if the type-level condition 's' holds.
---
--- This type is used as a way to enable/disable parts of the syntax tree based
--- on type level booleans (typically incorporating the compilation 'stage') 
-data Witness (s :: Bool) where
-  Witness :: Witness True
+  NumberType s = If (s .< Expanded) Text Integer
 
 -- A Name is multiple identifiers separated by dots. It's the way of namespaces
 -- to different packages.
@@ -249,7 +239,7 @@ data FiddleUnit (stage :: Stage) (f :: Type -> Type) a where
   FiddleUnit ::
     { -- | The interface for this FiddleUnit. Early on, this is just () because
       -- not enough information is provided to determine the interface..
-      fiddleUnitInterface :: FiddleUnitInterface stage,
+      fiddleUnitInterface :: When (stage == Checked) UnitInterface,
       -- | List of declarations.
       fiddleDecls :: [Directed FiddleDecl stage f a],
       -- | Annotation for the 'FiddleUnit'.
@@ -294,7 +284,7 @@ data ImportStatement stage f a where
       importPath :: Text,
       -- | Optional list of imported items.
       importList :: Maybe (ImportList f a),
-      importInterface :: ImportInterface stage,
+      importInterface :: When (stage .>= ImportsResolved) UnitInterface,
       -- | Annotation for the import statement.
       importStatementAnnot :: a
     } ->
@@ -433,7 +423,7 @@ data ObjType stage f a where
   -- | An anonymous object type, allowed only in Parsed.
   AnonymousObjType ::
     { -- | Witness for stage constraint.
-      disableAnonymousTypesAfterExpansion :: Witness (stage < Expanded),
+      disableAnonymousTypesAfterExpansion :: Witness (stage .< Expanded),
       -- | The body of the anonymous type.
       anonBody :: f (ObjTypeBody stage f a),
       -- | Annotation for the anonymous type.
@@ -467,7 +457,7 @@ data ObjTypeDecl stage f a where
   -- | An assertion statement for a specific position.
   AssertPosStatement ::
     { -- | Witness for stage constraint.
-      disableAssertStatementsAfterConsistencyCheck :: Witness (stage < Checked),
+      disableAssertStatementsAfterConsistencyCheck :: Witness (stage .< Checked),
       -- | The expression for the assertion.
       assertExpr :: Expression stage f a,
       -- | Annotation for the assertion.
@@ -629,7 +619,7 @@ data RegisterBitsTypeRef stage f a where
   -- | An anonymous type for register bits, used in Parsed.
   RegisterBitsAnonymousType ::
     { -- | Witness for stage constraint.
-      disableAnonymousBitsAfterExpansion :: Witness (stage < Expanded),
+      disableAnonymousBitsAfterExpansion :: Witness (stage .< Expanded),
       -- | The anonymous type.
       anonBitsType :: AnonymousBitsType stage f a,
       -- | Annotation for the anonymous type.
diff --git a/src/Language/Fiddle/Compiler/ConsistencyCheck.hs b/src/Language/Fiddle/Compiler/ConsistencyCheck.hs
index 903e6f4..a4f252e 100644
--- a/src/Language/Fiddle/Compiler/ConsistencyCheck.hs
+++ b/src/Language/Fiddle/Compiler/ConsistencyCheck.hs
@@ -77,7 +77,7 @@ deriving instance AdvanceStage S FiddleDecl
 
 instance AdvanceStage S FiddleUnit where
   advanceStage () fu@(FiddleUnit _ decls a) =
-    FiddleUnit (getUnitInterface fu) <$> mapM (advanceStage ()) decls <*> pure a
+    FiddleUnit (Present $ getUnitInterface fu) <$> mapM (advanceStage ()) decls <*> pure a
     where
       getUnitInterface = execWriter . walk_ doWalk
 
@@ -102,7 +102,7 @@ instance AdvanceStage S FiddleUnit where
                 tell (UnitInterface.singleton d)
             | (Just (ImportStatement {importInterface = ii})) <-
                 castTS t ->
-                tell (UnitInterface mempty (dependencies ii))
+                tell (UnitInterface mempty (dependencies (unwrap ii)))
           _ -> return ()
 
       castTS ::
diff --git a/src/Language/Fiddle/Compiler/Expansion.hs b/src/Language/Fiddle/Compiler/Expansion.hs
index 19b7323..935d8ee 100644
--- a/src/Language/Fiddle/Compiler/Expansion.hs
+++ b/src/Language/Fiddle/Compiler/Expansion.hs
@@ -105,8 +105,8 @@ instance AdvanceStage CurrentStage FiddleDecl where
         _ -> id
 
 instance AdvanceStage CurrentStage FiddleUnit where
-  advanceStage path (FiddleUnit _ decls a) =
-    FiddleUnit () <$> reconfigureFiddleDecls path decls <*> pure a
+  advanceStage path (FiddleUnit v decls a) =
+    FiddleUnit v <$> reconfigureFiddleDecls path decls <*> pure a
 
 instance AdvanceStage CurrentStage Expression where
   advanceStage _ = \case
diff --git a/src/Language/Fiddle/Compiler/ImportResolution.hs b/src/Language/Fiddle/Compiler/ImportResolution.hs
index 6ecfc86..2249714 100644
--- a/src/Language/Fiddle/Compiler/ImportResolution.hs
+++ b/src/Language/Fiddle/Compiler/ImportResolution.hs
@@ -148,7 +148,7 @@ instance AdvanceStage CurrentStage ImportStatement where
         when (isNothing val) markFatal
         return $ fromMaybe empty val
 
-    return $ ImportStatement path list v a
+    return $ ImportStatement path list (Present v) a
 
 getImportResolutionState ::
   ( FilePath ->
@@ -210,7 +210,7 @@ getImportResolutionState parseFile compileToChecked flags unit = do
 
       let doFullCompile = do
             parsed <- bump (parseFile path)
-            unitInterface <- addDependency path . fiddleUnitInterface <$> bump (compileToChecked parsed)
+            unitInterface <- addDependency path . unwrap . fiddleUnitInterface <$> bump (compileToChecked parsed)
             lift2 $ writeInterfaceFile intf unitInterface
             return unitInterface
 
diff --git a/src/Language/Fiddle/Compiler/Qualification.hs b/src/Language/Fiddle/Compiler/Qualification.hs
index 7eea141..a39e5dc 100644
--- a/src/Language/Fiddle/Compiler/Qualification.hs
+++ b/src/Language/Fiddle/Compiler/Qualification.hs
@@ -117,8 +117,8 @@ instance AdvanceStage S PackageBody where
     PackageBody <$> advanceFiddleDecls localState decls <*> pure a
 
 instance AdvanceStage S FiddleUnit where
-  advanceStage localState (FiddleUnit () decls a) =
-    FiddleUnit () <$> advanceFiddleDecls localState decls <*> pure a
+  advanceStage localState (FiddleUnit v decls a) =
+    FiddleUnit v <$> advanceFiddleDecls localState decls <*> pure a
 
 modifyEphemeralScope ::
   ( Scope String (Metadata, ExportedDecl) -> Scope String (Metadata, ExportedDecl)
@@ -200,7 +200,7 @@ advanceFiddleDecls localState decls = fmap (reverse . fst) $ do
                     return (declsRet, modifyCurrentScopePath (addUsingPath (nameToList name)) localState')
                   OptionDecl key value ann -> doReturn $ OptionDecl key value ann
                   ImportDecl st@(ImportStatement {importInterface = interface}) a ->
-                    let localState'' = modifyEphemeralScope (<> rootScope interface) localState'
+                    let localState'' = modifyEphemeralScope (<> rootScope (unwrap interface)) localState'
                      in doReturnWith localState''
                           =<< ImportDecl
                             <$> advanceStage localState'' st
diff --git a/src/Language/Fiddle/GenericTree.hs b/src/Language/Fiddle/GenericTree.hs
index e83a2b4..694b3ab 100644
--- a/src/Language/Fiddle/GenericTree.hs
+++ b/src/Language/Fiddle/GenericTree.hs
@@ -32,7 +32,6 @@ type Context stage =
     Typeable stage,
     ToJSON (NumberType stage),
     ToJSON (RegisterOffset stage),
-    ToJSON (ImportInterface stage),
     ToJSON (FiddleUnitInterface stage),
     ToJSON (QualificationMetadata stage ()),
     ToJSON (QualificationMetadata stage ExportedPackageDecl),
@@ -220,6 +219,10 @@ instance
 instance (GToGenericSyntaxTree r f a) => (GToGenericSyntaxTree (M1 i c r) f a) where
   gToGenericSyntaxTree t (M1 r) = gToGenericSyntaxTree t r
 
+instance (ToJSON t) => ToJSON (When s t) where
+  toJSON (Present t) = toJSON t
+  toJSON _ = toJSON ()
+
 -- deriving instance (ToGenericSyntaxTree (Test stage))
 
 deriving instance (ToGenericSyntaxTree Identifier)
diff --git a/src/Language/Fiddle/Parser.hs b/src/Language/Fiddle/Parser.hs
index b3eed63..f3cbfee 100644
--- a/src/Language/Fiddle/Parser.hs
+++ b/src/Language/Fiddle/Parser.hs
@@ -10,7 +10,6 @@ where
 import Control.Monad (void)
 import Data.Functor.Identity
 import Data.Kind (Type)
-import Data.List.NonEmpty (NonEmpty (..))
 import Data.Text (Text)
 import Language.Fiddle.Ast
 import Language.Fiddle.Tokenizer
@@ -106,7 +105,7 @@ directiveExpressionP = withMeta $ do
 fiddleUnit :: Pa FiddleUnit
 fiddleUnit = do
   withMeta
-    ( FiddleUnit () <$> many1 (directedP fiddleDeclP <* tok TokSemi)
+    ( FiddleUnit Vacant <$> many1 (directedP fiddleDeclP <* tok TokSemi)
     )
     <* many commentP
 
@@ -128,7 +127,10 @@ importListP = withMeta $ do
 importStatementP :: Pa ImportStatement
 importStatementP =
   withMeta $
-    ImportStatement <$> stringTokenP <*> optionMaybe importListP <*> pure ()
+    ImportStatement
+      <$> stringTokenP
+      <*> optionMaybe importListP
+      <*> pure Vacant
 
 fiddleDeclP :: Pa FiddleDecl
 fiddleDeclP = do