Merge pull request #161 from phadej/readLocalCabalFiles

Move readLocalCabalFiles to Peura
phadej · Dec 8, 2024 · b894e4a · b894e4a
2 parents 68e436d + 2577017
commit b894e4a
Show file tree

Hide file tree

Showing 4 changed files with 74 additions and 146 deletions.
diff --git a/cabal-docspec/src/CabalDocspec/Package.hs b/cabal-docspec/src/CabalDocspec/Package.hs
@@ -6,43 +6,7 @@ module CabalDocspec.Package (
 
 import Peura
 
-import qualified Cabal.Plan                                   as Plan
-import qualified Data.Map.Strict                              as Map
-import qualified Distribution.PackageDescription.Parsec       as C
-import qualified Distribution.Types.GenericPackageDescription as C
-
-data Package = Package
-    { pkgGpd   :: C.GenericPackageDescription
-    , pkgDir   :: Path Absolute
-    , pkgUnits :: [Plan.Unit]
-    }
-  deriving Show
-
-readLocalCabalFiles
-    :: TracerPeu r w
-    -> Plan.PlanJson
-    -> Peu r [Package]
-readLocalCabalFiles tracer plan =
-    for (itoList units0) $ \(path, units) -> do
-        path' <- makeAbsoluteFilePath path
-        cabalPath <- globDir1First "*.cabal" path'
-        cabalBS <- readByteString cabalPath
-        gpd <- maybe (die tracer $ "cannot parse " ++ toFilePath cabalPath) return
-            $ C.parseGenericPackageDescriptionMaybe cabalBS
-
-        return Package
-            { pkgGpd   = gpd
-            , pkgDir   = path'
-            , pkgUnits = toList units
-            }
-  where
-    units0 :: Map FilePath (NonEmpty Plan.Unit)
-    units0 = group
-        [ (path, unit)
-        | unit <- toList (Plan.pjUnits plan)
-        , Plan.uType unit == Plan.UnitTypeLocal
-        , Just (Plan.LocalUnpackedPackage path) <- return (Plan.uPkgSrc unit)
-        ]
+import qualified Distribution.PackageDescription.Parsec as C
 
 readDirectCabalFiles
     :: TracerPeu r w
@@ -53,12 +17,9 @@ readDirectCabalFiles tracer paths = for paths $ \path -> do
     cabalBS <- readByteString cabalPath
     gpd <- maybe (die tracer $ "cannot parse " ++ toFilePath cabalPath) return
         $ C.parseGenericPackageDescriptionMaybe cabalBS
-    
+
     return Package
         { pkgGpd   = gpd
         , pkgDir  = takeDirectory cabalPath
         , pkgUnits = []
         }
-
-group :: (Ord a) => [(a,b)] -> Map a (NonEmpty b)
-group = Map.fromListWith (<>) . map (fmap pure)
diff --git a/cabal-hasklint/src/CabalHasklint/Package.hs b/cabal-hasklint/src/CabalHasklint/Package.hs
@@ -6,43 +6,7 @@ module CabalHasklint.Package (
 
 import Peura
 
-import qualified Cabal.Plan                                   as Plan
-import qualified Data.Map.Strict                              as Map
-import qualified Distribution.PackageDescription.Parsec       as C
-import qualified Distribution.Types.GenericPackageDescription as C
-
-data Package = Package
-    { pkgGpd   :: C.GenericPackageDescription
-    , pkgDir   :: Path Absolute
-    , pkgUnits :: [Plan.Unit]
-    }
-  deriving Show
-
-readLocalCabalFiles
-    :: TracerPeu r w
-    -> Plan.PlanJson
-    -> Peu r [Package]
-readLocalCabalFiles tracer plan =
-    for (itoList units0) $ \(path, units) -> do
-        path' <- makeAbsoluteFilePath path
-        cabalPath <- globDir1First "*.cabal" path'
-        cabalBS <- readByteString cabalPath
-        gpd <- maybe (die tracer $ "cannot parse " ++ toFilePath cabalPath) return
-            $ C.parseGenericPackageDescriptionMaybe cabalBS
-
-        return Package
-            { pkgGpd   = gpd
-            , pkgDir   = path'
-            , pkgUnits = toList units
-            }
-  where
-    units0 :: Map FilePath (NonEmpty Plan.Unit)
-    units0 = group
-        [ (path, unit)
-        | unit <- toList (Plan.pjUnits plan)
-        , Plan.uType unit == Plan.UnitTypeLocal
-        , Just (Plan.LocalUnpackedPackage path) <- return (Plan.uPkgSrc unit)
-        ]
+import qualified Distribution.PackageDescription.Parsec as C
 
 readDirectCabalFiles
     :: TracerPeu r w
@@ -53,12 +17,9 @@ readDirectCabalFiles tracer paths = for paths $ \path -> do
     cabalBS <- readByteString cabalPath
     gpd <- maybe (die tracer $ "cannot parse " ++ toFilePath cabalPath) return
         $ C.parseGenericPackageDescriptionMaybe cabalBS
-    
+
     return Package
         { pkgGpd   = gpd
         , pkgDir  = takeDirectory cabalPath
         , pkgUnits = []
         }
-
-group :: (Ord a) => [(a,b)] -> Map a (NonEmpty b)
-group = Map.fromListWith (<>) . map (fmap pure)
diff --git a/cabal-hie/src/CabalHie/Main.hs b/cabal-hie/src/CabalHie/Main.hs
@@ -1,6 +1,6 @@
-{-# LANGUAGE OverloadedStrings      #-}
-{-# LANGUAGE ScopedTypeVariables    #-}
-{-# LANGUAGE TypeFamilies           #-}
+{-# LANGUAGE OverloadedStrings   #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeFamilies        #-}
 -- |
 -- Copyright: Oleg Grenrus
 -- License: GPL-2.0-or-later
@@ -25,14 +25,13 @@ import qualified System.FilePath          as FP
 
 import qualified Distribution.Compiler                        as C
 import qualified Distribution.Package                         as C
-import qualified Distribution.PackageDescription.Parsec       as C
 import qualified Distribution.System                          as C
 import qualified Distribution.Types.CondTree                  as C
 import qualified Distribution.Types.ConfVar                   as C
 import qualified Distribution.Types.Flag                      as C
 import qualified Distribution.Types.GenericPackageDescription as C
+import qualified Distribution.Utils.Path                      as C
 import qualified Distribution.Version                         as C
-import qualified Distribution.Utils.Path as C
 
 import qualified Distribution.Types.BuildInfo.Lens as CL
 
@@ -180,7 +179,7 @@ generateHie tracer opts = do
             [ A.object
                 [ "path"      A..= fp
                 , "component" A..= selector
-                ] 
+                ]
             | (fp, selector) <- allDirs'
             ]
         ]]
@@ -189,46 +188,6 @@ generateHie tracer opts = do
 -- hie cradle
 -------------------------------------------------------------------------------
 
--------------------------------------------------------------------------------
--- From cabal-docspec
--------------------------------------------------------------------------------
-
-data Package = Package
-    { pkgGpd   :: C.GenericPackageDescription
-    , pkgDir   :: Path Absolute
-    , pkgUnits :: [Plan.Unit]
-    }
-  deriving Show
-
-readLocalCabalFiles
-    :: TracerPeu r w
-    -> Plan.PlanJson
-    -> Peu r [Package]
-readLocalCabalFiles tracer plan =
-    for (itoList units0) $ \(path, units) -> do
-        path' <- makeAbsoluteFilePath path
-        cabalPath <- globDir1First "*.cabal" path'
-        cabalBS <- readByteString cabalPath
-        gpd <- maybe (die tracer $ "cannot parse " ++ toFilePath cabalPath) return
-            $ C.parseGenericPackageDescriptionMaybe cabalBS
-
-        return Package
-            { pkgGpd   = gpd
-            , pkgDir   = path'
-            , pkgUnits = toList units
-            }
-  where
-    units0 :: Map FilePath (NonEmpty Plan.Unit)
-    units0 = group
-        [ (path, unit)
-        | unit <- toList (Plan.pjUnits plan)
-        , Plan.uType unit == Plan.UnitTypeLocal
-        , Just (Plan.LocalUnpackedPackage path) <- return (Plan.uPkgSrc unit)
-        ]
-
-group :: (Ord a) => [(a,b)] -> Map a (NonEmpty b)
-group = Map.fromListWith (<>) . map (fmap pure)
-
 -------------------------------------------------------------------------------
 -- cabal-docspec main
 -------------------------------------------------------------------------------

diff --git a/peura/src/Peura/Cabal.hs b/peura/src/Peura/Cabal.hs
@@ -11,13 +11,17 @@ module Peura.Cabal (
     ephemeralPlanJson',
     -- * Index
     cachedHackageMetadata,
+    -- * Local packages
+    Package (..),
+    readLocalCabalFiles,
     -- * Trace
     TraceCabal (..),
     MakeCabalTracer (..),
     ) where
 
 import Peura.ByteString
 import Peura.Exports
+import Peura.Glob
 import Peura.Monad
 import Peura.Paths
 import Peura.Process
@@ -26,21 +30,23 @@ import Peura.Tracer
 
 import Text.PrettyPrint ((<+>))
 
-import qualified Cabal.Index                            as I
-import qualified Cabal.Plan                             as P
-import qualified Data.Aeson                             as A
-import qualified Data.Map.Strict                        as Map
-import qualified Data.Set                               as Set
-import qualified Data.Text                              as T
-import qualified Distribution.Fields.Pretty             as C
-import qualified Distribution.Package                   as C
-import qualified Distribution.Pretty                    as C
-import qualified Distribution.Types.ComponentName       as C
-import qualified Distribution.Types.Flag                as C
-import qualified Distribution.Types.LibraryName         as C
-import qualified Distribution.Types.UnqualComponentName as C
-import qualified Distribution.Version                   as C
-import qualified Text.PrettyPrint                       as PP
+import qualified Cabal.Index                                  as I
+import qualified Cabal.Plan                                   as P
+import qualified Data.Aeson                                   as A
+import qualified Data.Map.Strict                              as Map
+import qualified Data.Set                                     as Set
+import qualified Data.Text                                    as T
+import qualified Distribution.Fields.Pretty                   as C
+import qualified Distribution.Package                         as C
+import qualified Distribution.PackageDescription.Parsec       as C
+import qualified Distribution.Pretty                          as C
+import qualified Distribution.Types.ComponentName             as C
+import qualified Distribution.Types.Flag                      as C
+import qualified Distribution.Types.GenericPackageDescription as C
+import qualified Distribution.Types.LibraryName               as C
+import qualified Distribution.Types.UnqualComponentName       as C
+import qualified Distribution.Version                         as C
+import qualified Text.PrettyPrint                             as PP
 
 -------------------------------------------------------------------------------
 -- Convert
@@ -97,7 +103,7 @@ cachedHackageMetadata tracer = do
     return meta
 
 -------------------------------------------------------------------------------
--- plan.json input
+-- P.json input
 -------------------------------------------------------------------------------
 
 data PlanInput = PlanInput
@@ -152,7 +158,7 @@ ephemeralPlanJson
     -> Peu r (Maybe P.PlanJson)
 ephemeralPlanJson tracer = fmap (fmap snd) . ephemeralPlanJson' tracer
 
--- | Like 'ephemeralPlanJson', but also return the @plan.json@ original contents.
+-- | Like 'ephemeralPlanJson', but also return the @P.json@ original contents.
 ephemeralPlanJson'
     :: (MakeCabalTracer t, MakeProcessTracer t, MakePeuTracer t)
     => Tracer (Peu r) t
@@ -183,7 +189,7 @@ ephemeralPlanJson' tracer pi = do
                 planBS    <- readByteString planPath'
                 plan      <- case A.eitherDecodeStrict' planBS of
                     Right x  -> return x
-                    Left err -> die tracer $ "Cannot parse plan.json: " ++ err
+                    Left err -> die tracer $ "Cannot parse P.json: " ++ err
 
                 return $ Just (planBS, plan)
 
@@ -237,3 +243,44 @@ cabalProject pi = C.showFields (const C.NoComment) $
     ]
   where
     fi = C.PrettyField ()
+
+-------------------------------------------------------------------------------
+-- Local cabal files from a plan
+-------------------------------------------------------------------------------
+
+data Package = Package
+    { pkgGpd   :: C.GenericPackageDescription
+    , pkgDir   :: Path Absolute
+    , pkgUnits :: [P.Unit]
+    }
+  deriving Show
+
+readLocalCabalFiles
+    :: MakePeuTracer t
+    => Tracer (Peu r) t
+    -> P.PlanJson
+    -> Peu r [Package]
+readLocalCabalFiles tracer plan =
+    for (itoList units0) $ \(path, units) -> do
+        path' <- makeAbsoluteFilePath path
+        cabalPath <- globDir1First "*.cabal" path'
+        cabalBS <- readByteString cabalPath
+        gpd <- maybe (die tracer $ "cannot parse " ++ toFilePath cabalPath) return
+            $ C.parseGenericPackageDescriptionMaybe cabalBS
+
+        return Package
+            { pkgGpd   = gpd
+            , pkgDir   = path'
+            , pkgUnits = toList units
+            }
+  where
+    units0 :: Map FilePath (NonEmpty P.Unit)
+    units0 = group
+        [ (path, unit)
+        | unit <- toList (P.pjUnits plan)
+        , P.uType unit == P.UnitTypeLocal
+        , Just (P.LocalUnpackedPackage path) <- return (P.uPkgSrc unit)
+        ]
+
+group :: (Ord a) => [(a,b)] -> Map a (NonEmpty b)
+group = Map.fromListWith (<>) . map (fmap pure)