Generate a single hie.yaml file

Tests are broken and so are benchmark sections

Author: Avi-D-coder

app/Main.hs

@@ -4,6 +4,8 @@ module Main where
 
 import Control.Monad
 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
@@ -17,26 +19,38 @@ main = do
   pwd <- getCurrentDirectory
   files <- listDirectory pwd
   cfs <- cabalFiles pwd
-  let cabal = (cabalHieYaml, "Cabal ")
-      stack = (stackHieYaml, "Stack ")
-      sOrC =
+  let cabal = (cabalComponent, "cabal")
+      stack = (stackComponent, "stack")
+      (fmt, name) =
         if  | any (("dist-newstyle" ==) . takeFileName) files -> cabal
             | any ((".stack-work" ==) . takeFileName) files -> stack
             | any (("stack.yaml" ==) . takeFileName) files -> stack
             | otherwise -> cabal
       gen f = do
         f' <- T.readFile f
         case parsePackage' f' of
-          Right r -> do
+          Right (Package n cs) -> do
             let hiePath = fst (splitFileName f) </> "hie.yaml"
-            T.writeFile hiePath $ fst sOrC r
-            pure ("wrote " <> snd sOrC <> hiePath)
-          _ -> pure $ "Could not parse " <> f
+                dir =
+                  fromJust $ stripPrefix (splitDirectories pwd)
+                    $ splitDirectories
+                    $ fst (splitFileName f)
+                pkg =
+                  Package n $
+                    map
+                      ( \(Comp t n p) ->
+                          Comp t n (T.pack $ joinPath dir </> T.unpack p)
+                      )
+                      cs
+            pure $ Just pkg
+          _ -> pure Nothing
   when (null cfs) $ error $
     "No .cabal files found under"
       <> pwd
       <> "\n You may need to run stack build."
-  mapM_ (putStrLn <=< gen) cfs
+  pkgs <- catMaybes <$> mapM gen cfs
+  putStr <$> hieYaml name $ unlines $
+    concatMap (\(Package n cs) -> map ((<> "\n") . fmtComponent . fmt n) cs) pkgs
 
 cabalFiles :: FilePath -> IO [FilePath]
 cabalFiles f = do

hie.yaml

@@ -2,7 +2,10 @@ cradle:
   cabal:
     - path: "src"
       component: "lib:implicit-hie"
+    
     - path: "app/Main.hs"
       component: "implicit-hie:exe:gen-hie"
+    
     - path: "test"
       component: "implicit-hie:test:implicit-hie-test"
+    

src/Hie/Cabal/Parser.hs

@@ -8,7 +8,6 @@ import Data.Attoparsec.Text
 import Data.Char (isSpace)
 import Data.Text (Text)
 import qualified Data.Text as T
-import Debug.Trace
 
 type Name = Text
 
@@ -19,11 +18,11 @@ type Indent = Int
 data Package = Package Name [Component]
   deriving (Show, Eq, Ord)
 
+data CompType = Lib | Exe | Test | Bench
+  deriving (Show, Eq, Ord)
+
 data Component
-  = Lib Name Path
-  | Exe Name Path
-  | Test Name Path
-  | Bench Name Path
+  = Comp CompType Name Path
   deriving (Show, Eq, Ord)
 
 parsePackage' :: Text -> Either String Package
@@ -46,11 +45,8 @@ parsePackage =
 
 componentHeader :: Indent -> Text -> Parser Name
 componentHeader i t = do
-  traceM $ "indent" <> show i
   indent i
-  traceM $ "asciiCI" <> T.unpack t
   _ <- asciiCI t
-  traceM "parseString"
   skipMany tabOrSpace
   n <- parseString <|> pure ""
   skipToNextLine
@@ -63,16 +59,16 @@ parseComponent i =
     <|> parseTestSuite i
 
 parseLib :: Indent -> Parser Component
-parseLib i = parseSec i "library" Lib
+parseLib i = parseSec i "library" $ Comp Lib
 
 parseTestSuite :: Indent -> Parser Component
-parseTestSuite i = parseSec i "test-suite" Test
+parseTestSuite i = parseSec i "test-suite" $ Comp Test
 
 parseExe :: Indent -> Parser Component
