Merge pull request #476 from github/i-am-projecting

Move Data.Project to semantic-analysis.

bench/Evaluation.hs

@@ -6,6 +6,7 @@
 
 module Evaluation (benchmarks) where
 
+import           Analysis.Project
 import           Control.Carrier.Parse.Simple
 import           Data.Abstract.Evaluatable
 import           Data.Bifunctor
@@ -13,7 +14,6 @@ import           Data.Blob.IO (readBlobFromPath)
 import qualified Data.Duration as Duration
 import           Data.Graph.Algebraic (topologicalSort)
 import qualified Data.Language as Language
-import           Data.Project
 import           Data.Proxy
 import           Gauge.Main
 import           Parsing.Parser

semantic-analysis/semantic-analysis.cabal

@@ -40,6 +40,7 @@ library
   import: common
   hs-source-dirs: src
   exposed-modules:
+    Analysis.Blob
     Analysis.Carrier.Env.Monovariant
     Analysis.Carrier.Env.Precise
     Analysis.Carrier.Heap.Monovariant
@@ -54,6 +55,7 @@ library
     Analysis.ImportGraph
     Analysis.Intro
     Analysis.Name
+    Analysis.Project
     Analysis.Typecheck
     Control.Carrier.Fail.WithLoc
   build-depends:

semantic-analysis/src/Analysis/Blob.hs

