Locate cabal module

Author: Avi-D-coder

app/Main.hs

@@ -10,6 +10,7 @@ import qualified Data.Text as T
 import qualified Data.Text.IO as T
 import Hie.Cabal.Parser
 import Hie.Yaml
+import Hie.Locate
 import System.Directory
 import System.Directory.Internal
 import System.FilePath.Posix
@@ -18,48 +19,16 @@ main :: IO ()
 main = do
   pwd <- getCurrentDirectory
   files <- listDirectory pwd
-  cfs <- cabalFiles pwd
+  cfs <- nestedCabalFiles pwd
   let 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 (Package n cs) -> do
-            let hiePath = fst (splitFileName f) </> "hie.yaml"
-                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."
-  pkgs <- catMaybes <$> mapM gen cfs
+  pkgs <- catMaybes <$> mapM (nestedPkg pwd) cfs
   putStr <$> hieYaml name $ fmtPkgs name pkgs
 
-cabalFiles :: FilePath -> IO [FilePath]
-cabalFiles f = do
-  fs <- listDirectory f
-  case filter ((".cabal" ==) . takeExtension) fs of
-    h : _ -> pure [f </> h]
-    _ ->
-      fmap concat . mapM cabalFiles
-        =<< filterM
-          (fmap (fileTypeIsDirectory . fileTypeFromMetadata) . getFileMetadata)
-          ( map (f </>) $
-              filter
-                (`notElem` [".git", "dist", "dist-newstyle", ".stack-work"])
-                fs
-          )

implicit-hie.cabal

@@ -4,7 +4,7 @@ cabal-version: 1.12
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: 19d5dbbfaaca0af267a9130152cdf8d4a25d59ddd71229a803bfa48283606994
+-- hash: 62b7d90b1ed53933a4c7c61b6392cf2f7ce368607095d9255b80154c6997e755
 
 name:           implicit-hie
 version:        0.1.0.0
@@ -28,6 +28,7 @@ source-repository head
 library
   exposed-modules:
       Hie.Cabal.Parser
+      Hie.Locate
       Hie.Yaml
   other-modules:
       Paths_implicit_hie
@@ -37,6 +38,8 @@ library
   build-depends:
       attoparsec
     , base >=4.7 && <5
+    , directory
+    , filepath
     , text
     , yaml
   default-language: Haskell2010
@@ -69,6 +72,8 @@ test-suite implicit-hie-test
   build-depends:
       attoparsec
     , base >=4.7 && <5
+    , directory
+    , filepath
     , hspec
     , hspec-attoparsec
     , implicit-hie

package.yaml

@@ -24,6 +24,8 @@ dependencies:
 - text
 - attoparsec
 - yaml
+- directory
+- filepath
 
 ghc-options:
 # - -O2
@@ -51,8 +53,6 @@ executables:
     - -with-rtsopts=-N
     dependencies:
     - implicit-hie
-    - directory
-    - filepath
 
 tests:
   implicit-hie-test:

src/Hie/Locate.hs

@@ -0,0 +1,51 @@
+module Hie.Locate
+  ( nestedPkg,
+    nestedCabalFiles,
+  )
+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
+import Hie.Yaml
+import System.Directory
+import System.Directory.Internal
+import System.FilePath.Posix
+
+nestedCabalFiles :: FilePath -> IO [FilePath]
+nestedCabalFiles f = do
+  fs <- listDirectory f
+  case filter ((".cabal" ==) . takeExtension) fs of
+    h : _ -> pure [f </> h]
+    _ ->
+      fmap concat . mapM nestedCabalFiles
+        =<< filterM
+          (fmap (fileTypeIsDirectory . fileTypeFromMetadata) . getFileMetadata)
+          ( map (f </>) $
+              filter
+                (`notElem` [".git", "dist", "dist-newstyle", ".stack-work"])
+                fs
+          )
+
+nestedPkg :: FilePath -> FilePath -> IO (Maybe Package)
+nestedPkg parrent child = do
+  f' <- T.readFile child
+  case parsePackage' f' of
+    Right (Package n cs) -> do
+      let dir =
+            fromJust $ stripPrefix (splitDirectories parrent)
+              $ splitDirectories
+              $ fst (splitFileName child)
+          pkg =
+            Package n $
+              map
+                ( \(Comp t n p) ->
+                    Comp t n (T.pack $ joinPath dir </> T.unpack p)
+                )
+                cs
+      pure $ Just pkg
+    _ -> pure Nothing