mirror of
https://github.com/Avi-D-coder/implicit-hie.git
synced 2024-11-22 09:44:28 +03:00
Fmt and fixes
This commit is contained in:
parent
fc1d332914
commit
78b6224c06
15
app/Main.hs
15
app/Main.hs
@ -4,18 +4,12 @@ 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.Locate
|
||||
import Hie.Yaml
|
||||
import System.Directory
|
||||
import System.Directory.Internal
|
||||
import System.FilePath.Posix
|
||||
import System.Environment
|
||||
import System.FilePath.Posix
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
@ -24,7 +18,8 @@ main = do
|
||||
cfs <- runMaybeT $ case name of
|
||||
"cabal" -> cabalPkgs pwd
|
||||
_ -> stackYamlPkgs pwd
|
||||
when (null cfs) $ error $
|
||||
when (null cfs) $
|
||||
error $
|
||||
"No .cabal files found under"
|
||||
<> pwd
|
||||
<> "\n You may need to run stack build."
|
||||
@ -37,7 +32,8 @@ resolveName pwd = do
|
||||
files <- listDirectory pwd
|
||||
let fileNames = map takeFileName files
|
||||
name =
|
||||
if | "--cabal" `elem` args -> "cabal"
|
||||
if
|
||||
| "--cabal" `elem` args -> "cabal"
|
||||
| "--stack" `elem` args -> "stack"
|
||||
| "dist-newstyle" `elem` fileNames -> "cabal"
|
||||
| ".stack-work" `elem` fileNames -> "stack"
|
||||
@ -45,4 +41,3 @@ resolveName pwd = do
|
||||
| "stack.yaml" `elem` fileNames -> "stack"
|
||||
| otherwise -> "cabal"
|
||||
return name
|
||||
|
||||
|
@ -102,7 +102,8 @@ optSkipToNextLine i = do
|
||||
skipMany $ satisfy (\c -> isSpace c && not (isEndOfLine c))
|
||||
mChar <- peekChar
|
||||
case mChar of
|
||||
Just c | isEndOfLine c ->
|
||||
Just c
|
||||
| isEndOfLine c ->
|
||||
char c *> indent i $> ()
|
||||
_ -> pure ()
|
||||
|
||||
|
@ -8,9 +8,7 @@ module Hie.Locate
|
||||
)
|
||||
where
|
||||
|
||||
import Control.Applicative
|
||||
import Control.Exception
|
||||
import Control.Monad
|
||||
import Control.Monad.IO.Class
|
||||
import Control.Monad.Trans.Maybe
|
||||
import Data.Attoparsec.Text (parseOnly)
|
||||
@ -20,9 +18,7 @@ import Data.Maybe
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.IO as T
|
||||
import Data.Yaml
|
||||
import GHC.Generics
|
||||
import Hie.Cabal.Parser
|
||||
import Hie.Yaml
|
||||
import System.Directory
|
||||
import System.FilePath.Posix
|
||||
import System.FilePattern.Directory (getDirectoryFiles)
|
||||
@ -35,7 +31,8 @@ instance FromJSON Pkgs where
|
||||
parseJSON _ = fail "could not read packages from stack.yaml"
|
||||
|
||||
stackYamlPkgs :: FilePath -> MaybeT IO [FilePath]
|
||||
stackYamlPkgs p = liftIO $
|
||||
stackYamlPkgs p =
|
||||
liftIO $
|
||||
decodeFileEither (p </> "stack.yaml") >>= \case
|
||||
Right (Pkgs f) ->
|
||||
liftIO $
|
||||
@ -48,7 +45,8 @@ cabalPkgs p = do
|
||||
cp <- cabalP "cabal.project"
|
||||
cl <- cabalP "cabal.project.local"
|
||||
case concat . rights $ map (parseOnly extractPkgs) $ rights [cp, cl] of
|
||||
[] -> liftIO (cfs p) >>= \case
|
||||
[] ->
|
||||
liftIO (cfs p) >>= \case
|
||||
[] -> fail "no cabal files found"
|
||||
h : _ -> pure [p </> h]
|
||||
xs -> do
|
||||
@ -71,9 +69,10 @@ nestedPkg parrent child = do
|
||||
case parsePackage' f' of
|
||||
Right (Package n cs) -> do
|
||||
let dir =
|
||||
fromJust $ stripPrefix (splitDirectories parrent)
|
||||
$ splitDirectories
|
||||
$ fst (splitFileName child)
|
||||
fromJust $
|
||||
stripPrefix (splitDirectories parrent) $
|
||||
splitDirectories $
|
||||
fst (splitFileName child)
|
||||
pkg =
|
||||
Package n $
|
||||
map
|
||||
|
@ -6,7 +6,7 @@
|
||||
packages: []
|
||||
snapshots:
|
||||
- completed:
|
||||
size: 492027
|
||||
url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/15/9.yaml
|
||||
sha256: 11394dc975e96c2fea90f7f2b3229630d46351a092ebcec78f0a56403930b429
|
||||
original: lts-15.9
|
||||
size: 496111
|
||||
url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/15/14.yaml
|
||||
sha256: c442d702d66b8c129b3473a32c609050aabf1dc2f8e8502402c143271a8fb141
|
||||
original: lts-15.14
|
||||
|
101
test/Spec.hs
101
test/Spec.hs
@ -1,7 +1,6 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
import Data.Attoparsec.Text
|
||||
import qualified Data.Text as T
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text.IO as T
|
||||
import Hie.Cabal.Parser
|
||||
@ -14,35 +13,35 @@ main = hspec spec
|
||||
|
||||
spec :: Spec
|
||||
spec = do
|
||||
describe "Should Succeed"
|
||||
$ it "successfully parses executable section"
|
||||
$ exeSection ~> parseExe 0
|
||||
describe "Should Succeed" $
|
||||
it "successfully parses executable section" $
|
||||
exeSection ~> parseExe 0
|
||||
`shouldParse` [Comp Exe "gen-hie" "app/Main.hs"]
|
||||
describe "Should Succeed"
|
||||
$ it "successfully parses test section"
|
||||
$ testSection ~> parseTestSuite 0
|
||||
describe "Should Succeed" $
|
||||
it "successfully parses test section" $
|
||||
testSection ~> parseTestSuite 0
|
||||
`shouldParse` [Comp Test "implicit-hie-test" "test"]
|
||||
describe "Should Succeed"
|
||||
$ it "successfully parses library section"
|
||||
$ libSection ~> parseLib 0
|
||||
describe "Should Succeed" $
|
||||
it "successfully parses library section" $
|
||||
libSection ~> parseLib 0
|
||||
`shouldParse` [Comp Lib "" "src"]
|
||||
describe "Should Succeed"
|
||||
$ it "successfully parses library section with 2 hs-source-dirs"
|
||||
$ libSection2 ~> parseLib 0
|
||||
describe "Should Succeed" $
|
||||
it "successfully parses library section with 2 hs-source-dirs" $
|
||||
libSection2 ~> parseLib 0
|
||||
`shouldParse` [Comp Lib "" "src", Comp Lib "" "src2"]
|
||||
describe "Should Succeed"
|
||||
$ it "successfully parses library section with 2 paths under hs-source-dirs"
|
||||
$ libSection3 ~> parseLib 0
|
||||
describe "Should Succeed" $
|
||||
it "successfully parses library section with 2 paths under hs-source-dirs" $
|
||||
libSection3 ~> parseLib 0
|
||||
`shouldParse` [Comp Lib "" "src", Comp Lib "" "src2"]
|
||||
describe "Should Succeed"
|
||||
$ it "successfully parses bench section"
|
||||
$ do
|
||||
describe "Should Succeed" $
|
||||
it "successfully parses bench section" $
|
||||
do
|
||||
bs <- T.readFile "test/benchSection"
|
||||
bs ~> parseBench 0
|
||||
`shouldParse` [Comp Bench "folds" "benchmarks/folds.hs"]
|
||||
describe "Should Succeed"
|
||||
$ it "successfully parses package"
|
||||
$ do
|
||||
describe "Should Succeed" $
|
||||
it "successfully parses package" $
|
||||
do
|
||||
cf <- T.readFile "implicit-hie.cabal"
|
||||
cf ~> parsePackage
|
||||
`shouldParse` Package
|
||||
@ -51,51 +50,51 @@ spec = do
|
||||
Comp Exe "gen-hie" "app/Main.hs",
|
||||
Comp Test "implicit-hie-test" "test"
|
||||
]
|
||||
describe "Should Succeed"
|
||||
$ it
|
||||
describe "Should Succeed" $
|
||||
it
|
||||
"skips to end of block section"
|
||||
$ let r = "test\n"
|
||||
in (libSection <> r) ~?> parseLib 0
|
||||
`leavesUnconsumed` r
|
||||
describe "Should Succeed"
|
||||
$ it "successfully generates stack hie.yaml"
|
||||
$ do
|
||||
describe "Should Succeed" $
|
||||
it "successfully generates stack hie.yaml" $
|
||||
do
|
||||
sf <- readFile "test/stackHie.yaml"
|
||||
cf <- T.readFile "implicit-hie.cabal"
|
||||
(hieYaml "stack" . fmtPkgs "stack" . (: []) <$> parseOnly parsePackage cf)
|
||||
`shouldBe` Right sf
|
||||
describe "Should Succeed"
|
||||
$ it "successfully generates cabal hie.yaml for haskell-language-server"
|
||||
$ do
|
||||
describe "Should Succeed" $
|
||||
it "successfully generates cabal hie.yaml for haskell-language-server" $
|
||||
do
|
||||
f <- T.readFile "test/haskell-language-server-cabal"
|
||||
o <- readFile "test/hie.yaml.cbl"
|
||||
(hieYaml "cabal" . fmtPkgs "cabal" . (: []) <$> parseOnly parsePackage f)
|
||||
`shouldBe` Right o
|
||||
describe "Should Succeed"
|
||||
$ it "successfully parses comma list"
|
||||
$ ("one, two" :: Text) ~> parseList 1 `shouldParse` ["one", "two"]
|
||||
describe "Should Succeed"
|
||||
$ it "successfully parses newline list"
|
||||
$ ("one\n two \n three3" :: Text) ~> parseList 1
|
||||
describe "Should Succeed" $
|
||||
it "successfully parses comma list" $
|
||||
("one, two" :: Text) ~> parseList 1 `shouldParse` ["one", "two"]
|
||||
describe "Should Succeed" $
|
||||
it "successfully parses newline list" $
|
||||
("one\n two \n three3" :: Text) ~> parseList 1
|
||||
`shouldParse` ["one", "two", "three3"]
|
||||
describe "Should Succeed"
|
||||
$ it "successfully parses newline comma list"
|
||||
$ ("one\n two, three3" :: Text) ~> parseList 1
|
||||
describe "Should Succeed" $
|
||||
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
|
||||
describe "Should Succeed" $
|
||||
it "quoted list" $
|
||||
("\"one\"\n two\n three3" :: Text) ~> parseList 1
|
||||
`shouldParse` ["one", "two", "three3"]
|
||||
describe "Should Succeed"
|
||||
$ it "list with leading commas"
|
||||
$ ("one\n , two\n , three3" :: Text) ~> parseList 1
|
||||
describe "Should Succeed" $
|
||||
it "list with leading commas" $
|
||||
("one\n , two\n , three3" :: Text) ~> parseList 1
|
||||
`shouldParse` ["one", "two", "three3"]
|
||||
describe "Should Succeed"
|
||||
$ it "succesfully parses exe component with other-modules containing dots"
|
||||
$ exeSection2 ~> parseExe 0
|
||||
`shouldParse` [ Comp Exe "gen-hie" "app/Main.hs"
|
||||
, Comp Exe "gen-hie" "app/Hie/Executable/Helper.hs"
|
||||
, Comp Exe "gen-hie" "app/Hie/Executable/Utils.hs"
|
||||
describe "Should Succeed" $
|
||||
it "succesfully parses exe component with other-modules containing dots" $
|
||||
exeSection2 ~> parseExe 0
|
||||
`shouldParse` [ Comp Exe "gen-hie" "app/Main.hs",
|
||||
Comp Exe "gen-hie" "app/Hie/Executable/Helper.hs",
|
||||
Comp Exe "gen-hie" "app/Hie/Executable/Utils.hs"
|
||||
]
|
||||
|
||||
exeSection :: Text
|
||||
|
Loading…
Reference in New Issue
Block a user