Use cabal-plan-0.5 from Hackage

1 files changed, 0 insertions, 271 deletions

diff --git a/cabal-plan/src-exe/LicenseReport.hs b/cabal-plan/src-exe/LicenseReport.hs
deleted file mode 100644
index 7afe4e7..0000000
--- a/cabal-plan/src-exe/LicenseReport.hs
+++ /dev/null
@@ -1,271 +0,0 @@
-{-# LANGUAGE CPP               #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE RecordWildCards   #-}
-
--- | Implements @cabal-plan license-report@ functionality
-module LicenseReport
-    ( generateLicenseReport
-    ) where
-
-#if defined(MIN_VERSION_Cabal)
-import           Cabal.Plan
-import qualified Codec.Archive.Tar                      as Tar
-import qualified Codec.Archive.Tar.Entry                as Tar
-import qualified Codec.Compression.GZip                 as GZip
-import           Control.Monad.Compat                   (forM, forM_, guard, unless, when)
-import qualified Data.ByteString.Lazy                   as BSL
-import qualified Data.ByteString                        as BS
-import           Data.Map                               (Map)
-import           Data.List                              (nub)
-import qualified Data.Map                               as Map
-import           Data.Semigroup
-import           Data.Set                               (Set)
-import qualified Data.Set                               as Set
-import qualified Data.Text                              as T
-import qualified Data.Text.IO                           as T
-import qualified Data.Version                           as DV
-import           Distribution.PackageDescription
-import           Distribution.PackageDescription.Parsec
-import           Distribution.Pretty
-import           System.Directory
-import           System.FilePath
-import           System.IO                              (stderr)
-import           Text.ParserCombinators.ReadP
-import           Prelude ()
-import           Prelude.Compat
-
--- | Read tarball lazily (and possibly decompress)
-readTarEntries :: FilePath -> IO [Tar.Entry]
-readTarEntries idxtar = do
-    es <- case takeExtension idxtar of
-            ".gz"  -> Tar.read . GZip.decompress <$> BSL.readFile idxtar
-            ".tar" -> Tar.read                   <$> BSL.readFile idxtar
-            ext    -> error ("unknown extension " ++ show ext)
-
-    return (Tar.foldEntries (:) [] (\err -> error ("readTarEntries " ++ show err)) es)
-
-fp2pid :: FilePath -> Maybe PkgId
-fp2pid fn0 = do
-  [pns,pvs,rest] <- Just (splitDirectories fn0)
-  guard (rest == pns <.> "cabal")
-  pv <- parseVer pvs
-  pure (PkgId (PkgName $ T.pack pns) pv)
-
-
-parseVer :: String -> Maybe Ver
-parseVer str = case reverse $ readP_to_S DV.parseVersion str of
-  (ver, "") : _ | not (null (DV.versionBranch ver)), all (>= 0) (DV.versionBranch ver)
-      -> Just (Ver $ DV.versionBranch ver)
-  _   -> Nothing
-
-
-readHackageIndex :: IO [(PkgId, BSL.ByteString)]
-readHackageIndex = do
-    -- TODO: expose package index configuration as CLI flag
-    cabalPkgCacheDir <- getAppUserDataDirectory "cabal/packages/hackage.haskell.org"
-    ents <- readTarEntries (cabalPkgCacheDir </> "01-index.tar")
-
-    pure [ (maybe (error $ show n) id $ fp2pid n,bsl)
-         | e@(Tar.Entry { Tar.entryContent = Tar.NormalFile bsl _ }) <- ents
-         , let n = Tar.entryPath e
-         , takeExtension n == ".cabal"
-         ]
-
-getLicenseFiles :: PkgId -> UnitId -> [FilePath] -> IO [BS.ByteString]
-getLicenseFiles compilerId (UnitId uidt) fns = do
-  storeDir <- getAppUserDataDirectory "cabal/store"
-  let docDir = storeDir </> T.unpack (dispPkgId compilerId) </> T.unpack uidt </> "share" </> "doc"
-  forM fns $ \fn -> BS.readFile (docDir </> fn)
-
-{- WARNING: the code that follows will make you cry; a safety pig is provided below for your benefit.
-
-                         _
- _._ _..._ .-',     _.._(`))
-'-. `     '  /-._.-'    ',/
-   )         \            '.
-  / _    _    |             \
- |  a    a    /              |
- \   .-.                     ;
-  '-('' ).-'       ,'       ;
-     '-;           |      .'
-        \           \    /
-        | 7  .__  _.-\   \
-        | |  |  ``/  /`  /
-       /,_|  |   /,_/   /
-          /,_/      '`-'
-
--}
-
--- TODO: emit report to Text or Text builder
-generateLicenseReport :: Maybe FilePath -> PlanJson -> UnitId -> CompName -> IO ()
-generateLicenseReport mlicdir plan uid0 cn0 = do
-    let pidsOfInterest = Set.fromList (map uPId (Map.elems $ pjUnits plan))
-
-    indexDb <- Map.fromList . filter (flip Set.member pidsOfInterest . fst) <$> readHackageIndex
-
-    let -- generally, units belonging to the same package as 'root'
-        rootPkgUnits = [ u | u@(Unit { uPId = PkgId pn' _ }) <- Map.elems (pjUnits plan), pn' == pn0 ]
-        rootPkgUnitIds = Set.fromList (map uId rootPkgUnits)
-
-        -- the component of interest
-        Just root@Unit { uPId = PkgId pn0 _ } = Map.lookup uid0 (pjUnits plan)
-
-        fwdDeps = planJsonIdGraph' plan
-        revDeps = invertMap fwdDeps
-
-    let transUids = transDeps fwdDeps (uId root) Set.\\ rootPkgUnitIds
-
-        indirectDeps = Set.fromList [ u | u <- Set.toList transUids, Set.null (Map.findWithDefault mempty u revDeps `Set.intersection` rootPkgUnitIds) ]
-
-        directDeps = transUids Set.\\ indirectDeps
-
-
-    let printInfo :: UnitId -> IO ()
-        printInfo uid = do
-          let Just u = Map.lookup uid (pjUnits plan)
-
-              PkgId (PkgName pn) pv = uPId u
-
-          case BSL.toStrict <$> Map.lookup (uPId u) indexDb of
-            Nothing
-              | PkgId (PkgName "rts") _ <- uPId u -> pure ()
-              | otherwise -> fail (show u)
-
-            Just x -> do
-              gpd <- maybe (fail "parseGenericPackageDescriptionMaybe") pure $
-                     parseGenericPackageDescriptionMaybe x
-
-              let desc = escapeDesc $ synopsis $ packageDescription gpd
-                  lic  = license  $ packageDescription gpd
-                  -- cr   = copyright $ packageDescription gpd
-                  lfs  = licenseFiles $ packageDescription gpd
-
-                  usedBy = Set.fromList [ uPId (Map.findWithDefault undefined unit (pjUnits plan))
-                                        | unit <- Set.toList (Map.findWithDefault mempty uid revDeps)
-                                        , unit `Set.member` (directDeps <> indirectDeps)
-                                        ]
-
-              let url = "http://hackage.haskell.org/package/" <> dispPkgId (uPId u)
-
-                  isB = uType u == UnitTypeBuiltin
-
-                  -- special core libs whose reverse deps are too noisy
-                  baseLibs = ["base", "ghc-prim", "integer-gmp", "integer-simple", "rts"]
-
-                  licurl = case lfs of
-                             [] -> url
-                             (l:_)
-                               | Just licdir <- mlicdir, uType u == UnitTypeGlobal -> T.pack (licdir </> T.unpack (dispPkgId (uPId u)) </> takeFileName l)
-                               | otherwise              -> url <> "/src/" <> T.pack l
-
-              T.putStrLn $ mconcat
-                [ if isB then "| **`" else "| `", pn, if isB then "`** | [`" else "` | [`", dispVer pv, "`](", url , ")", " | "
-                , "[`", T.pack (prettyShow lic), "`](", licurl , ")", " | "
-                , T.pack desc, " | "
-                , if pn `elem` baseLibs then "*(core library)*"
-                  else T.intercalate ", " [ T.singleton '`' <> (j :: T.Text) <> "`" | PkgId (z@(PkgName j)) _ <- Set.toList usedBy,  z /= pn0], " |"
-                ]
-
-              -- print (pn, pv, prettyShow lic, cr, lfs, [ j | PkgId (PkgName j) _ <- Set.toList usedBy ])
-
-              forM_ mlicdir $ \licdir -> do
-
-                case uType u of
-                  UnitTypeGlobal -> do
-                    let lfs' = nub (map takeFileName lfs)
-
-                    when (length lfs' /= length lfs) $ do
-                      T.hPutStrLn stderr ("WARNING: Overlapping license filenames for " <> dispPkgId (uPId u))
-
-                    crdat <- getLicenseFiles (pjCompilerId plan) uid lfs'
-
-                    forM_ (zip lfs' crdat) $ \(fn,txt) -> do
-                      let d = licdir </> T.unpack (dispPkgId (uPId u))
-                      createDirectoryIfMissing True d
-                      BS.writeFile (d </> fn) txt
-
-                    -- forM_ crdat $ print
-                    pure ()
-
-                  -- TODO:
-                  --   UnitTypeBuiltin
-                  --   UnitTypeLocal
-                  --   UnitTypeInplace
-
-                  UnitTypeBuiltin -> T.hPutStrLn stderr ("WARNING: license files for " <> dispPkgId (uPId u) <> " (global/GHC bundled) not copied")
-                  UnitTypeLocal   -> T.hPutStrLn stderr ("WARNING: license files for " <> dispPkgId (uPId u) <> " (project-local package) not copied")
-                  UnitTypeInplace -> T.hPutStrLn stderr ("WARNING: license files for " <> dispPkgId (uPId u) <> " (project-inplace package) not copied")
-
-                unless (length lfs == Set.size (Set.fromList lfs)) $
-                  fail ("internal invariant broken for " <> show (uPId u))
-
-          pure ()
-
-    T.putStrLn "# Dependency License Report"
-    T.putStrLn ""
-    T.putStrLn ("Bold-faced **`package-name`**s denote standard libraries bundled with `" <> dispPkgId (pjCompilerId plan) <> "`.")
-    T.putStrLn ""
-
-    T.putStrLn ("## Direct dependencies of `" <> unPkgN pn0 <> ":" <> dispCompNameTarget pn0 cn0 <> "`")
-    T.putStrLn ""
-    T.putStrLn "| Name | Version | [SPDX](https://spdx.org/licenses/) License Id | Description | Also depended upon by |"
-    T.putStrLn "| --- | --- | --- | --- | --- |"
-    forM_ directDeps $ printInfo
-    T.putStrLn ""
-
-    T.putStrLn "## Indirect transitive dependencies"
-    T.putStrLn ""
-    T.putStrLn "| Name | Version | [SPDX](https://spdx.org/licenses/) License Id | Description | Depended upon by |"
-    T.putStrLn "| --- | --- | --- | --- | --- |"
-    forM_ indirectDeps $ printInfo
-    T.putStrLn ""
-
-    pure ()
-
-escapeDesc :: String -> String
-escapeDesc []          = []
-escapeDesc ('\n':rest) = ' ':escapeDesc rest
-escapeDesc ('|':rest)  = '\\':'|':escapeDesc rest
-escapeDesc (x:xs)      = x:escapeDesc xs
-
-unPkgN :: PkgName -> T.Text
-unPkgN (PkgName t) = t
-
-planItemAllLibDeps :: Unit -> Set.Set UnitId
-planItemAllLibDeps Unit{..} = mconcat [ ciLibDeps | (cn,CompInfo{..}) <- Map.toList uComps, wantC cn ]
-  where
-    wantC (CompNameSetup)   = False
-    wantC (CompNameTest _)  = False
-    wantC (CompNameBench _) = False
-    wantC _                 = True
-
-planJsonIdGraph':: PlanJson -> Map UnitId (Set UnitId)
-planJsonIdGraph' PlanJson{..} = Map.fromList [ (uId unit, planItemAllLibDeps unit) | unit <- Map.elems pjUnits ]
-
-
-
-invertMap :: Ord k => Map k (Set k) -> Map k (Set k)
-invertMap m0 = Map.fromListWith mappend [ (v, Set.singleton k) | (k,vs) <- Map.toList m0, v <- Set.toList vs ]
-
-transDeps :: Map UnitId (Set UnitId) -> UnitId -> Set UnitId
-transDeps g n0 = go mempty [n0]
-  where
-    go :: Set UnitId -> [UnitId] -> Set UnitId
-    go acc [] = acc
-    go acc (n:ns)
-      | Set.member n acc = go acc ns
-      | otherwise = go (Set.insert n acc) (ns ++ Set.toList (Map.findWithDefault undefined n g))
-
-#else
-
-----------------------------------------------------------------------------
-import           Cabal.Plan
-import           System.Exit
-import           System.IO
-
-generateLicenseReport :: Maybe FilePath -> PlanJson -> UnitId -> CompName -> IO ()
-generateLicenseReport _ _ _ _ = do
-  hPutStrLn stderr "ERROR: `cabal-plan license-report` sub-command not available! Please recompile/reinstall `cabal-plan` with the `license-report` Cabal flag activated."
-  exitFailure
-
-#endif