1 files changed, 53 insertions, 7 deletions

diff --git a/src/Language/Fiddle/Internal/UnitInterface.hs b/src/Language/Fiddle/Internal/UnitInterface.hs
index 42ce810..1302e40 100644
--- a/src/Language/Fiddle/Internal/UnitInterface.hs
+++ b/src/Language/Fiddle/Internal/UnitInterface.hs
@@ -1,14 +1,20 @@
+{-# LANGUAGE DeriveFoldable #-}
+{-# LANGUAGE DeriveTraversable #-}
+
 module Language.Fiddle.Internal.UnitInterface where
 
 import Data.Aeson
+import Data.List (intercalate)
 import Data.List.NonEmpty (NonEmpty)
-import Data.Text
+import qualified Data.List.NonEmpty as NonEmpty
+import Data.Maybe (fromMaybe, maybeToList)
+import qualified Data.Text
 import Data.Word
 import GHC.Generics
 import Language.Fiddle.Internal.Scopes (Scope)
 import qualified Language.Fiddle.Internal.Scopes as Scopes
-import Language.Fiddle.Types (SourceSpan)
 import Language.Fiddle.Internal.UnitNumbers
+import Language.Fiddle.Types (SourceSpan)
 
 data InternalDirectiveExpression
   = InternalDirectiveExpressionNumber String
@@ -31,16 +37,45 @@ data InternalDirective = InternalDirective
   }
   deriving (Generic, ToJSON, FromJSON, Show, Eq, Ord)
 
+data QualifiedPath a = QualifiedPath
+  { -- | The part of the qualified path that belongs to the package.
+    packagePart :: [String],
+    -- | The part of the qualified path that belongs to the object.
+    objectPart :: Maybe String,
+    -- | The part of the qualified path that belongs to a register.
+    registerPart :: [String],
+    -- | The basename (unqualified path)
+    basenamePart :: a
+  }
+  deriving (Generic, ToJSON, FromJSON, Show, Eq, Ord, Functor)
+
+qualifiedPathToString :: String -> String -> QualifiedPath String -> String
+qualifiedPathToString majorSeparator minorSeparator qp =
+  intercalate majorSeparator $
+    map (intercalate minorSeparator) $
+      filter
+        (not . null)
+        [ packagePart qp,
+          maybeToList (objectPart qp),
+          registerPart qp,
+          [basenamePart qp]
+        ]
+
+-- | Turn a QualifiedPath with a string to a String list for scope lookups.
+qualifiedPathToList :: QualifiedPath String -> NonEmpty String
+qualifiedPathToList (QualifiedPath package obj reg base) =
+  NonEmpty.prependList (package ++ maybeToList obj ++ reg) (NonEmpty.singleton base)
+
 -- | Metadata about an exported value. This includes things like the source
 -- location, doc comments and compiler directives associated with the exported
 -- symbol.
 data Metadata = Metadata
   { -- | Fully-qualified path the the element.
-    metadataFullyQualifiedPath :: NonEmpty String,
+    metadataFullyQualifiedPath :: QualifiedPath String,
     -- | Source location for the exported symbol.
     metadataSourceSpan :: SourceSpan,
     -- | Doc comment associated with the symbol.
-    metadataDocComment :: Text,
+    metadataDocComment :: Data.Text.Text,
     -- | List of directives associated with this exported symbol.
     metadataDirectives :: [InternalDirective]
   }
@@ -61,12 +96,12 @@ data UnitInterface where
 insert :: (ExportableDecl d) => d -> UnitInterface -> UnitInterface
 insert decl (UnitInterface sc deps) =
   let metadata = getMetadata decl
-      path = metadataFullyQualifiedPath metadata
+      path = qualifiedPathToList (metadataFullyQualifiedPath metadata)
    in UnitInterface (Scopes.insertScope path (metadata, toExportedDecl decl) sc) deps
 
 singleton :: (ExportableDecl d) => d -> UnitInterface
 singleton decl =
-  let path = metadataFullyQualifiedPath (getMetadata decl)
+  let path = qualifiedPathToList (metadataFullyQualifiedPath (getMetadata decl))
       metadata = getMetadata decl
    in UnitInterface (Scopes.singleton path (metadata, toExportedDecl decl)) []
 
@@ -125,7 +160,7 @@ data ExportedTypeDecl where
 
 data ReferencedObjectType where
   ReferencedObjectType ::
-    {objectTypeReference :: NonEmpty String} -> ReferencedObjectType
+    {objectTypeReference :: QualifiedPath String} -> ReferencedObjectType
   ArrayObjectType ::
     { arrayObjectTypeType :: ReferencedObjectType,
       arrayObjectTypeNumber :: N Unitless
@@ -192,6 +227,17 @@ instance ExportableDecl ExportedObjectDecl where
     _ -> Nothing
   getMetadata = exportedObjectDeclMetadata
 
+instance ExportableDecl ExportedDecl where
+  toExportedDecl = id
+  fromExportedDecl = Just
+  getMetadata =
+    \case
+      ExportedPackage e -> getMetadata e
+      ExportedLocation e -> getMetadata e
+      ExportedBits e -> getMetadata e
+      ExportedType e -> getMetadata e
+      ExportedObject e -> getMetadata e
+
 -- | A generalized representation of different exported declarations.
 -- This data type allows for a uniform way to handle various exportable
 -- syntax tree elements (e.g., packages, locations, bits, types, objects).