Avi-D-coder/implicit-hie
1
1
Fork 0
mirror of https://github.com/Avi-D-coder/implicit-hie.git synced 2024-11-22 09:44:28 +03:00
Code Issues Projects Releases Wiki Activity

Fmt and fixes

Browse Source
This commit is contained in:
Avi Dessauer 2020-11-09 18:35:45 -05:00
parent fc1d332914
commit 78b6224c06
6 changed files with 115 additions and 120 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
Setup.hs
View File

@ -1,2 +1,3 @@
import Distribution.Simple import Distribution.Simple
main = defaultMain main = defaultMain

21
app/Main.hs
View File

@ -4,18 +4,12 @@ module Main where
import Control.Monad import Control.Monad
import Control.Monad.Trans.Maybe import Control.Monad.Trans.Maybe
import Data.Attoparsec.Text
import Data.List
import Data.Maybe import Data.Maybe
import qualified Data.Text as T
import qualified Data.Text.IO as T
import Hie.Cabal.Parser
import Hie.Locate import Hie.Locate
import Hie.Yaml import Hie.Yaml
import System.Directory import System.Directory
import System.Directory.Internal
import System.FilePath.Posix
import System.Environment import System.Environment
import System.FilePath.Posix
main :: IO () main :: IO ()
main = do main = do
@ -24,10 +18,11 @@ main = do
cfs <- runMaybeT $ case name of cfs <- runMaybeT $ case name of
"cabal" -> cabalPkgs pwd "cabal" -> cabalPkgs pwd
_ -> stackYamlPkgs pwd _ -> stackYamlPkgs pwd
when (null cfs) $ error $ when (null cfs) $
"No .cabal files found under" error $
<> pwd "No .cabal files found under"
<> "\n You may need to run stack build." <> pwd
<> "\n You may need to run stack build."
pkgs <- catMaybes <$> mapM (nestedPkg pwd) (concat cfs) pkgs <- catMaybes <$> mapM (nestedPkg pwd) (concat cfs)
putStr <$> hieYaml name $ fmtPkgs name pkgs putStr <$> hieYaml name $ fmtPkgs name pkgs
@ -37,7 +32,8 @@ resolveName pwd = do
files <- listDirectory pwd files <- listDirectory pwd
let fileNames = map takeFileName files let fileNames = map takeFileName files
name = name =
if | "--cabal" `elem` args -> "cabal" if
| "--cabal" `elem` args -> "cabal"
| "--stack" `elem` args -> "stack" | "--stack" `elem` args -> "stack"
| "dist-newstyle" `elem` fileNames -> "cabal" | "dist-newstyle" `elem` fileNames -> "cabal"
| ".stack-work" `elem` fileNames -> "stack" | ".stack-work" `elem` fileNames -> "stack"
@ -45,4 +41,3 @@ resolveName pwd = do
| "stack.yaml" `elem` fileNames -> "stack" | "stack.yaml" `elem` fileNames -> "stack"
| otherwise -> "cabal" | otherwise -> "cabal"
return name return name

5
src/Hie/Cabal/Parser.hs
View File

@ -102,8 +102,9 @@ optSkipToNextLine i = do
skipMany $ satisfy (\c -> isSpace c && not (isEndOfLine c)) skipMany $ satisfy (\c -> isSpace c && not (isEndOfLine c))
mChar <- peekChar mChar <- peekChar
case mChar of case mChar of
Just c | isEndOfLine c -> Just c
char c *> indent i $> () | isEndOfLine c ->
char c *> indent i $> ()
_ -> pure () _ -> pure ()
-- | Comma or space separated list, with optional new lines. -- | Comma or space separated list, with optional new lines.

33
src/Hie/Locate.hs
View File