@@ -0,0 +1,45 @@
+{-# LANGUAGE OverloadedStrings #-}
+module Analysis.Blob
+  ( Blob (..)
+  , fromSource
+  , blobLanguage
+  , blobPath
+  , nullBlob
+  ) where
+
+import           Analysis.File
+import           Data.Aeson
+import           Source.Language as Language
+import           Source.Source as Source
+import qualified System.Path as Path
+import qualified System.Path.PartClass as Path.PartClass
+
+-- | The source, path information, and language of a file read from disk.
+data Blob = Blob
+  { blobSource :: Source         -- ^ The UTF-8 encoded source text of the blob.
+  , blobFile   :: File Language  -- ^ Path/language information for this blob.
+  } deriving (Show, Eq)
+
+instance FromJSON Blob where
+  parseJSON = withObject "Blob" $ \b -> do
+    src <- b .: "content"
+    Right pth <- fmap Path.parse (b .: "path")
+    lang <- b .: "language"
+    let lang' = if knownLanguage lang then lang else Language.forPath pth
+    pure (fromSource (pth :: Path.AbsRelFile) lang' src)
+
+
+-- | Create a Blob from a provided path, language, and UTF-8 source.
+-- The resulting Blob's span is taken from the 'totalSpan' of the source.
+fromSource :: Path.PartClass.AbsRel ar => Path.File ar -> Language -> Source -> Blob
+fromSource filepath language source
+  = Blob source (Analysis.File.File (Path.toAbsRel filepath) (totalSpan source) language)
+
+blobLanguage :: Blob -> Language
+blobLanguage = Analysis.File.fileBody . blobFile
+
+blobPath :: Blob -> FilePath
+blobPath = Path.toString . Analysis.File.filePath . blobFile
+
+nullBlob :: Blob -> Bool
+nullBlob = Source.null . blobSource

semantic-analysis/src/Analysis/Project.hs

@@ -0,0 +1,33 @@
+module Analysis.Project
+  ( Project (..)
+  , projectExtensions
+  , projectName
+  , projectFiles
+  ) where
+
+import Prelude hiding (readFile)
+
+import           Analysis.Blob
+import           Analysis.File
+import           Data.Text (Text)
+import qualified Data.Text as T
+import           Source.Language
+import           System.FilePath.Posix
+
+-- | A 'Project' contains all the information that semantic needs
+-- to execute an analysis, diffing, or graphing pass.
+data Project = Project
+  { projectRootDir     :: FilePath
+  , projectBlobs       :: [Blob]
+  , projectLanguage    :: Language
+  , projectExcludeDirs :: [FilePath]
+  } deriving (Eq, Show)
+
+projectName :: Project -> Text
+projectName = T.pack . dropExtensions . takeFileName . projectRootDir
+
+projectExtensions :: Project -> [String]
+projectExtensions = extensionsForLanguage . projectLanguage
+
+projectFiles :: Project -> [File Language]
+projectFiles = fmap blobFile . projectBlobs

semantic.cabal

@@ -160,7 +160,6 @@ library
                      , Data.Language
                      , Data.Map.Monoidal
                      , Data.Maybe.Exts
-                     , Data.Project
                      , Data.Quieterm
                      , Data.Semigroup.App
                      , Data.Scientific.Exts

src/Data/Blob.hs

@@ -5,15 +5,12 @@
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RecordWildCards #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+-- | Semantic-specific functionality for blob handling.
 module Data.Blob
-( Blob(..)
-, Blobs(..)
-, blobLanguage
+( Blobs(..)
 , NoLanguageForBlob (..)
-, blobPath
 , decodeBlobs
-, nullBlob
-, fromSource
 , moduleForBlob
 , noLanguageForBlob
 , BlobPair
@@ -23,10 +20,11 @@ module Data.Blob
 , languageTagForBlobPair
 , pathForBlobPair
 , pathKeyForBlobPair
+, module Analysis.Blob
 ) where
 
 
-import           Analysis.File (File (..))
+import           Analysis.Blob
 import           Control.Effect.Error
 import           Control.Exception
 import           Data.Aeson
@@ -39,44 +37,12 @@ import           Data.Maybe.Exts
 import           Data.Module
 import           GHC.Generics (Generic)
 import           Source.Language as Language
-import           Source.Source (Source, totalSpan)
-import qualified Source.Source as Source
 import qualified System.FilePath as FP
-import qualified System.Path as Path
-import qualified System.Path.PartClass as Path.PartClass
 
--- | The source, path information, and language of a file read from disk.
-data Blob = Blob
-  { blobSource :: Source         -- ^ The UTF-8 encoded source text of the blob.
-  , blobFile   :: File Language  -- ^ Path/language information for this blob.
-  } deriving (Show, Eq)
-
-blobLanguage :: Blob -> Language
-blobLanguage = Analysis.File.fileBody . blobFile
-
-blobPath :: Blob -> FilePath
-blobPath = Path.toString . Analysis.File.filePath . blobFile
 
 newtype Blobs a = Blobs { blobs :: [a] }
   deriving (Generic, FromJSON)
 
-instance FromJSON Blob where
-  parseJSON = withObject "Blob" $ \b -> do
-    src <- b .: "content"
-    Right pth <- fmap Path.parse (b .: "path")
-    lang <- b .: "language"
-    let lang' = if knownLanguage lang then lang else Language.forPath pth
-    pure (fromSource (pth :: Path.AbsRelFile) lang' src)
-
-nullBlob :: Blob -> Bool
-nullBlob Blob{..} = Source.null blobSource
-
--- | Create a Blob from a provided path, language, and UTF-8 source.
--- The resulting Blob's span is taken from the 'totalSpan' of the source.
-fromSource :: Path.PartClass.AbsRel ar => Path.File ar -> Language -> Source -> Blob
-fromSource filepath language source
-  = Blob source (Analysis.File.File (Path.toAbsRel filepath) (totalSpan source) language)
-
 decodeBlobs :: BL.ByteString -> Either String [Blob]
 decodeBlobs = fmap blobs <$> eitherDecode
 

src/Data/Blob/IO.hs

@@ -7,19 +7,49 @@ module Data.Blob.IO
   , readBlobFromPath
   , readBlobsFromDir
   , readFilePair
+  , readProjectFromPaths
   ) where
 
+import           Analysis.Blob
 import           Analysis.File as File
+import           Analysis.Project
 import qualified Control.Concurrent.Async as Async
 import           Control.Monad.IO.Class
 import           Data.Blob
 import qualified Data.ByteString as B
 import           Data.Language
 import           Data.Maybe.Exts
+import           Data.Semilattice.Lower
 import           Semantic.IO
 import qualified Source.Source as Source
 import qualified System.Path as Path
 
+-- | Deprecated: this has very weird semantics.
+readProjectFromPaths :: MonadIO m
+                     => Maybe Path.AbsRelDir -- ^ An optional root directory for the project
+                     -> Path.AbsRelFileDir   -- ^ A file or directory to parse. Passing a file path loads all files in that file's parent directory.
+                     -> Language
+                     -> [Path.AbsRelDir]     -- ^ Directories to exclude.
+                     -> m Project
+readProjectFromPaths maybeRoot path lang excludeDirs = do
+  let rootDir :: Path.AbsRelDir
+      rootDir = case maybeRoot >>= Path.fromAbsRel of
+        -- If we were provided a root directory, use that.
+        Just root -> root
+        Nothing   -> case Path.fileFromFileDir path of
+          -- If we weren't and the path is a file, drop its file name.
+          Just fp -> Path.takeDirectory fp
+          -- Otherwise, load from the path.
+          Nothing -> Path.dirFromFileDir path
+
+  paths <- liftIO $ findFilesInDir rootDir exts excludeDirs
+  blobs <- liftIO $ traverse (readBlobFromFile' . toFile) paths
+  pure $ Project (Path.toString rootDir) blobs lang (fmap Path.toString excludeDirs)
+  where
+    toFile path = File path lowerBound lang
+    exts = extensionsForLanguage lang
+
+
 -- | Read a utf8-encoded file to a 'Blob'.
 readBlobFromFile :: MonadIO m => File Language -> m (Maybe Blob)
 readBlobFromFile (File (Path.toString -> "/dev/null") _ _) = pure Nothing

src/Data/Project.hs

@@ -1,63 +0,0 @@
-module Data.Project
-  ( Project (..)
-  , projectExtensions
-  , projectName
-  , projectFiles
-  , readProjectFromPaths
-  ) where
-
-import Prelude hiding (readFile)
-
-import           Analysis.File
-import           Control.Monad.IO.Class
-import           Data.Blob
-import           Data.Blob.IO
-import           Data.Language
-import           Data.Semilattice.Lower
-import           Data.Text (Text)
-import qualified Data.Text as T
-import           Semantic.IO
-import           System.FilePath.Posix
-import qualified System.Path as Path
-
--- | A 'Project' contains all the information that semantic needs
--- to execute an analysis, diffing, or graphing pass.
-data Project = Project
-  { projectRootDir     :: FilePath
-  , projectBlobs       :: [Blob]
-  , projectLanguage    :: Language
-  , projectExcludeDirs :: [FilePath]
-  } deriving (Eq, Show)
-
-projectName :: Project -> Text
-projectName = T.pack . dropExtensions . takeFileName . projectRootDir
-
-projectExtensions :: Project -> [String]
-projectExtensions = extensionsForLanguage . projectLanguage
-
-projectFiles :: Project -> [File Language]
-projectFiles = fmap blobFile . projectBlobs
-
-readProjectFromPaths :: MonadIO m
-                     => Maybe Path.AbsRelDir -- ^ An optional root directory for the project
-                     -> Path.AbsRelFileDir   -- ^ A file or directory to parse. Passing a file path loads all files in that file's parent directory.
-                     -> Language
-                     -> [Path.AbsRelDir]     -- ^ Directories to exclude.
-                     -> m Project
-readProjectFromPaths maybeRoot path lang excludeDirs = do
-  let rootDir :: Path.AbsRelDir
-      rootDir = case maybeRoot >>= Path.fromAbsRel of
-        -- If we were provided a root directory, use that.
-        Just root -> root
-        Nothing   -> case Path.fileFromFileDir path of
-          -- If we weren't and the path is a file, drop its file name.
-          Just fp -> Path.takeDirectory fp
-          -- Otherwise, load from the path.
-          Nothing -> Path.dirFromFileDir path
-
-  paths <- liftIO $ findFilesInDir rootDir exts excludeDirs
-  blobs <- liftIO $ traverse (readBlobFromFile' . toFile) paths
-  pure $ Project (Path.toString rootDir) blobs lang (fmap Path.toString excludeDirs)
-  where
-    toFile path = File path lowerBound lang
-    exts = extensionsForLanguage lang

src/Semantic/CLI.hs

@@ -3,6 +3,7 @@
 module Semantic.CLI (main) where
 
 import qualified Analysis.File as File
+import           Analysis.Project
 import qualified Control.Carrier.Parse.Measured as Parse
 import           Control.Carrier.Reader
 import           Control.Exception
@@ -15,7 +16,6 @@ import           Data.Handle
 import qualified Data.Language as Language
 import           Data.List (intercalate)
 import           Data.Maybe.Exts
-import           Data.Project
 import           Options.Applicative hiding (style)
 import           Semantic.Api hiding (File)
 import           Semantic.Config

src/Semantic/Graph.hs

@@ -44,6 +44,7 @@ import           Analysis.Abstract.Caching.FlowInsensitive
 import           Analysis.Abstract.Collecting
 import           Analysis.Abstract.Graph as Graph
 import           Analysis.File
+import           Analysis.Project
 import           Control.Abstract hiding (String)
 import           Control.Abstract.PythonPackage as PythonPackage
 import           Control.Carrier.Fresh.Strict
@@ -73,7 +74,6 @@ import           Data.Language as Language
 import           Data.List (find, isPrefixOf)
 import           Data.Map (Map)
 import qualified Data.Map as Map
-import           Data.Project
 import           Data.Proxy
 import           Data.Text (pack, unpack)
 import           Language.Haskell.HsColour

src/Semantic/Resolution.hs

@@ -20,6 +20,7 @@ module Semantic.Resolution
   ) where
 
 import           Analysis.File as File
+import           Analysis.Project
 import           Control.Algebra
 import           Control.Monad.IO.Class
 import           Data.Aeson
@@ -30,7 +31,6 @@ import           Data.Language
 import qualified Data.Map as Map
 import           Data.Map.Strict (Map)
 import           Data.Maybe.Exts
-import           Data.Project
 import           Data.Text (Text)
 import           GHC.Generics (Generic1)
 import           Semantic.Task.Files

src/Semantic/Task/Files.hs

@@ -28,6 +28,7 @@ module Semantic.Task.Files
   ) where
 
 import           Analysis.File
+import           Analysis.Project
 import           Control.Algebra
 import           Control.Effect.Error
 import           Control.Exception
@@ -37,7 +38,6 @@ import           Data.Blob.IO
 import qualified Data.ByteString.Builder as B
 import           Data.Handle
 import           Data.Language
-import           Data.Project
 import           Prelude hiding (readFile)
 import           Semantic.IO
 import qualified System.IO as IO hiding (withBinaryFile)

src/Semantic/Util.hs

@@ -18,6 +18,7 @@ module Semantic.Util
 import Prelude hiding (readFile)
 
 import           Analysis.File
+import           Analysis.Project
 import           Control.Abstract
 import           Control.Carrier.Fresh.Strict
 import           Control.Carrier.Lift
@@ -40,7 +41,6 @@ import           Data.Graph.Algebraic (topologicalSort)
 import qualified Data.Language as Language
 import           Data.List (uncons)
 import           Data.Maybe
-import           Data.Project
 import           Data.Semilattice.Lower
 import           Data.Sum
 import           Parsing.Parser

test/SpecHelpers.hs

@@ -26,6 +26,7 @@ module SpecHelpers
 
 import qualified Analysis.File as File
 import           Analysis.Name as X
+import           Analysis.Project as X
 import           Control.Abstract
 import           Control.Carrier.Fresh.Strict
 import           Control.Carrier.Lift
@@ -56,7 +57,6 @@ import           Data.Language as X hiding (Precise)
 import           Data.List.NonEmpty as X (NonEmpty (..))
 import           Data.Maybe as X
 import           Data.Monoid as X (First (..), Last (..), Monoid (..))
-import           Data.Project as X
 import           Data.Proxy as X
 import           Data.Semigroup as X (Semigroup (..))
 import           Data.Semilattice.Lower as X