absolutely massive patch that touches everything

semantic.cabal

@@ -128,10 +128,10 @@ library
                      , Data.Algebra
                      , Data.AST
                      , Data.Blob
+                     , Data.Blob.IO
                      , Data.Diff
                      , Data.Duration
                      , Data.Error
-                     , Data.File
                      , Data.Flag
                      , Data.Functor.Both
                      , Data.Functor.Classes.Generic

src/Analysis/TOCSummary.hs

@@ -76,8 +76,8 @@ class CustomHasDeclaration whole syntax where
 
 -- | Produce a 'HeadingDeclaration' from the first line of the heading of a 'Markdown.Heading' node.
 instance CustomHasDeclaration whole Markdown.Heading where
-  customToDeclaration Blob{..} ann (Markdown.Heading level terms _)
-    = Just $ HeadingDeclaration (headingText terms) mempty (locationSpan ann) blobLanguage level
+  customToDeclaration blob@Blob{..} ann (Markdown.Heading level terms _)
+    = Just $ HeadingDeclaration (headingText terms) mempty (locationSpan ann) (blobLanguage blob) level
     where headingText terms = getSource $ maybe (locationByteRange ann) sconcat (nonEmpty (headingByteRange <$> toList terms))
           headingByteRange (Term (In ann _), _) = locationByteRange ann
           getSource = firstLine . toText . flip Source.slice blobSource
@@ -85,8 +85,8 @@ instance CustomHasDeclaration whole Markdown.Heading where
 
 -- | Produce an 'ErrorDeclaration' for 'Syntax.Error' nodes.
 instance CustomHasDeclaration whole Syntax.Error where
-  customToDeclaration Blob{..} ann err@Syntax.Error{}
-    = Just $ ErrorDeclaration (T.pack (formatTOCError (Syntax.unError (locationSpan ann) err))) mempty (locationSpan ann) blobLanguage
+  customToDeclaration blob@Blob{..} ann err@Syntax.Error{}
+    = Just $ ErrorDeclaration (T.pack (formatTOCError (Syntax.unError (locationSpan ann) err))) mempty (locationSpan ann) (blobLanguage blob)
     where formatTOCError e = showExpectation (flag Colourize False) (errorExpected e) (errorActual e) ""
 
 -- | Produce a 'FunctionDeclaration' for 'Declaration.Function' nodes so long as their identifier is non-empty (defined as having a non-empty 'Range').
@@ -95,7 +95,7 @@ instance CustomHasDeclaration whole Declaration.Function where
     -- Do not summarize anonymous functions
     | isEmpty identifierAnn = Nothing
     -- Named functions
-    | otherwise             = Just $ FunctionDeclaration (getSource blobSource identifierAnn) functionSource (locationSpan ann) blobLanguage
+    | otherwise             = Just $ FunctionDeclaration (getSource blobSource identifierAnn) functionSource (locationSpan ann) (blobLanguage blob)
     where isEmpty = (== 0) . rangeLength . locationByteRange
           functionSource = getIdentifier (arr Declaration.functionBody) blob (In ann decl)
 
@@ -103,12 +103,12 @@ instance CustomHasDeclaration whole Declaration.Function where
 instance CustomHasDeclaration whole Declaration.Method where
   customToDeclaration blob@Blob{..} ann decl@(Declaration.Method _ (Term (In receiverAnn receiverF), _) (Term (In identifierAnn _), _) _ _ _)
     -- Methods without a receiver
-    | isEmpty receiverAnn = Just $ MethodDeclaration (getSource blobSource identifierAnn) methodSource (locationSpan ann) blobLanguage Nothing
+    | isEmpty receiverAnn = Just $ MethodDeclaration (getSource blobSource identifierAnn) methodSource (locationSpan ann) (blobLanguage blob) Nothing
     -- Methods with a receiver type and an identifier (e.g. (a *Type) in Go).
