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:
parent
4d8fe33ad4
commit
63fdf40cb0
@ -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 =
|
||||
|
@ -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
|
||||
|
@ -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 ()
|
||||
|
||||
|
@ -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)
|
||||
|
@ -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
|
||||
|
Loading…
Reference in New Issue
Block a user