generalize Project

src/Data/Project.hs

@@ -1,25 +1,58 @@
+{-# LANGUAGE DeriveAnyClass #-}
 module Data.Project where
 
-import Data.Text as T (pack)
+import Data.Blob
 import Data.Language
+import qualified Data.Text as T
 import Prologue
+import Proto3.Suite
 import System.FilePath.Posix
 
-data Project = Project
-  { projectRootDir     :: FilePath
-  , projectFiles       :: [File]
+data Project blobs paths path = Project
+  { projectRootDir     :: path
+  , projectBlobs       :: blobs Blob
   , projectLanguage    :: Language
-  , projectEntryPoints :: [File]
-  , projectExcludeDirs :: [FilePath]
-  }
-  deriving (Eq, Ord, Show)
+  , projectEntryPaths  :: paths path
+  , projectExcludeDirs :: paths path
+  } deriving (Functor, Generic, Named)
 
-projectName :: Project -> Text
+deriving instance ( MessageField path
+                  , MessageField (paths path)
+                  , MessageField (blobs Blob)
+                  ) => Message (Project 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)
+
+type Concrete = Project [] [] FilePath
+type PB = Project NestedVec UnpackedVec Text
+
+fromPB :: PB -> Concrete
+fromPB Project {..} = Project
+  { projectRootDir     = T.unpack projectRootDir
+  , projectBlobs       = go projectBlobs
+  , projectLanguage    = projectLanguage
+  , projectEntryPaths  = T.unpack <$> go projectEntryPaths
+  , projectExcludeDirs = T.unpack <$> go projectExcludeDirs
+  } where go :: Foldable f => f a -> [a]
+          go = foldr (:) []
+
+projectName :: Concrete -> Text
 projectName = T.pack . dropExtensions . takeFileName . projectRootDir
 
-projectExtensions :: Project -> [String]
+projectExtensions :: Concrete -> [String]
 projectExtensions = extensionsForLanguage . projectLanguage
 
+projectEntryPoints :: Concrete -> [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 = fmap toFile . projectBlobs where
+
 
 data File = File
   { filePath     :: FilePath
@@ -29,3 +62,6 @@ data File = File
 file :: FilePath -> File
 file path = File path (languageForFilePath path)
   where languageForFilePath = languageForType . takeExtension
+
+toFile :: Blob -> File
+toFile (Blob _ p l) = File p l

src/Semantic/Graph.hs

@@ -27,6 +27,7 @@ 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 (Concrete)
 import           Data.Record
 import           Data.Term
 import           Data.Text (pack)
@@ -40,7 +41,7 @@ data GraphType = ImportGraph | CallGraph
 runGraph :: ( Member (Distribute WrappedTask) effs, Member Files effs, Member Resolution effs, Member Task effs, Member Trace effs)
          => GraphType
          -> Bool
-         -> Project
+         -> Project.Concrete
          -> Eff effs (Graph Vertex)
 runGraph graphType includePackages project
   | SomeAnalysisParser parser prelude <- someAnalysisParser
@@ -71,21 +72,21 @@ runGraph graphType includePackages project
 parsePackage :: (Member (Distribute WrappedTask) effs, Member Files effs, Member Resolution effs, Member Task effs, Member Trace effs)
              => Parser term -- ^ A parser.
              -> Maybe File  -- ^ Prelude (optional).
-             -> Project     -- ^ Project to parse into a package.
+             -> Project.Concrete     -- ^ Project to parse into a package.
              -> Eff effs (Package term)
 parsePackage parser preludeFile project@Project{..} = do
   prelude <- traverse (parseModule parser Nothing) preludeFile
   p <- parseModules parser project
   resMap <- Task.resolutionMap project
-  let pkg = Package.fromModules n Nothing prelude (length projectEntryPoints) p resMap
+  let pkg = Package.fromModules n Nothing prelude (length projectEntryPaths) p resMap
   pkg <$ trace ("project: " <> show pkg)
 
   where
     n = name (projectName project)
 
     -- | Parse all files in a project into 'Module's.
-    parseModules :: Member (Distribute WrappedTask) effs => Parser term -> Project -> Eff effs [Module term]
-    parseModules parser Project{..} = distributeFor (projectEntryPoints <> projectFiles) (WrapTask . parseModule parser (Just projectRootDir))
+    parseModules :: Member (Distribute WrappedTask) effs => Parser term -> Project.Concrete -> Eff effs [Module term]
+    parseModules parser Project{..} = distributeFor (projectEntryPoints project <> projectFiles project) (WrapTask . parseModule parser (Just projectRootDir))
 
 -- | Parse a file into a 'Module'.
 parseModule :: (Member Files effs, Member Task effs) => Parser term -> Maybe FilePath -> File -> Eff effs (Module term)

src/Semantic/IO.hs

@@ -39,12 +39,14 @@ import           Control.Monad.IO.Class
 import           Data.Aeson
 import qualified Data.Blob as Blob
 import           Data.Bool
-import           Data.Project
+import           Data.Project (File (..), Project (..))
+import qualified Data.Project as Project
 import qualified Data.ByteString as B
 import qualified Data.ByteString.Builder as B
 import qualified Data.ByteString.Lazy as BL
 import           Data.Language
 import           Data.Source (fromUTF8, fromText)
+import qualified Data.Text as T
 import           Prelude hiding (readFile)
 import           Prologue hiding (MonadError (..), fail)
 import           System.Directory (doesDirectoryExist)
@@ -98,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
+readProjectFromPaths :: MonadIO m => Maybe FilePath -> FilePath -> Language -> [FilePath] -> m Project.Concrete
 readProjectFromPaths maybeRoot path lang excludeDirs = do
   isDir <- isDirectory path
   let (filterFun, entryPoints, rootDir) = if isDir
@@ -106,9 +108,11 @@ readProjectFromPaths maybeRoot path lang excludeDirs = do
       else (filter (/= path), [toFile path], fromMaybe (takeDirectory path) maybeRoot)
 
   paths <- liftIO $ filterFun <$> findFilesInDir rootDir exts excludeDirs
-  pure $ Project rootDir (toFile <$> paths) lang entryPoints excludeDirs
+  blobs <- traverse (readBlobFromPath . toFile) paths
+
+  pure $ Project rootDir blobs lang (filePath <$> entryPoints) excludeDirs
   where
-    toFile path = File path lang
+    toFile p = File p lang
     exts = extensionsForLanguage lang
 
 -- Recursively find files in a directory.
@@ -203,7 +207,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
+readProject :: Member Files effs => Maybe FilePath -> FilePath -> Language -> [FilePath] -> Eff effs Project.Concrete
 readProject rootDir dir excludeDirs = send . ReadProject rootDir dir excludeDirs
 
 findFiles :: Member Files effs => FilePath -> [String] -> [FilePath] -> Eff effs [FilePath]
@@ -247,7 +251,7 @@ data Destination = ToPath FilePath | ToHandle (Handle 'IO.WriteMode)
 -- | An effect to read/write 'Blob.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
+  ReadProject :: Maybe FilePath -> FilePath -> Language -> [FilePath] -> Files Project.Concrete
   FindFiles   :: FilePath -> [String] -> [FilePath] -> Files [FilePath]
   Write       :: Destination -> B.Builder -> Files ()
 

src/Semantic/Resolution.hs

@@ -6,6 +6,7 @@ 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
@@ -29,7 +30,7 @@ nodeJSResolutionMap rootDir prop excludeDirs = do
       where relPkgDotJSONPath = makeRelative rootDir path
             relEntryPath x = takeDirectory relPkgDotJSONPath </> x
 
-resolutionMap :: Member Resolution effs => Project -> Eff effs (Map FilePath FilePath)
+resolutionMap :: Member Resolution effs => Project.Concrete -> Eff effs (Map FilePath FilePath)
 resolutionMap Project{..} = case projectLanguage of
   TypeScript -> send (NodeJSResolution projectRootDir "types" projectExcludeDirs)
   JavaScript -> send (NodeJSResolution projectRootDir "main" projectExcludeDirs)