{-# 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 ()
extraInfo :: Bool -> InstalledPackageInfo -> IO ()
extraInfo 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