File holds a Reference.

semantic-analysis/src/Analysis/Blob.hs

@@ -8,7 +8,8 @@ module Analysis.Blob
   , nullBlob
   ) where
 
-import           Analysis.File
+import           Analysis.File as A
+import           Analysis.Reference as A
 import           Data.Aeson
 import           Source.Language as Language
 import           Source.Source as Source
@@ -34,13 +35,13 @@ instance FromJSON Blob where
 -- The resulting Blob's span is taken from the 'totalSpan' of the source.
 fromSource :: Path.PartClass.AbsRel ar => Path.File ar -> Language -> Source -> Blob
 fromSource filepath language source
-  = Blob source (Analysis.File.File (Path.toAbsRel filepath) (totalSpan source) language)
+  = Blob source (A.File (A.Reference (Path.toAbsRel filepath) (totalSpan source)) language)
 
 blobLanguage :: Blob -> Language
-blobLanguage = Analysis.File.fileBody . blobFile
+blobLanguage = A.fileBody . blobFile
 
 blobPath :: Blob -> Path.AbsRelFile
-blobPath = Analysis.File.filePath . blobFile
+blobPath = A.refPath . A.fileRef . blobFile
 
 -- | Show FilePath for error or json outputs.
 blobFilePath :: Blob -> String

semantic-analysis/src/Analysis/Concrete.hs

@@ -148,7 +148,7 @@ runFile
   -> File term
   -> m (File (Either (Reference, String) Concrete))
 runFile eval file = traverse run file
-  where run = runReader (Reference (filePath file) (fileSpan file))
+  where run = runReader (fileRef file)
             . runFail
             . runReader @Env mempty
             . A.runEnv

semantic-analysis/src/Analysis/File.hs

@@ -1,11 +1,15 @@
 {-# LANGUAGE DeriveTraversable #-}
 module Analysis.File
-( File(..)
+( -- * Files
-, fileLanguage
+  File(..)
+  -- * Constructors
 , fromBody
 , fromPath
+  -- * Eliminators
+, fileLanguage
 ) where
 
+import qualified Analysis.Reference as A
 import           Data.Maybe (fromJust, listToMaybe)
 import           GHC.Stack
 import           Source.Language as Language
@@ -13,20 +17,27 @@ import           Source.Span
 import qualified System.Path as Path
 import qualified System.Path.PartClass as Path.PartClass
 
+-- Files
+
 data File a = File
-  { filePath :: !Path.AbsRelFile
+  { fileRef  :: !A.Reference
-  , fileSpan :: Span
   , fileBody :: !a
   }
   deriving (Eq, Foldable, Functor, Ord, Show, Traversable)
 
+
+-- Constructors
+
 fromBody :: HasCallStack => a -> File a
-fromBody body = File (Path.absRel (srcLocFile srcLoc)) (spanFromSrcLoc srcLoc) body where
+fromBody body = File (A.Reference (Path.absRel (srcLocFile srcLoc)) (spanFromSrcLoc srcLoc)) body where
   srcLoc = snd (fromJust (listToMaybe (getCallStack callStack)))
 
+fromPath :: Path.PartClass.AbsRel ar => Path.File ar -> File Language
+fromPath p = File (A.fromPath p) (Language.forPath p)
+
+
+-- Eliminators
+
 -- | The language of the provided file, as inferred by 'Language.forPath'.
 fileLanguage :: File a -> Language
-fileLanguage = Language.forPath . filePath
+fileLanguage = Language.forPath . A.refPath . fileRef
-
-fromPath :: Path.PartClass.AbsRel ar => Path.File ar -> File Language
-fromPath p = File (Path.toAbsRel p) (point (Pos 0 0)) (Language.forPath p)

semantic-analysis/src/Analysis/Reference.hs

@@ -1,10 +1,13 @@
 module Analysis.Reference
 ( -- * Reference
   Reference(..)
+  -- * Constructors
+, fromPath
 ) where
 
 import Source.Span
 import System.Path as Path
+import System.Path.PartClass as Path.PartClass
 
 -- Reference
 
@@ -14,3 +17,9 @@ data Reference = Reference
   }
   deriving (Eq, Ord, Show)
 -- FIXME: add this to some sort of static context carried in analyses
+
+
+-- Constructors
+
+fromPath :: Path.PartClass.AbsRel ar => Path.File ar -> Reference
+fromPath p = Reference (Path.toAbsRel p) (point (Pos 0 0))

semantic-analysis/src/Analysis/Typecheck.hs

@@ -148,7 +148,7 @@ runFile eval file = traverse run file
               modify @(Heap Type) (fmap (Set.map (substAll subst)))
               pure (substAll subst <$> t))
           . runState @Substitution mempty
-          . runReader (Reference (filePath file) (fileSpan file))
+          . runReader (fileRef file)
           . runEnv
           . runFail
           . (\ m -> do