Replace all the qualification metadata with 'When (s .>= Qualified)'

This makes deriving much easier and cleans up the messy contexts in
GenericTree and elsewhere at the cost of slightly more obtuse syntax.

1 files changed, 14 insertions, 33 deletions

diff --git a/src/Language/Fiddle/Ast/Internal/SyntaxTree.hs b/src/Language/Fiddle/Ast/Internal/SyntaxTree.hs
index 66b8e42..6f67149 100644
--- a/src/Language/Fiddle/Ast/Internal/SyntaxTree.hs
+++ b/src/Language/Fiddle/Ast/Internal/SyntaxTree.hs
@@ -3,17 +3,16 @@
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE IncoherentInstances #-}
+{-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE TypeOperators #-}
 {-# LANGUAGE UndecidableInstances #-}
 
 module Language.Fiddle.Ast.Internal.SyntaxTree
   ( -- Type Families
     NumberType,
-    FiddleUnitInterface,
-    QualificationMetadata,
-    CommonQualificationData (..),
     RegisterOffset,
     BitsOffset,
+    QMd (..),
     -- Witness Types
     Witness (..),
     -- AST Types
@@ -53,29 +52,22 @@ module Language.Fiddle.Ast.Internal.SyntaxTree
 where
 
 import Control.Monad (forM_)
+import Data.Aeson (ToJSON (..))
 import Data.Kind (Type)
 import Data.List.NonEmpty hiding (map)
 import Data.Text (Text)
 import Data.Type.Bool
+import Data.Type.Equality
 import Data.Typeable
 import Data.Word (Word32)
 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.Ast.Internal.Stage
 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
-  = CommonQualificationData
-  { -- The fully qualified path to this qualified element.
-    fullyQualifiedPath :: [String]
-  }
-  deriving (Eq, Ord, Show)
+
+type QMd s t = When (s .>= Qualified) t
 
 type BitsOffset stage = RegisterOffset stage
 
@@ -85,17 +77,6 @@ type BitsOffset stage = RegisterOffset stage
 type family RegisterOffset stage where
   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
-
--- | 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
-
 -- | 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.
@@ -341,7 +322,7 @@ data FiddleDecl :: StagedSynTree where
   PackageDecl ::
     { -- | Qualification metadata about this package statement.
       packageQualificationMetadata ::
-        f (QualificationMetadata stage ExportedPackageDecl),
+        f (QMd stage ExportedPackageDecl),
       -- | The package name.
       packageName :: Name f a,
       -- | The body of the package.
@@ -354,7 +335,7 @@ data FiddleDecl :: StagedSynTree where
   LocationDecl ::
     { -- | qualified metadata about this location.
       locationQualificationMetadata ::
-        f (QualificationMetadata stage ExportedLocationDecl),
+        f (QMd stage ExportedLocationDecl),
       -- | The location identifier.
       locationIdent :: Identifier f a,
       -- | The associated expression.
@@ -366,7 +347,7 @@ data FiddleDecl :: StagedSynTree where
   -- | A bits declaration in the form 'bits <identifier> : <type>'.
   BitsDecl ::
     { -- | Qualification metadata about this "bits" declaration.
-      bitsQualificationMetadata :: f (QualificationMetadata stage ExportedBitsDecl),
+      bitsQualificationMetadata :: f (QMd stage ExportedBitsDecl),
       -- | The identifier of the bits.
       bitsIdent :: Identifier f a,
       -- | The type of the bits.
@@ -378,7 +359,7 @@ data FiddleDecl :: StagedSynTree where
   -- | An object type declaration.
   ObjTypeDecl ::
     { -- | Qualification metadata about this object type.
-      objTypeQualificationMetadata :: f (QualificationMetadata stage ExportedTypeDecl),
+      objTypeQualificationMetadata :: f (QMd stage ExportedTypeDecl),
       -- | The identifier of the object type.
       objTypeIdent :: Identifier f a,
       -- | The body of the object type.
@@ -390,7 +371,7 @@ data FiddleDecl :: StagedSynTree where
   -- | An object declaration in the form 'object <ident> at <expr> : <type>'.
   ObjectDecl ::
     { -- | Qualification metadata about this object.
-      objectQualificationMetadata :: f (QualificationMetadata stage ExportedObjectDecl),
+      objectQualificationMetadata :: f (QMd stage ExportedObjectDecl),
       -- | The identifier of the object.
       objectIdent :: Identifier f a,
       -- | The location expression.
@@ -442,7 +423,7 @@ data ObjType stage f a where
     ObjType stage f a
   -- | A reference to an existing type by name.
   ReferencedObjType ::
-    { refQualificationMetadata :: f (QualificationMetadata stage ExportedTypeDecl),
+    { refQualificationMetadata :: f (QMd stage ExportedTypeDecl),
       -- | The name of the referenced type.
       refName :: Name f a,
       -- | Annotation for the referenced type.
@@ -609,7 +590,7 @@ data RegisterBitsTypeRef stage f a where
   -- | A reference to another type by name.
   RegisterBitsReference ::
     { -- | Qualification metadata about this Bits reference.
-      bitsRefQualificationMetadata :: f (QualificationMetadata stage ExportedBitsDecl),
+      bitsRefQualificationMetadata :: f (QMd stage ExportedBitsDecl),
       -- | The name of the referenced type.
       bitsRefName :: Name f a,
       -- | Annotation for the reference.