{-# LANGUAGE CPP #-}
module Distribution.Cab.Printer (
printDeps
, printRevDeps
, extraInfo
) where
import Control.Monad
import Data.Function
import Data.List
import Data.Map (Map)
import qualified Data.Map as M
import Distribution.Cab.PkgDB
import Distribution.Cab.Version
import Distribution.Cab.Utils (UnitId, installedUnitId, lookupUnitId)
import Distribution.InstalledPackageInfo (author, depends, license)
import Distribution.License (License(..))
import Distribution.Simple.PackageIndex (allPackages)
#if MIN_VERSION_Cabal(2,2,0)
import Distribution.License (licenseFromSPDX)
#endif
type RevDB = Map UnitId [UnitId]
makeRevDepDB :: PkgDB -> RevDB
makeRevDepDB :: PkgDB -> RevDB
makeRevDepDB PkgDB
db = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(UnitId, [UnitId])]
revdeps
where
pkgs :: [InstalledPackageInfo]
pkgs = forall a. PackageIndex a -> [a]
allPackages PkgDB
db
deps :: [(UnitId, [UnitId])]
deps = forall a b. (a -> b) -> [a] -> [b]
map InstalledPackageInfo -> (UnitId, [UnitId])
idDeps [InstalledPackageInfo]
pkgs
idDeps :: InstalledPackageInfo -> (UnitId, [UnitId])
idDeps InstalledPackageInfo
pkg = (InstalledPackageInfo -> UnitId
installedUnitId InstalledPackageInfo
pkg, InstalledPackageInfo -> [UnitId]
depends InstalledPackageInfo
pkg)
kvs :: [(UnitId, UnitId)]
kvs = forall a. Ord a => [a] -> [a]
sort forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall {b} {a}. (b, [a]) -> [(a, b)]
decomp [(UnitId, [UnitId])]
deps
decomp :: (b, [a]) -> [(a, b)]
decomp (b
k,[a]
vs) = forall a b. (a -> b) -> [a] -> [b]
map (\a
v -> (a
v,b
k)) [a]
vs
kvss :: [[(UnitId, UnitId)]]
kvss = forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (forall a. Eq a => a -> a -> Bool
(==) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall a b. (a, b) -> a
fst) [(UnitId, UnitId)]
kvs
comp :: [(a, b)] -> (a, [b])
comp [(a, b)]
xs = (forall a b. (a, b) -> a
fst (forall a. [a] -> a
head [(a, b)]
xs), forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [(a, b)]
xs)
revdeps :: [(UnitId, [UnitId])]
revdeps = forall a b. (a -> b) -> [a] -> [b]
map forall {a} {b}. [(a, b)] -> (a, [b])
comp [[(UnitId, UnitId)]]
kvss
printDeps :: Bool -> Bool -> PkgDB -> Int -> PkgInfo -> IO ()
printDeps :: Bool -> Bool -> PkgDB -> Int -> InstalledPackageInfo -> IO ()
printDeps Bool
rec Bool
info PkgDB
db Int
n InstalledPackageInfo
pkgi = forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Bool -> Bool -> PkgDB -> Int -> UnitId -> IO ()
printDep Bool
rec Bool
info PkgDB
db Int
n) forall a b. (a -> b) -> a -> b
$ InstalledPackageInfo -> [UnitId]
depends InstalledPackageInfo
pkgi
printDep :: Bool -> Bool -> PkgDB -> Int -> UnitId -> IO ()
printDep :: Bool -> Bool -> PkgDB -> Int -> UnitId -> IO ()
printDep Bool
rec Bool
info PkgDB
db Int
n UnitId
uid = case forall a. PackageIndex a -> UnitId -> Maybe a
lookupUnitId PkgDB
db UnitId
uid of
Maybe InstalledPackageInfo
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just InstalledPackageInfo
uniti -> do
String -> IO ()
putStr forall a b. (a -> b) -> a -> b
$ String
prefix forall a. [a] -> [a] -> [a]
++ InstalledPackageInfo -> String
fullNameOfPkgInfo InstalledPackageInfo
uniti
Bool -> InstalledPackageInfo -> IO ()
extraInfo Bool
info InstalledPackageInfo
uniti
String -> IO ()
putStrLn String
""
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
rec forall a b. (a -> b) -> a -> b
$ Bool -> Bool -> PkgDB -> Int -> InstalledPackageInfo -> IO ()
printDeps Bool
rec Bool
info PkgDB
db (Int
nforall a. Num a => a -> a -> a
+Int
1) InstalledPackageInfo
uniti
where
prefix :: String
prefix = forall a. Int -> a -> [a]
replicate (Int
n forall a. Num a => a -> a -> a
* Int
4) Char
' '
printRevDeps :: Bool -> Bool -> PkgDB -> Int -> PkgInfo -> IO ()
printRevDeps :: Bool -> Bool -> PkgDB -> Int -> InstalledPackageInfo -> IO ()
printRevDeps Bool
rec Bool
info PkgDB
db Int
n InstalledPackageInfo
pkgi = Bool
-> Bool -> PkgDB -> RevDB -> Int -> InstalledPackageInfo -> IO ()
printRevDeps' Bool
rec Bool
info PkgDB
db RevDB
revdb Int
n InstalledPackageInfo
pkgi
where
revdb :: RevDB
revdb = PkgDB -> RevDB
makeRevDepDB PkgDB
db
printRevDeps' :: Bool -> Bool -> PkgDB -> RevDB -> Int -> PkgInfo -> IO ()
printRevDeps' :: Bool
-> Bool -> PkgDB -> RevDB -> Int -> InstalledPackageInfo -> IO ()
printRevDeps' Bool
rec Bool
info PkgDB
db RevDB
revdb Int
n InstalledPackageInfo
pkgi = case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup UnitId
unitid RevDB
revdb of
Maybe [UnitId]
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just [UnitId]
unitids -> forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Bool -> Bool -> PkgDB -> RevDB -> Int -> UnitId -> IO ()
printRevDep' Bool
rec Bool
info PkgDB
db RevDB
revdb Int
n) [UnitId]
unitids
where
unitid :: UnitId
unitid = InstalledPackageInfo -> UnitId
installedUnitId InstalledPackageInfo
pkgi
printRevDep' :: Bool -> Bool -> PkgDB -> RevDB -> Int -> UnitId -> IO ()
printRevDep' :: Bool -> Bool -> PkgDB -> RevDB -> Int -> UnitId -> IO ()
printRevDep' Bool
rec Bool
info PkgDB
db RevDB
revdb Int
n UnitId
uid = case forall a. PackageIndex a -> UnitId -> Maybe a
lookupUnitId PkgDB
db UnitId
uid of
Maybe InstalledPackageInfo
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just InstalledPackageInfo
uniti -> do
String -> IO ()
putStr forall a b. (a -> b) -> a -> b
$ String
prefix forall a. [a] -> [a] -> [a]
++ InstalledPackageInfo -> String
fullNameOfPkgInfo InstalledPackageInfo
uniti
Bool -> InstalledPackageInfo -> IO ()
extraInfo Bool
info InstalledPackageInfo
uniti
String -> IO ()
putStrLn String
""
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
rec forall a b. (a -> b) -> a -> b
$ Bool
-> Bool -> PkgDB -> RevDB -> Int -> InstalledPackageInfo -> IO ()
printRevDeps' Bool
rec Bool
info PkgDB
db RevDB
revdb (Int
nforall a. Num a => a -> a -> a
+Int
1) InstalledPackageInfo
uniti
where
prefix :: String
prefix = forall a. Int -> a -> [a]
replicate (Int
n forall a. Num a => a -> a -> a
* Int
4) Char
' '
extraInfo :: Bool -> PkgInfo -> IO ()
Bool
False InstalledPackageInfo
_ = forall (m :: * -> *) a. Monad m => a -> m a
return ()
extraInfo Bool
True InstalledPackageInfo
pkgi = String -> IO ()
putStr forall a b. (a -> b) -> a -> b
$ String
" " forall a. [a] -> [a] -> [a]
++ String
lcns forall a. [a] -> [a] -> [a]
++ String
" \"" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show ShortText
auth forall a. [a] -> [a] -> [a]
++ String
"\""
where
lcns :: String
lcns = License -> String
showLicense (InstalledPackageInfo -> License
pkgInfoLicense InstalledPackageInfo
pkgi)
auth :: ShortText
auth = InstalledPackageInfo -> ShortText
author InstalledPackageInfo
pkgi
pkgInfoLicense :: PkgInfo -> License
#if MIN_VERSION_Cabal(2,2,0)
pkgInfoLicense :: InstalledPackageInfo -> License
pkgInfoLicense = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either License -> License
licenseFromSPDX forall a. a -> a
id forall b c a. (b -> c) -> (a -> b) -> a -> c
. InstalledPackageInfo -> Either License License
license
#else
pkgInfoLicense = license
#endif
showLicense :: License -> String
showLicense :: License -> String
showLicense (GPL (Just Version
v)) = String
"GPL" forall a. [a] -> [a] -> [a]
++ Version -> String
versionToString Version
v
showLicense (GPL Maybe Version
Nothing) = String
"GPL"
showLicense (LGPL (Just Version
v)) = String
"LGPL" forall a. [a] -> [a] -> [a]
++ Version -> String
versionToString Version
v
showLicense (LGPL Maybe Version
Nothing) = String
"LGPL"
showLicense (UnknownLicense String
s) = String
s
showLicense License
x = forall a. Show a => a -> String
show License
x