-    | blobLanguage == Go
-    , [ _, Term (In receiverType _) ] <- toList receiverF = Just $ MethodDeclaration (getSource blobSource identifierAnn) methodSource (locationSpan ann) blobLanguage (Just (getSource blobSource receiverType))
+    | (blobLanguage blob) == Go
+    , [ _, Term (In receiverType _) ] <- toList receiverF = Just $ MethodDeclaration (getSource blobSource identifierAnn) methodSource (locationSpan ann) (blobLanguage blob) (Just (getSource blobSource receiverType))
     -- Methods with a receiver (class methods) are formatted like `receiver.method_name`
-    | otherwise           = Just $ MethodDeclaration (getSource blobSource identifierAnn) methodSource (locationSpan ann) blobLanguage (Just (getSource blobSource receiverAnn))
+    | otherwise           = Just $ MethodDeclaration (getSource blobSource identifierAnn) methodSource (locationSpan ann) (blobLanguage blob) (Just (getSource blobSource receiverAnn))
     where
       isEmpty = (== 0) . rangeLength . locationByteRange
       methodSource = getIdentifier (arr Declaration.methodBody) blob (In ann decl)

src/Data/Abstract/Module.hs

@@ -28,9 +28,9 @@ moduleForBlob :: Maybe FilePath -- ^ The root directory relative to which the mo
               -> Blob           -- ^ The 'Blob' containing the module.
               -> term           -- ^ The @term@ representing the body of the module.
               -> Module term    -- ^ A 'Module' named appropriate for the 'Blob', holding the @term@, and constructed relative to the root 'FilePath', if any.
-moduleForBlob rootDir Blob{..} = Module info
-  where root = fromMaybe (takeDirectory blobPath) rootDir
-        info = ModuleInfo (makeRelative root blobPath) blobLanguage blobOid
+moduleForBlob rootDir b = Module info
+  where root = fromMaybe (takeDirectory (blobPath b)) rootDir
+        info = ModuleInfo (makeRelative root (blobPath b)) (blobLanguage b) (blobOid b)
 
 
 type ModulePath = FilePath

src/Data/Blob.hs

