1
1
mirror of https://github.com/github/semantic.git synced 2024-11-30 14:47:30 +03:00

Start moving Blob around.

This commit is contained in:
Patrick Thomson 2020-02-11 13:18:10 -05:00
parent 6162dbd191
commit d2bd643745
5 changed files with 78 additions and 61 deletions

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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