@ -8,9 +8,7 @@ module Hie.Locate
) )
where where
import Control.Applicative
import Control.Exception import Control.Exception
import Control.Monad
import Control.Monad.IO.Class import Control.Monad.IO.Class
import Control.Monad.Trans.Maybe import Control.Monad.Trans.Maybe
import Data.Attoparsec.Text (parseOnly) import Data.Attoparsec.Text (parseOnly)
@ -20,9 +18,7 @@ import Data.Maybe
import qualified Data.Text as T import qualified Data.Text as T
import qualified Data.Text.IO as T import qualified Data.Text.IO as T
import Data.Yaml import Data.Yaml
import GHC.Generics
import Hie.Cabal.Parser import Hie.Cabal.Parser
import Hie.Yaml
import System.Directory import System.Directory
import System.FilePath.Posix import System.FilePath.Posix
import System.FilePattern.Directory (getDirectoryFiles) import System.FilePattern.Directory (getDirectoryFiles)
@ -35,22 +31,24 @@ instance FromJSON Pkgs where
parseJSON _ = fail "could not read packages from stack.yaml" parseJSON _ = fail "could not read packages from stack.yaml"
stackYamlPkgs :: FilePath -> MaybeT IO [FilePath] stackYamlPkgs :: FilePath -> MaybeT IO [FilePath]
stackYamlPkgs p = liftIO $ stackYamlPkgs p =
decodeFileEither (p </> "stack.yaml") >>= \case liftIO $
Right (Pkgs f) -> decodeFileEither (p </> "stack.yaml") >>= \case
liftIO $ Right (Pkgs f) ->
map (p </>) liftIO $
<$> getDirectoryFiles p (map (</> "*.cabal") f) map (p </>)
Left e -> fail $ show e <$> getDirectoryFiles p (map (</> "*.cabal") f)
Left e -> fail $ show e
cabalPkgs :: FilePath -> MaybeT IO [FilePath] cabalPkgs :: FilePath -> MaybeT IO [FilePath]
cabalPkgs p = do cabalPkgs p = do
cp <- cabalP "cabal.project" cp <- cabalP "cabal.project"
cl <- cabalP "cabal.project.local" cl <- cabalP "cabal.project.local"
case concat . rights $ map (parseOnly extractPkgs) $ rights [cp, cl] of case concat . rights $ map (parseOnly extractPkgs) $ rights [cp, cl] of
[] -> liftIO (cfs p) >>= \case [] ->
[] -> fail "no cabal files found" liftIO (cfs p) >>= \case
h : _ -> pure [p </> h] [] -> fail "no cabal files found"
h : _ -> pure [p </> h]
xs -> do xs -> do
cd <- liftIO $ map (p </>) <$> getDirectoryFiles p (map (matchDirs . T.unpack) xs) cd <- liftIO $ map (p </>) <$> getDirectoryFiles p (map (matchDirs . T.unpack) xs)
cf <- cf <-
@ -71,9 +69,10 @@ nestedPkg parrent child = do
case parsePackage' f' of case parsePackage' f' of
Right (Package n cs) -> do Right (Package n cs) -> do
let dir = let dir =
fromJust $ stripPrefix (splitDirectories parrent) fromJust $
$ splitDirectories stripPrefix (splitDirectories parrent) $
$ fst (splitFileName child) splitDirectories $
fst (splitFileName child)
pkg = pkg =
Package n $ Package n $
map map

8
stack.yaml.lock
View File

@ -6,7 +6,7 @@
packages: [] packages: []
snapshots: snapshots:
- completed: - completed:
size: 492027 size: 496111
url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/15/9.yaml url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/15/14.yaml
sha256: 11394dc975e96c2fea90f7f2b3229630d46351a092ebcec78f0a56403930b429 sha256: c442d702d66b8c129b3473a32c609050aabf1dc2f8e8502402c143271a8fb141
original: lts-15.9 original: lts-15.14

167
test/Spec.hs
View File