@@ -1,7 +1,12 @@
 {-# LANGUAGE DeriveAnyClass, ExplicitNamespaces, PatternSynonyms #-}
 module Data.Blob
-( Blob(..)
+( File(..)
+, fileForPath
+, Blob(..)
 , Blobs(..)
+, blobLanguage
+, blobPath
+, legacyMakeBlob
 , decodeBlobs
 , nullBlob
 , sourceBlob
@@ -28,14 +33,29 @@ import           Data.JSON.Fields
 import           Data.Language
 import           Data.Source as Source
 
+data File = File
+  { filePath    :: FilePath
+  , fileLanguage :: Language
+  } deriving (Show, Eq, Generic)
+
+fileForPath :: FilePath  -> File
+fileForPath p = File p (languageForFilePath p)
+
 -- | The source, path, and language of a blob.
 data Blob = Blob
   { blobSource   :: Source   -- ^ The UTF-8 encoded source text of the blob.
-  , blobPath     :: FilePath -- ^ The file path to the blob.
-  , blobLanguage :: Language -- ^ The language of this blob.
+  , blobInfo     :: File -- ^ 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, Generic)
+  } deriving (Show, Eq, Generic)
+
+blobLanguage :: Blob -> Language
+blobLanguage = fileLanguage . blobInfo
+
+blobPath :: Blob -> FilePath
+blobPath = filePath . blobInfo
+
+legacyMakeBlob :: Source -> FilePath -> Language -> Text -> Blob
+legacyMakeBlob s p l = Blob s (File p l)
 
 newtype Blobs a = Blobs { blobs :: [a] }
   deriving (Generic, FromJSON)
@@ -50,12 +70,12 @@ nullBlob :: Blob -> Bool
 nullBlob Blob{..} = nullSource blobSource
 
 sourceBlob :: FilePath -> Language -> Source -> Blob
-sourceBlob filepath language source = Blob source filepath language mempty
+sourceBlob filepath language source = legacyMakeBlob source filepath language mempty
 
 inferringLanguage :: Source -> FilePath -> Language -> Blob
 inferringLanguage src pth lang
-  | knownLanguage lang = Blob src pth lang mempty
-  | otherwise = Blob src pth (languageForFilePath pth) mempty
+  | knownLanguage lang = legacyMakeBlob src pth lang mempty
+  | otherwise = legacyMakeBlob src pth (languageForFilePath pth) mempty
 
 decodeBlobs :: BL.ByteString -> Either String [Blob]
 decodeBlobs = fmap blobs <$> eitherDecode
@@ -100,8 +120,8 @@ maybeBlobPair a b = case (a, b) of
   _                 -> Prologue.fail "expected file pair with content on at least one side"
 
 languageForBlobPair :: BlobPair -> Language
-languageForBlobPair (Deleting Blob{..})  = blobLanguage
-languageForBlobPair (Inserting Blob{..}) = blobLanguage
+languageForBlobPair (Deleting b)  = blobLanguage b
+languageForBlobPair (Inserting b) = blobLanguage b
 languageForBlobPair (Diffing a b)
   | blobLanguage a == Unknown || blobLanguage b == Unknown
     = Unknown
@@ -109,9 +129,10 @@ languageForBlobPair (Diffing a b)
     = blobLanguage b
 
 pathForBlobPair :: BlobPair -> FilePath
-pathForBlobPair (Deleting Blob{..})  = blobPath
-pathForBlobPair (Inserting Blob{..}) = blobPath
-pathForBlobPair (Diffing _ Blob{..}) = blobPath
+pathForBlobPair x = blobPath $ case x of
+  (Inserting b) -> b
+  (Deleting b)  -> b
+  (Diffing _ b) -> b
 
 languageTagForBlobPair :: BlobPair -> [(String, String)]
 languageTagForBlobPair pair = showLanguage (languageForBlobPair pair)
@@ -125,7 +146,7 @@ pathKeyForBlobPair blobs = case bimap blobPath blobPath (runJoin blobs) of
                       | otherwise -> before <> " -> " <> after
 
 instance ToJSONFields Blob where
-  toJSONFields Blob{..} = [ "path" .= blobPath, "language" .= blobLanguage ]
+  toJSONFields p = [ "path" .= blobPath p, "language" .= blobLanguage p]
 
 decodeBlobPairs :: BL.ByteString -> Either String [BlobPair]
 decodeBlobPairs = fmap blobs <$> eitherDecode

src/Data/Blob/IO.hs

@@ -1,39 +1,24 @@
-{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE Rank2Types #-}
 
-module Data.File
-  ( File (..)
-  , file
-  , toFile
-  , readBlobFromFile
+-- | 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'
   , readBlobsFromDir
   , readBlobsFromGitRepo
   , readFilePair
   ) where
 
-import qualified Control.Concurrent.Async as Async
-import           Data.Blob
-import qualified Data.ByteString as B
-import           Data.Language
-import           Data.Source
-import           Prologue
+import Prologue
+
+import Data.Blob
+import Data.Language
+import Semantic.IO
+import Data.Source
 import qualified Semantic.Git as Git
-import           Semantic.IO
-import           System.FilePath.Posix
-
-data File = File
-  { filePath     :: FilePath
-  , fileLanguage :: Language
-  } deriving (Eq, Ord, Show)
-
-file :: FilePath -> File
-file path = File path (languageForFilePath path)
-  where languageForFilePath = languageForType . takeExtension
-
--- This is kind of a wart; Blob and File should be two views of
--- the same higher-kinded datatype.
-toFile :: Blob -> File
-toFile (Blob _ p l _) = File p l
+import qualified Control.Concurrent.Async as Async
+import qualified Data.ByteString as B
 
 -- | Read a utf8-encoded file to a 'Blob'.
 readBlobFromFile :: forall m. MonadIO m => File -> m (Maybe Blob)
@@ -51,7 +36,7 @@ readBlobFromFile' file = do
 -- | Read all blobs in the directory with Language.supportedExts
 readBlobsFromDir :: MonadIO m => FilePath -> m [Blob]
 readBlobsFromDir path = liftIO . fmap catMaybes $
-  findFilesInDir path supportedExts mempty >>= Async.mapConcurrently (readBlobFromFile . file)
+  findFilesInDir path supportedExts mempty >>= Async.mapConcurrently (readBlobFromFile . fileForPath)
 
 -- | Read all blobs from the Git repo with Language.supportedExts
 readBlobsFromGitRepo :: MonadIO m => FilePath -> Git.OID -> [FilePath] -> m [Blob]
@@ -68,7 +53,7 @@ readBlobsFromGitRepo path oid excludePaths = liftIO . fmap catMaybes $
       = Just . sourceBlob' path lang oid . fromText <$> Git.catFile gitDir oid
     blobFromTreeEntry _ _ = pure Nothing
 
-    sourceBlob' filepath language (Git.OID oid) source = Blob source filepath language oid
+    sourceBlob' filepath language (Git.OID oid) source = legacyMakeBlob source filepath language oid
 
 readFilePair :: MonadIO m => File -> File -> m BlobPair
 readFilePair a b = do

src/Data/Error.hs

@@ -54,7 +54,7 @@ formatError includeSource colourize blob@Blob{..} Error{..}
   . (if Flag.toBool LogPrintSource includeSource then showExcerpt colourize errorSpan blob else id)
   . showCallStack colourize callStack . showChar '\n'
   where
-    path = Just $ if Flag.toBool LogPrintSource includeSource then blobPath else "<filtered>"
+    path = Just $ if Flag.toBool LogPrintSource includeSource then blobPath blob else "<filtered>"
 
 showExcerpt :: Flag Colourize -> Span -> Blob -> ShowS
 showExcerpt colourize Span{..} Blob{..}

src/Data/Project.hs

@@ -18,7 +18,7 @@ import Prologue
 import           Control.Effect
 import           Control.Effect.Error
 import           Data.Blob
-import           Data.File
+import           Data.Blob.IO
 import           Data.Language
 import qualified Data.Text as T
 import           System.FilePath.Posix
@@ -52,7 +52,7 @@ projectExtensions :: Project -> [String]
 projectExtensions = extensionsForLanguage . projectLanguage
 
 projectFiles :: Project -> [File]
-projectFiles = fmap toFile . projectBlobs
+projectFiles = fmap blobInfo . projectBlobs
 
 newtype ProjectException
   = FileNotFound FilePath

src/Parsing/TreeSitter.hs

@@ -65,7 +65,7 @@ parseToAST :: ( Bounded grammar
            -> Ptr TS.Language
            -> Blob
            -> m (Maybe (AST [] grammar))
-parseToAST parseTimeout language Blob{..} = bracket (liftIO TS.ts_parser_new) (liftIO . TS.ts_parser_delete) $ \ parser -> do
+parseToAST parseTimeout language b@Blob{..} = bracket (liftIO TS.ts_parser_new) (liftIO . TS.ts_parser_delete) $ \ parser -> do
   result <- liftIO $ do
     let timeoutMicros = fromIntegral $ toMicroseconds parseTimeout
     TS.ts_parser_set_timeout_micros parser timeoutMicros
@@ -73,8 +73,8 @@ parseToAST parseTimeout language Blob{..} = bracket (liftIO TS.ts_parser_new) (l
     TS.ts_parser_set_language parser language
     runParser parser blobSource
   case result of
-    Failed          -> Nothing  <$ trace ("tree-sitter: parsing failed " <> blobPath)
-    (Succeeded ast) -> Just ast <$ trace ("tree-sitter: parsing succeeded " <> blobPath)
+    Failed          -> Nothing  <$ trace ("tree-sitter: parsing failed " <> blobPath b)
+    (Succeeded ast) -> Just ast <$ trace ("tree-sitter: parsing succeeded " <> blobPath b)
 
 toAST :: forall grammar . (Bounded grammar, Enum grammar) => TS.Node -> IO (Base (AST [] grammar) TS.Node)
 toAST node@TS.Node{..} = do

src/Rendering/JSON.hs

@@ -105,10 +105,11 @@ renderJSONError blob e = JSON [ renderError blob e ]
 
 -- | Render an error for a particular blob.
 renderError :: ToJSON a => Blob -> a -> SomeJSON
-renderError Blob{..} e = SomeJSON $ object
+renderError b e = SomeJSON $ object
   [ "error" .= e
-  , "path" .= blobPath
-  , "language" .= blobLanguage ]
+  , "path" .= blobPath b
+  , "language" .= blobLanguage b
+  ]
 
 -- | Render an error for diffs.
 renderJSONDiffError :: BlobPair -> String -> JSON "diffs" SomeJSON

src/Rendering/TOC.hs

@@ -144,10 +144,10 @@ diffTOC :: (Foldable f, Functor f) => Diff f (Maybe Declaration) (Maybe Declarat
 diffTOC = fmap entrySummary . dedupe . tableOfContentsBy declaration
 
 renderToCTerm :: (Foldable f, Functor f) => Blob -> Term f (Maybe Declaration) -> Summaries
-renderToCTerm Blob{..} = uncurry Summaries . bimap toMap toMap . List.partition isValidSummary . termToC
+renderToCTerm b@Blob{..} = uncurry Summaries . bimap toMap toMap . List.partition isValidSummary . termToC
   where
     toMap [] = mempty
-    toMap as = Map.singleton (T.pack blobPath) (toJSON <$> as)
+    toMap as = Map.singleton (T.pack (blobPath b)) (toJSON <$> as)
 
     termToC :: (Foldable f, Functor f) => Term f (Maybe Declaration) -> [TOCSummary]
     termToC = fmap (recordSummary "unchanged") . termTableOfContentsBy declaration

src/Semantic/AST.hs

@@ -29,8 +29,8 @@ withSomeAST f (SomeAST ast) = f ast
 
 astParseBlob :: (Member (Error SomeException) sig, Member Task sig, Carrier sig m) => Blob -> m SomeAST
 astParseBlob blob@Blob{..}
-  | Just (SomeASTParser parser) <- someASTParser blobLanguage = SomeAST <$> parse parser blob
-  | otherwise = noLanguageForBlob blobPath
+  | Just (SomeASTParser parser) <- someASTParser (blobLanguage blob) = SomeAST <$> parse parser blob
+  | otherwise = noLanguageForBlob (blobPath blob)
 
 
 data ASTFormat = SExpression | JSON | Show | Quiet

src/Semantic/Api/Bridge.hs

@@ -97,8 +97,8 @@ instance APIBridge T.Text Data.Language where
 
 instance APIBridge API.Blob Data.Blob where
   bridging = iso apiBlobToBlob blobToApiBlob where
-    blobToApiBlob Data.Blob{..} = API.Blob (toText blobSource) (T.pack blobPath) (bridging # blobLanguage)
-    apiBlobToBlob API.Blob{..} = Data.Blob (fromText content) (T.unpack path) (language ^. bridging) mempty
+    blobToApiBlob b = API.Blob (toText (Data.blobSource b)) (T.pack (Data.blobPath b)) (bridging # Data.blobLanguage b)
+    apiBlobToBlob API.Blob{..} = Data.legacyMakeBlob (fromText content) (T.unpack path) (language ^. bridging) mempty
 
 
 instance APIConvert API.BlobPair Data.BlobPair where

src/Semantic/Api/LegacyTypes.hs

@@ -10,7 +10,7 @@ module Semantic.Api.LegacyTypes
   ) where
 
 import Data.Aeson
-import Data.Blob
+import Data.Blob hiding (File(..))
 import Prologue
 
 newtype DiffTreeRequest = DiffTreeRequest { blobs :: [BlobPair] }

src/Semantic/Api/Symbols.hs

@@ -11,7 +11,7 @@ import           Control.Effect
 import           Control.Effect.Error
 import           Control.Exception
 import           Control.Lens
-import           Data.Blob
+import           Data.Blob hiding (File (..))
 import           Data.ByteString.Builder
 import           Data.Location
 import           Data.Maybe
@@ -35,7 +35,7 @@ legacyParseSymbols blobs = Legacy.ParseTreeSymbolResponse <$> distributeFoldMap
   where
     go :: (Member (Error SomeException) sig, Member Task sig, Carrier sig m) => Blob -> m [Legacy.File]
     go blob@Blob{..} = (doParse blob >>= withSomeTerm (renderToSymbols blob)) `catchError` (\(SomeException _) -> pure (pure emptyFile))
-      where emptyFile = Legacy.File (pack blobPath) (pack (show blobLanguage)) []
+      where emptyFile = Legacy.File (pack (blobPath blob)) (pack (show (blobLanguage blob))) []
 
     -- Legacy symbols output doesn't include Function Calls.
     symbolsToSummarize :: [Text]
@@ -45,7 +45,7 @@ legacyParseSymbols blobs = Legacy.ParseTreeSymbolResponse <$> distributeFoldMap
     renderToSymbols blob term = pure $ either mempty (pure . tagsToFile blob) (runTagging blob symbolsToSummarize term)
 
     tagsToFile :: Blob -> [Tag] -> Legacy.File
-    tagsToFile Blob{..} tags = Legacy.File (pack blobPath) (pack (show blobLanguage)) (fmap tagToSymbol tags)
+    tagsToFile b@Blob{..} tags = Legacy.File (pack (blobPath b)) (pack (show (blobLanguage b))) (fmap tagToSymbol tags)
 
     tagToSymbol :: Tag -> Legacy.Symbol
     tagToSymbol Tag{..}
@@ -65,7 +65,7 @@ parseSymbols blobs = ParseTreeSymbolResponse . V.fromList . toList <$> distribut
     go :: (Member (Error SomeException) sig, Member Task sig, Carrier sig m) => Blob -> m File
     go blob@Blob{..} = (doParse blob >>= withSomeTerm (renderToSymbols blob)) `catchError` (\(SomeException e) -> pure $ errorFile (show e))
       where
-        errorFile e = File (pack blobPath) (bridging # blobLanguage) mempty (V.fromList [ParseError (T.pack e)]) blobOid
+        errorFile e = File (pack (blobPath blob)) (bridging # blobLanguage blob) mempty (V.fromList [ParseError (T.pack e)]) blobOid
 
         symbolsToSummarize :: [Text]
         symbolsToSummarize = ["Function", "Method", "Class", "Module", "Call", "Send"]
@@ -74,7 +74,7 @@ parseSymbols blobs = ParseTreeSymbolResponse . V.fromList . toList <$> distribut
         renderToSymbols blob@Blob{..} term = pure $ either (errorFile . show) (tagsToFile blob) (runTagging blob symbolsToSummarize term)
 
         tagsToFile :: Blob -> [Tag] -> File
-        tagsToFile Blob{..} tags = File (pack blobPath) (bridging # blobLanguage) (V.fromList (fmap tagToSymbol tags)) mempty blobOid
+        tagsToFile b@Blob{..} tags = File (pack (blobPath b)) (bridging # blobLanguage b) (V.fromList (fmap tagToSymbol tags)) mempty blobOid
 
         tagToSymbol :: Tag -> Symbol
         tagToSymbol Tag{..}

src/Semantic/Api/Terms.hs

@@ -99,7 +99,7 @@ quietTerm blob = showTiming blob <$> time' ( (doParse blob >>= withSomeTerm (fma
     timingError (SomeException e) = pure (Left (show e))
     showTiming Blob{..} (res, duration) =
       let status = if isLeft res then "ERR" else "OK"
-      in stringUtf8 (status <> "\t" <> show blobLanguage <> "\t" <> blobPath <> "\t" <> show duration <> " ms\n")
+      in stringUtf8 (status <> "\t" <> show (blobLanguage blob) <> "\t" <> blobPath blob <> "\t" <> show duration <> " ms\n")
 
 
 type ParseEffects sig m = (Member (Error SomeException) sig, Member Task sig, Carrier sig m)
@@ -113,7 +113,7 @@ type TermConstraints =
   ]
 
 doParse :: (ParseEffects sig m) => Blob -> m (SomeTerm TermConstraints Location)
-doParse blob@Blob{..} = case blobLanguage of
+doParse blob@Blob{..} = case blobLanguage blob of
   Go         -> SomeTerm <$> parse goParser blob
   Haskell    -> SomeTerm <$> parse haskellParser blob
   Java       -> SomeTerm <$> parse javaParser blob
@@ -125,4 +125,4 @@ doParse blob@Blob{..} = case blobLanguage of
   Ruby       -> SomeTerm <$> parse rubyParser blob
   TypeScript -> SomeTerm <$> parse typescriptParser blob
   PHP        -> SomeTerm <$> parse phpParser blob
-  _          -> noLanguageForBlob blobPath
+  _          -> noLanguageForBlob (blobPath blob)

src/Semantic/CLI.hs

@@ -2,7 +2,8 @@
 module Semantic.CLI (main) where
 
 import           Control.Exception as Exc (displayException)
-import           Data.File
+import           Data.Blob
+import           Data.Blob.IO
 import           Data.Handle
 import           Data.Language (languageForFilePath, parseLanguage)
 import           Data.List (intercalate, uncons)

src/Semantic/Graph.hs

@@ -49,7 +49,7 @@ import           Data.Abstract.Value.Concrete as Concrete
 import           Data.Abstract.Value.Type as Type
 import           Data.Abstract.AccessControls.Instances ()
 import           Data.Blob
-import           Data.File
+import           Data.Blob.IO
 import           Data.Graph
 import           Data.Graph.ControlFlowVertex (VertexDeclarationStrategy, VertexDeclarationWithStrategy)
 import           Data.Language as Language

src/Semantic/REPL.hs

@@ -18,9 +18,9 @@ import Data.Abstract.Module
 import Data.Abstract.ModuleTable as ModuleTable
 import Data.Abstract.Package
 import Data.Abstract.Value.Concrete as Concrete
-import Data.Blob (Blob(..))
+import Data.Blob (File(..), Blob(..))
 import Data.Error (Colourize (..), showExcerpt)
-import Data.File (File (..), readBlobFromFile)
+import Data.Blob.IO (readBlobFromFile)
 import Data.Flag (flag)
 import Data.Graph (topologicalSort)
 import Data.Language as Language

src/Semantic/Resolution.hs

@@ -13,7 +13,6 @@ import           Control.Effect.Sum
 import           Data.Aeson
 import           Data.Aeson.Types (parseMaybe)
 import           Data.Blob
-import           Data.File
 import           Data.Project
 import qualified Data.Map as Map
 import           Data.Source
@@ -26,12 +25,12 @@ import           System.FilePath.Posix
 nodeJSResolutionMap :: (Member Files sig, Carrier sig m, MonadIO m) => FilePath -> Text -> [FilePath] -> m (Map FilePath FilePath)
 nodeJSResolutionMap rootDir prop excludeDirs = do
   files <- findFiles rootDir [".json"] excludeDirs
-  let packageFiles = file <$> filter ((==) "package.json" . takeFileName) files
+  let packageFiles = fileForPath <$> filter ((==) "package.json" . takeFileName) files
   blobs <- readBlobs (FilesFromPaths packageFiles)
   pure $ fold (mapMaybe (lookup prop) blobs)
   where
     lookup :: Text -> Blob -> Maybe (Map FilePath FilePath)
-    lookup k Blob{..} = decodeStrict (sourceBytes blobSource) >>= lookupProp blobPath k
+    lookup k b@Blob{..} = decodeStrict (sourceBytes blobSource) >>= lookupProp (blobPath b) k
 
     lookupProp :: FilePath -> Text -> Object -> Maybe (Map FilePath FilePath)
     lookupProp path k res = flip parseMaybe res $ \obj -> Map.singleton relPkgDotJSONPath . relEntryPath <$> obj .: k

src/Semantic/Task.hs

@@ -286,7 +286,7 @@ runParser blob@Blob{..} parser = case parser of
       let term = cmarkParser blobSource
       in length term `seq` pure term
   SomeParser parser -> SomeTerm <$> runParser blob parser
-  where languageTag = pure . (,) ("language" :: String) . show $ blobLanguage
+  where languageTag = pure . (,) ("language" :: String) . show $ blobLanguage blob
         errors :: (Syntax.Error :< fs, Apply Foldable fs, Apply Functor fs) => Term (Sum fs) Assignment.Location -> [Error.Error String]
         errors = cata $ \ (In Assignment.Location{..} syntax) -> case syntax of
           _ | Just err@Syntax.Error{} <- project syntax -> [Syntax.unError locationSpan err]
@@ -313,7 +313,7 @@ runParser blob@Blob{..} parser = case parser of
           let requestID' = ("github_request_id", requestID taskSession)
           let isPublic'  = ("github_is_public", show (isPublic taskSession))
           let logPrintFlag = configLogPrintSource . config $ taskSession
-          let blobFields = ("path", if isPublic taskSession || Flag.toBool LogPrintSource logPrintFlag then blobPath else "<filtered>")
+          let blobFields = ("path", if isPublic taskSession || Flag.toBool LogPrintSource logPrintFlag then blobPath blob else "<filtered>")
           let logFields = requestID' : isPublic' : blobFields : languageTag
           let shouldFailForTesting = configFailParsingForTesting $ config taskSession
           let shouldFailOnParsing = optionsFailOnParseError . configOptions $ config taskSession

src/Semantic/Task/Files.hs

@@ -23,8 +23,8 @@ import           Control.Effect.Catch
 import           Control.Effect.Error
 import           Control.Effect.Sum
 import           Data.Blob
+import           Data.Blob.IO
 import qualified Data.ByteString.Builder as B
-import           Data.File
 import           Data.Handle
 import           Data.Language
 import           Data.Project hiding (readFile)

src/Semantic/Util.hs

@@ -25,7 +25,8 @@ import           Data.Abstract.Module
 import qualified Data.Abstract.ModuleTable as ModuleTable
 import           Data.Abstract.Package
 import           Data.Abstract.Value.Concrete as Concrete
-import           Data.File
+import           Data.Blob
+import           Data.Blob.IO
 import           Data.Graph (topologicalSort)
 import qualified Data.Language as Language
 import           Data.List (uncons)
@@ -218,7 +219,7 @@ evaluateProject' session proxy parser paths = do
   either (die . displayException) pure res
 
 parseFile :: Parser term -> FilePath -> IO term
-parseFile parser = runTask' . (parse parser <=< readBlob . file)
+parseFile parser = runTask' . (parse parser <=< readBlob . fileForPath)
 
 runTask' :: TaskEff a -> IO a
 runTask' task = runTaskWithOptions debugOptions task >>= either (die . displayException) pure

src/Semantic/UtilDisabled.hs

@@ -28,7 +28,7 @@ import           Data.Abstract.Package
 import           Data.Abstract.Value.Concrete as Concrete
 import           Data.Abstract.Value.Type as Type
 import           Data.Blob
-import           Data.File
+import           Data.Blob.IO
 import           Data.Graph (topologicalSort)
 import           Data.Graph.ControlFlowVertex
 import qualified Data.Language as Language

src/Tags/Taggable.hs

@@ -118,9 +118,9 @@ tagging :: (IsTaggable syntax)
   => Blob
   -> Term syntax Location
   -> Machine.Source Token
-tagging Blob{..} term = pipe
+tagging b term = pipe
   where pipe = Machine.construct $ compile go
-        go   = foldSubterms (descend blobLanguage) term
+        go   = foldSubterms (descend (blobLanguage b)) term
 
 descend ::
   ( Taggable (TermF syntax Location)

test/Examples.hs

@@ -9,7 +9,7 @@ import qualified Data.ByteString as B
 import           Data.ByteString.Builder
 import qualified Data.ByteString.Char8 as BC
 import           Data.Either
-import           Data.File (file)
+import           Data.Blob.IO (file)
 import           Data.Flag
 import           Data.Foldable
 import           Data.List

test/SpecHelpers.hs

@@ -38,12 +38,11 @@ import Data.Abstract.Name as X
 import Data.Abstract.Value.Concrete (Value(..), ValueError, runValueError)
 import Data.Bifunctor (first)
 import Data.Blob as X
+import Data.Blob.IO as X hiding (readFilePair)
 import Data.ByteString.Builder (toLazyByteString)
 import Data.ByteString.Lazy (toStrict)
 import Data.Project as X
 import Data.Proxy as X
-import qualified Data.File as F
-import Data.File as X hiding (readFilePair)
 import Data.Foldable (toList)
 import Data.Functor.Listable as X
 import Data.Language as X