mirror of
https://github.com/github/semantic.git
synced 2024-12-27 00:44:57 +03:00
Concrete was a lousy name
This commit is contained in:
parent
4d8fe33ad4
commit
63fdf40cb0
@ -2,8 +2,8 @@
|
|||||||
|
|
||||||
module Data.Project (
|
module Data.Project (
|
||||||
-- * Projects
|
-- * Projects
|
||||||
Project (..)
|
ProjectF (..)
|
||||||
, Concrete
|
, Project
|
||||||
, PB
|
, PB
|
||||||
, ProjectException (..)
|
, ProjectException (..)
|
||||||
, fromPB
|
, fromPB
|
||||||
@ -33,8 +33,8 @@ import System.FilePath.Posix
|
|||||||
-- in terms of the container type for paths and blobs, as well as the
|
-- in terms of the container type for paths and blobs, as well as the
|
||||||
-- path type (this is necessary because protobuf uses different vector
|
-- path type (this is necessary because protobuf uses different vector
|
||||||
-- representations for @repeated string@ and @repeated Blob@.
|
-- representations for @repeated string@ and @repeated Blob@.
|
||||||
-- You probably want to use the 'Concrete' or 'PB' type aliases.
|
-- You probably want to use the 'Project' or 'PB' type aliases.
|
||||||
data Project (blobs :: * -> *) (paths :: * -> *) path = Project
|
data ProjectF (blobs :: * -> *) (paths :: * -> *) path = Project
|
||||||
{ projectRootDir :: path
|
{ projectRootDir :: path
|
||||||
, projectBlobs :: blobs Blob
|
, projectBlobs :: blobs Blob
|
||||||
, projectLanguage :: Language
|
, projectLanguage :: Language
|
||||||
@ -45,22 +45,22 @@ data Project (blobs :: * -> *) (paths :: * -> *) path = Project
|
|||||||
deriving instance ( MessageField path
|
deriving instance ( MessageField path
|
||||||
, MessageField (paths path)
|
, MessageField (paths path)
|
||||||
, MessageField (blobs Blob)
|
, MessageField (blobs Blob)
|
||||||
) => Message (Project blobs paths path)
|
) => Message (ProjectF blobs paths path)
|
||||||
|
|
||||||
deriving instance (Eq path, Eq (blobs Blob), Eq (paths path)) => Eq (Project blobs paths path)
|
deriving instance (Eq path, Eq (blobs Blob), Eq (paths path)) => Eq (ProjectF blobs paths path)
|
||||||
deriving instance (Show path, Show (blobs Blob), Show (paths path)) => Show (Project blobs paths path)
|
deriving instance (Show path, Show (blobs Blob), Show (paths path)) => Show (ProjectF blobs paths path)
|
||||||
|
|
||||||
-- | This 'Project' type is the one used during semantic's normal
|
-- | This 'Project' type is the one used during semantic's normal
|
||||||
-- course of diffing, evaluation, and graphing. You probably want to
|
-- course of diffing, evaluation, and graphing. You probably want to
|
||||||
-- use this one.
|
-- use this one.
|
||||||
type Concrete = Project [] [] FilePath
|
type Project = ProjectF [] [] FilePath
|
||||||
|
|
||||||
-- | This 'Project' type is protobuf-compatible, and corresponds with
|
-- | This 'Project' type is protobuf-compatible, and corresponds with
|
||||||
-- the @Project@ message declaration present in types.proto.
|
-- the @Project@ message declaration present in types.proto.
|
||||||
type PB = Project NestedVec UnpackedVec Text
|
type PB = ProjectF NestedVec UnpackedVec Text
|
||||||
|
|
||||||
-- | Convert from a packed protobuf representatio nto a more useful one.
|
-- | Convert from a packed protobuf representatio nto a more useful one.
|
||||||
fromPB :: PB -> Concrete
|
fromPB :: PB -> Project
|
||||||
fromPB Project {..} = Project
|
fromPB Project {..} = Project
|
||||||
{ projectRootDir = T.unpack projectRootDir
|
{ projectRootDir = T.unpack projectRootDir
|
||||||
, projectBlobs = toList projectBlobs
|
, projectBlobs = toList projectBlobs
|
||||||
@ -69,20 +69,20 @@ fromPB Project {..} = Project
|
|||||||
, projectExcludeDirs = T.unpack <$> toList projectExcludeDirs
|
, projectExcludeDirs = T.unpack <$> toList projectExcludeDirs
|
||||||
}
|
}
|
||||||
|
|
||||||
projectName :: Concrete -> Text
|
projectName :: Project -> Text
|
||||||
projectName = T.pack . dropExtensions . takeFileName . projectRootDir
|
projectName = T.pack . dropExtensions . takeFileName . projectRootDir
|
||||||
|
|
||||||
projectExtensions :: Concrete -> [String]
|
projectExtensions :: Project -> [String]
|
||||||
projectExtensions = extensionsForLanguage . projectLanguage
|
projectExtensions = extensionsForLanguage . projectLanguage
|
||||||
|
|
||||||
projectEntryPoints :: Concrete -> [File]
|
projectEntryPoints :: Project -> [File]
|
||||||
projectEntryPoints Project {..} = foldr go [] projectBlobs
|
projectEntryPoints Project {..} = foldr go [] projectBlobs
|
||||||
where go b acc =
|
where go b acc =
|
||||||
if blobPath b `elem` projectEntryPaths
|
if blobPath b `elem` projectEntryPaths
|
||||||
then toFile b : acc
|
then toFile b : acc
|
||||||
else acc
|
else acc
|
||||||
|
|
||||||
projectFiles :: Concrete -> [File]
|
projectFiles :: Project -> [File]
|
||||||
projectFiles = fmap toFile . projectBlobs
|
projectFiles = fmap toFile . projectBlobs
|
||||||
|
|
||||||
data File = File
|
data File = File
|
||||||
@ -103,7 +103,7 @@ newtype ProjectException
|
|||||||
deriving (Show, Eq, Typeable, Exception)
|
deriving (Show, Eq, Typeable, Exception)
|
||||||
|
|
||||||
readFile :: Member (Exc SomeException) effs
|
readFile :: Member (Exc SomeException) effs
|
||||||
=> Concrete
|
=> Project
|
||||||
-> File
|
-> File
|
||||||
-> Eff effs (Maybe Blob)
|
-> Eff effs (Maybe Blob)
|
||||||
readFile Project{..} f =
|
readFile Project{..} f =
|
||||||
|
@ -16,6 +16,8 @@ module Semantic.Graph
|
|||||||
, resumingEnvironmentError
|
, resumingEnvironmentError
|
||||||
) where
|
) where
|
||||||
|
|
||||||
|
import Prelude hiding (readFile)
|
||||||
|
|
||||||
import Analysis.Abstract.Evaluating
|
import Analysis.Abstract.Evaluating
|
||||||
import Analysis.Abstract.Graph
|
import Analysis.Abstract.Graph
|
||||||
import Control.Abstract
|
import Control.Abstract
|
||||||
@ -27,7 +29,6 @@ import Data.Abstract.Package as Package
|
|||||||
import Data.Abstract.Value (Value, ValueError (..), runValueErrorWith)
|
import Data.Abstract.Value (Value, ValueError (..), runValueErrorWith)
|
||||||
import Data.Graph
|
import Data.Graph
|
||||||
import Data.Project
|
import Data.Project
|
||||||
import qualified Data.Project as Project
|
|
||||||
import Data.Record
|
import Data.Record
|
||||||
import Data.Term
|
import Data.Term
|
||||||
import Data.Text (pack)
|
import Data.Text (pack)
|
||||||
@ -40,7 +41,7 @@ data GraphType = ImportGraph | CallGraph
|
|||||||
runGraph :: (Member (Exc SomeException) effs, Member (Distribute WrappedTask) effs, Member Resolution effs, Member Task effs, Member Trace effs)
|
runGraph :: (Member (Exc SomeException) effs, Member (Distribute WrappedTask) effs, Member Resolution effs, Member Task effs, Member Trace effs)
|
||||||
=> GraphType
|
=> GraphType
|
||||||
-> Bool
|
-> Bool
|
||||||
-> Project.Concrete
|
-> Project
|
||||||
-> Eff effs (Graph Vertex)
|
-> Eff effs (Graph Vertex)
|
||||||
runGraph graphType includePackages project
|
runGraph graphType includePackages project
|
||||||
| SomeAnalysisParser parser prelude <- someAnalysisParser
|
| SomeAnalysisParser parser prelude <- someAnalysisParser
|
||||||
@ -71,7 +72,7 @@ runGraph graphType includePackages project
|
|||||||
parsePackage :: (Member (Exc SomeException) effs, Member (Distribute WrappedTask) effs, Member Resolution effs, Member Task effs, Member Trace effs)
|
parsePackage :: (Member (Exc SomeException) effs, Member (Distribute WrappedTask) effs, Member Resolution effs, Member Task effs, Member Trace effs)
|
||||||
=> Parser term -- ^ A parser.
|
=> Parser term -- ^ A parser.
|
||||||
-> Maybe File -- ^ Prelude (optional).
|
-> Maybe File -- ^ Prelude (optional).
|
||||||
-> Project.Concrete -- ^ Project to parse into a package.
|
-> Project -- ^ Project to parse into a package.
|
||||||
-> Eff effs (Package term)
|
-> Eff effs (Package term)
|
||||||
parsePackage parser preludeFile project@Project{..} = do
|
parsePackage parser preludeFile project@Project{..} = do
|
||||||
prelude <- traverse (parseModule project parser) preludeFile
|
prelude <- traverse (parseModule project parser) preludeFile
|
||||||
@ -88,12 +89,12 @@ parsePackage parser preludeFile project@Project{..} = do
|
|||||||
parseModules parser = distributeFor (projectEntryPoints project <> projectFiles project) (WrapTask . parseModule project parser)
|
parseModules parser = distributeFor (projectEntryPoints project <> projectFiles project) (WrapTask . parseModule project parser)
|
||||||
|
|
||||||
-- | Parse a file into a 'Module'.
|
-- | Parse a file into a 'Module'.
|
||||||
parseModule :: (Member (Exc SomeException) effs, Member Task effs) => Project.Concrete -> Parser term -> File -> Eff effs (Module term)
|
parseModule :: (Member (Exc SomeException) effs, Member Task effs) => Project -> Parser term -> File -> Eff effs (Module term)
|
||||||
parseModule proj parser file = do
|
parseModule proj parser file = do
|
||||||
mBlob <- Project.readFile proj file
|
mBlob <- readFile proj file
|
||||||
case mBlob of
|
case mBlob of
|
||||||
Just blob -> moduleForBlob (Just (projectRootDir proj)) blob <$> parse parser blob
|
Just blob -> moduleForBlob (Just (projectRootDir proj)) blob <$> parse parser blob
|
||||||
Nothing -> throwError (SomeException (Project.FileNotFound (Project.filePath file)))
|
Nothing -> throwError (SomeException (FileNotFound (filePath file)))
|
||||||
|
|
||||||
withTermSpans :: ( HasField fields Span
|
withTermSpans :: ( HasField fields Span
|
||||||
, Member (Reader Span) effects
|
, Member (Reader Span) effects
|
||||||
|
@ -42,8 +42,7 @@ import Control.Monad.IO.Class
|
|||||||
import Data.Aeson
|
import Data.Aeson
|
||||||
import Data.Blob
|
import Data.Blob
|
||||||
import Data.Bool
|
import Data.Bool
|
||||||
import qualified Data.Project as Project
|
import Data.Project hiding (readFile)
|
||||||
import Data.Project (File (..))
|
|
||||||
import qualified Data.ByteString as B
|
import qualified Data.ByteString as B
|
||||||
import qualified Data.ByteString.Builder as B
|
import qualified Data.ByteString.Builder as B
|
||||||
import qualified Data.ByteString.Lazy as BL
|
import qualified Data.ByteString.Lazy as BL
|
||||||
@ -101,7 +100,7 @@ readBlobFromPath file = do
|
|||||||
maybeFile <- readFile file
|
maybeFile <- readFile file
|
||||||
maybeM (fail ("cannot read '" <> show file <> "', file not found or language not supported.")) maybeFile
|
maybeM (fail ("cannot read '" <> show file <> "', file not found or language not supported.")) maybeFile
|
||||||
|
|
||||||
readProjectFromPaths :: MonadIO m => Maybe FilePath -> FilePath -> Language -> [FilePath] -> m Project.Concrete
|
readProjectFromPaths :: MonadIO m => Maybe FilePath -> FilePath -> Language -> [FilePath] -> m Project
|
||||||
readProjectFromPaths maybeRoot path lang excludeDirs = do
|
readProjectFromPaths maybeRoot path lang excludeDirs = do
|
||||||
liftIO $ putStrLn "Starting readProjectFromPath"
|
liftIO $ putStrLn "Starting readProjectFromPath"
|
||||||
isDir <- isDirectory path
|
isDir <- isDirectory path
|
||||||
@ -112,7 +111,7 @@ readProjectFromPaths maybeRoot path lang excludeDirs = do
|
|||||||
|
|
||||||
paths <- liftIO $ filterFun <$> findFilesInDir rootDir exts excludeDirs
|
paths <- liftIO $ filterFun <$> findFilesInDir rootDir exts excludeDirs
|
||||||
blobs <- traverse readBlobFromPath (entryPoints <> (toFile <$> paths))
|
blobs <- traverse readBlobFromPath (entryPoints <> (toFile <$> paths))
|
||||||
let p = Project.Project rootDir blobs lang (filePath <$> entryPoints) excludeDirs
|
let p = Project rootDir blobs lang (filePath <$> entryPoints) excludeDirs
|
||||||
liftIO $ putStrLn "Done"
|
liftIO $ putStrLn "Done"
|
||||||
pure p
|
pure p
|
||||||
where
|
where
|
||||||
@ -179,7 +178,7 @@ readBlobPairs :: Member Files effs => Either (Handle 'IO.ReadMode) [Both File] -
|
|||||||
readBlobPairs (Left handle) = send (Read (FromPairHandle handle))
|
readBlobPairs (Left handle) = send (Read (FromPairHandle handle))
|
||||||
readBlobPairs (Right paths) = traverse (send . Read . FromPathPair) paths
|
readBlobPairs (Right paths) = traverse (send . Read . FromPathPair) paths
|
||||||
|
|
||||||
readProject :: Member Files effs => Maybe FilePath -> FilePath -> Language -> [FilePath] -> Eff effs Project.Concrete
|
readProject :: Member Files effs => Maybe FilePath -> FilePath -> Language -> [FilePath] -> Eff effs Project
|
||||||
readProject rootDir dir excludeDirs = send . ReadProject rootDir dir excludeDirs
|
readProject rootDir dir excludeDirs = send . ReadProject rootDir dir excludeDirs
|
||||||
|
|
||||||
findFiles :: Member Files effs => FilePath -> [String] -> [FilePath] -> Eff effs [FilePath]
|
findFiles :: Member Files effs => FilePath -> [String] -> [FilePath] -> Eff effs [FilePath]
|
||||||
@ -223,7 +222,7 @@ data Destination = ToPath FilePath | ToHandle (Handle 'IO.WriteMode)
|
|||||||
-- | An effect to read/write 'Blob's from 'Handle's or 'FilePath's.
|
-- | An effect to read/write 'Blob's from 'Handle's or 'FilePath's.
|
||||||
data Files out where
|
data Files out where
|
||||||
Read :: Source out -> Files out
|
Read :: Source out -> Files out
|
||||||
ReadProject :: Maybe FilePath -> FilePath -> Language -> [FilePath] -> Files Project.Concrete
|
ReadProject :: Maybe FilePath -> FilePath -> Language -> [FilePath] -> Files Project
|
||||||
FindFiles :: FilePath -> [String] -> [FilePath] -> Files [FilePath]
|
FindFiles :: FilePath -> [String] -> [FilePath] -> Files [FilePath]
|
||||||
Write :: Destination -> B.Builder -> Files ()
|
Write :: Destination -> B.Builder -> Files ()
|
||||||
|
|
||||||
|
@ -6,7 +6,6 @@ import Data.Aeson
|
|||||||
import Data.Aeson.Types (parseMaybe)
|
import Data.Aeson.Types (parseMaybe)
|
||||||
import Data.Blob
|
import Data.Blob
|
||||||
import Data.Project
|
import Data.Project
|
||||||
import qualified Data.Project as Project (Concrete)
|
|
||||||
import qualified Data.Map as Map
|
import qualified Data.Map as Map
|
||||||
import Data.Source
|
import Data.Source
|
||||||
import Data.Language
|
import Data.Language
|
||||||
@ -30,7 +29,7 @@ nodeJSResolutionMap rootDir prop excludeDirs = do
|
|||||||
where relPkgDotJSONPath = makeRelative rootDir path
|
where relPkgDotJSONPath = makeRelative rootDir path
|
||||||
relEntryPath x = takeDirectory relPkgDotJSONPath </> x
|
relEntryPath x = takeDirectory relPkgDotJSONPath </> x
|
||||||
|
|
||||||
resolutionMap :: Member Resolution effs => Project.Concrete -> Eff effs (Map FilePath FilePath)
|
resolutionMap :: Member Resolution effs => Project -> Eff effs (Map FilePath FilePath)
|
||||||
resolutionMap Project{..} = case projectLanguage of
|
resolutionMap Project{..} = case projectLanguage of
|
||||||
TypeScript -> send (NodeJSResolution projectRootDir "types" projectExcludeDirs)
|
TypeScript -> send (NodeJSResolution projectRootDir "types" projectExcludeDirs)
|
||||||
JavaScript -> send (NodeJSResolution projectRootDir "main" projectExcludeDirs)
|
JavaScript -> send (NodeJSResolution projectRootDir "main" projectExcludeDirs)
|
||||||
|
@ -80,7 +80,7 @@ javaScriptPrelude = Just $ File (TypeLevel.symbolVal (Proxy :: Proxy (PreludePat
|
|||||||
evaluateProject parser lang prelude path = evaluatePackageWith id withTermSpans . fmap quieterm <$> runTask (readProject Nothing path lang [] >>= addPrelude lang >>= parsePackage parser prelude)
|
evaluateProject parser lang prelude path = evaluatePackageWith id withTermSpans . fmap quieterm <$> runTask (readProject Nothing path lang [] >>= addPrelude lang >>= parsePackage parser prelude)
|
||||||
evaluateProjectWithCaching parser lang prelude path = evaluatePackageWith convergingModules (withTermSpans . cachingTerms) . fmap quieterm <$> runTask (readProject Nothing path lang [] >>= addPrelude lang >>= parsePackage parser prelude)
|
evaluateProjectWithCaching parser lang prelude path = evaluatePackageWith convergingModules (withTermSpans . cachingTerms) . fmap quieterm <$> runTask (readProject Nothing path lang [] >>= addPrelude lang >>= parsePackage parser prelude)
|
||||||
|
|
||||||
addPrelude :: Member IO effs => Language.Language -> Concrete -> Eff effs Concrete
|
addPrelude :: Member IO effs => Language.Language -> Project -> Eff effs Project
|
||||||
addPrelude l proj = do
|
addPrelude l proj = do
|
||||||
let p = case l of
|
let p = case l of
|
||||||
Language.Ruby -> rubyPrelude
|
Language.Ruby -> rubyPrelude
|
||||||
|
Loading…
Reference in New Issue
Block a user