cabal-plan 0.7.1.0 → 0.7.2.0
raw patch · 5 files changed
+72/−28 lines, 5 filesdep +cabal-install-parsersdep ~Cabaldep ~base16-bytestringPVP ok
version bump matches the API change (PVP)
Dependencies added: cabal-install-parsers
Dependency ranges changed: Cabal, base16-bytestring
API changes (from Hackage documentation)
Files
- ChangeLog.md +15/−0
- cabal-plan.cabal +4/−3
- src-exe/LicenseReport.hs +15/−9
- src-exe/cabal-plan.hs +31/−16
- src/Cabal/Plan.hs +7/−0
ChangeLog.md view
@@ -1,11 +1,26 @@ # Revision history for `cabal-plan` +## 0.7.2.0++### `exe:cabal-plan` Executable++* Use `cabal-install-parsers` to find and parse `~/cabal/config`+* Fix ascii/unicode output in `tred`+* Add flags to hide setup and executable components in dot command+* Update dependencies (support `base16-bytestring-1.0.0.0`)++### Library++* Update dependencies (support `base16-bytestring-1.0.0.0`)+ ## 0.7.1.0 ### `exe:cabal-plan` Executable * Add `--ascii` / `--unicode` flags to control output character set * Add `dot-png` command as a version of `dot` command with different defaults+* Use `cabal-install-parsers`,+ this makes `license-report` work with non-default configurations ## 0.7.0.0
cabal-plan.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.2 name: cabal-plan-version: 0.7.1.0+version: 0.7.2.0 synopsis: Library and utility for processing cabal's plan.json file description: {@@ -84,7 +84,7 @@ , text ^>= 1.2.2 , directory ^>= 1.2.0 || ^>= 1.3.0 , filepath ^>= 1.3.0 || ^>= 1.4.0- , base16-bytestring ^>= 0.1.1+ , base16-bytestring ^>= 0.1.1 || ^>= 1.0.0.0 hs-source-dirs: src @@ -128,7 +128,8 @@ , vector ^>= 0.12.0.1 if flag(license-report)- build-depends: Cabal ^>= 2.2.0.1 || ^>= 2.4.0.1 || ^>= 3.0.0.0 || ^>=3.2.0.0+ build-depends: Cabal ^>=3.2.0.0+ , cabal-install-parsers ^>=0.3.0.1 || ^>=0.4 , tar ^>= 0.5.1.0 , zlib ^>= 0.6.2 , filepath ^>= 1.4.1.1
src-exe/LicenseReport.hs view
@@ -17,6 +17,7 @@ import Control.Monad.Compat (forM, forM_, guard, unless, when) import qualified Data.ByteString.Lazy as BSL import qualified Data.ByteString as BS+import Data.Functor.Identity (Identity (..)) import Data.Map (Map) import Data.List (nub) import qualified Data.Map as Map@@ -36,6 +37,8 @@ import Prelude () import Prelude.Compat +import Cabal.Config (readConfig, Config (..), cfgRepoIndex, hackageHaskellOrg)+ #if MIN_VERSION_Cabal(3,2,0) import Distribution.Utils.ShortText (fromShortText) #endif@@ -65,11 +68,10 @@ _ -> Nothing -readHackageIndex :: IO [(PkgId, BSL.ByteString)]-readHackageIndex = do+readHackageIndex :: FilePath -> IO [(PkgId, BSL.ByteString)]+readHackageIndex indexPath = do -- TODO: expose package index configuration as CLI flag- cabalPkgCacheDir <- getAppUserDataDirectory "cabal/packages/hackage.haskell.org"- ents <- readTarEntries (cabalPkgCacheDir </> "01-index.tar")+ ents <- readTarEntries indexPath pure [ (maybe (error $ show n) id $ fp2pid n,bsl) | e@(Tar.Entry { Tar.entryContent = Tar.NormalFile bsl _ }) <- ents@@ -77,9 +79,8 @@ , takeExtension n == ".cabal" ] -getLicenseFiles :: PkgId -> UnitId -> [FilePath] -> IO [BS.ByteString]-getLicenseFiles compilerId (UnitId uidt) fns = do- storeDir <- getAppUserDataDirectory "cabal/store"+getLicenseFiles :: FilePath -> PkgId -> UnitId -> [FilePath] -> IO [BS.ByteString]+getLicenseFiles storeDir compilerId (UnitId uidt) fns = do let docDir = storeDir </> T.unpack (dispPkgId compilerId) </> T.unpack uidt </> "share" </> "doc" forM fns $ \fn -> BS.readFile (docDir </> fn) @@ -105,9 +106,14 @@ -- TODO: emit report to Text or Text builder generateLicenseReport :: Maybe FilePath -> PlanJson -> UnitId -> CompName -> IO () generateLicenseReport mlicdir plan uid0 cn0 = do+ -- find and read ~/.cabal/config+ cfg <- readConfig+ indexPath <- maybe (fail "No hackage.haskell.org repository") return $ cfgRepoIndex cfg hackageHaskellOrg+ let storeDir = runIdentity (cfgStoreDir cfg)+ let pidsOfInterest = Set.fromList (map uPId (Map.elems $ pjUnits plan)) - indexDb <- Map.fromList . filter (flip Set.member pidsOfInterest . fst) <$> readHackageIndex+ indexDb <- Map.fromList . filter (flip Set.member pidsOfInterest . fst) <$> readHackageIndex indexPath let -- generally, units belonging to the same package as 'root' rootPkgUnits = [ u | u@(Unit { uPId = PkgId pn' _ }) <- Map.elems (pjUnits plan), pn' == pn0 ]@@ -197,7 +203,7 @@ when (length lfs' /= length lfs) $ do T.hPutStrLn stderr ("WARNING: Overlapping license filenames for " <> dispPkgId (uPId u)) - crdat <- getLicenseFiles (pjCompilerId plan) uid lfs'+ crdat <- getLicenseFiles storeDir (pjCompilerId plan) uid lfs' forM_ (zip lfs' crdat) $ \(fn,txt) -> do let d = licdir </> T.unpack (dispPkgId (uPId u))
src-exe/cabal-plan.hs view
@@ -58,6 +58,8 @@ data ShowBuiltin = ShowBuiltin data ShowGlobal = ShowGlobal+data ShowSetup = ShowSetup+data ShowExes = ShowExes data ShowCabSha = ShowCabSha data DotTred = DotTred data DotTredWght = DotTredWght@@ -66,6 +68,8 @@ instance HasDefault 'True ShowBuiltin instance HasDefault 'True ShowGlobal+instance HasDefault 'True ShowSetup+instance HasDefault 'True ShowExes instance HasDefault 'False ShowCabSha instance HasDefault 'False DotTred instance HasDefault 'False DotTredWght@@ -75,6 +79,8 @@ data GlobalOptions = GlobalOptions { optsShowBuiltin :: Flag ShowBuiltin , optsShowGlobal :: Flag ShowGlobal+ , optsShowSetup :: Flag ShowSetup+ , optsShowExes :: Flag ShowExes , optsUseColors :: UseColors , optsUseAscii :: UseAscii , cmd :: Command@@ -274,7 +280,7 @@ print plan TredCommand s -> do (_, plan) <- findPlan s- doTred optsUseColors plan+ doTred optsUseColors optsUseAscii plan DiffCommand old new -> do (_, oldPlan) <- findPlan (Just old) (_, newPlan) <- findPlan (Just new)@@ -298,7 +304,7 @@ doFingerprint plan showCabSha DotCommand s tred tredWeights highlights rootPatterns output mdot -> do (_, plan) <- findPlan s- doDot optsShowBuiltin optsShowGlobal plan tred tredWeights highlights rootPatterns output mdot+ doDot optsShowBuiltin optsShowGlobal optsShowSetup optsShowExes plan tred tredWeights highlights rootPatterns output mdot TopoCommand s rev showFlags -> do (_, plan) <- findPlan s doTopo optsUseColors optsShowBuiltin optsShowGlobal plan rev showFlags@@ -320,6 +326,8 @@ optParser = GlobalOptions <$> showHide ShowBuiltin "builtin" "Show / hide packages in global (non-nix-style) package db" <*> showHide ShowGlobal "global" "Show / hide packages in nix-store"+ <*> showHide ShowSetup "setup" "Show / hide setup components"+ <*> showHide ShowExes "exes" "Show / hide executable components" <*> useColorsParser <*> useAsciiParser <*> (cmdParser <|> defaultCommand)@@ -539,8 +547,8 @@ -- tred - Transitive reduction ------------------------------------------------------------------------------- -doTred :: UseColors -> PlanJson -> IO ()-doTred useColors plan = runCWriterIO useColors UseAscii (dumpTred plan)+doTred :: UseColors -> UseAscii -> PlanJson -> IO ()+doTred useColors useAscii plan = runCWriterIO useColors useAscii (dumpTred plan) dumpTred :: PlanJson -> CWriter () dumpTred plan = case fst <$> reductionClosureAM plan of@@ -604,7 +612,7 @@ let pid_label = emphasise' $ ccol comp (prettyCompTy pid comp) if seen- then putCTextLn $ linepfx lvl <> pid_label <> " ┄┄"+ then putCTextLn $ linepfx lvl <> pid_label <> fromT Rest else do putCTextLn $ linepfx lvl <> pid_label @@ -899,6 +907,8 @@ doDot :: Flag ShowBuiltin -> Flag ShowGlobal+ -> Flag ShowSetup+ -> Flag ShowExes -> PlanJson -> Flag DotTred -> Flag DotTredWght@@ -907,7 +917,7 @@ -> FilePath -> Maybe RunDot -> IO ()-doDot showBuiltin showGlobal plan tred tredWeights highlights rootPatterns output mdot = either loopGraph id $ TG.runG am $ \g' -> do+doDot showBuiltin showGlobal showSetup showExes plan tred tredWeights highlights rootPatterns output mdot = either loopGraph id $ TG.runG am $ \g' -> do let g = if fromFlag DotTred tred then TG.reduction g' else g' let closureAM = TG.adjacencyMap (TG.closure g)@@ -929,16 +939,21 @@ isReachableUnit unitId = S.member unitId reachableUnits let duShow :: DotUnitId -> Bool- duShow dotUnitId@(DU unitId _) = case M.lookup unitId units of- Nothing -> False- Just unit ->- if isReachableUnit dotUnitId- then case uType unit of- UnitTypeBuiltin -> fromFlag ShowBuiltin showBuiltin- UnitTypeGlobal -> fromFlag ShowGlobal showGlobal- UnitTypeLocal -> True- UnitTypeInplace -> True- else False+ duShow dotUnitId@(DU unitId compName) = case M.lookup unitId units of+ Nothing -> False+ Just unit ->+ if isReachableUnit dotUnitId+ then case uType unit of+ UnitTypeBuiltin -> fromFlag ShowBuiltin showBuiltin && showComp+ UnitTypeGlobal -> fromFlag ShowGlobal showGlobal && showComp+ UnitTypeLocal -> showComp+ UnitTypeInplace -> showComp+ else False+ where+ showComp = case compName of+ Just CompNameSetup -> fromFlag ShowSetup showSetup+ Just (CompNameExe _) -> fromFlag ShowExes showExes+ _ -> True let vertex :: Set DotUnitId -> DotUnitId -> [Text] vertex redVertices du = do
src/Cabal/Plan.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-}@@ -579,10 +580,16 @@ -- @since 0.3.0.0 parseSha256 :: Text -> Maybe Sha256 parseSha256 t+#if MIN_VERSION_base16_bytestring(1,0,0)+ = case B16.decode (T.encodeUtf8 t) of+ Right s | B.length s == 32 -> Just (Sha256 s)+ _ -> Nothing+#else | B.length s == 32, B.null rest = Just (Sha256 s) | otherwise = Nothing where (s, rest) = B16.decode $ T.encodeUtf8 t+#endif -- | Export the 'Sha256' digest to a 32-byte 'B.ByteString'. --