1
1
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:
Patrick Thomson 2018-06-12 14:10:28 -04:00
parent 4d8fe33ad4
commit 63fdf40cb0
5 changed files with 29 additions and 30 deletions

View File

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

View File

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

View File

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

View File

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

View File

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