Merge pull request #355 from github/pathtype-project-from-path

Make readProjectFromPaths use typed paths.

src/Data/Project.hs

@@ -35,16 +35,26 @@ projectExtensions = extensionsForLanguage . projectLanguage
 projectFiles :: Project -> [File]
 projectFiles = fmap blobFile . projectBlobs
 
-readProjectFromPaths :: MonadIO m => Maybe FilePath -> FilePath -> Language -> [FilePath] -> m Project
+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
-  isDir <- isDirectory path
-  let rootDir = if isDir
-      then fromMaybe path maybeRoot
-      else fromMaybe (takeDirectory path) maybeRoot
+  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 (Path.absRel rootDir) exts (fmap Path.absRel excludeDirs)
+  paths <- liftIO $ findFilesInDir rootDir exts excludeDirs
   blobs <- liftIO $ traverse (readBlobFromFile' . toFile) paths
-  pure $ Project rootDir blobs lang excludeDirs
+  pure $ Project (Path.toString rootDir) blobs lang (fmap Path.toString excludeDirs)
   where
     toFile path = File (Path.toString path) lang
     exts = extensionsForLanguage lang

src/Semantic/CLI.hs

@@ -160,9 +160,9 @@ graphCommand = command "graph" (info graphArgumentsParser (progDesc "Compute a g
         _     -> pure $! Project "/" mempty Language.Unknown mempty
     readProjectRecursively = makeReadProjectRecursivelyTask
       <$> option auto (long "language" <> help "The language for the analysis.")
-      <*> optional (strOption (long "root" <> help "Root directory of project. Optional, defaults to entry file/directory." <> metavar "DIR"))
-      <*> many (strOption (long "exclude-dir" <> help "Exclude a directory (e.g. vendor)" <> metavar "DIR"))
-      <*> argument str (metavar "DIR")
+      <*> optional (pathOption (long "root" <> help "Root directory of project. Optional, defaults to entry file/directory." <> metavar "DIR"))
+      <*> many (pathOption (long "exclude-dir" <> help "Exclude a directory (e.g. vendor)" <> metavar "DIR"))
+      <*> argument path (metavar "PATH")
     makeReadProjectRecursivelyTask language rootDir excludeDirs dir = Task.readProject rootDir dir language excludeDirs
     makeGraphTask graphType includePackages serializer projectTask = projectTask >>= Graph.runGraph graphType includePackages >>= serializer
 

src/Semantic/Task/Files.hs

@@ -44,7 +44,7 @@ data Destination = ToPath Path.AbsRelFile | ToHandle (Handle 'IO.WriteMode)
 -- | An effect to read/write 'Blob's from 'Handle's or 'FilePath's.
 data Files (m :: * -> *) k
   = forall a . Read (Source a)                                     (a -> m k)
-  | ReadProject (Maybe FilePath) FilePath Language [FilePath] (Project -> m k)
+  | ReadProject (Maybe Path.AbsRelDir) Path.AbsRelFileDir Language [Path.AbsRelDir] (Project -> m k)
   | FindFiles Path.AbsRelDir [String] [Path.AbsRelDir] ([Path.AbsRelFile] -> m k)
   | Write Destination B.Builder                               (m k)
 
@@ -105,7 +105,7 @@ readBlobPairs :: (Member Files sig, Carrier sig m) => Either (Handle 'IO.ReadMod
 readBlobPairs (Left handle) = send (Read (FromPairHandle handle) pure)
 readBlobPairs (Right paths) = traverse (send . flip Read pure . uncurry FromPathPair) paths
 
-readProject :: (Member Files sig, Carrier sig m) => Maybe FilePath -> FilePath -> Language -> [FilePath] -> m Project
+readProject :: (Member Files sig, Carrier sig m) => Maybe Path.AbsRelDir -> Path.AbsRelFileDir -> Language -> [Path.AbsRelDir] -> m Project
 readProject rootDir dir lang excludeDirs = send (ReadProject rootDir dir lang excludeDirs pure)
 
 findFiles :: (Member Files sig, Carrier sig m) => Path.AbsRelDir -> [String] -> [Path.AbsRelDir] -> m [Path.AbsRelFile]