diff --git a/semantic-analysis/semantic-analysis.cabal b/semantic-analysis/semantic-analysis.cabal index a3740d9da..cbb1aa731 100644 --- a/semantic-analysis/semantic-analysis.cabal +++ b/semantic-analysis/semantic-analysis.cabal @@ -40,6 +40,7 @@ library import: common hs-source-dirs: src exposed-modules: + Analysis.Blob Analysis.Carrier.Env.Monovariant Analysis.Carrier.Env.Precise Analysis.Carrier.Heap.Monovariant diff --git a/semantic-analysis/src/Analysis/Blob.hs b/semantic-analysis/src/Analysis/Blob.hs new file mode 100644 index 000000000..11de2338b --- /dev/null +++ b/semantic-analysis/src/Analysis/Blob.hs @@ -0,0 +1,45 @@ +{-# LANGUAGE OverloadedStrings #-} +module Analysis.Blob + ( Blob (..) + , fromSource + , blobLanguage + , blobPath + , nullBlob + ) where + +import Analysis.File +import Data.Aeson +import Source.Language as Language +import Source.Source as Source +import qualified System.Path as Path +import qualified System.Path.PartClass as Path.PartClass + +-- | 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 Language -- ^ Path/language information for this blob. + } deriving (Show, Eq) + +instance FromJSON Blob where + parseJSON = withObject "Blob" $ \b -> do + src <- b .: "content" + Right pth <- fmap Path.parse (b .: "path") + lang <- b .: "language" + let lang' = if knownLanguage lang then lang else Language.forPath pth + pure (fromSource (pth :: Path.AbsRelFile) lang' src) + + +-- | Create a Blob from a provided path, language, and UTF-8 source. +-- 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) + +blobLanguage :: Blob -> Language +blobLanguage = Analysis.File.fileBody . blobFile + +blobPath :: Blob -> FilePath +blobPath = Path.toString . Analysis.File.filePath . blobFile + +nullBlob :: Blob -> Bool +nullBlob = Source.null . blobSource diff --git a/semantic-analysis/src/Analysis/Project.hs b/semantic-analysis/src/Analysis/Project.hs index 0831d85bc..b4908cd09 100644 --- a/semantic-analysis/src/Analysis/Project.hs +++ b/semantic-analysis/src/Analysis/Project.hs @@ -3,22 +3,16 @@ module Analysis.Project , projectExtensions , projectName , projectFiles - , readProjectFromPaths ) where import Prelude hiding (readFile) +import Analysis.Blob import Analysis.File -import Control.Monad.IO.Class -import Data.Blob -import Data.Blob.IO import Data.Language -import Data.Semilattice.Lower import Data.Text (Text) import qualified Data.Text as T -import Semantic.IO import System.FilePath.Posix -import qualified System.Path as Path -- | A 'Project' contains all the information that semantic needs -- to execute an analysis, diffing, or graphing pass. @@ -37,27 +31,3 @@ projectExtensions = extensionsForLanguage . projectLanguage projectFiles :: Project -> [File Language] projectFiles = fmap blobFile . projectBlobs - -readProjectFromPaths :: MonadIO m - => Maybe Path.AbsRelDir -- ^ An optional root directory for the project - -> Path.AbsRelFileDir -- ^ A file or directory to parse. Passing a file path loads all files in that file's parent directory. - -> Language - -> [Path.AbsRelDir] -- ^ Directories to exclude. - -> m Project -readProjectFromPaths maybeRoot path lang excludeDirs = do - let rootDir :: Path.AbsRelDir - rootDir = case maybeRoot >>= Path.fromAbsRel of - -- If we were provided a root directory, use that. - Just root -> root - Nothing -> case Path.fileFromFileDir path of - -- If we weren't and the path is a file, drop its file name. - Just fp -> Path.takeDirectory fp - -- Otherwise, load from the path. - Nothing -> Path.dirFromFileDir path - - paths <- liftIO $ findFilesInDir rootDir exts excludeDirs - blobs <- liftIO $ traverse (readBlobFromFile' . toFile) paths - pure $ Project (Path.toString rootDir) blobs lang (fmap Path.toString excludeDirs) - where - toFile path = File path lowerBound lang - exts = extensionsForLanguage lang diff --git a/src/Data/Blob.hs b/src/Data/Blob.hs index 9b6a7853d..f61abb51d 100644 --- a/src/Data/Blob.hs +++ b/src/Data/Blob.hs @@ -5,9 +5,9 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} +-- | Semantic-specific functionality for blob handling. module Data.Blob -( Blob(..) -, Blobs(..) +( Blobs(..) , blobLanguage , NoLanguageForBlob (..) , blobPath @@ -23,9 +23,11 @@ module Data.Blob , languageTagForBlobPair , pathForBlobPair , pathKeyForBlobPair +, module Analysis.Blob ) where +import Analysis.Blob import Analysis.File (File (..)) import Control.Effect.Error import Control.Exception @@ -45,38 +47,10 @@ import qualified System.FilePath as FP import qualified System.Path as Path import qualified System.Path.PartClass as Path.PartClass --- | 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 Language -- ^ Path/language information for this blob. - } deriving (Show, Eq) - -blobLanguage :: Blob -> Language -blobLanguage = Analysis.File.fileBody . blobFile - -blobPath :: Blob -> FilePath -blobPath = Path.toString . Analysis.File.filePath . blobFile newtype Blobs a = Blobs { blobs :: [a] } deriving (Generic, FromJSON) -instance FromJSON Blob where - parseJSON = withObject "Blob" $ \b -> do - src <- b .: "content" - Right pth <- fmap Path.parse (b .: "path") - 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 - --- | Create a Blob from a provided path, language, and UTF-8 source. --- 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) - decodeBlobs :: BL.ByteString -> Either String [Blob] decodeBlobs = fmap blobs <$> eitherDecode diff --git a/src/Data/Blob/IO.hs b/src/Data/Blob/IO.hs index 7ceae0e47..5f8a0bb43 100644 --- a/src/Data/Blob/IO.hs +++ b/src/Data/Blob/IO.hs @@ -9,6 +9,7 @@ module Data.Blob.IO , readFilePair ) where +import Analysis.Blob import Analysis.File as File import qualified Control.Concurrent.Async as Async import Control.Monad.IO.Class @@ -20,6 +21,32 @@ import Semantic.IO import qualified Source.Source as Source import qualified System.Path as Path +-- | Deprecated: this has very weird semantics. +readProjectFromPaths :: MonadIO m + => Maybe Path.AbsRelDir -- ^ An optional root directory for the project + -> Path.AbsRelFileDir -- ^ A file or directory to parse. Passing a file path loads all files in that file's parent directory. + -> Language + -> [Path.AbsRelDir] -- ^ Directories to exclude. + -> m Project +readProjectFromPaths maybeRoot path lang excludeDirs = do + let rootDir :: Path.AbsRelDir + rootDir = case maybeRoot >>= Path.fromAbsRel of + -- If we were provided a root directory, use that. + Just root -> root + Nothing -> case Path.fileFromFileDir path of + -- If we weren't and the path is a file, drop its file name. + Just fp -> Path.takeDirectory fp + -- Otherwise, load from the path. + Nothing -> Path.dirFromFileDir path + + paths <- liftIO $ findFilesInDir rootDir exts excludeDirs + blobs <- liftIO $ traverse (readBlobFromFile' . toFile) paths + pure $ Project (Path.toString rootDir) blobs lang (fmap Path.toString excludeDirs) + where + toFile path = File path lowerBound lang + exts = extensionsForLanguage lang + + -- | Read a utf8-encoded file to a 'Blob'. readBlobFromFile :: MonadIO m => File Language -> m (Maybe Blob) readBlobFromFile (File (Path.toString -> "/dev/null") _ _) = pure Nothing