@ -1,7 +1,6 @@
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
import Data.Attoparsec.Text import Data.Attoparsec.Text
import qualified Data.Text as T
import Data.Text (Text) import Data.Text (Text)
import qualified Data.Text.IO as T import qualified Data.Text.IO as T
import Hie.Cabal.Parser import Hie.Cabal.Parser
@ -14,89 +13,89 @@ main = hspec spec
spec :: Spec spec :: Spec
spec = do spec = do
describe "Should Succeed" describe "Should Succeed" $
$ it "successfully parses executable section" it "successfully parses executable section" $
$ exeSection ~> parseExe 0 exeSection ~> parseExe 0
`shouldParse` [Comp Exe "gen-hie" "app/Main.hs"] `shouldParse` [Comp Exe "gen-hie" "app/Main.hs"]
describe "Should Succeed" describe "Should Succeed" $
$ it "successfully parses test section" it "successfully parses test section" $
$ testSection ~> parseTestSuite 0 testSection ~> parseTestSuite 0
`shouldParse` [Comp Test "implicit-hie-test" "test"] `shouldParse` [Comp Test "implicit-hie-test" "test"]
describe "Should Succeed" describe "Should Succeed" $
$ it "successfully parses library section" it "successfully parses library section" $
$ libSection ~> parseLib 0 libSection ~> parseLib 0
`shouldParse` [Comp Lib "" "src"] `shouldParse` [Comp Lib "" "src"]
describe "Should Succeed" describe "Should Succeed" $
$ it "successfully parses library section with 2 hs-source-dirs" it "successfully parses library section with 2 hs-source-dirs" $
$ libSection2 ~> parseLib 0 libSection2 ~> parseLib 0
`shouldParse` [Comp Lib "" "src", Comp Lib "" "src2"] `shouldParse` [Comp Lib "" "src", Comp Lib "" "src2"]
describe "Should Succeed" describe "Should Succeed" $
$ it "successfully parses library section with 2 paths under hs-source-dirs" it "successfully parses library section with 2 paths under hs-source-dirs" $
$ libSection3 ~> parseLib 0 libSection3 ~> parseLib 0
`shouldParse` [Comp Lib "" "src", Comp Lib "" "src2"] `shouldParse` [Comp Lib "" "src", Comp Lib "" "src2"]
describe "Should Succeed" describe "Should Succeed" $
$ it "successfully parses bench section" it "successfully parses bench section" $
$ do do
bs <- T.readFile "test/benchSection" bs <- T.readFile "test/benchSection"
bs ~> parseBench 0 bs ~> parseBench 0
`shouldParse` [Comp Bench "folds" "benchmarks/folds.hs"] `shouldParse` [Comp Bench "folds" "benchmarks/folds.hs"]
describe "Should Succeed" describe "Should Succeed" $
$ it "successfully parses package" it "successfully parses package" $
$ do do
cf <- T.readFile "implicit-hie.cabal" cf <- T.readFile "implicit-hie.cabal"
cf ~> parsePackage cf ~> parsePackage
`shouldParse` Package `shouldParse` Package
"implicit-hie" "implicit-hie"
[ Comp Lib "" "src", [ Comp Lib "" "src",
Comp Exe "gen-hie" "app/Main.hs", Comp Exe "gen-hie" "app/Main.hs",
Comp Test "implicit-hie-test" "test" Comp Test "implicit-hie-test" "test"
] ]
describe "Should Succeed" describe "Should Succeed" $
$ it it
"skips to end of block section" "skips to end of block section"
$ let r = "test\n" $ let r = "test\n"
in (libSection <> r) ~?> parseLib 0 in (libSection <> r) ~?> parseLib 0
`leavesUnconsumed` r `leavesUnconsumed` r
describe "Should Succeed" describe "Should Succeed" $
$ it "successfully generates stack hie.yaml" it "successfully generates stack hie.yaml" $
$ do do
sf <- readFile "test/stackHie.yaml" sf <- readFile "test/stackHie.yaml"
cf <- T.readFile "implicit-hie.cabal" cf <- T.readFile "implicit-hie.cabal"
(hieYaml "stack" . fmtPkgs "stack" . (: []) <$> parseOnly parsePackage cf) (hieYaml "stack" . fmtPkgs "stack" . (: []) <$> parseOnly parsePackage cf)
`shouldBe` Right sf `shouldBe` Right sf
describe "Should Succeed" describe "Should Succeed" $
$ it "successfully generates cabal hie.yaml for haskell-language-server" it "successfully generates cabal hie.yaml for haskell-language-server" $
$ do do
f <- T.readFile "test/haskell-language-server-cabal" f <- T.readFile "test/haskell-language-server-cabal"
o <- readFile "test/hie.yaml.cbl" o <- readFile "test/hie.yaml.cbl"
(hieYaml "cabal" . fmtPkgs "cabal" . (: []) <$> parseOnly parsePackage f) (hieYaml "cabal" . fmtPkgs "cabal" . (: []) <$> parseOnly parsePackage f)
`shouldBe` Right o `shouldBe` Right o
describe "Should Succeed" describe "Should Succeed" $
$ it "successfully parses comma list" it "successfully parses comma list" $
$ ("one, two" :: Text) ~> parseList 1 `shouldParse` ["one", "two"] ("one, two" :: Text) ~> parseList 1 `shouldParse` ["one", "two"]
describe "Should Succeed" describe "Should Succeed" $
$ it "successfully parses newline list" it "successfully parses newline list" $
$ ("one\n two \n three3" :: Text) ~> parseList 1 ("one\n two \n three3" :: Text) ~> parseList 1
`shouldParse` ["one", "two", "three3"] `shouldParse` ["one", "two", "three3"]
describe "Should Succeed" describe "Should Succeed" $
$ it "successfully parses newline comma list" it "successfully parses newline comma list" $
$ ("one\n two, three3" :: Text) ~> parseList 1 ("one\n two, three3" :: Text) ~> parseList 1
`shouldParse` ["one", "two", "three3"] `shouldParse` ["one", "two", "three3"]
describe "Should Succeed" describe "Should Succeed" $
$ it "quoted list" it "quoted list" $
$ ("\"one\"\n two\n three3" :: Text) ~> parseList 1 ("\"one\"\n two\n three3" :: Text) ~> parseList 1
`shouldParse` ["one", "two", "three3"] `shouldParse` ["one", "two", "three3"]
describe "Should Succeed" describe "Should Succeed" $
$ it "list with leading commas" it "list with leading commas" $
$ ("one\n , two\n , three3" :: Text) ~> parseList 1 ("one\n , two\n , three3" :: Text) ~> parseList 1
`shouldParse` ["one", "two", "three3"] `shouldParse` ["one", "two", "three3"]
describe "Should Succeed" describe "Should Succeed" $
$ it "succesfully parses exe component with other-modules containing dots" it "succesfully parses exe component with other-modules containing dots" $
$ exeSection2 ~> parseExe 0 exeSection2 ~> parseExe 0
`shouldParse` [ Comp Exe "gen-hie" "app/Main.hs" `shouldParse` [ Comp Exe "gen-hie" "app/Main.hs",
, Comp Exe "gen-hie" "app/Hie/Executable/Helper.hs" Comp Exe "gen-hie" "app/Hie/Executable/Helper.hs",
, Comp Exe "gen-hie" "app/Hie/Executable/Utils.hs" Comp Exe "gen-hie" "app/Hie/Executable/Utils.hs"
] ]
exeSection :: Text exeSection :: Text
exeSection = exeSection =
@ -191,4 +190,4 @@ exeSection2 =
\ Hie.Executable.Utils\n\ \ Hie.Executable.Utils\n\
\ hs-source-dirs:\n\ \ hs-source-dirs:\n\
\ app\n\ \ app\n\
\ main-is: Main.hs \n" \ main-is: Main.hs \n"