support multi package cabal projects

This commit is contained in:
Avi Dessauer 2020-05-01 20:28:14 -04:00
parent 53996020b6
commit ea43db6bc6
2 changed files with 34 additions and 9 deletions

View File

@ -1,5 +1,5 @@
# implicit-hie # implicit-hie
```bash ```bash
cd your-stack-or-cabal-package cd your-stack-or-cabal-package
gen-hie > hie.yaml gen-hie
``` ```

View File

@ -9,19 +9,44 @@ import qualified Data.Text.IO as T
import Hie.Cabal.Parser import Hie.Cabal.Parser
import Hie.Yaml import Hie.Yaml
import System.Directory import System.Directory
import System.Directory.Internal
import System.FilePath.Posix import System.FilePath.Posix
main :: IO () main :: IO ()
main = do main = do
files <- listDirectory =<< getCurrentDirectory pwd <- getCurrentDirectory
let path = filter ((".cabal" ==) . takeExtension) files files <- listDirectory pwd
sOrC = cfs <- cabalFiles pwd
let sOrC =
if | any ((".stack-work" ==) . takeFileName) files -> stackHieYaml if | any ((".stack-work" ==) . takeFileName) files -> stackHieYaml
| any (("dist-newstyle" ==) . takeFileName) files -> cabalHieYaml | any (("dist-newstyle" ==) . takeFileName) files -> cabalHieYaml
| any (("stack.yaml" ==) . takeFileName) files -> stackHieYaml | any (("stack.yaml" ==) . takeFileName) files -> stackHieYaml
| otherwise -> cabalHieYaml | otherwise -> cabalHieYaml
when (null path) $ error "No .cabal file found!\n You may need to run stack build." gen f = do
file <- T.readFile $ head path f' <- T.readFile f
case parseOnly parsePackage file of case parseOnly parsePackage f' of
Right r -> T.putStr $ sOrC r Right r -> do
_ -> error "Could not parse *.cabal file" let hiePath = fst (splitFileName f) </> "hie.yaml"
T.writeFile hiePath $ sOrC r
pure ("wrote " <> hiePath)
_ -> pure $ "Could not parse " <> f
when (null cfs) $ error $
"No .cabal files found under"
<> pwd
<> "\n You may need to run stack build."
mapM_ (putStrLn <=< gen) cfs
cabalFiles :: FilePath -> IO [FilePath]
cabalFiles f = do
fs <- listDirectory f
case filter ((".cabal" ==) . takeExtension) fs of
h : _ -> pure [f </> h]
_ ->
fmap concat . mapM cabalFiles
=<< filterM
(fmap (fileTypeIsDirectory . fileTypeFromMetadata) . getFileMetadata)
( map (f </>) $
filter
(`notElem` [".git", "dist", "dist-newstyle", ".stack-work"])
fs
)