Merge pull request #439 from github/tower-of-babble

Remove Data.Blob.File in favor of Analysis.File and use semantic-source’s Language type.

.github/workflows/haskell.yml

@@ -37,7 +37,7 @@ jobs:
       name: Cache ~/.cabal/store
       with:
         path: ~/.cabal/store
-        key: ${{ runner.os }}-${{ matrix.ghc }}-v4-cabal-store
+        key: ${{ runner.os }}-${{ matrix.ghc }}-v5-cabal-store
 
     - uses: actions/cache@v1
       name: Cache dist-newstyle

bench/Evaluation.hs

@@ -1,13 +1,17 @@
-{-# LANGUAGE DataKinds, FlexibleContexts, PackageImports, PartialTypeSignatures, TypeApplications, TypeFamilies #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE PackageImports #-}
+{-# LANGUAGE PartialTypeSignatures #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies #-}
 
 module Evaluation (benchmarks) where
 
 import           Control.Carrier.Parse.Simple
-import qualified Data.Duration as Duration
 import           Data.Abstract.Evaluatable
-import           Data.Blob
-import           Data.Blob.IO (readBlobFromFile')
 import           Data.Bifunctor
+import           Data.Blob.IO (readBlobFromPath)
+import qualified Data.Duration as Duration
 import           "semantic" Data.Graph (topologicalSort)
 import qualified Data.Language as Language
 import           Data.Project
@@ -18,21 +22,23 @@ import           Semantic.Config (defaultOptions)
 import           Semantic.Graph
 import           Semantic.Task (TaskSession (..), runTask, withOptions)
 import           Semantic.Util
-import qualified System.Path as Path
 import           System.Path ((</>))
+import qualified System.Path as Path
+import qualified System.Path.PartClass as Path.PartClass
 
 -- Duplicating this stuff from Util to shut off the logging
 
 callGraphProject' :: ( Language.SLanguage lang
                      , HasPrelude lang
+                     , Path.PartClass.AbsRel ar
                      )
                   => TaskSession
                   -> Proxy lang
-                  -> Path.RelFile
+                  -> Path.File ar
                   -> IO (Either String ())
 callGraphProject' session proxy path
   | Just (SomeParser parser) <- parserForLanguage analysisParsers lang = fmap (bimap show (const ())) . runTask session $ do
-  blob <- readBlobFromFile' (fileForTypedPath path)
+  blob <- readBlobFromPath (Path.toAbsRel path)
   package <- fmap snd <$> runParse (Duration.fromSeconds 10) (parsePackage parser (Project (Path.toString (Path.takeDirectory path)) [blob] lang []))
   modules <- topologicalSort <$> runImportGraphToModules proxy package
   runCallGraph proxy False modules package

bench/Tagging.hs

@@ -8,13 +8,13 @@ import           Control.Carrier.Parse.Measured
 import           Control.Carrier.Reader
 import           Control.Exception (throwIO)
 import           Control.Monad
-import           Data.Blob
 import           Data.Foldable
 import           Data.Language (LanguageMode (..), PerLanguageModes (..))
 import           Gauge
 import           System.FilePath.Glob
 import qualified System.Path as Path
 
+import qualified Analysis.File as File
 import           Data.Flag
 import           Proto.Semantic as P hiding (Blob, BlobPair)
 import           Semantic.Api.Symbols (parseSymbols)
@@ -66,7 +66,7 @@ parseSymbolsFilePath ::
   => PerLanguageModes
   -> Path.RelFile
   -> m ParseTreeSymbolResponse
-parseSymbolsFilePath languageModes path = readBlob (fileForTypedPath path) >>= runReader languageModes . parseSymbols . pure @[]
+parseSymbolsFilePath languageModes path = readBlob (File.fromPath path) >>= runReader languageModes . parseSymbols . pure @[]
 
 aLaCarteLanguageModes :: PerLanguageModes
 aLaCarteLanguageModes = PerLanguageModes

semantic-analysis/semantic-analysis.cabal

@@ -56,17 +56,22 @@ library
     Analysis.Typecheck
     Control.Carrier.Fail.WithLoc
   build-depends:
-      algebraic-graphs            ^>= 0.3
+    , aeson                       ^>= 1.4
+    , algebraic-graphs            ^>= 0.3
     , base                         >= 4.13 && < 5
     , containers                  ^>= 0.6
+    , filepath
     , fused-effects               ^>= 1.0
     , fused-effects-readline
     , fused-syntax
+    , hashable
     , haskeline                   ^>= 0.7.5
+    , lingo                       ^>= 0.3
     , pathtype                    ^>= 0.8.1
     , prettyprinter                >= 1.2 && < 2
     , prettyprinter-ansi-terminal ^>= 1.1.1
-    , semantic-source             ^>= 0.0.1
+    , semantic-source             ^>= 0.0.2
+    , semilattices
     , terminal-size               ^>= 0.3
     , text                        ^>= 1.2.3.1
     , transformers                ^>= 0.5

semantic-analysis/src/Analysis/File.hs

@@ -1,13 +1,18 @@
 {-# LANGUAGE DeriveTraversable #-}
 module Analysis.File
 ( File(..)
+, fileLanguage
 , fromBody
+, fromPath
 ) where
 
 import           Data.Maybe (fromJust, listToMaybe)
+import           Data.Semilattice.Lower
 import           GHC.Stack
+import           Source.Language as Language
 import           Source.Span
 import qualified System.Path as Path
+import qualified System.Path.PartClass as Path.PartClass
 
 data File a = File
   { filePath :: !Path.AbsRelFile
@@ -19,3 +24,10 @@ data File a = File
 fromBody :: HasCallStack => a -> File a
 fromBody body = File (Path.absRel (srcLocFile srcLoc)) (spanFromSrcLoc srcLoc) body where
   srcLoc = snd (fromJust (listToMaybe (getCallStack callStack)))
+
+-- | The language of the provided file, as inferred by 'Language.forPath'.
+fileLanguage :: File a -> Language
+fileLanguage = Language.forPath . filePath
+
+fromPath :: Path.PartClass.AbsRel ar => Path.File ar -> File Language
+fromPath p = File (Path.toAbsRel p) lowerBound (Language.forPath p)

semantic-ast/app/Main.hs

@@ -19,9 +19,9 @@ import Data.ByteString.Lazy.Char8 (putStrLn)
 import Data.Aeson.Encode.Pretty (encodePretty)
 
 data SemanticAST = SemanticAST
-  { format :: Format
+  { _format :: Format
-  , noColor  :: Bool
+  , _noColor  :: Bool
-  , source :: Either [FilePath] String
+  , _source :: Either [FilePath] String
   }
 
 -- Usage: semantic-ast --format ARG [--no-color] (--sourceString STRING | FILEPATHS…)

semantic-ast/semantic-ast.cabal

@@ -43,7 +43,7 @@ library
   -- other-extensions:
   build-depends:       base ^>= 4.13
                      , tree-sitter ^>= 0.8
-                     , semantic-source ^>= 0.0.1
+                     , semantic-source ^>= 0.0.2
                      , tree-sitter-python ^>= 0.8.1
                      , bytestring ^>= 0.10.8.2
                      , optparse-applicative >= 0.14.3 && < 0.16

semantic-ast/src/Marshal/JSON.hs

@@ -1,14 +1,14 @@
-{-# LANGUAGE DefaultSignatures #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE TypeOperators #-}
-{-# LANGUAGE TypeApplications #-}
-{-# LANGUAGE RankNTypes #-}
-{-# LANGUAGE ExistentialQuantification #-}
-{-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE DataKinds #-}
-{-# LANGUAGE TypeSynonymInstances #-}
+{-# LANGUAGE DefaultSignatures #-}
-{-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE ExistentialQuantification #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE TypeSynonymInstances #-}
 {-# LANGUAGE UndecidableInstances #-}
 
 module Marshal.JSON
@@ -17,11 +17,10 @@ module Marshal.JSON
 
 import           Data.Aeson as Aeson
 import           Data.List.NonEmpty (NonEmpty)
-import GHC.Generics
 import           Data.Text (Text)
 import qualified Data.Text as Text
+import           GHC.Generics
 
--- TODO: range and span will require a new release of semantic-source
 -- TODO: use toEncoding -- direct serialization to ByteString
 
 -- Serialize unmarshaled ASTs into JSON representation by auto-deriving Aeson instances generically

semantic-core/semantic-core.cabal

@@ -54,7 +54,7 @@ library
     , prettyprinter                >= 1.2.1 && < 2
     , prettyprinter-ansi-terminal ^>= 1.1.1
     , semantic-analysis           ^>= 0
-    , semantic-source             ^>= 0.0.1
+    , semantic-source             ^>= 0.0.2
     , text                        ^>= 1.2.3.1
     , trifecta                     >= 2 && < 2.2
     , unordered-containers        ^>= 0.2.10
@@ -69,7 +69,7 @@ test-suite test
       base
     , semantic-analysis
     , semantic-core
-    , semantic-source ^>= 0.0.1
+    , semantic-source
     , fused-effects
     , fused-syntax
     , hedgehog ^>= 1

semantic-go/semantic-go.cabal

@@ -25,7 +25,7 @@ common haskell
                      , fused-syntax
                      , parsers ^>= 0.12.10
                      , semantic-core ^>= 0.0
-                     , semantic-source ^>= 0.0.1
+                     , semantic-source ^>= 0.0.2
                      , semantic-tags ^>= 0.0
                      , text ^>= 1.2.3
                      , tree-sitter ^>= 0.8

semantic-java/semantic-java.cabal

@@ -25,7 +25,7 @@ library
   build-depends:
       base              >= 4.13 && < 5
     , fused-effects    ^>= 1.0
-    , semantic-source  ^>= 0.0.1
+    , semantic-source  ^>= 0.0.2
     , semantic-tags    ^>= 0.0
     , tree-sitter      ^>= 0.8
     , tree-sitter-java ^>= 0.6.1

semantic-python/semantic-python.cabal

@@ -25,7 +25,7 @@ common haskell
                      , fused-syntax
                      , parsers ^>= 0.12.10
                      , semantic-core ^>= 0.0
-                     , semantic-source ^>= 0.0.1
+                     , semantic-source ^>= 0.0.2
                      , semantic-tags ^>= 0.0
                      , semantic-scope-graph ^>= 0.0
                      , semilattices ^>= 0

semantic-ruby/semantic-ruby.cabal

@@ -25,7 +25,7 @@ common haskell
                      , fused-syntax
                      , parsers ^>= 0.12.10
                      , semantic-core ^>= 0.0
-                     , semantic-source ^>= 0.0.1
+                     , semantic-source ^>= 0.0.2
                      , semantic-tags ^>= 0.0
                      , text ^>= 1.2.3
                      , tree-sitter ^>= 0.8

semantic-scope-graph/semantic-scope-graph.cabal

@@ -38,7 +38,7 @@ library
     , semilattices
     , generic-monoid
     , pathtype
-    , semantic-source    ^>= 0.0
+    , semantic-source    ^>= 0.0.2
     , text               ^>= 1.2.3.1
   hs-source-dirs:      src
   default-language:    Haskell2010

semantic-tags/semantic-tags.cabal

@@ -26,7 +26,7 @@ library
   build-depends:
       base                >= 4.13 && < 5
     , fused-effects      ^>= 1.0
-    , semantic-source    ^>= 0.0.1
+    , semantic-source    ^>= 0.0.2
     , text               ^>= 1.2.3.1
   hs-source-dirs:      src
   default-language:    Haskell2010

semantic-tsx/semantic-tsx.cabal

@@ -25,7 +25,7 @@ common haskell
                      , fused-syntax
                      , parsers ^>= 0.12.10
                      , semantic-core ^>= 0.0
-                     , semantic-source ^>= 0.0.1
+                     , semantic-source ^>= 0.0.2
                      , semantic-tags ^>= 0.0
                      , text ^>= 1.2.3
                      , tree-sitter ^>= 0.8

semantic-typescript/semantic-typescript.cabal

@@ -25,7 +25,7 @@ common haskell
                      , fused-syntax
                      , parsers ^>= 0.12.10
                      , semantic-core ^>= 0.0
-                     , semantic-source ^>= 0.0.1
+                     , semantic-source ^>= 0.0.2
                      , semantic-tags ^>= 0.0
                      , text ^>= 1.2.3
                      , tree-sitter ^>= 0.8

semantic.cabal

@@ -67,7 +67,8 @@ common dependencies
                      , recursion-schemes ^>= 5.1
                      , scientific ^>= 0.3.6.2
                      , safe-exceptions ^>= 0.1.7.0
-                     , semantic-source ^>= 0.0.1
+                     , semantic-analysis
+                     , semantic-source ^>= 0.0.2
                      , semilattices ^>= 0.0.0.3
                      , streaming ^>= 0.2.2.0
                      , text ^>= 1.2.3.1

src/Data/Blob.hs

@@ -6,18 +6,14 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RecordWildCards #-}
 module Data.Blob
-( File(..)
+( Blob(..)
-, fileForPath
-, fileForTypedPath
-, Blob(..)
 , Blobs(..)
 , blobLanguage
 , NoLanguageForBlob (..)
 , blobPath
-, makeBlob
 , decodeBlobs
 , nullBlob
-, sourceBlob
+, fromSource
 , moduleForBlob
 , noLanguageForBlob
 , BlobPair
@@ -31,69 +27,51 @@ module Data.Blob
 
 import Prologue
 
+import           Analysis.File (File (..))
 import           Control.Effect.Error
 import           Data.Aeson
 import qualified Data.ByteString.Lazy as BL
 import           Data.Edit
 import           Data.JSON.Fields
-import           Data.Language
 import           Data.Module
-import           Source.Source (Source)
+import           Source.Language as Language
+import           Source.Source (Source, totalSpan)
 import qualified Source.Source as Source
 import qualified System.FilePath as FP
 import qualified System.Path as Path
 import qualified System.Path.PartClass as Path.PartClass
 
--- | A 'FilePath' paired with its corresponding 'Language'.
--- Unpacked to have the same size overhead as (FilePath, Language).
-data File = File
-  { filePath     :: FilePath
-  , fileLanguage :: Language
-  } deriving (Show, Eq)
-
--- | Prefer 'fileForTypedPath' if at all possible.
-fileForPath :: FilePath  -> File
-fileForPath p = File p (languageForFilePath p)
-
-fileForTypedPath :: Path.PartClass.AbsRel ar => Path.File ar -> File
-fileForTypedPath = fileForPath . Path.toString
-
 -- | The source, path information, and language of a file read from disk.
 data Blob = Blob
   { blobSource :: Source         -- ^ The UTF-8 encoded source text of the blob.
-  , blobFile   :: File   -- ^ Path/language information for this blob.
+  , blobFile   :: File Language  -- ^ Path/language information for this blob.
-  , blobOid    :: Text   -- ^ Git OID for this blob, mempty if blob is not from a git db.
   } deriving (Show, Eq)
 
 blobLanguage :: Blob -> Language
-blobLanguage = fileLanguage . blobFile
+blobLanguage = Analysis.File.fileBody . blobFile
 
 blobPath :: Blob -> FilePath
-blobPath = filePath . blobFile
+blobPath = Path.toString . Analysis.File.filePath . blobFile
-
-makeBlob :: Source -> FilePath -> Language -> Text -> Blob
-makeBlob s p l = Blob s (File p l)
-{-# INLINE makeBlob #-}
 
 newtype Blobs a = Blobs { blobs :: [a] }
   deriving (Generic, FromJSON)
 
 instance FromJSON Blob where
-  parseJSON = withObject "Blob" $ \b -> inferringLanguage
+  parseJSON = withObject "Blob" $ \b -> do
-    <$> b .: "content"
+    src <- b .: "content"
-    <*> b .: "path"
+    Right pth <- fmap Path.parse (b .: "path")
-    <*> b .: "language"
+    lang <- b .: "language"
+    let lang' = if knownLanguage lang then lang else Language.forPath pth
+    pure (fromSource (pth :: Path.AbsRelFile) lang' src)
 
 nullBlob :: Blob -> Bool
 nullBlob Blob{..} = Source.null blobSource
 
-sourceBlob :: FilePath -> Language -> Source -> Blob
+-- | Create a Blob from a provided path, language, and UTF-8 source.
-sourceBlob filepath language source = makeBlob source filepath language mempty
+-- The resulting Blob's span is taken from the 'totalSpan' of the source.
-
+fromSource :: Path.PartClass.AbsRel ar => Path.File ar -> Language -> Source -> Blob
-inferringLanguage :: Source -> FilePath -> Language -> Blob
+fromSource filepath language source
-inferringLanguage src pth lang
+  = Blob source (Analysis.File.File (Path.toAbsRel filepath) (totalSpan source) language)
-  | knownLanguage lang = makeBlob src pth lang mempty
-  | otherwise = makeBlob src pth (languageForFilePath pth) mempty
 
 decodeBlobs :: BL.ByteString -> Either String [Blob]
 decodeBlobs = fmap blobs <$> eitherDecode
@@ -112,7 +90,7 @@ moduleForBlob :: Maybe FilePath -- ^ The root directory relative to which the mo
               -> Module term    -- ^ A 'Module' named appropriate for the 'Blob', holding the @term@, and constructed relative to the root 'FilePath', if any.
 moduleForBlob rootDir b = Module info
   where root = fromMaybe (FP.takeDirectory (blobPath b)) rootDir
-        info = ModuleInfo (FP.makeRelative root (blobPath b)) (languageToText (blobLanguage b)) (blobOid b)
+        info = ModuleInfo (FP.makeRelative root (blobPath b)) (languageToText (blobLanguage b)) mempty
 
 -- | Represents a blobs suitable for diffing which can be either a blob to
 -- delete, a blob to insert, or a pair of blobs to diff.

src/Data/Blob/IO.hs

@@ -1,14 +1,17 @@
+{-# LANGUAGE ViewPatterns #-}
 -- | These are primitive file IO methods for use in ghci and as internal functions.
 -- Instead of using these, consider if you can use the Files DSL instead.
 module Data.Blob.IO
   ( readBlobFromFile
   , readBlobFromFile'
+  , readBlobFromPath
   , readBlobsFromDir
   , readFilePair
   ) where
 
 import Prologue
 
+import           Analysis.File as File
 import qualified Control.Concurrent.Async as Async
 import           Data.Blob
 import qualified Data.ByteString as B
@@ -18,24 +21,29 @@ import qualified Source.Source as Source
 import qualified System.Path as Path
 
 -- | Read a utf8-encoded file to a 'Blob'.
-readBlobFromFile :: MonadIO m => File -> m (Maybe Blob)
+readBlobFromFile :: MonadIO m => File Language -> m (Maybe Blob)
-readBlobFromFile (File "/dev/null" _) = pure Nothing
+readBlobFromFile (File (Path.toString -> "/dev/null") _ _) = pure Nothing
-readBlobFromFile (File path language) = do
+readBlobFromFile file@(File path _ _language) = do
-  raw <- liftIO $ B.readFile path
+  raw <- liftIO $ B.readFile (Path.toString path)
-  pure . Just . sourceBlob path language . Source.fromUTF8 $ raw
+  let newblob = Blob (Source.fromUTF8 raw) file
+  pure . Just $ newblob
 
--- | Read a utf8-encoded file to a 'Blob', raising an IOError if it can't be found.
+-- | Read a utf8-encoded file to a 'Blob', failing if it can't be found.
-readBlobFromFile' :: (MonadFail m, MonadIO m) => File -> m Blob
+readBlobFromFile' :: (MonadFail m, MonadIO m) => File Language -> m Blob
 readBlobFromFile' file = do
   maybeFile <- readBlobFromFile file
   maybeM (fail ("cannot read '" <> show file <> "', file not found or language not supported.")) maybeFile
 
+-- | Read a blob from the provided absolute or relative path , failing if it can't be found.
+readBlobFromPath :: (MonadFail m, MonadIO m) => Path.AbsRelFile -> m Blob
+readBlobFromPath = readBlobFromFile' . File.fromPath
+
 -- | Read all blobs in the directory with Language.supportedExts.
 readBlobsFromDir :: MonadIO m => Path.AbsRelDir -> m [Blob]
 readBlobsFromDir path = liftIO . fmap catMaybes $
-  findFilesInDir path supportedExts mempty >>= Async.mapConcurrently (readBlobFromFile . fileForTypedPath)
+  findFilesInDir path supportedExts mempty >>= Async.mapConcurrently (readBlobFromFile . File.fromPath)
 
-readFilePair :: MonadIO m => File -> File -> m BlobPair
+readFilePair :: MonadIO m => File Language -> File Language -> m BlobPair
 readFilePair a b = do
   before <- readBlobFromFile a
   after  <- readBlobFromFile b

src/Data/Language.hs

@@ -1,107 +1,19 @@
-{-# LANGUAGE DataKinds, DeriveAnyClass, DeriveGeneric, KindSignatures, LambdaCase, OverloadedStrings #-}
 module Data.Language
-  ( Language (..)
+  ( module Source.Language
-  , SLanguage (..)
+  , LanguageMode(..)
-  , extensionsForLanguage
-  , knownLanguage
-  , languageForFilePath
-  , pathIsMinified
-  , supportedExts
-  , codeNavLanguages
-  , textToLanguage
-  , languageToText
   , PerLanguageModes(..)
   , defaultLanguageModes
-  , LanguageMode(..)
+  , codeNavLanguages
+  , supportedExts
   ) where
 
-import           Data.Aeson
 import qualified Data.Languages as Lingo
-import qualified Data.Text as T
 import qualified Data.Map.Strict as Map
-import           Prologue
+import qualified Data.Text as T
-import           System.FilePath.Posix
+import           Source.Language
 
--- | The various languages we support.
+codeNavLanguages :: [Language]
--- Please do not reorder any of the field names: the current implementation of 'Primitive'
+codeNavLanguages = [Go, Java, Ruby, Python, JavaScript, TypeScript, PHP]
--- delegates to the auto-generated 'Enum' instance.
-data Language
-    = Unknown
-    | Go
-    | Haskell
-    | Java
-    | JavaScript
-    | JSON
-    | JSX
-    | Markdown
-    | Python
-    | Ruby
-    | TypeScript
-    | PHP
-    | TSX
-    deriving (Eq, Generic, Ord, Read, Show, Bounded, Hashable, ToJSON, Enum)
-
-class SLanguage (lang :: Language) where
-  reflect :: proxy lang -> Language
-
-instance SLanguage 'Unknown where
-  reflect _ = Unknown
-
-instance SLanguage 'Go where
-  reflect _ = Go
-
-instance SLanguage 'Haskell where
-  reflect _ = Haskell
-
-instance SLanguage 'Java where
-  reflect _ = Java
-
-instance SLanguage 'JavaScript where
-  reflect _ = JavaScript
-
-instance SLanguage 'JSON where
-  reflect _ = JSON
-
-instance SLanguage 'JSX where
-  reflect _ = JSX
-
-instance SLanguage 'Markdown where
-  reflect _ = Markdown
-
-instance SLanguage 'Python where
-  reflect _ = Python
-
-instance SLanguage 'Ruby where
-  reflect _ = Ruby
-
-instance SLanguage 'TypeScript where
-  reflect _ = TypeScript
-
-instance SLanguage 'PHP where
-  reflect _ = PHP
-
-instance FromJSON Language where
-  parseJSON = withText "Language" $ \l ->
-    pure $ textToLanguage l
-
--- | Predicate failing on 'Unknown' and passing in all other cases.
-knownLanguage :: Language -> Bool
-knownLanguage = (/= Unknown)
-
-extensionsForLanguage :: Language -> [String]
-extensionsForLanguage language = T.unpack <$> maybe mempty Lingo.languageExtensions (Map.lookup (languageToText language) Lingo.languages)
-
--- | Return a language based on a FilePath's extension.
-languageForFilePath :: FilePath -> Language
-languageForFilePath path =
-  let spurious lang = lang `elem` [ "Hack" -- .php files
-                                  , "GCC Machine Description" -- .md files
-                                  , "XML" -- .tsx files
-                                  ]
-      allResults = Lingo.languageName <$> Lingo.languagesForPath path
-  in case filter (not . spurious) allResults of
-    [result] -> textToLanguage result
-    _        -> Unknown
 
 supportedExts :: [String]
 supportedExts = foldr append mempty supportedLanguages
@@ -111,44 +23,6 @@ supportedExts = foldr append mempty supportedLanguages
     supportedLanguages = fmap lookup (languageToText <$> codeNavLanguages)
     lookup k = Map.lookup k Lingo.languages
 
-codeNavLanguages :: [Language]
-codeNavLanguages = [Go, Java, Ruby, Python, JavaScript, TypeScript, PHP]
-
-pathIsMinified :: FilePath -> Bool
-pathIsMinified = isExtensionOf ".min.js"
-
-languageToText :: Language -> T.Text
-languageToText = \case
-  Unknown -> "Unknown"
-  Go -> "Go"
-  Haskell -> "Haskell"
-  Java -> "Java"
-  JavaScript -> "JavaScript"
-  JSON -> "JSON"
-  JSX -> "JSX"
-  Markdown -> "Markdown"
-  Python -> "Python"
-  Ruby -> "Ruby"
-  TypeScript -> "TypeScript"
-  TSX -> "TSX"
-  PHP -> "PHP"
-
-textToLanguage :: T.Text -> Language
-textToLanguage = \case
-  "Go" -> Go
-  "Haskell" -> Haskell
-  "Java" -> Java
-  "JavaScript" -> JavaScript
-  "JSON" -> JSON
-  "JSX" -> JSX
-  "Markdown" -> Markdown
-  "Python" -> Python
-  "Ruby" -> Ruby
-  "TypeScript" -> TypeScript
-  "TSX" -> TSX
-  "PHP" -> PHP
-  _ -> Unknown
-
 
 data PerLanguageModes = PerLanguageModes
   { pythonMode     :: LanguageMode

src/Data/Project.hs

@@ -9,12 +9,13 @@ module Data.Project
 import Prelude hiding (readFile)
 import Prologue
 
+import           Analysis.File
 import           Data.Blob
 import           Data.Blob.IO
 import           Data.Language
 import qualified Data.Text as T
-import           System.FilePath.Posix
 import           Semantic.IO
+import           System.FilePath.Posix
 import qualified System.Path as Path
 
 -- | A 'Project' contains all the information that semantic needs
@@ -32,7 +33,7 @@ projectName = T.pack . dropExtensions . takeFileName . projectRootDir
 projectExtensions :: Project -> [String]
 projectExtensions = extensionsForLanguage . projectLanguage
 
-projectFiles :: Project -> [File]
+projectFiles :: Project -> [File Language]
 projectFiles = fmap blobFile . projectBlobs
 
 readProjectFromPaths :: MonadIO m
@@ -56,5 +57,5 @@ readProjectFromPaths maybeRoot path lang excludeDirs = do
   blobs <- liftIO $ traverse (readBlobFromFile' . toFile) paths
   pure $ Project (Path.toString rootDir) blobs lang (fmap Path.toString excludeDirs)
   where
-    toFile path = File (Path.toString path) lang
+    toFile path = File path lowerBound lang
     exts = extensionsForLanguage lang

src/Semantic/Api/Bridge.hs

@@ -1,21 +1,28 @@
-{-# LANGUAGE FlexibleContexts, FlexibleInstances, FunctionalDependencies, RecordWildCards #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE RecordWildCards #-}
 module Semantic.Api.Bridge
   ( APIBridge (..)
   , APIConvert (..)
   , (#?)
   ) where
 
+import           Analysis.File
 import           Control.Lens
 import qualified Data.Blob as Data
 import qualified Data.Edit as Data
+import           Data.Either
 import qualified Data.Language as Data
 import           Data.ProtoLens (defMessage)
 import qualified Data.Text as T
-import qualified Semantic.Api.LegacyTypes as Legacy
+import           Data.Text.Lens
 import qualified Proto.Semantic as API
 import           Proto.Semantic_Fields as P
-import           Source.Source (fromText, toText)
+import qualified Semantic.Api.LegacyTypes as Legacy
+import qualified Source.Source as Source (fromText, toText, totalSpan)
 import qualified Source.Span as Source
+import qualified System.Path as Path
 
 -- | An @APIBridge x y@ instance describes an isomorphism between @x@ and @y@.
 -- This is suitable for types such as 'Pos' which are representationally equivalent
@@ -71,8 +78,18 @@ instance APIBridge T.Text Data.Language where
 
 instance APIBridge API.Blob Data.Blob where
   bridging = iso apiBlobToBlob blobToApiBlob where
-    blobToApiBlob b = defMessage & P.content .~ toText (Data.blobSource b) & P.path .~ T.pack (Data.blobPath b) & P.language .~ (bridging # Data.blobLanguage b)
+    blobToApiBlob b
-    apiBlobToBlob blob = Data.makeBlob (fromText (blob^.content)) (T.unpack (blob^.path)) (blob^.(language . bridging)) mempty
+      = defMessage
+      & P.content .~ Source.toText (Data.blobSource b)
+      & P.path .~ T.pack (Data.blobPath b)
+      & P.language .~ (bridging # Data.blobLanguage b)
+    apiBlobToBlob blob =
+      let src = blob^.content.to Source.fromText
+          pth = fromRight (Path.toAbsRel Path.emptyFile) (blob^.path._Text.to Path.parse)
+      in Data.Blob
+      { blobSource = src
+      , blobFile = File pth (Source.totalSpan src) (blob^.language.bridging)
+      }
 
 
 instance APIConvert API.BlobPair Data.BlobPair where

src/Semantic/Api/LegacyTypes.hs

@@ -1,4 +1,9 @@
-{-# LANGUAGE DeriveGeneric, DerivingVia, DeriveAnyClass, DuplicateRecordFields, OverloadedStrings, RecordWildCards #-}
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DerivingVia #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
 module Semantic.Api.LegacyTypes
   ( DiffTreeRequest(..)
   , ParseTreeRequest(..)
@@ -10,7 +15,7 @@ module Semantic.Api.LegacyTypes
   ) where
 
 import Data.Aeson
-import Data.Blob hiding (File(..))
+import Data.Blob
 import Prologue
 
 newtype DiffTreeRequest = DiffTreeRequest { blobs :: [BlobPair] }

src/Semantic/Api/Symbols.hs

@@ -1,4 +1,14 @@
-{-# LANGUAGE AllowAmbiguousTypes, DataKinds, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, OverloadedStrings, RecordWildCards, ScopedTypeVariables, TypeApplications, TypeFamilies, UndecidableInstances #-}
+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE UndecidableInstances #-}
 module Semantic.Api.Symbols
   ( legacyParseSymbols
   , parseSymbols
@@ -12,7 +22,7 @@ import           Control.Effect.Reader
 import           Control.Exception
 import           Control.Lens
 import           Data.Abstract.Declarations
-import           Data.Blob hiding (File (..))
+import           Data.Blob
 import           Data.ByteString.Builder
 import           Data.Language
 import           Data.ProtoLens (defMessage)
@@ -78,7 +88,6 @@ parseSymbols blobs = do
           & P.language .~ (bridging # blobLanguage')
           & P.symbols .~ mempty
           & P.errors .~ [defMessage & P.error .~ pack e]
-          & P.blobOid .~ blobOid
 
         tagsToFile :: [Tag] -> File
         tagsToFile tags = defMessage
@@ -86,7 +95,6 @@ parseSymbols blobs = do
           & P.language .~ (bridging # blobLanguage')
           & P.symbols .~ fmap tagToSymbol tags
           & P.errors .~ mempty
-          & P.blobOid .~ blobOid
 
         tagToSymbol :: Tag -> Symbol
         tagToSymbol Tag{..} = defMessage

src/Semantic/CLI.hs

@@ -1,10 +1,12 @@
-{-# LANGUAGE ApplicativeDo, FlexibleContexts #-}
+{-# LANGUAGE ApplicativeDo #-}
+{-# LANGUAGE FlexibleContexts #-}
 module Semantic.CLI (main) where
 
+import qualified Analysis.File as File
 import qualified Control.Carrier.Parse.Measured as Parse
 import           Control.Carrier.Reader
-import           Data.Blob
 import           Data.Blob.IO
+import           Data.Either
 import qualified Data.Flag as Flag
 import           Data.Handle
 import qualified Data.Language as Language
@@ -22,7 +24,6 @@ import qualified Semantic.Telemetry.Log as Log
 import           Semantic.Version
 import           Serializing.Format hiding (Options)
 import           System.Exit (die)
-import           System.FilePath
 import qualified System.Path as Path
 import qualified System.Path.PartClass as Path.PartClass
 
@@ -151,10 +152,11 @@ graphCommand = command "graph" (info graphArgumentsParser (progDesc "Compute a g
       <$> (   Just <$> some (strArgument (metavar "FILES..."))
           <|> flag' Nothing (long "stdin" <> help "Read a list of newline-separated paths to analyze from stdin."))
     makeReadProjectFromPathsTask maybePaths = do
-      paths <- maybeM (liftIO (many getLine)) maybePaths
+      strPaths <- maybeM (liftIO (many getLine)) maybePaths
-      blobs <- traverse readBlobFromFile' (fileForPath <$> paths)
+      let paths = rights (Path.parse <$> strPaths)
+      blobs <- traverse readBlobFromPath paths
       case paths of
-        (x:_) -> pure $! Project (takeDirectory x) blobs (Language.languageForFilePath x) mempty
+        (x:_) -> pure $! Project (Path.toString (Path.takeDirectory x)) blobs (Language.forPath x) mempty
         _     -> pure $! Project "/" mempty Language.Unknown mempty
 
     allLanguages = intercalate "|" . fmap show $ [Language.Go .. maxBound]
@@ -183,8 +185,8 @@ languageModes = Language.PerLanguageModes
                     <> value Language.ALaCarte
                     <> showDefault)
 
-filePathReader :: ReadM File
+filePathReader :: ReadM (File.File Language.Language)
-filePathReader = fileForPath <$> str
+filePathReader = File.fromPath <$> path
 
 path :: (Path.PartClass.FileDir fd) => ReadM (Path.AbsRel fd)
 path = eitherReader Path.parse

src/Semantic/Graph.hs

@@ -43,6 +43,7 @@ import Prelude hiding (readFile)
 import           Analysis.Abstract.Caching.FlowInsensitive
 import           Analysis.Abstract.Collecting
 import           Analysis.Abstract.Graph as Graph
+import           Analysis.File
 import           Control.Abstract hiding (String)
 import           Control.Abstract.PythonPackage as PythonPackage
 import           Control.Algebra
@@ -68,7 +69,7 @@ import           Data.Blob
 import           Data.Graph
 import           Data.Graph.ControlFlowVertex (VertexDeclaration)
 import           Data.Language as Language
-import           Data.List (isPrefixOf, isSuffixOf)
+import           Data.List (isPrefixOf)
 import qualified Data.Map as Map
 import           Data.Project
 import           Data.Text (pack, unpack)
@@ -81,6 +82,7 @@ import           Semantic.Task as Task
 import           Source.Loc as Loc
 import           Source.Span
 import           System.FilePath.Posix (takeDirectory, (</>))
+import qualified System.Path as Path
 import           Text.Show.Pretty (ppShow)
 
 data GraphType = ImportGraph | CallGraph
@@ -334,8 +336,9 @@ parsePythonPackage parser project = do
                                         ]
     PythonPackage.FindPackages excludeDirs -> do
       trace "In Graph.FindPackages"
-      let initFiles = filter (("__init__.py" `isSuffixOf`) . filePath) (projectFiles project)
+      let initFiles = filter (isInit . filePath) (projectFiles project)
-      let packageDirs = filter (`notElem` ((projectRootDir project </>) . unpack <$> excludeDirs)) (takeDirectory . filePath <$> initFiles)
+          isInit = (== Path.relFile "__init__.py") . Path.takeFileName
+          packageDirs = filter (`notElem` ((projectRootDir project </>) . unpack <$> excludeDirs)) (takeDirectory . Path.toString . filePath <$> initFiles)
       packageFromProject project [ blob | dir <- packageDirs
                                         , blob <- projectBlobs project
                                         , dir `isPrefixOf` blobPath blob

src/Semantic/IO.hs

@@ -1,4 +1,8 @@
-{-# LANGUAGE DuplicateRecordFields, GADTs, ScopedTypeVariables, TypeOperators, UndecidableInstances #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE UndecidableInstances #-}
 module Semantic.IO
   ( isDirectory
   , findFilesInDir
@@ -7,7 +11,6 @@ module Semantic.IO
 import Prelude hiding (readFile)
 import Prologue
 
-import           Data.Language
 import           System.Directory (doesDirectoryExist)
 import           System.Directory.Tree (AnchoredDirTree (..))
 import qualified System.Directory.Tree as Tree
@@ -18,6 +21,9 @@ import qualified System.Path.PartClass as Path.PartClass
 isDirectory :: MonadIO m => FilePath -> m Bool
 isDirectory path = liftIO (doesDirectoryExist path)
 
+pathIsMinified :: FilePath -> Bool
+pathIsMinified = isExtensionOf ".min.js"
+
 -- Recursively find files in a directory.
 findFilesInDir :: (Path.PartClass.AbsRel ar, MonadIO m) => Path.Dir ar -> [String] -> [Path.Dir ar] -> m [Path.File ar]
 findFilesInDir path exts excludeDirs = do

src/Semantic/Resolution.hs

@@ -1,4 +1,16 @@
-{-# LANGUAGE DeriveFunctor, DeriveGeneric, FlexibleContexts, FlexibleInstances, GADTs, GeneralizedNewtypeDeriving, KindSignatures, MultiParamTypeClasses, OverloadedStrings, RecordWildCards, ScopedTypeVariables, TypeOperators, UndecidableInstances #-}
+{-# LANGUAGE DeriveFunctor #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE UndecidableInstances #-}
 module Semantic.Resolution
   ( Resolution (..)
   , nodeJSResolutionMap
@@ -7,6 +19,7 @@ module Semantic.Resolution
   , ResolutionC(..)
   ) where
 
+import           Analysis.File as File
 import           Control.Algebra
 import           Data.Aeson
 import           Data.Aeson.Types (parseMaybe)
@@ -21,10 +34,10 @@ import           System.FilePath.Posix
 import qualified System.Path as Path
 
 
-nodeJSResolutionMap :: (Has Files sig m, MonadIO m) => FilePath -> Text -> [FilePath] -> m (Map FilePath FilePath)
+nodeJSResolutionMap :: Has Files sig m => FilePath -> Text -> [FilePath] -> m (Map FilePath FilePath)
 nodeJSResolutionMap rootDir prop excludeDirs = do
   files <- findFiles (Path.absRel rootDir) [".json"] (fmap Path.absRel excludeDirs)
-  let packageFiles = fileForTypedPath <$> filter ((==) (Path.relFile "package.json") . Path.takeFileName) files
+  let packageFiles = File.fromPath <$> filter ((==) (Path.relFile "package.json") . Path.takeFileName) files
   blobs <- readBlobs (FilesFromPaths packageFiles)
   pure $ fold (mapMaybe (lookup prop) blobs)
   where

src/Semantic/Task/Files.hs

@@ -1,6 +1,15 @@
-{-# LANGUAGE DataKinds, DeriveFunctor, ExistentialQuantification, FlexibleContexts, FlexibleInstances, GADTs,
+{-# LANGUAGE DataKinds #-}
-             GeneralizedNewtypeDeriving, KindSignatures, MultiParamTypeClasses, StandaloneDeriving, TypeOperators,
+{-# LANGUAGE DeriveFunctor #-}
-             UndecidableInstances #-}
+{-# LANGUAGE ExistentialQuantification #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE UndecidableInstances #-}
 
 module Semantic.Task.Files
   ( Files
@@ -18,6 +27,7 @@ module Semantic.Task.Files
   , FilesArg(..)
   ) where
 
+import           Analysis.File
 import           Control.Algebra
 import           Control.Effect.Error
 import           Data.Blob
@@ -34,10 +44,10 @@ import qualified System.Path as Path
 import qualified System.Path.IO as IO (withBinaryFile)
 
 data Source blob where
-  FromPath       :: File                            -> Source Blob
+  FromPath       :: File Language                   -> Source Blob
   FromHandle     :: Handle 'IO.ReadMode             -> Source [Blob]
   FromDir        :: Path.AbsRelDir                  -> Source [Blob]
-  FromPathPair   :: File -> File                    -> Source BlobPair
+  FromPathPair   :: File Language -> File Language  -> Source BlobPair
   FromPairHandle :: Handle 'IO.ReadMode             -> Source [BlobPair]
 
 data Destination = ToPath Path.AbsRelFile | ToHandle (Handle 'IO.WriteMode)
@@ -83,26 +93,21 @@ instance (Has (Error SomeException) sig m, MonadFail m, MonadIO m) => Algebra (F
     Write (ToPath path) builder k                             -> liftIO (IO.withBinaryFile path IO.WriteMode (`B.hPutBuilder` builder)) >> k
     Write (ToHandle (WriteHandle handle)) builder k           -> liftIO (B.hPutBuilder handle builder) >> k
 
-readBlob :: Has Files sig m => File -> m Blob
+readBlob :: Has Files sig m => File Language -> m Blob
 readBlob file = send (Read (FromPath file) pure)
 
 -- Various ways to read in files
 data FilesArg
   = FilesFromHandle (Handle 'IO.ReadMode)
-  | FilesFromPaths [File]
+  | FilesFromPaths [File Language]
 
 -- | A task which reads a list of 'Blob's from a 'Handle' or a list of 'FilePath's optionally paired with 'Language's.
-readBlobs :: (Has Files sig m, MonadIO m) => FilesArg -> m [Blob]
+readBlobs :: Has Files sig m => FilesArg -> m [Blob]
 readBlobs (FilesFromHandle handle) = send (Read (FromHandle handle) pure)
-readBlobs (FilesFromPaths [path]) = do
-  isDir <- isDirectory (filePath path)
-  if isDir
-    then send (Read (FromDir (Path.path (filePath path))) pure)
-    else pure <$> send (Read (FromPath path) pure)
 readBlobs (FilesFromPaths paths)   = traverse (send . flip Read pure . FromPath) paths
 
 -- | A task which reads a list of pairs of 'Blob's from a 'Handle' or a list of pairs of 'FilePath's optionally paired with 'Language's.
-readBlobPairs :: Has Files sig m => Either (Handle 'IO.ReadMode) [(File, File)] -> m [BlobPair]
+readBlobPairs :: Has Files sig m => Either (Handle 'IO.ReadMode) [(File Language, File Language)] -> m [BlobPair]
 readBlobPairs (Left handle) = send (Read (FromPairHandle handle) pure)
 readBlobPairs (Right paths) = traverse (send . flip Read pure . uncurry FromPathPair) paths
 

src/Semantic/Util.hs

@@ -1,4 +1,10 @@
-{-# LANGUAGE AllowAmbiguousTypes, DataKinds, FlexibleContexts, PartialTypeSignatures, TypeApplications, TypeOperators #-}
+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE PartialTypeSignatures #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE ViewPatterns #-}
 {-# OPTIONS_GHC -Wno-missing-signatures -Wno-missing-exported-signatures -Wno-partial-type-signatures -O0 #-}
 module Semantic.Util
   ( evaluateProject'
@@ -11,14 +17,15 @@ module Semantic.Util
 
 import Prelude hiding (readFile)
 
+import           Analysis.File
 import           Control.Abstract
 import           Control.Carrier.Fresh.Strict
-import           Control.Carrier.Parse.Simple
 import           Control.Carrier.Lift
-import           Control.Carrier.Trace.Printing
+import           Control.Carrier.Parse.Simple
 import           Control.Carrier.Reader
 import           Control.Carrier.Resumable.Either (SomeError (..))
 import           Control.Carrier.State.Strict
+import           Control.Carrier.Trace.Printing
 import           Control.Lens.Getter
 import           Data.Abstract.Address.Precise as Precise
 import           Data.Abstract.Evaluatable
@@ -26,7 +33,6 @@ import           Data.Abstract.Module
 import qualified Data.Abstract.ModuleTable as ModuleTable
 import           Data.Abstract.Package
 import           Data.Abstract.Value.Concrete as Concrete
-import           Data.Blob
 import           Data.Blob.IO
 import           Data.Graph (topologicalSort)
 import qualified Data.Language as Language
@@ -42,6 +48,7 @@ import           Semantic.Task
 import           Source.Span (HasSpan (..))
 import           System.Exit (die)
 import           System.FilePath.Posix (takeDirectory)
+import qualified System.Path as Path
 
 justEvaluating :: Evaluator term Precise (Value term Precise) _ result
                -> IO ( Heap Precise Precise (Value term Precise),
@@ -69,7 +76,7 @@ justEvaluating
 evaluateProject' session proxy parser paths = do
   let lang = Language.reflect proxy
   res <- runTask session $ asks configTreeSitterParseTimeout >>= \ timeout -> runParse timeout $ do
-    blobs <- catMaybes <$> traverse readBlobFromFile (flip File lang <$> paths)
+    blobs <- catMaybes <$> traverse readBlobFromFile (fileForPath <$> paths)
     package <- fmap snd <$> parsePackage parser (Project (takeDirectory (maybe "/" fst (uncons paths))) blobs lang [])
     modules <- topologicalSort <$> runImportGraphToModules proxy package
     trace $ "evaluating with load order: " <> show (map (modulePath . moduleInfo) modules)
@@ -86,6 +93,9 @@ parseFile, parseFileQuiet :: Parser term -> FilePath -> IO term
 parseFile      parser = runTask'     . (parse parser <=< readBlob . fileForPath)
 parseFileQuiet parser = runTaskQuiet . (parse parser <=< readBlob . fileForPath)
 
+fileForPath :: FilePath -> File Language.Language
+fileForPath (Path.absRel -> p) = File p lowerBound (Language.forPath p)
+
 runTask', runTaskQuiet :: ParseC TaskC a -> IO a
 runTask'     task = runTaskWithOptions debugOptions   (asks configTreeSitterParseTimeout >>= \ timeout -> runParse timeout task) >>= either (die . displayException) pure
 runTaskQuiet task = runTaskWithOptions defaultOptions (asks configTreeSitterParseTimeout >>= \ timeout -> runParse timeout task) >>= either (die . displayException) pure

test/Data/Language/Spec.hs

@@ -1,6 +1,7 @@
 module Data.Language.Spec (testTree) where
 
-import Data.Language
+import           Data.Language as Language
+import qualified System.Path as Path
 import           Test.Tasty
 import           Test.Tasty.HUnit
 
@@ -13,7 +14,7 @@ testTree = testGroup "Data.Language"
       codeNavLanguages @=? [Go, Java, Ruby, Python, JavaScript, TypeScript, PHP]
 
   , testCase "languageForFilePath works for languages with ambiguous lingo extensions" $ do
-      languageForFilePath "foo.php" @=? PHP
+      Language.forPath (Path.relFile "foo.php") @=? PHP
-      languageForFilePath "foo.md" @=? Markdown
+      Language.forPath (Path.relFile "foo.md" ) @=? Markdown
-      languageForFilePath "foo.tsx" @=? TSX
+      Language.forPath (Path.relFile "foo.tsx") @=? TSX
   ]

test/Examples.hs

@@ -1,13 +1,14 @@
+{-# LANGUAGE AllowAmbiguousTypes #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE TypeApplications #-}
-{-# LANGUAGE AllowAmbiguousTypes  #-}
 
 {-# OPTIONS_GHC -O1 #-}
 {-# OPTIONS_GHC -Wno-unused-top-binds -Wno-unused-imports #-}
 module Main (main) where
 
+import qualified Analysis.File as File
 import           Control.Carrier.Parse.Measured
 import           Control.Carrier.Reader
 import           Control.Concurrent.Async (forConcurrently)
@@ -16,9 +17,9 @@ import           Control.Lens
 import           Control.Monad
 import           Data.Blob
 import           Data.Foldable
+import           Data.Int
 import           Data.Language (LanguageMode (..), PerLanguageModes (..))
 import           Data.List
-import           Data.Int
 import qualified Data.Text as Text
 import           Data.Traversable
 import           System.FilePath.Glob
@@ -307,4 +308,4 @@ parseSymbolsFilePath ::
   => PerLanguageModes
   -> Path.RelFile
   -> m ParseTreeSymbolResponse
-parseSymbolsFilePath languageModes path = readBlob (fileForTypedPath path) >>= runReader languageModes . parseSymbols . pure @[]
+parseSymbolsFilePath languageModes path = readBlob (File.fromPath path) >>= runReader languageModes . parseSymbols . pure @[]

test/Graphing/Calls/Spec.hs

@@ -1,4 +1,8 @@
-{-# LANGUAGE DataKinds, GADTs, OverloadedStrings, PackageImports, TypeApplications #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE PackageImports #-}
+{-# LANGUAGE TypeApplications #-}
 
 module Graphing.Calls.Spec ( spec ) where
 
@@ -7,6 +11,7 @@ import SpecHelpers
 
 import Algebra.Graph
 
+import qualified Analysis.File as File
 import           Control.Effect.Parse
 import           "semantic" Data.Graph (Graph (..), topologicalSort)
 import           Data.Graph.ControlFlowVertex
@@ -19,7 +24,7 @@ callGraphPythonProject path = runTaskOrDie $ do
   let proxy = Proxy @'Language.Python
       lang = Language.Python
   SomeParser parser <- pure . fromJust $! parserForLanguage analysisParsers Language.Python
-  blob <- readBlobFromFile' (fileForTypedPath path)
+  blob <- readBlobFromFile' (File.fromPath path)
   package <- fmap snd <$> parsePackage parser (Project (Path.toString (Path.takeDirectory path)) [blob] lang [])
   modules <- topologicalSort <$> runImportGraphToModules proxy package
   runCallGraph proxy False modules package

test/Parsing/Spec.hs

@@ -9,13 +9,14 @@ import Data.Language
 import           Parsing.TreeSitter
 import           Source.Source
 import           SpecHelpers
+import qualified System.Path as Path
 import           TreeSitter.JSON (Grammar, tree_sitter_json)
 
 spec :: Spec
 spec = do
   describe "parseToAST" $ do
     let source = toJSONSource [1 :: Int .. 10000]
-    let largeBlob = sourceBlob "large.json" JSON source
+    let largeBlob = fromSource (Path.relFile "large.json") JSON source
 
     it "returns a result when the timeout does not expire" $ do
       let timeout = fromMicroseconds 0 -- Zero microseconds indicates no timeout

test/Semantic/CLI/Spec.hs

@@ -1,14 +1,16 @@
 module Semantic.CLI.Spec (testTree) where
 
+import           Analysis.File
 import           Control.Carrier.Parse.Simple
 import           Control.Carrier.Reader
 import           Data.ByteString.Builder
+import           Data.Language
 import           Semantic.Api hiding (Blob, BlobPair, File)
 import           Semantic.Task
 import           Serializing.Format
 import           System.IO.Unsafe
-import qualified System.Path as Path
 import           System.Path ((</>))
+import qualified System.Path as Path
 import qualified System.Path.Directory as Path
 
 import SpecHelpers
@@ -34,7 +36,7 @@ renderDiff ref new = unsafePerformIO $ do
     else ["git", "diff", ref, new]
 {-# NOINLINE renderDiff #-}
 
-testForDiffFixture :: (String, [BlobPair] -> ParseC TaskC Builder, [(File, File)], Path.RelFile) -> TestTree
+testForDiffFixture :: (String, [BlobPair] -> ParseC TaskC Builder, [(File Language, File Language)], Path.RelFile) -> TestTree
 testForDiffFixture (diffRenderer, runDiff, files, expected) =
   goldenVsStringDiff
     ("diff fixture renders to " <> diffRenderer <> " " <> show files)
@@ -42,7 +44,7 @@ testForDiffFixture (diffRenderer, runDiff, files, expected) =
     (Path.toString expected)
     (fmap toLazyByteString . runTaskOrDie $ readBlobPairs (Right files) >>= runDiff)
 
-testForParseFixture :: (String, [Blob] -> ParseC TaskC Builder, [File], Path.RelFile) -> TestTree
+testForParseFixture :: (String, [Blob] -> ParseC TaskC Builder, [File Language], Path.RelFile) -> TestTree
 testForParseFixture (format, runParse, files, expected) =
   goldenVsStringDiff
     ("diff fixture renders to " <> format)
@@ -50,7 +52,7 @@ testForParseFixture (format, runParse, files, expected) =
     (Path.toString expected)
     (fmap toLazyByteString . runTaskOrDie $ readBlobs (FilesFromPaths files) >>= runParse)
 
-parseFixtures :: [(String, [Blob] -> ParseC TaskC Builder, [File], Path.RelFile)]
+parseFixtures :: [(String, [Blob] -> ParseC TaskC Builder, [File Language], Path.RelFile)]
 parseFixtures =
   [ ("s-expression", run . parseTermBuilder TermSExpression, path, Path.relFile "test/fixtures/ruby/corpus/and-or.parseA.txt")
   , ("json", run . parseTermBuilder TermJSONTree, path, prefix </> Path.file "parse-tree.json")
@@ -59,18 +61,18 @@ parseFixtures =
   , ("symbols", run . parseSymbolsBuilder Serializing.Format.JSON, path'', prefix </> Path.file "parse-tree.symbols.json")
   , ("protobuf symbols", run . parseSymbolsBuilder Serializing.Format.Proto, path'', prefix </> Path.file "parse-tree.symbols.protobuf.bin")
   ]
-  where path = [File "test/fixtures/ruby/corpus/and-or.A.rb" Ruby]
+  where path = [File (Path.absRel "test/fixtures/ruby/corpus/and-or.A.rb") lowerBound Ruby]
-        path' = [File "test/fixtures/ruby/corpus/and-or.A.rb" Ruby, File "test/fixtures/ruby/corpus/and-or.B.rb" Ruby]
+        path' = [File (Path.absRel "test/fixtures/ruby/corpus/and-or.A.rb") lowerBound Ruby, File (Path.absRel"test/fixtures/ruby/corpus/and-or.B.rb") lowerBound Ruby]
-        path'' = [File "test/fixtures/ruby/corpus/method-declaration.A.rb" Ruby]
+        path'' = [File (Path.absRel "test/fixtures/ruby/corpus/method-declaration.A.rb") lowerBound Ruby]
         prefix = Path.relDir "test/fixtures/cli"
         run = runReader defaultLanguageModes
 
-diffFixtures :: [(String, [BlobPair] -> ParseC TaskC Builder, [(File, File)], Path.RelFile)]
+diffFixtures :: [(String, [BlobPair] -> ParseC TaskC Builder, [(File Language, File Language)], Path.RelFile)]
 diffFixtures =
   [ ("json diff", parseDiffBuilder DiffJSONTree, pathMode, prefix </> Path.file "diff-tree.json")
   , ("s-expression diff", parseDiffBuilder DiffSExpression, pathMode, Path.relFile "test/fixtures/ruby/corpus/method-declaration.diffA-B.txt")
   , ("toc summaries diff", runReader defaultLanguageModes . diffSummaryBuilder Serializing.Format.JSON, pathMode, prefix </> Path.file "diff-tree.toc.json")
   , ("protobuf diff", runReader defaultLanguageModes . diffSummaryBuilder Serializing.Format.Proto, pathMode, prefix </> Path.file "diff-tree.toc.protobuf.bin")
   ]
-  where pathMode = [(File "test/fixtures/ruby/corpus/method-declaration.A.rb" Ruby, File "test/fixtures/ruby/corpus/method-declaration.B.rb"  Ruby)]
+  where pathMode = [(File (Path.absRel "test/fixtures/ruby/corpus/method-declaration.A.rb") lowerBound Ruby, File (Path.absRel "test/fixtures/ruby/corpus/method-declaration.B.rb") lowerBound Ruby)]
         prefix = Path.relDir "test/fixtures/cli"

test/Semantic/IO/Spec.hs

@@ -4,23 +4,25 @@ module Semantic.IO.Spec (spec) where
 
 import Prelude hiding (readFile)
 
-import           Data.Blob
+import           Analysis.File as File
+import           Data.Blob as Blob
 import           Data.Handle
 import           SpecHelpers
+import qualified System.Path as Path
 
 spec :: Spec
 spec = do
   describe "readFile" $ do
     it "returns a blob for extant files" $ do
-      Just blob <- readBlobFromFile (File "semantic.cabal" Unknown)
+      Just blob <- readBlobFromFile (File (Path.absRel "semantic.cabal") lowerBound Unknown)
       blobPath blob `shouldBe` "semantic.cabal"
 
     it "throws for absent files" $ do
-      readBlobFromFile (File "this file should not exist" Unknown) `shouldThrow` anyIOException
+      readBlobFromFile (File (Path.absRel "/dev/doesnotexist") lowerBound Unknown) `shouldThrow` anyIOException
 
   describe "readBlobPairsFromHandle" $ do
-    let a = sourceBlob "method.rb" Ruby "def foo; end"
+    let a = Blob.fromSource (Path.relFile "method.rb") Ruby "def foo; end"
-    let b = sourceBlob "method.rb" Ruby "def bar(x); end"
+    let b = Blob.fromSource (Path.relFile "method.rb") Ruby "def bar(x); end"
     it "returns blobs for valid JSON encoded diff input" $ do
       blobs <- blobsFromFilePath "test/fixtures/cli/diff.json"
       blobs `shouldBe` [Compare a b]
@@ -45,7 +47,7 @@ spec = do
     it "returns blobs for unsupported language" $ do
       h <- openFileForReading "test/fixtures/cli/diff-unsupported-language.json"
       blobs <- readBlobPairsFromHandle h
-      let b' = sourceBlob "test.kt" Unknown "fun main(args: Array<String>) {\nprintln(\"hi\")\n}\n"
+      let b' = Blob.fromSource (Path.relFile "test.kt") Unknown "fun main(args: Array<String>) {\nprintln(\"hi\")\n}\n"
       blobs `shouldBe` [Insert b']
 
     it "detects language based on filepath for empty language" $ do
@@ -68,7 +70,7 @@ spec = do
     it "returns blobs for valid JSON encoded parse input" $ do
       h <- openFileForReading "test/fixtures/cli/parse.json"
       blobs <- readBlobsFromHandle h
-      let a = sourceBlob "method.rb" Ruby "def foo; end"
+      let a = Blob.fromSource (Path.relFile "method.rb") Ruby "def foo; end"
       blobs `shouldBe` [a]
 
     it "throws on blank input" $ do

test/Semantic/Spec.hs

@@ -1,20 +1,23 @@
 {-# LANGUAGE OverloadedStrings #-}
 module Semantic.Spec (spec) where
 
+import           Analysis.File
 import           Control.Carrier.Reader
 import           Control.Exception (fromException)
+import qualified Data.Blob as Blob
 import           SpecHelpers
+import qualified System.Path as Path
 
 import Semantic.Api hiding (Blob)
 
  -- we need some lenses here, oof
 setBlobLanguage :: Language -> Blob -> Blob
-setBlobLanguage lang b = b { blobFile = (blobFile b) { fileLanguage = lang }}
+setBlobLanguage lang b = b { blobFile = (blobFile b) { fileBody = lang }}
 
 spec :: Spec
 spec = do
   describe "parseBlob" $ do
-    let methodsBlob = makeBlob "def foo\nend\n" "methods.rb" Ruby mempty
+    let methodsBlob = Blob.fromSource (Path.relFile "methods.rb") Ruby "def foo\nend\n"
 
     it "returns error if given an unknown language (json)" $ do
       output <- fmap runBuilder . runTaskOrDie . runReader defaultLanguageModes $ parseTermBuilder TermJSONTree [ setBlobLanguage Unknown methodsBlob ]

test/SpecHelpers.hs

@@ -1,4 +1,5 @@
-{-# LANGUAGE DataKinds, FlexibleContexts #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE FlexibleContexts #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 
 module SpecHelpers
@@ -23,14 +24,15 @@ module SpecHelpers
 , evaluateProject
 ) where
 
+import qualified Analysis.File as File
 import           Control.Abstract
 import           Control.Carrier.Fresh.Strict
+import           Control.Carrier.Lift
 import           Control.Carrier.Parse.Simple
 import           Control.Carrier.Reader as X
-import qualified Control.Carrier.Trace.Ignoring as Trace.Ignoring
 import           Control.Carrier.Resumable.Either
-import Control.Carrier.Lift
 import           Control.Carrier.State.Strict
+import qualified Control.Carrier.Trace.Ignoring as Trace.Ignoring
 import           Control.Exception (displayException)
 import           Control.Monad as X
 import           Data.Abstract.Address.Precise as X
@@ -53,7 +55,7 @@ import Data.Functor.Listable as X
 import           Data.Language as X hiding (Precise)
 import           Data.List.NonEmpty as X (NonEmpty (..))
 import           Data.Maybe as X
-import Data.Monoid as X (Monoid(..), First(..), Last(..))
+import           Data.Monoid as X (First (..), Last (..), Monoid (..))
 import           Data.Project as X
 import           Data.Proxy as X
 import           Data.Semigroup as X (Semigroup (..))
@@ -62,20 +64,20 @@ import Data.String
 import           Data.Sum as Sum
 import           Data.Term as X
 import           Data.Traversable as X (for)
-import Debug.Trace as X (traceShowM, traceM)
+import           Debug.Trace as X (traceM, traceShowM)
 import           Parsing.Parser as X
-import Semantic.Api hiding (File, Blob, BlobPair)
+import           Semantic.Api hiding (Blob, BlobPair, File)
 import           Semantic.Config (Config (..), optionsLogLevel)
 import           Semantic.Graph (analysisParsers, runHeap, runScopeGraph)
 import           Semantic.Task as X
 import           Semantic.Telemetry (LogQueue, StatQueue)
 import           Semantic.Util as X
-import Source.Range as X hiding (start, end, point)
+import           Source.Range as X hiding (end, point, start)
 import           Source.Source as X (Source)
-import Source.Span as X hiding (HasSpan(..), start, end, point)
+import           Source.Span as X hiding (HasSpan (..), end, point, start)
 import           System.Exit (die)
 import qualified System.Path as Path
-import Test.Hspec as X (Spec, SpecWith, context, describe, it, xit, parallel, pendingWith, around, runIO)
+import           Test.Hspec as X (Spec, SpecWith, around, context, describe, it, parallel, pendingWith, runIO, xit)
 import           Test.Hspec.Expectations as X
 import           Test.Hspec.LeanCheck as X
 import           Test.LeanCheck as X
@@ -99,7 +101,7 @@ diffFilePaths session p1 p2 = do
 -- | Returns an s-expression parse tree for the specified path.
 parseFilePath :: TaskSession -> Path.RelFile -> IO (Either SomeException ByteString)
 parseFilePath session path = do
-  blob <- readBlobFromFile (fileForTypedPath path)
+  blob <- readBlobFromFile (File.fromPath path)
   res <- runTask session . runParse (configTreeSitterParseTimeout (config session)) . runReader defaultLanguageModes $ parseTermBuilder TermSExpression (toList blob)
   pure (runBuilder <$> res)
 
@@ -108,7 +110,7 @@ runParseWithConfig task = asks configTreeSitterParseTimeout >>= \ timeout -> run
 
 -- | Read two files to a BlobPair.
 readFilePathPair :: Path.RelFile -> Path.RelFile -> IO BlobPair
-readFilePathPair p1 p2 = readFilePair (fileForTypedPath p1) (fileForTypedPath p2)
+readFilePathPair p1 p2 = readFilePair (File.fromPath p1) (File.fromPath p2)
 
 -- Run a Task and call `die` if it returns an Exception.
 runTaskOrDie :: ParseC TaskC a -> IO a

test/Tags/Spec.hs

@@ -1,6 +1,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 module Tags.Spec (spec) where
 
+import qualified Analysis.File as File
 import           Control.Carrier.Reader
 import           Semantic.Api.Symbols
 import           Source.Loc
@@ -90,4 +91,4 @@ spec = do
         ]
 
 parseTestFile :: Foldable t => t Tags.Kind -> Path.RelFile -> IO [Tag]
-parseTestFile include path = runTaskOrDie $ readBlob (fileForPath (Path.toString path)) >>= runReader defaultLanguageModes . fmap (filter ((`elem` include) . kind)) . tagsForBlob
+parseTestFile include path = runTaskOrDie $ readBlob (File.fromPath path) >>= runReader defaultLanguageModes . fmap (filter ((`elem` include) . kind)) . tagsForBlob