-parseExe = parseSecMain Exe "executable"
+parseExe = parseSecMain (Comp Exe) "executable"
 
 parseBench :: Indent -> Parser Component
-parseBench = parseSecMain Bench "benchmark"
+parseBench = parseSecMain (Comp Bench) "benchmark"
 
 parseSecMain :: (Name -> Path -> Component) -> Text -> Indent -> Parser Component
 parseSecMain c s i = do

src/Hie/Yaml.hs

@@ -1,8 +1,8 @@
 {-# LANGUAGE OverloadedStrings #-}
 
 module Hie.Yaml
-  ( cabalHieYaml,
-    stackHieYaml,
+  ( hieYaml,
+    fmtComponent,
     cabalComponent,
     stackComponent,
   )
@@ -11,36 +11,28 @@ where
 import qualified Data.Text as T
 import Hie.Cabal.Parser
 
-cabalHieYaml :: Package -> T.Text
-cabalHieYaml (Package n cs) =
-  T.pack $
-    "cradle:\n"
-      <> indent'
-        ("cabal:\n" <> indent' (unlines (map (fmtComponent . cabalComponent n) cs)))
-
-stackHieYaml :: Package -> T.Text
-stackHieYaml (Package n cs) =
-  T.pack $
-    "cradle:\n"
-      <> indent'
-        ("stack:\n" <> indent' (unlines (map (fmtComponent . stackComponent n) cs)))
+hieYaml :: String -> String -> String
+hieYaml sOrC pkgs =
+  "cradle:\n"
+    <> indent'
+      (sOrC <> ":\n" <> indent' pkgs)
 
 indent' :: String -> String
 indent' = unlines . map ("  " <>) . lines
 
 cabalComponent :: Name -> Component -> (FilePath, String)
-cabalComponent n (Lib "" p) = (T.unpack p, T.unpack $ "lib:" <> n)
-cabalComponent n (Lib cn p) = (T.unpack p, T.unpack $ "lib:" <> n <> ":" <> cn)
-cabalComponent n (Exe cn p) = (T.unpack p, T.unpack $ n <> ":exe:" <> cn)
-cabalComponent n (Bench cn p) = (T.unpack p, T.unpack $ n <> ":exe:" <> cn)
-cabalComponent n (Test cn p) = (T.unpack p, T.unpack $ n <> ":test:" <> cn)
+cabalComponent n (Comp Lib "" p) = (T.unpack p, T.unpack $ "lib:" <> n)
+cabalComponent n (Comp Lib cn p) = (T.unpack p, T.unpack $ "lib:" <> n <> ":" <> cn)
+cabalComponent n (Comp Exe cn p) = (T.unpack p, T.unpack $ n <> ":exe:" <> cn)
+cabalComponent n (Comp Bench cn p) = (T.unpack p, T.unpack $ n <> ":exe:" <> cn)
+cabalComponent n (Comp Test cn p) = (T.unpack p, T.unpack $ n <> ":test:" <> cn)
 
 stackComponent :: Name -> Component -> (FilePath, String)
-stackComponent n (Lib "" p) = (T.unpack p, T.unpack $ n <> ":lib")
-stackComponent n (Lib cn p) = (T.unpack p, T.unpack $ n <> ":lib:" <> cn)
-stackComponent n (Exe cn p) = (T.unpack p, T.unpack $ n <> ":exe:" <> cn)
-stackComponent n (Bench cn p) = (T.unpack p, T.unpack $ n <> ":exe:" <> cn)
-stackComponent n (Test cn p) = (T.unpack p, T.unpack $ n <> ":test:" <> cn)
+stackComponent n (Comp Lib "" p) = (T.unpack p, T.unpack $ n <> ":lib")
+stackComponent n (Comp Lib cn p) = (T.unpack p, T.unpack $ n <> ":lib:" <> cn)
+stackComponent n (Comp Exe cn p) = (T.unpack p, T.unpack $ n <> ":exe:" <> cn)
+stackComponent n (Comp Bench cn p) = (T.unpack p, T.unpack $ n <> ":exe:" <> cn)
+stackComponent n (Comp Test cn p) = (T.unpack p, T.unpack $ n <> ":test:" <> cn)
 
 fmtComponent :: (FilePath, String) -> String
 fmtComponent (p, c) =