Handle multiple hs-source-dirs and paths

Author: Avi-D-coder

src/Hie/Cabal/Parser.hs

@@ -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,117 +31,138 @@ 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
   q <- char '"' <|> char '\''
   takeTill (== q)
 
 parseString :: Parser Name
-parseString = parseQuoted <|> takeWhile1 (not . (\c -> isSpace c || c == ','))
-
-pathMain :: Indent -> Text -> Text -> Parser Text
+parseString = parseQuoted <|> unqualName
+
+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
 
 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"

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\

test/benchSection

@@ -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