mirror of
https://github.com/Avi-D-coder/implicit-hie.git
synced 2024-09-11 09:05:25 +03:00
Read cabal.project and stack.yaml packages
This commit is contained in:
parent
8219c06896
commit
ebafb8bdbf
10
app/Main.hs
10
app/Main.hs
@ -3,14 +3,15 @@
|
||||
module Main where
|
||||
|
||||
import Control.Monad
|
||||
import Control.Monad.Trans.Maybe
|
||||
import Data.Attoparsec.Text
|
||||
import Data.List
|
||||
import Data.Maybe
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.IO as T
|
||||
import Hie.Cabal.Parser
|
||||
import Hie.Yaml
|
||||
import Hie.Locate
|
||||
import Hie.Yaml
|
||||
import System.Directory
|
||||
import System.Directory.Internal
|
||||
import System.FilePath.Posix
|
||||
@ -19,16 +20,17 @@ main :: IO ()
|
||||
main = do
|
||||
pwd <- getCurrentDirectory
|
||||
files <- listDirectory pwd
|
||||
cfs <- nestedCabalFiles pwd
|
||||
let name =
|
||||
if | any (("dist-newstyle" ==) . takeFileName) files -> "cabal"
|
||||
| any ((".stack-work" ==) . takeFileName) files -> "stack"
|
||||
| any (("stack.yaml" ==) . takeFileName) files -> "stack"
|
||||
| otherwise -> "cabal"
|
||||
cfs <- runMaybeT $ case name of
|
||||
"cabal" -> cabalPkgs pwd
|
||||
_ -> stackYamlPkgs pwd
|
||||
when (null cfs) $ error $
|
||||
"No .cabal files found under"
|
||||
<> pwd
|
||||
<> "\n You may need to run stack build."
|
||||
pkgs <- catMaybes <$> mapM (nestedPkg pwd) cfs
|
||||
pkgs <- catMaybes <$> mapM (nestedPkg pwd) (concat cfs)
|
||||
putStr <$> hieYaml name $ fmtPkgs name pkgs
|
||||
|
||||
|
@ -81,7 +81,9 @@ parseSecMain c s i = do
|
||||
parseQuoted :: Parser Text
|
||||
parseQuoted = do
|
||||
q <- char '"' <|> char '\''
|
||||
takeTill (== q)
|
||||
s <- takeTill (== q)
|
||||
_ <- char q
|
||||
pure s
|
||||
|
||||
parseString :: Parser Name
|
||||
parseString = parseQuoted <|> unqualName
|
||||
|
@ -3,17 +3,17 @@
|
||||
|
||||
module Hie.Locate
|
||||
( nestedPkg,
|
||||
nestedCabalFiles,
|
||||
stackYamlPkgs,
|
||||
cabalProjectPkgs,
|
||||
cabalPkgs,
|
||||
)
|
||||
where
|
||||
|
||||
import Control.Applicative
|
||||
import Control.Exception
|
||||
import Control.Monad
|
||||
import Control.Monad.IO.Class
|
||||
import Control.Monad.Trans.Maybe
|
||||
import Data.Attoparsec.Text
|
||||
import Data.Attoparsec.Text (parseOnly)
|
||||
import Data.List
|
||||
import Data.Maybe
|
||||
import qualified Data.Text as T
|
||||
@ -25,6 +25,7 @@ import Hie.Yaml
|
||||
import System.Directory
|
||||
import System.Directory.Internal
|
||||
import System.FilePath.Posix
|
||||
import System.FilePattern.Directory (getDirectoryFiles)
|
||||
|
||||
newtype Pkgs = Pkgs [FilePath]
|
||||
deriving (Eq, Ord)
|
||||
@ -39,27 +40,14 @@ stackYamlPkgs p = liftIO $
|
||||
Right (Pkgs f) -> pure f
|
||||
Left e -> fail $ show e
|
||||
|
||||
cabalProjectPkgs :: FilePath -> MaybeT IO [FilePath]
|
||||
cabalProjectPkgs p = do
|
||||
cp <- liftIO $ T.readFile $ p </> "cabal.project"
|
||||
case parseOnly extractPkgs cp of
|
||||
Right f -> pure $ map T.unpack f
|
||||
_ -> fail "No packages found"
|
||||
|
||||
nestedCabalFiles :: FilePath -> IO [FilePath]
|
||||
nestedCabalFiles f = do
|
||||
fs <- listDirectory f
|
||||
nf <-
|
||||
fmap concat . mapM nestedCabalFiles
|
||||
=<< filterM
|
||||
(fmap (fileTypeIsDirectory . fileTypeFromMetadata) . getFileMetadata)
|
||||
( map (f </>) $
|
||||
filter
|
||||
(`notElem` [".git", "dist", "dist-newstyle", ".stack-work"])
|
||||
fs
|
||||
)
|
||||
let cf = filter ((".cabal" ==) . takeExtension) fs
|
||||
pure $ map (f </>) cf <> nf
|
||||
cabalPkgs :: FilePath -> MaybeT IO [FilePath]
|
||||
cabalPkgs p = do
|
||||
cp <- liftIO (try $ T.readFile $ p </> "cabal.project" :: IO (Either IOException T.Text))
|
||||
case parseOnly extractPkgs <$> cp of
|
||||
Right (Right f) -> liftIO $ map (p </>) <$> getDirectoryFiles p (map T.unpack f)
|
||||
_ -> filter ((".cabal" ==) . takeExtension) <$> liftIO (listDirectory p) >>= \case
|
||||
[] -> fail "no cabal files found"
|
||||
h : _ -> pure [p </> h]
|
||||
|
||||
nestedPkg :: FilePath -> FilePath -> IO (Maybe Package)
|
||||
nestedPkg parrent child = do
|
||||
|
@ -74,9 +74,13 @@ spec = do
|
||||
$ ("one\n two \n three3" :: Text) ~> parseList 1
|
||||
`shouldParse` ["one", "two", "three3"]
|
||||
describe "Should Succeed"
|
||||
$ it "successfully parses newline list"
|
||||
$ it "successfully parses newline comma list"
|
||||
$ ("one\n two, three3" :: Text) ~> parseList 1
|
||||
`shouldParse` ["one", "two", "three3"]
|
||||
describe "Should Succeed"
|
||||
$ it "quoted list"
|
||||
$ ("\"one\"\n two\n three3" :: Text) ~> parseList 1
|
||||
`shouldParse` ["one", "two", "three3"]
|
||||
|
||||
fullFile :: Text
|
||||
fullFile = "name: implicit-hie\n" <> libSection <> exeSection <> testSection
|
||||
|
Loading…
Reference in New Issue
Block a user