1
1
mirror of https://github.com/github/semantic.git synced 2024-12-26 08:25:19 +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 (
-- * Projects
Project (..)
, Concrete
ProjectF (..)
, Project
, PB
, ProjectException (..)
, fromPB
@ -33,8 +33,8 @@ import System.FilePath.Posix
-- in terms of the container type for paths and blobs, as well as the
-- path type (this is necessary because protobuf uses different vector
-- representations for @repeated string@ and @repeated Blob@.
-- You probably want to use the 'Concrete' or 'PB' type aliases.
data Project (blobs :: * -> *) (paths :: * -> *) path = Project
-- You probably want to use the 'Project' or 'PB' type aliases.
data ProjectF (blobs :: * -> *) (paths :: * -> *) path = Project
{ projectRootDir :: path
, projectBlobs :: blobs Blob
, projectLanguage :: Language
@ -45,22 +45,22 @@ data Project (blobs :: * -> *) (paths :: * -> *) path = Project
deriving instance ( MessageField path
, MessageField (paths path)
, 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 (Show path, Show (blobs Blob), Show (paths path)) => Show (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 (ProjectF blobs paths path)
-- | This 'Project' type is the one used during semantic's normal
-- course of diffing, evaluation, and graphing. You probably want to
-- use this one.
type Concrete = Project [] [] FilePath
type Project = ProjectF [] [] FilePath
-- | This 'Project' type is protobuf-compatible, and corresponds with
-- 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.
fromPB :: PB -> Concrete
fromPB :: PB -> Project
fromPB Project {..} = Project
{ projectRootDir = T.unpack projectRootDir
, projectBlobs = toList projectBlobs
@ -69,20 +69,20 @@ fromPB Project {..} = Project
, projectExcludeDirs = T.unpack <$> toList projectExcludeDirs
}
projectName :: Concrete -> Text
projectName :: Project -> Text
projectName = T.pack . dropExtensions . takeFileName . projectRootDir
projectExtensions :: Concrete -> [String]
projectExtensions :: Project -> [String]
projectExtensions = extensionsForLanguage . projectLanguage
projectEntryPoints :: Concrete -> [File]
projectEntryPoints :: Project -> [File]
projectEntryPoints Project {..} = foldr go [] projectBlobs
where go b acc =
if blobPath b `elem` projectEntryPaths
then toFile b : acc
else acc
projectFiles :: Concrete -> [File]
projectFiles :: Project -> [File]
projectFiles = fmap toFile . projectBlobs
data File = File
@ -103,7 +103,7 @@ newtype ProjectException
deriving (Show, Eq, Typeable, Exception)
readFile :: Member (Exc SomeException) effs
=> Concrete
=> Project
-> File
-> Eff effs (Maybe Blob)
readFile Project{..} f =

View File

@ -16,6 +16,8 @@ module Semantic.Graph
, resumingEnvironmentError
) where
import Prelude hiding (readFile)
import Analysis.Abstract.Evaluating
import Analysis.Abstract.Graph
import Control.Abstract
@ -27,7 +29,6 @@ import Data.Abstract.Package as Package
import Data.Abstract.Value (Value, ValueError (..), runValueErrorWith)
import Data.Graph
import Data.Project
import qualified Data.Project as Project
import Data.Record
import Data.Term
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)
=> GraphType
-> Bool
-> Project.Concrete
-> Project
-> Eff effs (Graph Vertex)
runGraph graphType includePackages project
| 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)
=> Parser term -- ^ A parser.
-> Maybe File -- ^ Prelude (optional).
-> Project.Concrete -- ^ Project to parse into a package.
-> Project -- ^ Project to parse into a package.
-> Eff effs (Package term)
parsePackage parser preludeFile project@Project{..} = do
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)
-- | 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
mBlob <- Project.readFile proj file
mBlob <- readFile proj file
case mBlob of
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
, Member (Reader Span) effects

View File

@ -42,8 +42,7 @@ import Control.Monad.IO.Class
import Data.Aeson
import Data.Blob
import Data.Bool
import qualified Data.Project as Project
import Data.Project (File (..))
import Data.Project hiding (readFile)
import qualified Data.ByteString as B
import qualified Data.ByteString.Builder as B
import qualified Data.ByteString.Lazy as BL
@ -101,7 +100,7 @@ readBlobFromPath file = do
maybeFile <- readFile file
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
liftIO $ putStrLn "Starting readProjectFromPath"
isDir <- isDirectory path
@ -112,7 +111,7 @@ readProjectFromPaths maybeRoot path lang excludeDirs = do
paths <- liftIO $ filterFun <$> findFilesInDir rootDir exts excludeDirs
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"
pure p
where
@ -179,7 +178,7 @@ readBlobPairs :: Member Files effs => Either (Handle 'IO.ReadMode) [Both File] -
readBlobPairs (Left handle) = send (Read (FromPairHandle handle))
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
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.
data Files out where
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]
Write :: Destination -> B.Builder -> Files ()

View File

@ -6,7 +6,6 @@ import Data.Aeson
import Data.Aeson.Types (parseMaybe)
import Data.Blob
import Data.Project
import qualified Data.Project as Project (Concrete)
import qualified Data.Map as Map
import Data.Source
import Data.Language
@ -30,7 +29,7 @@ nodeJSResolutionMap rootDir prop excludeDirs = do
where relPkgDotJSONPath = makeRelative rootDir path
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
TypeScript -> send (NodeJSResolution projectRootDir "types" 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)
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
let p = case l of
Language.Ruby -> rubyPrelude