mirror of
https://github.com/Avi-D-coder/implicit-hie.git
synced 2024-09-11 09:05:25 +03:00
Handle multiple hs-source-dirs and paths
This commit is contained in:
parent
a71069c2ba
commit
895fc55d12
@ -5,7 +5,7 @@ module Hie.Cabal.Parser where
|
||||
import Control.Applicative
|
||||
import Control.Monad
|
||||
import Data.Attoparsec.Text
|
||||
import Data.Char (isSpace)
|
||||
import Data.Char
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
|
||||
@ -31,50 +31,51 @@ parsePackage' = parseOnly parsePackage
|
||||
parsePackage :: Parser Package
|
||||
parsePackage =
|
||||
( do
|
||||
n <- field 0 "name"
|
||||
n <- field 0 "name" $ const parseString
|
||||
(Package _ t) <- parsePackage
|
||||
pure $ Package n t
|
||||
)
|
||||
<|> ( do
|
||||
h <- parseComponent 0
|
||||
(Package n t) <- parsePackage
|
||||
pure $ Package n (h : t)
|
||||
pure $ Package n (h <> t)
|
||||
)
|
||||
<|> (skipToNextLine >> parsePackage)
|
||||
<|> pure (Package "" [])
|
||||
|
||||
componentHeader :: Indent -> Text -> Parser Name
|
||||
componentHeader i t = do
|
||||
indent i
|
||||
_ <- indent i
|
||||
_ <- asciiCI t
|
||||
skipMany tabOrSpace
|
||||
n <- parseString <|> pure ""
|
||||
skipToNextLine
|
||||
pure n
|
||||
|
||||
parseComponent :: Indent -> Parser Component
|
||||
parseComponent :: Indent -> Parser [Component]
|
||||
parseComponent i =
|
||||
parseExe i
|
||||
<|> parseLib i
|
||||
<|> parseBench i
|
||||
<|> parseTestSuite i
|
||||
|
||||
parseLib :: Indent -> Parser Component
|
||||
parseLib :: Indent -> Parser [Component]
|
||||
parseLib i = parseSec i "library" $ Comp Lib
|
||||
|
||||
parseTestSuite :: Indent -> Parser Component
|
||||
parseTestSuite :: Indent -> Parser [Component]
|
||||
parseTestSuite i = parseSec i "test-suite" $ Comp Test
|
||||
|
||||
parseExe :: Indent -> Parser Component
|
||||
parseExe :: Indent -> Parser [Component]
|
||||
parseExe = parseSecMain (Comp Exe) "executable"
|
||||
|
||||
parseBench :: Indent -> Parser Component
|
||||
parseBench :: Indent -> Parser [Component]
|
||||
parseBench = parseSecMain (Comp Bench) "benchmark"
|
||||
|
||||
parseSecMain :: (Name -> Path -> Component) -> Text -> Indent -> Parser Component
|
||||
parseSecMain :: (Name -> Path -> Component) -> Text -> Indent -> Parser [Component]
|
||||
parseSecMain c s i = do
|
||||
n <- componentHeader i s
|
||||
c n <$> pathMain (i + 1) "./" ""
|
||||
p <- pathMain (i + 1) ["./"] ""
|
||||
pure $ map (c n) p
|
||||
|
||||
parseQuoted :: Parser Text
|
||||
parseQuoted = do
|
||||
@ -82,19 +83,38 @@ parseQuoted = do
|
||||
takeTill (== q)
|
||||
|
||||
parseString :: Parser Name
|
||||
parseString = parseQuoted <|> takeWhile1 (not . (\c -> isSpace c || c == ','))
|
||||
parseString = parseQuoted <|> unqualName
|
||||
|
||||
pathMain :: Indent -> Text -> Text -> Parser Text
|
||||
unqualName :: Parser Text
|
||||
unqualName = takeWhile1 (\c -> isAlphaNum c || c `elem` ("-_./" :: String))
|
||||
|
||||
parseList :: Indent -> Parser [Text]
|
||||
parseList i = items <|> (emptyOrComLine >> indent i >> items)
|
||||
where
|
||||
items = do
|
||||
skipMany tabOrSpace
|
||||
h <- parseString
|
||||
skipMany tabOrSpace
|
||||
skipMany (char ',')
|
||||
t <-
|
||||
items
|
||||
<|> (skipToNextLine >> indent i >> parseList i)
|
||||
<|> pure []
|
||||
pure $ h : t
|
||||
|
||||
pathMain :: Indent -> [Text] -> Text -> Parser [Text]
|
||||
pathMain i p m =
|
||||
(field i "hs-source-dirs" >>= (\p' -> pathMain i p' m))
|
||||
<|> (field i "main-is" >>= pathMain i p)
|
||||
(hsSourceDir i >>= (\p' -> pathMain i p' m))
|
||||
<|> (field i "main-is" (const parseString) >>= pathMain i p)
|
||||
<|> (skipBlockLine i >> pathMain i p m)
|
||||
<|> pure (p <> "/" <> m)
|
||||
<|> pure (map (<> "/" <> m) p)
|
||||
|
||||
parseSec :: Indent -> Text -> (Name -> Path -> Component) -> Parser Component
|
||||
parseSec :: Indent -> Text -> (Name -> Path -> Component) -> Parser [Component]
|
||||
parseSec i compType compCon = do
|
||||
n <- componentHeader i compType
|
||||
compCon n <$> extractPath (i + 1)
|
||||
p <- extractPath (i + 1) []
|
||||
let p' = if null p then ["./"] else p
|
||||
pure $ map (compCon n) p'
|
||||
|
||||
skipToNextLine :: Parser ()
|
||||
skipToNextLine = skipWhile (not . isEndOfLine) >> endOfLine
|
||||
@ -102,46 +122,47 @@ skipToNextLine = skipWhile (not . isEndOfLine) >> endOfLine
|
||||
skipBlock :: Indent -> Parser ()
|
||||
skipBlock i = skipMany $ skipBlockLine i
|
||||
|
||||
comment :: Parser ()
|
||||
comment = skipMany tabOrSpace >> "--" >> skipToNextLine
|
||||
|
||||
skipBlockLine :: Indent -> Parser ()
|
||||
skipBlockLine i =
|
||||
(indent i >> skipToNextLine)
|
||||
<|> (skipMany tabOrSpace >> endOfLine)
|
||||
<|> (skipSpace >> "--" >> skipToNextLine)
|
||||
skipBlockLine i = (indent i >> skipToNextLine) <|> emptyOrComLine
|
||||
|
||||
emptyOrComLine :: Parser ()
|
||||
emptyOrComLine = skipMany tabOrSpace >> endOfLine <|> comment
|
||||
|
||||
tabOrSpace :: Parser Char
|
||||
tabOrSpace = char ' ' <|> char '\t'
|
||||
|
||||
field :: Indent -> Text -> Parser Text
|
||||
field i f =
|
||||
hsSourceDir :: Indent -> Parser [Text]
|
||||
hsSourceDir i = field i "hs-source-dirs" parseList
|
||||
|
||||
-- field :: Indent -> Text -> Parser Text
|
||||
field ::
|
||||
Indent ->
|
||||
Text ->
|
||||
(Indent -> Parser a) ->
|
||||
Parser a
|
||||
field i f p =
|
||||
do
|
||||
indent i
|
||||
i' <- indent i
|
||||
_ <- asciiCI f
|
||||
skipSpace
|
||||
_ <- char ':'
|
||||
skipSpace
|
||||
p <- parseString
|
||||
p' <- p $ i' + 1
|
||||
skipToNextLine
|
||||
pure p
|
||||
pure p'
|
||||
|
||||
parseMainIs :: Indent -> Parser Path
|
||||
parseMainIs i =
|
||||
do
|
||||
p <- field i "main-is"
|
||||
skipBlock i
|
||||
pure p
|
||||
<?> "hs-source-dirs"
|
||||
|
||||
extractPath :: Indent -> Parser Path
|
||||
extractPath i =
|
||||
( do
|
||||
p <- field i "hs-source-dirs"
|
||||
skipBlock i
|
||||
pure p
|
||||
)
|
||||
<|> (skipBlockLine i >> extractPath i <?> "skip line")
|
||||
<|> (pure "./" <?> "not found") <?> "extractPath"
|
||||
extractPath :: Indent -> [Path] -> Parser [Path]
|
||||
extractPath i ps =
|
||||
(field i "hs-source-dirs" parseList >>= (\p -> extractPath i $ ps <> p))
|
||||
<|> (skipBlockLine i >> extractPath i ps)
|
||||
<|> (comment >> extractPath i ps)
|
||||
<|> pure ps
|
||||
|
||||
-- | Skip at least n spaces
|
||||
indent :: Indent -> Parser ()
|
||||
indent 0 = skipMany tabOrSpace <?> "indent 0"
|
||||
indent i = tabOrSpace >> indent (i - 1) <?> "indent 0"
|
||||
indent :: Indent -> Parser Int
|
||||
indent i = do
|
||||
c <- length <$> many' tabOrSpace
|
||||
if c >= i then pure c else fail "insufficient indent"
|
||||
|
64
test/Spec.hs
64
test/Spec.hs
@ -17,21 +17,29 @@ spec = do
|
||||
describe "Should Succeed"
|
||||
$ it "successfully parses executable section"
|
||||
$ exeSection ~> parseExe 0
|
||||
`shouldParse` Comp Exe "implicit-hie-exe" "app/Main.hs"
|
||||
`shouldParse` [Comp Exe "implicit-hie-exe" "app/Main.hs"]
|
||||
describe "Should Succeed"
|
||||
$ it "successfully parses test section"
|
||||
$ testSection ~> parseTestSuite 0
|
||||
`shouldParse` Comp Test "implicit-hie-test" "test"
|
||||
`shouldParse` [Comp Test "implicit-hie-test" "test"]
|
||||
describe "Should Succeed"
|
||||
$ it "successfully parses library section"
|
||||
$ libSection ~> parseLib 0
|
||||
`shouldParse` Comp Lib "" "src"
|
||||
`shouldParse` [Comp Lib "" "src"]
|
||||
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
|
||||
`shouldParse` [Comp Lib "" "src", Comp Lib "" "src2"]
|
||||
describe "Should Succeed"
|
||||
$ it "successfully parses bench section"
|
||||
$ do
|
||||
bs <- T.readFile "test/benchSection"
|
||||
bs ~> parseBench 0
|
||||
`shouldParse` Comp Bench "folds" "benchmarks/folds.hs"
|
||||
`shouldParse` [Comp Bench "folds" "benchmarks/folds.hs"]
|
||||
describe "Should Succeed"
|
||||
$ it "successfully parses package"
|
||||
$ fullFile ~> parsePackage
|
||||
@ -58,6 +66,17 @@ spec = do
|
||||
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
|
||||
`shouldParse` ["one", "two", "three3"]
|
||||
describe "Should Succeed"
|
||||
$ it "successfully parses newline list"
|
||||
$ ("one\n two, three3" :: Text) ~> parseList 1
|
||||
`shouldParse` ["one", "two", "three3"]
|
||||
|
||||
fullFile :: Text
|
||||
fullFile = "name: implicit-hie\n" <> libSection <> exeSection <> testSection
|
||||
@ -108,6 +127,43 @@ libSection =
|
||||
\ default-language: Haskell2010\n\
|
||||
\"
|
||||
|
||||
libSection2 :: Text
|
||||
libSection2 =
|
||||
"library\n\
|
||||
\ exposed-modules:\n\
|
||||
\ Lib\n\
|
||||
\ other-modules:\n\
|
||||
\ Paths_implicit_hie\n\
|
||||
\ hs-source-dirs:\n\
|
||||
\ src\n\
|
||||
\ hs-source-dirs:\n\
|
||||
\ src2\n\
|
||||
\ ghc-options: -fspecialize-aggressively -Wall -Wincomplete-record-updates -Wincomplete-uni-patterns -fno-warn-unused-imports -fno-warn-unused-binds -fno-warn-name-shadowing -fwarn-redundant-constraints\n\
|
||||
\ build-depends:\n\
|
||||
\ attoparsec\n\
|
||||
\ , base >=4.7 && <5\n\
|
||||
\ , text\n\
|
||||
\ default-language: Haskell2010\n\
|
||||
\"
|
||||
|
||||
libSection3 :: Text
|
||||
libSection3 =
|
||||
"library\n\
|
||||
\ exposed-modules:\n\
|
||||
\ Lib\n\
|
||||
\ other-modules:\n\
|
||||
\ Paths_implicit_hie\n\
|
||||
\ hs-source-dirs:\n\
|
||||
\ src,\n\
|
||||
\ src2\n\
|
||||
\ ghc-options: -fspecialize-aggressively -Wall -Wincomplete-record-updates -Wincomplete-uni-patterns -fno-warn-unused-imports -fno-warn-unused-binds -fno-warn-name-shadowing -fwarn-redundant-constraints\n\
|
||||
\ build-depends:\n\
|
||||
\ attoparsec\n\
|
||||
\ , base >=4.7 && <5\n\
|
||||
\ , text\n\
|
||||
\ default-language: Haskell2010\n\
|
||||
\"
|
||||
|
||||
stackHie :: String
|
||||
stackHie =
|
||||
"cradle:\n\
|
||||
|
20
test/benchSection
Normal file
20
test/benchSection
Normal file
@ -0,0 +1,20 @@
|
||||
benchmark folds
|
||||
default-language: Haskell2010
|
||||
hs-source-dirs: benchmarks
|
||||
ghc-options: -Wall -threaded
|
||||
|
||||
-- GHCJS takes forever to compile dependencies
|
||||
if impl(ghcjs)
|
||||
buildable: False
|
||||
|
||||
build-depends: base
|
||||
, bytestring
|
||||
, containers
|
||||
, criterion
|
||||
, lens
|
||||
, optics
|
||||
, unordered-containers
|
||||
, vector
|
||||
|
||||
type: exitcode-stdio-1.0
|
||||
main-is: folds.hs
|
Loading…
Reference in New Issue
Block a user