{-# LANGUAGE ScopedTypeVariables #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Distribution.Client.List
-- Copyright   :  (c) David Himmelstrup 2005
--                    Duncan Coutts 2008-2011
-- License     :  BSD-like
--
-- Maintainer  :  cabal-devel@haskell.org
--
-- Search for and print information about packages
-----------------------------------------------------------------------------
module Distribution.Client.List (
  list, info
  ) where

import Prelude ()
import Distribution.Client.Compat.Prelude

import Distribution.Package
         ( PackageName, Package(..), packageName
         , packageVersion, UnitId )
import Distribution.Types.Dependency
import Distribution.Types.UnqualComponentName
import Distribution.ModuleName (ModuleName)
import Distribution.License (License)
import qualified Distribution.InstalledPackageInfo as Installed
import qualified Distribution.PackageDescription   as Source
import Distribution.PackageDescription
         ( PackageFlag(..), unFlagName )
import Distribution.PackageDescription.Configuration
         ( flattenPackageDescription )

import Distribution.Simple.Compiler
        ( Compiler, PackageDBStack )
import Distribution.Simple.Program (ProgramDb)
import Distribution.Simple.Utils
        ( equating, die', notice )
import Distribution.Simple.Setup (fromFlag, fromFlagOrDefault)
import Distribution.Simple.PackageIndex (InstalledPackageIndex)
import qualified Distribution.Simple.PackageIndex as InstalledPackageIndex
import Distribution.Version
         ( Version, mkVersion, versionNumbers, VersionRange, withinRange, anyVersion
         , intersectVersionRanges, simplifyVersionRange )

import qualified Distribution.SPDX as SPDX

import           Distribution.Solver.Types.PackageConstraint
import qualified Distribution.Solver.Types.PackageIndex as PackageIndex
import           Distribution.Solver.Types.SourcePackage

import Distribution.Client.Types
         ( SourcePackageDb(..), PackageSpecifier(..), UnresolvedSourcePackage )
import Distribution.Client.Targets
         ( UserTarget, resolveUserTargets )
import Distribution.Client.Setup
         ( GlobalFlags(..), ListFlags(..), InfoFlags(..)
         , RepoContext(..) )
import Distribution.Client.Utils
         ( mergeBy, MergeResult(..) )
import Distribution.Client.IndexUtils as IndexUtils
         ( getSourcePackages, getInstalledPackages )
import Distribution.Client.FetchUtils
         ( isFetched )

import Data.Bits ((.|.))
import Data.List
         ( maximumBy )
import Data.List.NonEmpty (groupBy)
import qualified Data.List as L
import Data.Maybe
         ( fromJust )
import qualified Data.Map as Map
import Data.Tree as Tree
import Control.Exception
         ( assert )
import qualified Text.PrettyPrint as Disp
import Text.PrettyPrint
         ( lineLength, ribbonsPerLine, Doc, renderStyle, char
         , nest, ($+$), text, vcat, style, parens, fsep)
import System.Directory
         ( doesDirectoryExist )

import Distribution.Utils.ShortText (ShortText)
import qualified Distribution.Utils.ShortText as ShortText
import qualified Text.Regex.Base as Regex
import qualified Text.Regex.Posix.String as Regex


-- | Return a list of packages matching given search strings.
getPkgList :: Verbosity
           -> PackageDBStack
           -> RepoContext
           -> Maybe (Compiler, ProgramDb)
           -> ListFlags
           -> [String]
           -> IO [PackageDisplayInfo]
getPkgList :: Verbosity
-> PackageDBStack
-> RepoContext
-> Maybe (Compiler, ProgramDb)
-> ListFlags
-> [String]
-> IO [PackageDisplayInfo]
getPkgList Verbosity
verbosity PackageDBStack
packageDBs RepoContext
repoCtxt Maybe (Compiler, ProgramDb)
mcompprogdb ListFlags
listFlags [String]
pats = do
    Maybe InstalledPackageIndex
installedPkgIndex <- Maybe (Compiler, ProgramDb)
-> ((Compiler, ProgramDb) -> IO InstalledPackageIndex)
-> IO (Maybe InstalledPackageIndex)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for Maybe (Compiler, ProgramDb)
mcompprogdb (((Compiler, ProgramDb) -> IO InstalledPackageIndex)
 -> IO (Maybe InstalledPackageIndex))
-> ((Compiler, ProgramDb) -> IO InstalledPackageIndex)
-> IO (Maybe InstalledPackageIndex)
forall a b. (a -> b) -> a -> b
$ \(Compiler
comp, ProgramDb
progdb) ->
        Verbosity
-> Compiler
-> PackageDBStack
-> ProgramDb
-> IO InstalledPackageIndex
getInstalledPackages Verbosity
verbosity Compiler
comp PackageDBStack
packageDBs ProgramDb
progdb
    SourcePackageDb
sourcePkgDb       <- Verbosity -> RepoContext -> IO SourcePackageDb
getSourcePackages Verbosity
verbosity RepoContext
repoCtxt

    [Regex]
regexps <- [String] -> (String -> IO Regex) -> IO [Regex]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [String]
pats ((String -> IO Regex) -> IO [Regex])
-> (String -> IO Regex) -> IO [Regex]
forall a b. (a -> b) -> a -> b
$ \String
pat -> do
        Either WrapError Regex
e <- CompOption -> ExecOption -> String -> IO (Either WrapError Regex)
Regex.compile CompOption
compOption ExecOption
Regex.execBlank String
pat
        case Either WrapError Regex
e of
            Right Regex
r  -> Regex -> IO Regex
forall (m :: * -> *) a. Monad m => a -> m a
return Regex
r
            Left WrapError
err -> Verbosity -> String -> IO Regex
forall a. Verbosity -> String -> IO a
die' Verbosity
verbosity (String -> IO Regex) -> String -> IO Regex
forall a b. (a -> b) -> a -> b
$ String
"Failed to compile regex " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
pat String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": " String -> String -> String
forall a. [a] -> [a] -> [a]
++ WrapError -> String
forall a b. (a, b) -> b
snd WrapError
err

    let sourcePkgIndex :: PackageIndex UnresolvedSourcePackage
sourcePkgIndex = SourcePackageDb -> PackageIndex UnresolvedSourcePackage
packageIndex SourcePackageDb
sourcePkgDb
        prefs :: PackageName -> VersionRange
prefs PackageName
name = VersionRange -> Maybe VersionRange -> VersionRange
forall a. a -> Maybe a -> a
fromMaybe VersionRange
anyVersion
                       (PackageName -> Map PackageName VersionRange -> Maybe VersionRange
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup PackageName
name (SourcePackageDb -> Map PackageName VersionRange
packagePreferences SourcePackageDb
sourcePkgDb))

        pkgsInfoMatching ::
          [(PackageName, [Installed.InstalledPackageInfo], [UnresolvedSourcePackage])]
        pkgsInfoMatching :: [(PackageName, [InstalledPackageInfo], [UnresolvedSourcePackage])]
pkgsInfoMatching =
          let matchingInstalled :: [InstalledPackageInfo]
matchingInstalled = [InstalledPackageInfo]
-> (InstalledPackageIndex -> [InstalledPackageInfo])
-> Maybe InstalledPackageIndex
-> [InstalledPackageInfo]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ((InstalledPackageIndex
 -> (String -> Bool) -> [InstalledPackageInfo])
-> [Regex] -> InstalledPackageIndex -> [InstalledPackageInfo]
forall regex source t a.
RegexLike regex source =>
(t -> (source -> Bool) -> [a]) -> [regex] -> t -> [a]
matchingPackages InstalledPackageIndex -> (String -> Bool) -> [InstalledPackageInfo]
forall a. PackageIndex a -> (String -> Bool) -> [a]
InstalledPackageIndex.searchWithPredicate [Regex]
regexps) Maybe InstalledPackageIndex
installedPkgIndex
              matchingSource :: [UnresolvedSourcePackage]
matchingSource    = (PackageIndex UnresolvedSourcePackage
 -> (String -> Bool) -> [UnresolvedSourcePackage])
-> [Regex]
-> PackageIndex UnresolvedSourcePackage
-> [UnresolvedSourcePackage]
forall regex source t a.
RegexLike regex source =>
(t -> (source -> Bool) -> [a]) -> [regex] -> t -> [a]
matchingPackages (\ PackageIndex UnresolvedSourcePackage
idx String -> Bool
n -> ((PackageName, [UnresolvedSourcePackage])
 -> [UnresolvedSourcePackage])
-> [(PackageName, [UnresolvedSourcePackage])]
-> [UnresolvedSourcePackage]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (PackageName, [UnresolvedSourcePackage])
-> [UnresolvedSourcePackage]
forall a b. (a, b) -> b
snd (PackageIndex UnresolvedSourcePackage
-> (String -> Bool) -> [(PackageName, [UnresolvedSourcePackage])]
forall pkg.
PackageIndex pkg -> (String -> Bool) -> [(PackageName, [pkg])]
PackageIndex.searchWithPredicate PackageIndex UnresolvedSourcePackage
idx String -> Bool
n)) [Regex]
regexps PackageIndex UnresolvedSourcePackage
sourcePkgIndex
          in [InstalledPackageInfo]
-> [UnresolvedSourcePackage]
-> [(PackageName, [InstalledPackageInfo],
     [UnresolvedSourcePackage])]
mergePackages [InstalledPackageInfo]
matchingInstalled [UnresolvedSourcePackage]
matchingSource

        pkgsInfo ::
          [(PackageName, [Installed.InstalledPackageInfo], [UnresolvedSourcePackage])]
        pkgsInfo :: [(PackageName, [InstalledPackageInfo], [UnresolvedSourcePackage])]
pkgsInfo
            -- gather info for all packages
          | [Regex] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Regex]
regexps = [InstalledPackageInfo]
-> [UnresolvedSourcePackage]
-> [(PackageName, [InstalledPackageInfo],
     [UnresolvedSourcePackage])]
mergePackages
                           ([InstalledPackageInfo]
-> (InstalledPackageIndex -> [InstalledPackageInfo])
-> Maybe InstalledPackageIndex
-> [InstalledPackageInfo]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] InstalledPackageIndex -> [InstalledPackageInfo]
forall a. PackageIndex a -> [a]
InstalledPackageIndex.allPackages Maybe InstalledPackageIndex
installedPkgIndex)
                           (         PackageIndex UnresolvedSourcePackage -> [UnresolvedSourcePackage]
forall pkg. PackageIndex pkg -> [pkg]
PackageIndex.allPackages          PackageIndex UnresolvedSourcePackage
sourcePkgIndex)

            -- gather info for packages matching search term
          | Bool
otherwise = [(PackageName, [InstalledPackageInfo], [UnresolvedSourcePackage])]
pkgsInfoMatching

        matches :: [PackageDisplayInfo]
        matches :: [PackageDisplayInfo]
matches = [ VersionRange
-> [InstalledPackageInfo]
-> [UnresolvedSourcePackage]
-> Maybe UnresolvedSourcePackage
-> Bool
-> PackageDisplayInfo
mergePackageInfo VersionRange
pref
                      [InstalledPackageInfo]
installedPkgs [UnresolvedSourcePackage]
sourcePkgs Maybe UnresolvedSourcePackage
selectedPkg Bool
False
                  | (PackageName
pkgname, [InstalledPackageInfo]
installedPkgs, [UnresolvedSourcePackage]
sourcePkgs) <- [(PackageName, [InstalledPackageInfo], [UnresolvedSourcePackage])]
pkgsInfo
                  , Bool -> Bool
not Bool
onlyInstalled Bool -> Bool -> Bool
|| Bool -> Bool
not ([InstalledPackageInfo] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [InstalledPackageInfo]
installedPkgs)
                  , let pref :: VersionRange
pref        = PackageName -> VersionRange
prefs PackageName
pkgname
                        selectedPkg :: Maybe UnresolvedSourcePackage
selectedPkg = VersionRange
-> [UnresolvedSourcePackage] -> Maybe UnresolvedSourcePackage
forall pkg. Package pkg => VersionRange -> [pkg] -> Maybe pkg
latestWithPref VersionRange
pref [UnresolvedSourcePackage]
sourcePkgs ]
    [PackageDisplayInfo] -> IO [PackageDisplayInfo]
forall (m :: * -> *) a. Monad m => a -> m a
return [PackageDisplayInfo]
matches
  where
    onlyInstalled :: Bool
onlyInstalled   = Bool -> Flag Bool -> Bool
forall a. a -> Flag a -> a
fromFlagOrDefault Bool
False (ListFlags -> Flag Bool
listInstalled ListFlags
listFlags)
    caseInsensitive :: Bool
caseInsensitive = Bool -> Flag Bool -> Bool
forall a. a -> Flag a -> a
fromFlagOrDefault Bool
True (ListFlags -> Flag Bool
listCaseInsensitive ListFlags
listFlags)

    compOption :: CompOption
compOption | Bool
caseInsensitive = CompOption
Regex.compExtended CompOption -> CompOption -> CompOption
forall a. Bits a => a -> a -> a
.|. CompOption
Regex.compIgnoreCase
               | Bool
otherwise       = CompOption
Regex.compExtended

    matchingPackages :: (t -> (source -> Bool) -> [a]) -> [regex] -> t -> [a]
matchingPackages t -> (source -> Bool) -> [a]
search [regex]
regexps t
index =
      [ a
pkg
      | regex
re <- [regex]
regexps
      , a
pkg <- t -> (source -> Bool) -> [a]
search t
index (regex -> source -> Bool
forall regex source.
RegexLike regex source =>
regex -> source -> Bool
Regex.matchTest regex
re) ]


-- | Show information about packages.
list :: Verbosity
     -> PackageDBStack
     -> RepoContext
     -> Maybe (Compiler, ProgramDb)
     -> ListFlags
     -> [String]
     -> IO ()
list :: Verbosity
-> PackageDBStack
-> RepoContext
-> Maybe (Compiler, ProgramDb)
-> ListFlags
-> [String]
-> IO ()
list Verbosity
verbosity PackageDBStack
packageDBs RepoContext
repos Maybe (Compiler, ProgramDb)
mcompProgdb ListFlags
listFlags [String]
pats = do
    [PackageDisplayInfo]
matches <- Verbosity
-> PackageDBStack
-> RepoContext
-> Maybe (Compiler, ProgramDb)
-> ListFlags
-> [String]
-> IO [PackageDisplayInfo]
getPkgList Verbosity
verbosity PackageDBStack
packageDBs RepoContext
repos Maybe (Compiler, ProgramDb)
mcompProgdb ListFlags
listFlags [String]
pats

    if Bool
simpleOutput
      then String -> IO ()
putStr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines
             [ PackageName -> String
forall a. Pretty a => a -> String
prettyShow (PackageDisplayInfo -> PackageName
pkgName PackageDisplayInfo
pkg) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Version -> String
forall a. Pretty a => a -> String
prettyShow Version
version
             | PackageDisplayInfo
pkg <- [PackageDisplayInfo]
matches
             , Version
version <- if Bool
onlyInstalled
                            then              PackageDisplayInfo -> [Version]
installedVersions PackageDisplayInfo
pkg
                            else [Version] -> [Version]
forall a. Eq a => [a] -> [a]
nub ([Version] -> [Version])
-> ([Version] -> [Version]) -> [Version] -> [Version]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Version] -> [Version]
forall a. Ord a => [a] -> [a]
sort ([Version] -> [Version]) -> [Version] -> [Version]
forall a b. (a -> b) -> a -> b
$ PackageDisplayInfo -> [Version]
installedVersions PackageDisplayInfo
pkg
                                           [Version] -> [Version] -> [Version]
forall a. [a] -> [a] -> [a]
++ PackageDisplayInfo -> [Version]
sourceVersions    PackageDisplayInfo
pkg ]
             -- Note: this only works because for 'list', one cannot currently
             -- specify any version constraints, so listing all installed
             -- and source ones works.
      else
        if [PackageDisplayInfo] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [PackageDisplayInfo]
matches
            then Verbosity -> String -> IO ()
notice Verbosity
verbosity String
"No matches found."
            else String -> IO ()
putStr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines ((PackageDisplayInfo -> String) -> [PackageDisplayInfo] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map PackageDisplayInfo -> String
showPackageSummaryInfo [PackageDisplayInfo]
matches)
  where
    onlyInstalled :: Bool
onlyInstalled = Flag Bool -> Bool
forall a. WithCallStack (Flag a -> a)
fromFlag (ListFlags -> Flag Bool
listInstalled ListFlags
listFlags)
    simpleOutput :: Bool
simpleOutput  = Flag Bool -> Bool
forall a. WithCallStack (Flag a -> a)
fromFlag (ListFlags -> Flag Bool
listSimpleOutput ListFlags
listFlags)

info :: Verbosity
     -> PackageDBStack
     -> RepoContext
     -> Compiler
     -> ProgramDb
     -> GlobalFlags
     -> InfoFlags
     -> [UserTarget]
     -> IO ()
info :: Verbosity
-> PackageDBStack
-> RepoContext
-> Compiler
-> ProgramDb
-> GlobalFlags
-> InfoFlags
-> [UserTarget]
-> IO ()
info Verbosity
verbosity PackageDBStack
_ RepoContext
_ Compiler
_ ProgramDb
_ GlobalFlags
_ InfoFlags
_ [] =
    Verbosity -> String -> IO ()
notice Verbosity
verbosity String
"No packages requested. Nothing to do."

info Verbosity
verbosity PackageDBStack
packageDBs RepoContext
repoCtxt Compiler
comp ProgramDb
progdb
     GlobalFlags
_ InfoFlags
_listFlags [UserTarget]
userTargets = do

    InstalledPackageIndex
installedPkgIndex <- Verbosity
-> Compiler
-> PackageDBStack
-> ProgramDb
-> IO InstalledPackageIndex
getInstalledPackages Verbosity
verbosity Compiler
comp PackageDBStack
packageDBs ProgramDb
progdb
    SourcePackageDb
sourcePkgDb       <- Verbosity -> RepoContext -> IO SourcePackageDb
getSourcePackages Verbosity
verbosity RepoContext
repoCtxt
    let sourcePkgIndex :: PackageIndex UnresolvedSourcePackage
sourcePkgIndex = SourcePackageDb -> PackageIndex UnresolvedSourcePackage
packageIndex SourcePackageDb
sourcePkgDb
        prefs :: PackageName -> VersionRange
prefs PackageName
name = VersionRange -> Maybe VersionRange -> VersionRange
forall a. a -> Maybe a -> a
fromMaybe VersionRange
anyVersion
                       (PackageName -> Map PackageName VersionRange -> Maybe VersionRange
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup PackageName
name (SourcePackageDb -> Map PackageName VersionRange
packagePreferences SourcePackageDb
sourcePkgDb))

        -- Users may specify names of packages that are only installed, not
        -- just available source packages, so we must resolve targets using
        -- the combination of installed and source packages.
    let sourcePkgs' :: PackageIndex PackageIdentifier
sourcePkgs' = [PackageIdentifier] -> PackageIndex PackageIdentifier
forall pkg. Package pkg => [pkg] -> PackageIndex pkg
PackageIndex.fromList
                    ([PackageIdentifier] -> PackageIndex PackageIdentifier)
-> [PackageIdentifier] -> PackageIndex PackageIdentifier
forall a b. (a -> b) -> a -> b
$ (InstalledPackageInfo -> PackageIdentifier)
-> [InstalledPackageInfo] -> [PackageIdentifier]
forall a b. (a -> b) -> [a] -> [b]
map InstalledPackageInfo -> PackageIdentifier
forall pkg. Package pkg => pkg -> PackageIdentifier
packageId
                      (InstalledPackageIndex -> [InstalledPackageInfo]
forall a. PackageIndex a -> [a]
InstalledPackageIndex.allPackages InstalledPackageIndex
installedPkgIndex)
                   [PackageIdentifier] -> [PackageIdentifier] -> [PackageIdentifier]
forall a. [a] -> [a] -> [a]
++ (UnresolvedSourcePackage -> PackageIdentifier)
-> [UnresolvedSourcePackage] -> [PackageIdentifier]
forall a b. (a -> b) -> [a] -> [b]
map UnresolvedSourcePackage -> PackageIdentifier
forall pkg. Package pkg => pkg -> PackageIdentifier
packageId
                      (PackageIndex UnresolvedSourcePackage -> [UnresolvedSourcePackage]
forall pkg. PackageIndex pkg -> [pkg]
PackageIndex.allPackages PackageIndex UnresolvedSourcePackage
sourcePkgIndex)
    [PackageSpecifier UnresolvedSourcePackage]
pkgSpecifiers <- Verbosity
-> RepoContext
-> PackageIndex PackageIdentifier
-> [UserTarget]
-> IO [PackageSpecifier UnresolvedSourcePackage]
forall pkg.
Package pkg =>
Verbosity
-> RepoContext
-> PackageIndex pkg
-> [UserTarget]
-> IO [PackageSpecifier UnresolvedSourcePackage]
resolveUserTargets Verbosity
verbosity RepoContext
repoCtxt
                       PackageIndex PackageIdentifier
sourcePkgs' [UserTarget]
userTargets

    [PackageDisplayInfo]
pkgsinfo      <- [IO PackageDisplayInfo] -> IO [PackageDisplayInfo]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA
                       [ do PackageDisplayInfo
pkginfo <- (String -> IO PackageDisplayInfo)
-> (PackageDisplayInfo -> IO PackageDisplayInfo)
-> Either String PackageDisplayInfo
-> IO PackageDisplayInfo
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Verbosity -> String -> IO PackageDisplayInfo
forall a. Verbosity -> String -> IO a
die' Verbosity
verbosity) PackageDisplayInfo -> IO PackageDisplayInfo
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String PackageDisplayInfo -> IO PackageDisplayInfo)
-> Either String PackageDisplayInfo -> IO PackageDisplayInfo
forall a b. (a -> b) -> a -> b
$
                                         (PackageName -> VersionRange)
-> InstalledPackageIndex
-> PackageIndex UnresolvedSourcePackage
-> PackageSpecifier UnresolvedSourcePackage
-> Either String PackageDisplayInfo
gatherPkgInfo PackageName -> VersionRange
prefs
                                           InstalledPackageIndex
installedPkgIndex PackageIndex UnresolvedSourcePackage
sourcePkgIndex
                                           PackageSpecifier UnresolvedSourcePackage
pkgSpecifier
                            PackageDisplayInfo -> IO PackageDisplayInfo
updateFileSystemPackageDetails PackageDisplayInfo
pkginfo
                       | PackageSpecifier UnresolvedSourcePackage
pkgSpecifier <- [PackageSpecifier UnresolvedSourcePackage]
pkgSpecifiers ]

    String -> IO ()
putStr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines ((PackageDisplayInfo -> String) -> [PackageDisplayInfo] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map PackageDisplayInfo -> String
showPackageDetailedInfo [PackageDisplayInfo]
pkgsinfo)

  where
    gatherPkgInfo :: (PackageName -> VersionRange) ->
                     InstalledPackageIndex ->
                     PackageIndex.PackageIndex UnresolvedSourcePackage ->
                     PackageSpecifier UnresolvedSourcePackage ->
                     Either String PackageDisplayInfo
    gatherPkgInfo :: (PackageName -> VersionRange)
-> InstalledPackageIndex
-> PackageIndex UnresolvedSourcePackage
-> PackageSpecifier UnresolvedSourcePackage
-> Either String PackageDisplayInfo
gatherPkgInfo PackageName -> VersionRange
prefs InstalledPackageIndex
installedPkgIndex PackageIndex UnresolvedSourcePackage
sourcePkgIndex
      (NamedPackage PackageName
name [PackageProperty]
props)
      | [(Version, [InstalledPackageInfo])] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([(Version, [InstalledPackageInfo])]
selectedInstalledPkgs) Bool -> Bool -> Bool
&& [UnresolvedSourcePackage] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([UnresolvedSourcePackage]
selectedSourcePkgs)
      = String -> Either String PackageDisplayInfo
forall a b. a -> Either a b
Left (String -> Either String PackageDisplayInfo)
-> String -> Either String PackageDisplayInfo
forall a b. (a -> b) -> a -> b
$ String
"There is no available version of " String -> String -> String
forall a. [a] -> [a] -> [a]
++ PackageName -> String
forall a. Pretty a => a -> String
prettyShow PackageName
name
            String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" that satisfies "
            String -> String -> String
forall a. [a] -> [a] -> [a]
++ VersionRange -> String
forall a. Pretty a => a -> String
prettyShow (VersionRange -> VersionRange
simplifyVersionRange VersionRange
verConstraint)

      | Bool
otherwise
      = PackageDisplayInfo -> Either String PackageDisplayInfo
forall a b. b -> Either a b
Right (PackageDisplayInfo -> Either String PackageDisplayInfo)
-> PackageDisplayInfo -> Either String PackageDisplayInfo
forall a b. (a -> b) -> a -> b
$ VersionRange
-> [InstalledPackageInfo]
-> [UnresolvedSourcePackage]
-> Maybe UnresolvedSourcePackage
-> Bool
-> PackageDisplayInfo
mergePackageInfo VersionRange
pref [InstalledPackageInfo]
installedPkgs
                                 [UnresolvedSourcePackage]
sourcePkgs  Maybe UnresolvedSourcePackage
selectedSourcePkg'
                                 Bool
showPkgVersion
      where
        (VersionRange
pref, [InstalledPackageInfo]
installedPkgs, [UnresolvedSourcePackage]
sourcePkgs) =
          (PackageName -> VersionRange)
-> PackageName
-> InstalledPackageIndex
-> PackageIndex UnresolvedSourcePackage
-> (VersionRange, [InstalledPackageInfo],
    [UnresolvedSourcePackage])
sourcePkgsInfo PackageName -> VersionRange
prefs PackageName
name InstalledPackageIndex
installedPkgIndex PackageIndex UnresolvedSourcePackage
sourcePkgIndex

        selectedInstalledPkgs :: [(Version, [InstalledPackageInfo])]
selectedInstalledPkgs = InstalledPackageIndex
-> PackageName
-> VersionRange
-> [(Version, [InstalledPackageInfo])]
InstalledPackageIndex.lookupDependency
                                InstalledPackageIndex
installedPkgIndex
                                PackageName
name VersionRange
verConstraint
        selectedSourcePkgs :: [UnresolvedSourcePackage]
selectedSourcePkgs    = PackageIndex UnresolvedSourcePackage
-> PackageName -> VersionRange -> [UnresolvedSourcePackage]
forall pkg.
Package pkg =>
PackageIndex pkg -> PackageName -> VersionRange -> [pkg]
PackageIndex.lookupDependency PackageIndex UnresolvedSourcePackage
sourcePkgIndex
                                PackageName
name VersionRange
verConstraint
        selectedSourcePkg' :: Maybe UnresolvedSourcePackage
selectedSourcePkg'    = VersionRange
-> [UnresolvedSourcePackage] -> Maybe UnresolvedSourcePackage
forall pkg. Package pkg => VersionRange -> [pkg] -> Maybe pkg
latestWithPref VersionRange
pref [UnresolvedSourcePackage]
selectedSourcePkgs

                         -- display a specific package version if the user
                         -- supplied a non-trivial version constraint
        showPkgVersion :: Bool
showPkgVersion = Bool -> Bool
not ([VersionRange] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [VersionRange]
verConstraints)
        verConstraint :: VersionRange
verConstraint  = (VersionRange -> VersionRange -> VersionRange)
-> VersionRange -> [VersionRange] -> VersionRange
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr VersionRange -> VersionRange -> VersionRange
intersectVersionRanges VersionRange
anyVersion [VersionRange]
verConstraints
        verConstraints :: [VersionRange]
verConstraints = [ VersionRange
vr | PackagePropertyVersion VersionRange
vr <- [PackageProperty]
props ]

    gatherPkgInfo PackageName -> VersionRange
prefs InstalledPackageIndex
installedPkgIndex PackageIndex UnresolvedSourcePackage
sourcePkgIndex
      (SpecificSourcePackage UnresolvedSourcePackage
pkg) =
        PackageDisplayInfo -> Either String PackageDisplayInfo
forall a b. b -> Either a b
Right (PackageDisplayInfo -> Either String PackageDisplayInfo)
-> PackageDisplayInfo -> Either String PackageDisplayInfo
forall a b. (a -> b) -> a -> b
$ VersionRange
-> [InstalledPackageInfo]
-> [UnresolvedSourcePackage]
-> Maybe UnresolvedSourcePackage
-> Bool
-> PackageDisplayInfo
mergePackageInfo VersionRange
pref [InstalledPackageInfo]
installedPkgs [UnresolvedSourcePackage]
sourcePkgs
                                 Maybe UnresolvedSourcePackage
selectedPkg Bool
True
      where
        name :: PackageName
name          = UnresolvedSourcePackage -> PackageName
forall pkg. Package pkg => pkg -> PackageName
packageName UnresolvedSourcePackage
pkg
        selectedPkg :: Maybe UnresolvedSourcePackage
selectedPkg   = UnresolvedSourcePackage -> Maybe UnresolvedSourcePackage
forall a. a -> Maybe a
Just UnresolvedSourcePackage
pkg
        (VersionRange
pref, [InstalledPackageInfo]
installedPkgs, [UnresolvedSourcePackage]
sourcePkgs) =
          (PackageName -> VersionRange)
-> PackageName
-> InstalledPackageIndex
-> PackageIndex UnresolvedSourcePackage
-> (VersionRange, [InstalledPackageInfo],
    [UnresolvedSourcePackage])
sourcePkgsInfo PackageName -> VersionRange
prefs PackageName
name InstalledPackageIndex
installedPkgIndex PackageIndex UnresolvedSourcePackage
sourcePkgIndex

sourcePkgsInfo ::
  (PackageName -> VersionRange)
  -> PackageName
  -> InstalledPackageIndex
  -> PackageIndex.PackageIndex UnresolvedSourcePackage
  -> (VersionRange, [Installed.InstalledPackageInfo], [UnresolvedSourcePackage])
sourcePkgsInfo :: (PackageName -> VersionRange)
-> PackageName
-> InstalledPackageIndex
-> PackageIndex UnresolvedSourcePackage
-> (VersionRange, [InstalledPackageInfo],
    [UnresolvedSourcePackage])
sourcePkgsInfo PackageName -> VersionRange
prefs PackageName
name InstalledPackageIndex
installedPkgIndex PackageIndex UnresolvedSourcePackage
sourcePkgIndex =
  (VersionRange
pref, [InstalledPackageInfo]
installedPkgs, [UnresolvedSourcePackage]
sourcePkgs)
  where
    pref :: VersionRange
pref          = PackageName -> VersionRange
prefs PackageName
name
    installedPkgs :: [InstalledPackageInfo]
installedPkgs = ((Version, [InstalledPackageInfo]) -> [InstalledPackageInfo])
-> [(Version, [InstalledPackageInfo])] -> [InstalledPackageInfo]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Version, [InstalledPackageInfo]) -> [InstalledPackageInfo]
forall a b. (a, b) -> b
snd (InstalledPackageIndex
-> PackageName -> [(Version, [InstalledPackageInfo])]
forall a. PackageIndex a -> PackageName -> [(Version, [a])]
InstalledPackageIndex.lookupPackageName
                                   InstalledPackageIndex
installedPkgIndex PackageName
name)
    sourcePkgs :: [UnresolvedSourcePackage]
sourcePkgs    = PackageIndex UnresolvedSourcePackage
-> PackageName -> [UnresolvedSourcePackage]
forall pkg. Package pkg => PackageIndex pkg -> PackageName -> [pkg]
PackageIndex.lookupPackageName PackageIndex UnresolvedSourcePackage
sourcePkgIndex PackageName
name


-- | The info that we can display for each package. It is information per
-- package name and covers all installed and available versions.
--
data PackageDisplayInfo = PackageDisplayInfo {
    PackageDisplayInfo -> PackageName
pkgName           :: PackageName,
    PackageDisplayInfo -> Maybe Version
selectedVersion   :: Maybe Version,
    PackageDisplayInfo -> Maybe UnresolvedSourcePackage
selectedSourcePkg :: Maybe UnresolvedSourcePackage,
    PackageDisplayInfo -> [Version]
installedVersions :: [Version],
    PackageDisplayInfo -> [Version]
sourceVersions    :: [Version],
    PackageDisplayInfo -> VersionRange
preferredVersions :: VersionRange,
    PackageDisplayInfo -> ShortText
homepage          :: ShortText,
    PackageDisplayInfo -> ShortText
bugReports        :: ShortText,
    PackageDisplayInfo -> String
sourceRepo        :: String, -- TODO
    PackageDisplayInfo -> ShortText
synopsis          :: ShortText,
    PackageDisplayInfo -> ShortText
description       :: ShortText,
    PackageDisplayInfo -> ShortText
category          :: ShortText,
    PackageDisplayInfo -> Either License License
license           :: Either SPDX.License License,
    PackageDisplayInfo -> ShortText
author            :: ShortText,
    PackageDisplayInfo -> ShortText
maintainer        :: ShortText,
    PackageDisplayInfo -> [ExtDependency]
dependencies      :: [ExtDependency],
    PackageDisplayInfo -> [PackageFlag]
flags             :: [PackageFlag],
    PackageDisplayInfo -> Bool
hasLib            :: Bool,
    PackageDisplayInfo -> Bool
hasExe            :: Bool,
    PackageDisplayInfo -> [UnqualComponentName]
executables       :: [UnqualComponentName],
    PackageDisplayInfo -> [ModuleName]
modules           :: [ModuleName],
    PackageDisplayInfo -> String
haddockHtml       :: FilePath,
    PackageDisplayInfo -> Bool
haveTarball       :: Bool
  }

-- | Covers source dependencies and installed dependencies in
-- one type.
data ExtDependency = SourceDependency Dependency
                   | InstalledDependency UnitId

showPackageSummaryInfo :: PackageDisplayInfo -> String
showPackageSummaryInfo :: PackageDisplayInfo -> String
showPackageSummaryInfo PackageDisplayInfo
pkginfo =
  Style -> Doc -> String
renderStyle (Style
style {lineLength :: Int
lineLength = Int
80, ribbonsPerLine :: Float
ribbonsPerLine = Float
1}) (Doc -> String) -> Doc -> String
forall a b. (a -> b) -> a -> b
$
     Char -> Doc
char Char
'*' Doc -> Doc -> Doc
<+> PackageName -> Doc
forall a. Pretty a => a -> Doc
pretty (PackageDisplayInfo -> PackageName
pkgName PackageDisplayInfo
pkginfo)
     Doc -> Doc -> Doc
$+$
     (Int -> Doc -> Doc
nest Int
4 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
vcat [
       ShortText -> String -> (String -> Doc) -> Doc
maybeShowST (PackageDisplayInfo -> ShortText
synopsis PackageDisplayInfo
pkginfo) String
"Synopsis:" String -> Doc
reflowParagraphs
     , String -> Doc
text String
"Default available version:" Doc -> Doc -> Doc
<+>
       case PackageDisplayInfo -> Maybe UnresolvedSourcePackage
selectedSourcePkg PackageDisplayInfo
pkginfo of
         Maybe UnresolvedSourcePackage
Nothing  -> String -> Doc
text String
"[ Not available from any configured repository ]"
         Just UnresolvedSourcePackage
pkg -> Version -> Doc
forall a. Pretty a => a -> Doc
pretty (UnresolvedSourcePackage -> Version
forall pkg. Package pkg => pkg -> Version
packageVersion UnresolvedSourcePackage
pkg)
     , String -> Doc
text String
"Installed versions:" Doc -> Doc -> Doc
<+>
       case PackageDisplayInfo -> [Version]
installedVersions PackageDisplayInfo
pkginfo of
         []  | PackageDisplayInfo -> Bool
hasLib PackageDisplayInfo
pkginfo -> String -> Doc
text String
"[ Not installed ]"
             | Bool
otherwise      -> String -> Doc
text String
"[ Unknown ]"
         [Version]
versions             -> Int -> VersionRange -> [Version] -> Doc
dispTopVersions Int
4
                                   (PackageDisplayInfo -> VersionRange
preferredVersions PackageDisplayInfo
pkginfo) [Version]
versions
     , ShortText -> String -> (String -> Doc) -> Doc
maybeShowST (PackageDisplayInfo -> ShortText
homepage PackageDisplayInfo
pkginfo) String
"Homepage:" String -> Doc
text
     , String -> Doc
text String
"License: " Doc -> Doc -> Doc
<+> (License -> Doc)
-> (License -> Doc) -> Either License License -> Doc
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either License -> Doc
forall a. Pretty a => a -> Doc
pretty License -> Doc
forall a. Pretty a => a -> Doc
pretty (PackageDisplayInfo -> Either License License
license PackageDisplayInfo
pkginfo)
     ])
     Doc -> Doc -> Doc
$+$ String -> Doc
text String
""
  where
    maybeShowST :: ShortText -> String -> (String -> Doc) -> Doc
maybeShowST ShortText
l String
s String -> Doc
f
        | ShortText -> Bool
ShortText.null ShortText
l = Doc
Disp.empty
        | Bool
otherwise        = String -> Doc
text String
s Doc -> Doc -> Doc
<+> String -> Doc
f (ShortText -> String
ShortText.fromShortText ShortText
l)

showPackageDetailedInfo :: PackageDisplayInfo -> String
showPackageDetailedInfo :: PackageDisplayInfo -> String
showPackageDetailedInfo PackageDisplayInfo
pkginfo =
  Style -> Doc -> String
renderStyle (Style
style {lineLength :: Int
lineLength = Int
80, ribbonsPerLine :: Float
ribbonsPerLine = Float
1}) (Doc -> String) -> Doc -> String
forall a b. (a -> b) -> a -> b
$
   Char -> Doc
char Char
'*' Doc -> Doc -> Doc
<+> PackageName -> Doc
forall a. Pretty a => a -> Doc
pretty (PackageDisplayInfo -> PackageName
pkgName PackageDisplayInfo
pkginfo)
            Doc -> Doc -> Doc
<<>> Doc -> (Version -> Doc) -> Maybe Version -> Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc
Disp.empty (\Version
v -> Char -> Doc
char Char
'-' Doc -> Doc -> Doc
Disp.<> Version -> Doc
forall a. Pretty a => a -> Doc
pretty Version
v) (PackageDisplayInfo -> Maybe Version
selectedVersion PackageDisplayInfo
pkginfo)
            Doc -> Doc -> Doc
<+> String -> Doc
text (Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
16 Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (PackageName -> String
forall a. Pretty a => a -> String
prettyShow (PackageDisplayInfo -> PackageName
pkgName PackageDisplayInfo
pkginfo))) Char
' ')
            Doc -> Doc -> Doc
<<>> Doc -> Doc
parens Doc
pkgkind
   Doc -> Doc -> Doc
$+$
   (Int -> Doc -> Doc
nest Int
4 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
vcat [
     String
-> (PackageDisplayInfo -> ShortText)
-> (String -> Maybe (Maybe String))
-> (String -> Doc)
-> Doc
entryST String
"Synopsis"      PackageDisplayInfo -> ShortText
synopsis     String -> Maybe (Maybe String)
forall (t :: * -> *) a a. Foldable t => t a -> Maybe (Maybe a)
hideIfNull  String -> Doc
reflowParagraphs
   , String
-> (PackageDisplayInfo -> [Version])
-> ([Version] -> Maybe (Maybe String))
-> ([Version] -> Doc)
-> Doc
forall t.
String
-> (PackageDisplayInfo -> t)
-> (t -> Maybe (Maybe String))
-> (t -> Doc)
-> Doc
entry String
"Versions available" PackageDisplayInfo -> [Version]
sourceVersions
           (([Version] -> Bool) -> String -> [Version] -> Maybe (Maybe String)
forall t a. (t -> Bool) -> a -> t -> Maybe (Maybe a)
altText [Version] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
"[ Not available from server ]")
           (Int -> VersionRange -> [Version] -> Doc
dispTopVersions Int
9 (PackageDisplayInfo -> VersionRange
preferredVersions PackageDisplayInfo
pkginfo))
   , String
-> (PackageDisplayInfo -> [Version])
-> ([Version] -> Maybe (Maybe String))
-> ([Version] -> Doc)
-> Doc
forall t.
String
-> (PackageDisplayInfo -> t)
-> (t -> Maybe (Maybe String))
-> (t -> Doc)
-> Doc
entry String
"Versions installed" PackageDisplayInfo -> [Version]
installedVersions
           (([Version] -> Bool) -> String -> [Version] -> Maybe (Maybe String)
forall t a. (t -> Bool) -> a -> t -> Maybe (Maybe a)
altText [Version] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (if PackageDisplayInfo -> Bool
hasLib PackageDisplayInfo
pkginfo then String
"[ Not installed ]"
                                            else String
"[ Unknown ]"))
           (Int -> VersionRange -> [Version] -> Doc
dispTopVersions Int
4 (PackageDisplayInfo -> VersionRange
preferredVersions PackageDisplayInfo
pkginfo))
   , String
-> (PackageDisplayInfo -> ShortText)
-> (String -> Maybe (Maybe String))
-> (String -> Doc)
-> Doc
entryST String
"Homepage"      PackageDisplayInfo -> ShortText
homepage     String -> Maybe (Maybe String)
forall a. [a] -> Maybe (Maybe String)
orNotSpecified String -> Doc
text
   , String
-> (PackageDisplayInfo -> ShortText)
-> (String -> Maybe (Maybe String))
-> (String -> Doc)
-> Doc
entryST String
"Bug reports"   PackageDisplayInfo -> ShortText
bugReports   String -> Maybe (Maybe String)
forall a. [a] -> Maybe (Maybe String)
orNotSpecified String -> Doc
text
   , String
-> (PackageDisplayInfo -> ShortText)
-> (String -> Maybe (Maybe String))
-> (String -> Doc)
-> Doc
entryST String
"Description"   PackageDisplayInfo -> ShortText
description  String -> Maybe (Maybe String)
forall (t :: * -> *) a a. Foldable t => t a -> Maybe (Maybe a)
hideIfNull     String -> Doc
reflowParagraphs
   , String
-> (PackageDisplayInfo -> ShortText)
-> (String -> Maybe (Maybe String))
-> (String -> Doc)
-> Doc
entryST String
"Category"      PackageDisplayInfo -> ShortText
category     String -> Maybe (Maybe String)
forall (t :: * -> *) a a. Foldable t => t a -> Maybe (Maybe a)
hideIfNull     String -> Doc
text
   , String
-> (PackageDisplayInfo -> Either License License)
-> (Either License License -> Maybe (Maybe String))
-> (Either License License -> Doc)
-> Doc
forall t.
String
-> (PackageDisplayInfo -> t)
-> (t -> Maybe (Maybe String))
-> (t -> Doc)
-> Doc
entry String
"License"       PackageDisplayInfo -> Either License License
license      Either License License -> Maybe (Maybe String)
forall b a. b -> Maybe a
alwaysShow     ((License -> Doc)
-> (License -> Doc) -> Either License License -> Doc
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either License -> Doc
forall a. Pretty a => a -> Doc
pretty License -> Doc
forall a. Pretty a => a -> Doc
pretty)
   , String
-> (PackageDisplayInfo -> ShortText)
-> (String -> Maybe (Maybe String))
-> (String -> Doc)
-> Doc
entryST String
"Author"        PackageDisplayInfo -> ShortText
author       String -> Maybe (Maybe String)
forall (t :: * -> *) a a. Foldable t => t a -> Maybe (Maybe a)
hideIfNull     String -> Doc
reflowLines
   , String
-> (PackageDisplayInfo -> ShortText)
-> (String -> Maybe (Maybe String))
-> (String -> Doc)
-> Doc
entryST String
"Maintainer"    PackageDisplayInfo -> ShortText
maintainer   String -> Maybe (Maybe String)
forall (t :: * -> *) a a. Foldable t => t a -> Maybe (Maybe a)
hideIfNull     String -> Doc
reflowLines
   , String
-> (PackageDisplayInfo -> String)
-> (String -> Maybe (Maybe String))
-> (String -> Doc)
-> Doc
forall t.
String
-> (PackageDisplayInfo -> t)
-> (t -> Maybe (Maybe String))
-> (t -> Doc)
-> Doc
entry String
"Source repo"   PackageDisplayInfo -> String
sourceRepo   String -> Maybe (Maybe String)
forall a. [a] -> Maybe (Maybe String)
orNotSpecified String -> Doc
text
   , String
-> (PackageDisplayInfo -> [UnqualComponentName])
-> ([UnqualComponentName] -> Maybe (Maybe String))
-> ([UnqualComponentName] -> Doc)
-> Doc
forall t.
String
-> (PackageDisplayInfo -> t)
-> (t -> Maybe (Maybe String))
-> (t -> Doc)
-> Doc
entry String
"Executables"   PackageDisplayInfo -> [UnqualComponentName]
executables  [UnqualComponentName] -> Maybe (Maybe String)
forall (t :: * -> *) a a. Foldable t => t a -> Maybe (Maybe a)
hideIfNull     ((UnqualComponentName -> Doc) -> [UnqualComponentName] -> Doc
forall a. (a -> Doc) -> [a] -> Doc
commaSep UnqualComponentName -> Doc
forall a. Pretty a => a -> Doc
pretty)
   , String
-> (PackageDisplayInfo -> [PackageFlag])
-> ([PackageFlag] -> Maybe (Maybe String))
-> ([PackageFlag] -> Doc)
-> Doc
forall t.
String
-> (PackageDisplayInfo -> t)
-> (t -> Maybe (Maybe String))
-> (t -> Doc)
-> Doc
entry String
"Flags"         PackageDisplayInfo -> [PackageFlag]
flags        [PackageFlag] -> Maybe (Maybe String)
forall (t :: * -> *) a a. Foldable t => t a -> Maybe (Maybe a)
hideIfNull     ((PackageFlag -> Doc) -> [PackageFlag] -> Doc
forall a. (a -> Doc) -> [a] -> Doc
commaSep PackageFlag -> Doc
dispFlag)
   , String
-> (PackageDisplayInfo -> [ExtDependency])
-> ([ExtDependency] -> Maybe (Maybe String))
-> ([ExtDependency] -> Doc)
-> Doc
forall t.
String
-> (PackageDisplayInfo -> t)
-> (t -> Maybe (Maybe String))
-> (t -> Doc)
-> Doc
entry String
"Dependencies"  PackageDisplayInfo -> [ExtDependency]
dependencies [ExtDependency] -> Maybe (Maybe String)
forall (t :: * -> *) a a. Foldable t => t a -> Maybe (Maybe a)
hideIfNull     ((ExtDependency -> Doc) -> [ExtDependency] -> Doc
forall a. (a -> Doc) -> [a] -> Doc
commaSep ExtDependency -> Doc
dispExtDep)
   , String
-> (PackageDisplayInfo -> String)
-> (String -> Maybe (Maybe String))
-> (String -> Doc)
-> Doc
forall t.
String
-> (PackageDisplayInfo -> t)
-> (t -> Maybe (Maybe String))
-> (t -> Doc)
-> Doc
entry String
"Documentation" PackageDisplayInfo -> String
haddockHtml  String -> Maybe (Maybe String)
forall (t :: * -> *) a. Foldable t => t a -> Maybe (Maybe String)
showIfInstalled String -> Doc
text
   , String
-> (PackageDisplayInfo -> Bool)
-> (Bool -> Maybe (Maybe String))
-> (Bool -> Doc)
-> Doc
forall t.
String
-> (PackageDisplayInfo -> t)
-> (t -> Maybe (Maybe String))
-> (t -> Doc)
-> Doc
entry String
"Cached"        PackageDisplayInfo -> Bool
haveTarball  Bool -> Maybe (Maybe String)
forall b a. b -> Maybe a
alwaysShow     Bool -> Doc
dispYesNo
   , if Bool -> Bool
not (PackageDisplayInfo -> Bool
hasLib PackageDisplayInfo
pkginfo) then Doc
forall a. Monoid a => a
mempty else
     String -> Doc
text String
"Modules:" Doc -> Doc -> Doc
$+$ Int -> Doc -> Doc
nest Int
4 ([Doc] -> Doc
vcat ((ModuleName -> Doc) -> [ModuleName] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ModuleName -> Doc
forall a. Pretty a => a -> Doc
pretty ([ModuleName] -> [Doc])
-> (PackageDisplayInfo -> [ModuleName])
-> PackageDisplayInfo
-> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ModuleName] -> [ModuleName]
forall a. Ord a => [a] -> [a]
sort ([ModuleName] -> [ModuleName])
-> (PackageDisplayInfo -> [ModuleName])
-> PackageDisplayInfo
-> [ModuleName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageDisplayInfo -> [ModuleName]
modules (PackageDisplayInfo -> [Doc]) -> PackageDisplayInfo -> [Doc]
forall a b. (a -> b) -> a -> b
$ PackageDisplayInfo
pkginfo))
   ])
   Doc -> Doc -> Doc
$+$ String -> Doc
text String
""
  where
    entry :: String
-> (PackageDisplayInfo -> t)
-> (t -> Maybe (Maybe String))
-> (t -> Doc)
-> Doc
entry String
fname PackageDisplayInfo -> t
field t -> Maybe (Maybe String)
cond t -> Doc
format = case t -> Maybe (Maybe String)
cond (PackageDisplayInfo -> t
field PackageDisplayInfo
pkginfo) of
      Maybe (Maybe String)
Nothing           -> Doc
label Doc -> Doc -> Doc
<+> t -> Doc
format (PackageDisplayInfo -> t
field PackageDisplayInfo
pkginfo)
      Just Maybe String
Nothing      -> Doc
forall a. Monoid a => a
mempty
      Just (Just String
other) -> Doc
label Doc -> Doc -> Doc
<+> String -> Doc
text String
other
      where
        label :: Doc
label   = String -> Doc
text String
fname Doc -> Doc -> Doc
Disp.<> Char -> Doc
char Char
':' Doc -> Doc -> Doc
Disp.<> Doc
padding
        padding :: Doc
padding = String -> Doc
text (Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
13 Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
fname ) Char
' ')

    entryST :: String
-> (PackageDisplayInfo -> ShortText)
-> (String -> Maybe (Maybe String))
-> (String -> Doc)
-> Doc
entryST String
fname PackageDisplayInfo -> ShortText
field = String
-> (PackageDisplayInfo -> String)
-> (String -> Maybe (Maybe String))
-> (String -> Doc)
-> Doc
forall t.
String
-> (PackageDisplayInfo -> t)
-> (t -> Maybe (Maybe String))
-> (t -> Doc)
-> Doc
entry String
fname (ShortText -> String
ShortText.fromShortText (ShortText -> String)
-> (PackageDisplayInfo -> ShortText)
-> PackageDisplayInfo
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageDisplayInfo -> ShortText
field)

    normal :: Maybe a
normal      = Maybe a
forall a. Maybe a
Nothing
    hide :: Maybe (Maybe a)
hide        = Maybe a -> Maybe (Maybe a)
forall a. a -> Maybe a
Just Maybe a
forall a. Maybe a
Nothing
    replace :: a -> Maybe (Maybe a)
replace a
msg = Maybe a -> Maybe (Maybe a)
forall a. a -> Maybe a
Just (a -> Maybe a
forall a. a -> Maybe a
Just a
msg)

    alwaysShow :: b -> Maybe a
alwaysShow = Maybe a -> b -> Maybe a
forall a b. a -> b -> a
const Maybe a
forall a. Maybe a
normal
    hideIfNull :: t a -> Maybe (Maybe a)
hideIfNull t a
v = if t a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null t a
v then Maybe (Maybe a)
forall a. Maybe (Maybe a)
hide else Maybe (Maybe a)
forall a. Maybe a
normal
    showIfInstalled :: t a -> Maybe (Maybe String)
showIfInstalled t a
v
      | Bool -> Bool
not Bool
isInstalled = Maybe (Maybe String)
forall a. Maybe (Maybe a)
hide
      | t a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null t a
v          = String -> Maybe (Maybe String)
forall a. a -> Maybe (Maybe a)
replace String
"[ Not installed ]"
      | Bool
otherwise       = Maybe (Maybe String)
forall a. Maybe a
normal
    altText :: (t -> Bool) -> a -> t -> Maybe (Maybe a)
altText t -> Bool
nul a
msg t
v = if t -> Bool
nul t
v then a -> Maybe (Maybe a)
forall a. a -> Maybe (Maybe a)
replace a
msg else Maybe (Maybe a)
forall a. Maybe a
normal
    orNotSpecified :: [a] -> Maybe (Maybe String)
orNotSpecified = ([a] -> Bool) -> String -> [a] -> Maybe (Maybe String)
forall t a. (t -> Bool) -> a -> t -> Maybe (Maybe a)
altText [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
"[ Not specified ]"

    commaSep :: (a -> Doc) -> [a] -> Doc
commaSep a -> Doc
f = [Doc] -> Doc
Disp.fsep ([Doc] -> Doc) -> ([a] -> [Doc]) -> [a] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
Disp.punctuate (Char -> Doc
Disp.char Char
',') ([Doc] -> [Doc]) -> ([a] -> [Doc]) -> [a] -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Doc) -> [a] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map a -> Doc
f
    dispFlag :: PackageFlag -> Doc
dispFlag = String -> Doc
text (String -> Doc) -> (PackageFlag -> String) -> PackageFlag -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FlagName -> String
unFlagName (FlagName -> String)
-> (PackageFlag -> FlagName) -> PackageFlag -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageFlag -> FlagName
flagName
    dispYesNo :: Bool -> Doc
dispYesNo Bool
True  = String -> Doc
text String
"Yes"
    dispYesNo Bool
False = String -> Doc
text String
"No"

    dispExtDep :: ExtDependency -> Doc
dispExtDep (SourceDependency    Dependency
dep) = Dependency -> Doc
forall a. Pretty a => a -> Doc
pretty Dependency
dep
    dispExtDep (InstalledDependency UnitId
dep) = UnitId -> Doc
forall a. Pretty a => a -> Doc
pretty UnitId
dep

    isInstalled :: Bool
isInstalled = Bool -> Bool
not ([Version] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (PackageDisplayInfo -> [Version]
installedVersions PackageDisplayInfo
pkginfo))
    hasExes :: Bool
hasExes = [UnqualComponentName] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (PackageDisplayInfo -> [UnqualComponentName]
executables PackageDisplayInfo
pkginfo) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
2
    --TODO: exclude non-buildable exes
    pkgkind :: Doc
pkgkind | PackageDisplayInfo -> Bool
hasLib PackageDisplayInfo
pkginfo Bool -> Bool -> Bool
&& Bool
hasExes        = String -> Doc
text String
"programs and library"
            | PackageDisplayInfo -> Bool
hasLib PackageDisplayInfo
pkginfo Bool -> Bool -> Bool
&& PackageDisplayInfo -> Bool
hasExe PackageDisplayInfo
pkginfo = String -> Doc
text String
"program and library"
            | PackageDisplayInfo -> Bool
hasLib PackageDisplayInfo
pkginfo                   = String -> Doc
text String
"library"
            | Bool
hasExes                          = String -> Doc
text String
"programs"
            | PackageDisplayInfo -> Bool
hasExe PackageDisplayInfo
pkginfo                   = String -> Doc
text String
"program"
            | Bool
otherwise                        = Doc
forall a. Monoid a => a
mempty


reflowParagraphs :: String -> Doc
reflowParagraphs :: String -> Doc
reflowParagraphs =
    [Doc] -> Doc
vcat
  ([Doc] -> Doc) -> (String -> [Doc]) -> String -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
intersperse (String -> Doc
text String
"")                    -- re-insert blank lines
  ([Doc] -> [Doc]) -> (String -> [Doc]) -> String -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([String] -> Doc) -> [[String]] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ([Doc] -> Doc
fsep ([Doc] -> Doc) -> ([String] -> [Doc]) -> [String] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Doc) -> [String] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map String -> Doc
text ([String] -> [Doc]) -> ([String] -> [String]) -> [String] -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> [String]) -> [String] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap String -> [String]
words)  -- reflow paragraphs
  ([[String]] -> [Doc]) -> (String -> [[String]]) -> String -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([String] -> Bool) -> [[String]] -> [[String]]
forall a. (a -> Bool) -> [a] -> [a]
filter ([String] -> [String] -> Bool
forall a. Eq a => a -> a -> Bool
/= [String
""])
  ([[String]] -> [[String]])
-> (String -> [[String]]) -> String -> [[String]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String -> Bool) -> [String] -> [[String]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
L.groupBy (\String
x String
y -> String
"" String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [String
x,String
y])     -- break on blank lines
  ([String] -> [[String]])
-> (String -> [String]) -> String -> [[String]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines

reflowLines :: String -> Doc
reflowLines :: String -> Doc
reflowLines = [Doc] -> Doc
vcat ([Doc] -> Doc) -> (String -> [Doc]) -> String -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Doc) -> [String] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map String -> Doc
text ([String] -> [Doc]) -> (String -> [String]) -> String -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines

-- | We get the 'PackageDisplayInfo' by combining the info for the installed
-- and available versions of a package.
--
-- * We're building info about a various versions of a single named package so
-- the input package info records are all supposed to refer to the same
-- package name.
--
mergePackageInfo :: VersionRange
                 -> [Installed.InstalledPackageInfo]
                 -> [UnresolvedSourcePackage]
                 -> Maybe UnresolvedSourcePackage
                 -> Bool
                 -> PackageDisplayInfo
mergePackageInfo :: VersionRange
-> [InstalledPackageInfo]
-> [UnresolvedSourcePackage]
-> Maybe UnresolvedSourcePackage
-> Bool
-> PackageDisplayInfo
mergePackageInfo VersionRange
versionPref [InstalledPackageInfo]
installedPkgs [UnresolvedSourcePackage]
sourcePkgs Maybe UnresolvedSourcePackage
selectedPkg Bool
showVer =
  Bool -> PackageDisplayInfo -> PackageDisplayInfo
forall a. (?callStack::CallStack) => Bool -> a -> a
assert ([InstalledPackageInfo] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [InstalledPackageInfo]
installedPkgs Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [UnresolvedSourcePackage] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [UnresolvedSourcePackage]
sourcePkgs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (PackageDisplayInfo -> PackageDisplayInfo)
-> PackageDisplayInfo -> PackageDisplayInfo
forall a b. (a -> b) -> a -> b
$
  PackageDisplayInfo :: PackageName
-> Maybe Version
-> Maybe UnresolvedSourcePackage
-> [Version]
-> [Version]
-> VersionRange
-> ShortText
-> ShortText
-> String
-> ShortText
-> ShortText
-> ShortText
-> Either License License
-> ShortText
-> ShortText
-> [ExtDependency]
-> [PackageFlag]
-> Bool
-> Bool
-> [UnqualComponentName]
-> [ModuleName]
-> String
-> Bool
-> PackageDisplayInfo
PackageDisplayInfo {
    pkgName :: PackageName
pkgName           = (PackageDescription -> PackageName)
-> Maybe PackageDescription
-> (InstalledPackageInfo -> PackageName)
-> Maybe InstalledPackageInfo
-> PackageName
forall a a a. (a -> a) -> Maybe a -> (a -> a) -> Maybe a -> a
combine PackageDescription -> PackageName
forall pkg. Package pkg => pkg -> PackageName
packageName Maybe PackageDescription
source
                                InstalledPackageInfo -> PackageName
forall pkg. Package pkg => pkg -> PackageName
packageName Maybe InstalledPackageInfo
installed,
    selectedVersion :: Maybe Version
selectedVersion   = if Bool
showVer then (UnresolvedSourcePackage -> Version)
-> Maybe UnresolvedSourcePackage -> Maybe Version
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap UnresolvedSourcePackage -> Version
forall pkg. Package pkg => pkg -> Version
packageVersion Maybe UnresolvedSourcePackage
selectedPkg
                                   else Maybe Version
forall a. Maybe a
Nothing,
    selectedSourcePkg :: Maybe UnresolvedSourcePackage
selectedSourcePkg = Maybe UnresolvedSourcePackage
sourceSelected,
    installedVersions :: [Version]
installedVersions = (InstalledPackageInfo -> Version)
-> [InstalledPackageInfo] -> [Version]
forall a b. (a -> b) -> [a] -> [b]
map InstalledPackageInfo -> Version
forall pkg. Package pkg => pkg -> Version
packageVersion [InstalledPackageInfo]
installedPkgs,
    sourceVersions :: [Version]
sourceVersions    = (UnresolvedSourcePackage -> Version)
-> [UnresolvedSourcePackage] -> [Version]
forall a b. (a -> b) -> [a] -> [b]
map UnresolvedSourcePackage -> Version
forall pkg. Package pkg => pkg -> Version
packageVersion [UnresolvedSourcePackage]
sourcePkgs,
    preferredVersions :: VersionRange
preferredVersions = VersionRange
versionPref,

    license :: Either License License
license      = (PackageDescription -> Either License License)
-> Maybe PackageDescription
-> (InstalledPackageInfo -> Either License License)
-> Maybe InstalledPackageInfo
-> Either License License
forall a a a. (a -> a) -> Maybe a -> (a -> a) -> Maybe a -> a
combine PackageDescription -> Either License License
Source.licenseRaw    Maybe PackageDescription
source
                           InstalledPackageInfo -> Either License License
Installed.license    Maybe InstalledPackageInfo
installed,
    maintainer :: ShortText
maintainer   = (PackageDescription -> ShortText)
-> Maybe PackageDescription
-> (InstalledPackageInfo -> ShortText)
-> Maybe InstalledPackageInfo
-> ShortText
forall a a a. (a -> a) -> Maybe a -> (a -> a) -> Maybe a -> a
combine PackageDescription -> ShortText
Source.maintainer    Maybe PackageDescription
source
                           InstalledPackageInfo -> ShortText
Installed.maintainer Maybe InstalledPackageInfo
installed,
    author :: ShortText
author       = (PackageDescription -> ShortText)
-> Maybe PackageDescription
-> (InstalledPackageInfo -> ShortText)
-> Maybe InstalledPackageInfo
-> ShortText
forall a a a. (a -> a) -> Maybe a -> (a -> a) -> Maybe a -> a
combine PackageDescription -> ShortText
Source.author        Maybe PackageDescription
source
                           InstalledPackageInfo -> ShortText
Installed.author     Maybe InstalledPackageInfo
installed,
    homepage :: ShortText
homepage     = (PackageDescription -> ShortText)
-> Maybe PackageDescription
-> (InstalledPackageInfo -> ShortText)
-> Maybe InstalledPackageInfo
-> ShortText
forall a a a. (a -> a) -> Maybe a -> (a -> a) -> Maybe a -> a
combine PackageDescription -> ShortText
Source.homepage      Maybe PackageDescription
source
                           InstalledPackageInfo -> ShortText
Installed.homepage   Maybe InstalledPackageInfo
installed,
    bugReports :: ShortText
bugReports   = ShortText
-> (PackageDescription -> ShortText)
-> Maybe PackageDescription
-> ShortText
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ShortText
forall a. Monoid a => a
mempty PackageDescription -> ShortText
Source.bugReports Maybe PackageDescription
source,
    sourceRepo :: String
sourceRepo   = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
forall a. Monoid a => a
mempty (Maybe String -> String)
-> (Maybe PackageDescription -> Maybe String)
-> Maybe PackageDescription
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (Maybe String) -> Maybe String
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join
                 (Maybe (Maybe String) -> Maybe String)
-> (Maybe PackageDescription -> Maybe (Maybe String))
-> Maybe PackageDescription
-> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PackageDescription -> Maybe String)
-> Maybe PackageDescription -> Maybe (Maybe String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Maybe String
-> (SourceRepo -> Maybe String) -> [SourceRepo] -> Maybe String
forall b a. b -> (a -> b) -> [a] -> b
uncons Maybe String
forall a. Maybe a
Nothing SourceRepo -> Maybe String
Source.repoLocation
                       ([SourceRepo] -> Maybe String)
-> (PackageDescription -> [SourceRepo])
-> PackageDescription
-> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SourceRepo -> SourceRepo -> Ordering)
-> [SourceRepo] -> [SourceRepo]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ((SourceRepo -> RepoKind) -> SourceRepo -> SourceRepo -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing SourceRepo -> RepoKind
Source.repoKind)
                       ([SourceRepo] -> [SourceRepo])
-> (PackageDescription -> [SourceRepo])
-> PackageDescription
-> [SourceRepo]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageDescription -> [SourceRepo]
Source.sourceRepos)
                 (Maybe PackageDescription -> String)
-> Maybe PackageDescription -> String
forall a b. (a -> b) -> a -> b
$ Maybe PackageDescription
source,
                    --TODO: installed package info is missing synopsis
    synopsis :: ShortText
synopsis     = ShortText
-> (PackageDescription -> ShortText)
-> Maybe PackageDescription
-> ShortText
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ShortText
forall a. Monoid a => a
mempty PackageDescription -> ShortText
Source.synopsis      Maybe PackageDescription
source,
    description :: ShortText
description  = (PackageDescription -> ShortText)
-> Maybe PackageDescription
-> (InstalledPackageInfo -> ShortText)
-> Maybe InstalledPackageInfo
-> ShortText
forall a a a. (a -> a) -> Maybe a -> (a -> a) -> Maybe a -> a
combine PackageDescription -> ShortText
Source.description    Maybe PackageDescription
source
                           InstalledPackageInfo -> ShortText
Installed.description Maybe InstalledPackageInfo
installed,
    category :: ShortText
category     = (PackageDescription -> ShortText)
-> Maybe PackageDescription
-> (InstalledPackageInfo -> ShortText)
-> Maybe InstalledPackageInfo
-> ShortText
forall a a a. (a -> a) -> Maybe a -> (a -> a) -> Maybe a -> a
combine PackageDescription -> ShortText
Source.category       Maybe PackageDescription
source
                           InstalledPackageInfo -> ShortText
Installed.category    Maybe InstalledPackageInfo
installed,
    flags :: [PackageFlag]
flags        = [PackageFlag]
-> (GenericPackageDescription -> [PackageFlag])
-> Maybe GenericPackageDescription
-> [PackageFlag]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] GenericPackageDescription -> [PackageFlag]
Source.genPackageFlags Maybe GenericPackageDescription
sourceGeneric,
    hasLib :: Bool
hasLib       = Maybe InstalledPackageInfo -> Bool
forall a. Maybe a -> Bool
isJust Maybe InstalledPackageInfo
installed
                Bool -> Bool -> Bool
|| Bool
-> (GenericPackageDescription -> Bool)
-> Maybe GenericPackageDescription
-> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Maybe (CondTree ConfVar [Dependency] Library) -> Bool
forall a. Maybe a -> Bool
isJust (Maybe (CondTree ConfVar [Dependency] Library) -> Bool)
-> (GenericPackageDescription
    -> Maybe (CondTree ConfVar [Dependency] Library))
-> GenericPackageDescription
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenericPackageDescription
-> Maybe (CondTree ConfVar [Dependency] Library)
Source.condLibrary) Maybe GenericPackageDescription
sourceGeneric,
    hasExe :: Bool
hasExe       = Bool
-> (GenericPackageDescription -> Bool)
-> Maybe GenericPackageDescription
-> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Bool -> Bool
not (Bool -> Bool)
-> (GenericPackageDescription -> Bool)
-> GenericPackageDescription
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(UnqualComponentName, CondTree ConfVar [Dependency] Executable)]
-> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([(UnqualComponentName, CondTree ConfVar [Dependency] Executable)]
 -> Bool)
-> (GenericPackageDescription
    -> [(UnqualComponentName,
         CondTree ConfVar [Dependency] Executable)])
-> GenericPackageDescription
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenericPackageDescription
-> [(UnqualComponentName,
     CondTree ConfVar [Dependency] Executable)]
Source.condExecutables) Maybe GenericPackageDescription
sourceGeneric,
    executables :: [UnqualComponentName]
executables  = ((UnqualComponentName, CondTree ConfVar [Dependency] Executable)
 -> UnqualComponentName)
-> [(UnqualComponentName,
     CondTree ConfVar [Dependency] Executable)]
-> [UnqualComponentName]
forall a b. (a -> b) -> [a] -> [b]
map (UnqualComponentName, CondTree ConfVar [Dependency] Executable)
-> UnqualComponentName
forall a b. (a, b) -> a
fst ([(UnqualComponentName, CondTree ConfVar [Dependency] Executable)]
-> (GenericPackageDescription
    -> [(UnqualComponentName,
         CondTree ConfVar [Dependency] Executable)])
-> Maybe GenericPackageDescription
-> [(UnqualComponentName,
     CondTree ConfVar [Dependency] Executable)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] GenericPackageDescription
-> [(UnqualComponentName,
     CondTree ConfVar [Dependency] Executable)]
Source.condExecutables Maybe GenericPackageDescription
sourceGeneric),
    modules :: [ModuleName]
modules      = (InstalledPackageInfo -> [ModuleName])
-> Maybe InstalledPackageInfo
-> (PackageDescription -> [ModuleName])
-> Maybe PackageDescription
-> [ModuleName]
forall a a a. (a -> a) -> Maybe a -> (a -> a) -> Maybe a -> a
combine ((ExposedModule -> ModuleName) -> [ExposedModule] -> [ModuleName]
forall a b. (a -> b) -> [a] -> [b]
map ExposedModule -> ModuleName
Installed.exposedName ([ExposedModule] -> [ModuleName])
-> (InstalledPackageInfo -> [ExposedModule])
-> InstalledPackageInfo
-> [ModuleName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InstalledPackageInfo -> [ExposedModule]
Installed.exposedModules)
                           Maybe InstalledPackageInfo
installed
                           -- NB: only for the PUBLIC library
                           ((Library -> [ModuleName]) -> [Library] -> [ModuleName]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Library -> [ModuleName]
getListOfExposedModules ([Library] -> [ModuleName])
-> (PackageDescription -> [Library])
-> PackageDescription
-> [ModuleName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Library -> [Library]
forall a. Maybe a -> [a]
maybeToList (Maybe Library -> [Library])
-> (PackageDescription -> Maybe Library)
-> PackageDescription
-> [Library]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageDescription -> Maybe Library
Source.library)
                           Maybe PackageDescription
source,
    dependencies :: [ExtDependency]
dependencies =
      (PackageDescription -> [ExtDependency])
-> Maybe PackageDescription
-> (InstalledPackageInfo -> [ExtDependency])
-> Maybe InstalledPackageInfo
-> [ExtDependency]
forall a a a. (a -> a) -> Maybe a -> (a -> a) -> Maybe a -> a
combine ((Dependency -> ExtDependency) -> [Dependency] -> [ExtDependency]
forall a b. (a -> b) -> [a] -> [b]
map (Dependency -> ExtDependency
SourceDependency (Dependency -> ExtDependency)
-> (Dependency -> Dependency) -> Dependency -> ExtDependency
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dependency -> Dependency
simplifyDependency)
               ([Dependency] -> [ExtDependency])
-> (PackageDescription -> [Dependency])
-> PackageDescription
-> [ExtDependency]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageDescription -> [Dependency]
Source.allBuildDepends) Maybe PackageDescription
source
      ((UnitId -> ExtDependency) -> [UnitId] -> [ExtDependency]
forall a b. (a -> b) -> [a] -> [b]
map UnitId -> ExtDependency
InstalledDependency ([UnitId] -> [ExtDependency])
-> (InstalledPackageInfo -> [UnitId])
-> InstalledPackageInfo
-> [ExtDependency]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InstalledPackageInfo -> [UnitId]
Installed.depends) Maybe InstalledPackageInfo
installed,
    haddockHtml :: String
haddockHtml  = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"" (Maybe String -> String)
-> (Maybe InstalledPackageInfo -> Maybe String)
-> Maybe InstalledPackageInfo
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (Maybe String) -> Maybe String
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join
                 (Maybe (Maybe String) -> Maybe String)
-> (Maybe InstalledPackageInfo -> Maybe (Maybe String))
-> Maybe InstalledPackageInfo
-> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (InstalledPackageInfo -> Maybe String)
-> Maybe InstalledPackageInfo -> Maybe (Maybe String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([String] -> Maybe String
forall a. [a] -> Maybe a
listToMaybe ([String] -> Maybe String)
-> (InstalledPackageInfo -> [String])
-> InstalledPackageInfo
-> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InstalledPackageInfo -> [String]
Installed.haddockHTMLs)
                 (Maybe InstalledPackageInfo -> String)
-> Maybe InstalledPackageInfo -> String
forall a b. (a -> b) -> a -> b
$ Maybe InstalledPackageInfo
installed,
    haveTarball :: Bool
haveTarball  = Bool
False
  }
  where
    combine :: (a -> a) -> Maybe a -> (a -> a) -> Maybe a -> a
combine a -> a
f Maybe a
x a -> a
g Maybe a
y  = Maybe a -> a
forall a. (?callStack::CallStack) => Maybe a -> a
fromJust ((a -> a) -> Maybe a -> Maybe a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
f Maybe a
x Maybe a -> Maybe a -> Maybe a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` (a -> a) -> Maybe a -> Maybe a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
g Maybe a
y)
    installed :: Maybe Installed.InstalledPackageInfo
    installed :: Maybe InstalledPackageInfo
installed = VersionRange
-> [InstalledPackageInfo] -> Maybe InstalledPackageInfo
forall pkg. Package pkg => VersionRange -> [pkg] -> Maybe pkg
latestWithPref VersionRange
versionPref [InstalledPackageInfo]
installedPkgs

    getListOfExposedModules :: Library -> [ModuleName]
getListOfExposedModules Library
lib = Library -> [ModuleName]
Source.exposedModules Library
lib
                               [ModuleName] -> [ModuleName] -> [ModuleName]
forall a. [a] -> [a] -> [a]
++ (ModuleReexport -> ModuleName) -> [ModuleReexport] -> [ModuleName]
forall a b. (a -> b) -> [a] -> [b]
map ModuleReexport -> ModuleName
Source.moduleReexportName
                                      (Library -> [ModuleReexport]
Source.reexportedModules Library
lib)

    sourceSelected :: Maybe UnresolvedSourcePackage
sourceSelected
      | Maybe UnresolvedSourcePackage -> Bool
forall a. Maybe a -> Bool
isJust Maybe UnresolvedSourcePackage
selectedPkg = Maybe UnresolvedSourcePackage
selectedPkg
      | Bool
otherwise          = VersionRange
-> [UnresolvedSourcePackage] -> Maybe UnresolvedSourcePackage
forall pkg. Package pkg => VersionRange -> [pkg] -> Maybe pkg
latestWithPref VersionRange
versionPref [UnresolvedSourcePackage]
sourcePkgs
    sourceGeneric :: Maybe GenericPackageDescription
sourceGeneric = (UnresolvedSourcePackage -> GenericPackageDescription)
-> Maybe UnresolvedSourcePackage -> Maybe GenericPackageDescription
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap UnresolvedSourcePackage -> GenericPackageDescription
forall loc. SourcePackage loc -> GenericPackageDescription
srcpkgDescription Maybe UnresolvedSourcePackage
sourceSelected
    source :: Maybe PackageDescription
source        = (GenericPackageDescription -> PackageDescription)
-> Maybe GenericPackageDescription -> Maybe PackageDescription
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenericPackageDescription -> PackageDescription
flattenPackageDescription Maybe GenericPackageDescription
sourceGeneric

    uncons :: b -> (a -> b) -> [a] -> b
    uncons :: b -> (a -> b) -> [a] -> b
uncons b
z a -> b
_ []    = b
z
    uncons b
_ a -> b
f (a
x:[a]
_) = a -> b
f a
x


-- | Not all the info is pure. We have to check if the docs really are
-- installed, because the registered package info lies. Similarly we have to
-- check if the tarball has indeed been fetched.
--
updateFileSystemPackageDetails :: PackageDisplayInfo -> IO PackageDisplayInfo
updateFileSystemPackageDetails :: PackageDisplayInfo -> IO PackageDisplayInfo
updateFileSystemPackageDetails PackageDisplayInfo
pkginfo = do
  Bool
fetched   <- IO Bool
-> (UnresolvedSourcePackage -> IO Bool)
-> Maybe UnresolvedSourcePackage
-> IO Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False) (UnresolvedPkgLoc -> IO Bool
isFetched (UnresolvedPkgLoc -> IO Bool)
-> (UnresolvedSourcePackage -> UnresolvedPkgLoc)
-> UnresolvedSourcePackage
-> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnresolvedSourcePackage -> UnresolvedPkgLoc
forall loc. SourcePackage loc -> loc
srcpkgSource)
                     (PackageDisplayInfo -> Maybe UnresolvedSourcePackage
selectedSourcePkg PackageDisplayInfo
pkginfo)
  Bool
docsExist <- String -> IO Bool
doesDirectoryExist (PackageDisplayInfo -> String
haddockHtml PackageDisplayInfo
pkginfo)
  PackageDisplayInfo -> IO PackageDisplayInfo
forall (m :: * -> *) a. Monad m => a -> m a
return PackageDisplayInfo
pkginfo {
    haveTarball :: Bool
haveTarball = Bool
fetched,
    haddockHtml :: String
haddockHtml = if Bool
docsExist then PackageDisplayInfo -> String
haddockHtml PackageDisplayInfo
pkginfo else String
""
  }

latestWithPref :: Package pkg => VersionRange -> [pkg] -> Maybe pkg
latestWithPref :: VersionRange -> [pkg] -> Maybe pkg
latestWithPref VersionRange
_    []   = Maybe pkg
forall a. Maybe a
Nothing
latestWithPref VersionRange
pref [pkg]
pkgs = pkg -> Maybe pkg
forall a. a -> Maybe a
Just ((pkg -> pkg -> Ordering) -> [pkg] -> pkg
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
maximumBy ((pkg -> (Bool, Version)) -> pkg -> pkg -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing pkg -> (Bool, Version)
forall pkg. Package pkg => pkg -> (Bool, Version)
prefThenVersion) [pkg]
pkgs)
  where
    prefThenVersion :: pkg -> (Bool, Version)
prefThenVersion pkg
pkg = let ver :: Version
ver = pkg -> Version
forall pkg. Package pkg => pkg -> Version
packageVersion pkg
pkg
                           in (Version -> VersionRange -> Bool
withinRange Version
ver VersionRange
pref, Version
ver)


-- | Rearrange installed and source packages into groups referring to the
-- same package by name. In the result pairs, the lists are guaranteed to not
-- both be empty.
--
mergePackages :: [Installed.InstalledPackageInfo]
              -> [UnresolvedSourcePackage]
              -> [( PackageName
                  , [Installed.InstalledPackageInfo]
                  , [UnresolvedSourcePackage] )]
mergePackages :: [InstalledPackageInfo]
-> [UnresolvedSourcePackage]
-> [(PackageName, [InstalledPackageInfo],
     [UnresolvedSourcePackage])]
mergePackages [InstalledPackageInfo]
installedPkgs [UnresolvedSourcePackage]
sourcePkgs =
    (MergeResult
   (PackageName, [InstalledPackageInfo])
   (PackageName, [UnresolvedSourcePackage])
 -> (PackageName, [InstalledPackageInfo],
     [UnresolvedSourcePackage]))
-> [MergeResult
      (PackageName, [InstalledPackageInfo])
      (PackageName, [UnresolvedSourcePackage])]
-> [(PackageName, [InstalledPackageInfo],
     [UnresolvedSourcePackage])]
forall a b. (a -> b) -> [a] -> [b]
map MergeResult
  (PackageName, [InstalledPackageInfo])
  (PackageName, [UnresolvedSourcePackage])
-> (PackageName, [InstalledPackageInfo], [UnresolvedSourcePackage])
forall a a a. MergeResult (a, [a]) (a, [a]) -> (a, [a], [a])
collect
  ([MergeResult
    (PackageName, [InstalledPackageInfo])
    (PackageName, [UnresolvedSourcePackage])]
 -> [(PackageName, [InstalledPackageInfo],
      [UnresolvedSourcePackage])])
-> [MergeResult
      (PackageName, [InstalledPackageInfo])
      (PackageName, [UnresolvedSourcePackage])]
-> [(PackageName, [InstalledPackageInfo],
     [UnresolvedSourcePackage])]
forall a b. (a -> b) -> a -> b
$ ((PackageName, [InstalledPackageInfo])
 -> (PackageName, [UnresolvedSourcePackage]) -> Ordering)
-> [(PackageName, [InstalledPackageInfo])]
-> [(PackageName, [UnresolvedSourcePackage])]
-> [MergeResult
      (PackageName, [InstalledPackageInfo])
      (PackageName, [UnresolvedSourcePackage])]
forall a b. (a -> b -> Ordering) -> [a] -> [b] -> [MergeResult a b]
mergeBy (\(PackageName, [InstalledPackageInfo])
i (PackageName, [UnresolvedSourcePackage])
a -> (PackageName, [InstalledPackageInfo]) -> PackageName
forall a b. (a, b) -> a
fst (PackageName, [InstalledPackageInfo])
i PackageName -> PackageName -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` (PackageName, [UnresolvedSourcePackage]) -> PackageName
forall a b. (a, b) -> a
fst (PackageName, [UnresolvedSourcePackage])
a)
            ((InstalledPackageInfo -> PackageName)
-> [InstalledPackageInfo]
-> [(PackageName, [InstalledPackageInfo])]
forall key a. Ord key => (a -> key) -> [a] -> [(key, [a])]
groupOn InstalledPackageInfo -> PackageName
forall pkg. Package pkg => pkg -> PackageName
packageName [InstalledPackageInfo]
installedPkgs)
            ((UnresolvedSourcePackage -> PackageName)
-> [UnresolvedSourcePackage]
-> [(PackageName, [UnresolvedSourcePackage])]
forall key a. Ord key => (a -> key) -> [a] -> [(key, [a])]
groupOn UnresolvedSourcePackage -> PackageName
forall pkg. Package pkg => pkg -> PackageName
packageName [UnresolvedSourcePackage]
sourcePkgs)
  where
    collect :: MergeResult (a, [a]) (a, [a]) -> (a, [a], [a])
collect (OnlyInLeft  (a
name,[a]
is)         ) = (a
name, [a]
is, [])
    collect (    InBoth  (a
_,[a]
is)   (a
name,[a]
as)) = (a
name, [a]
is, [a]
as)
    collect (OnlyInRight          (a
name,[a]
as)) = (a
name, [], [a]
as)

groupOn :: Ord key => (a -> key) -> [a] -> [(key,[a])]
groupOn :: (a -> key) -> [a] -> [(key, [a])]
groupOn a -> key
key = (NonEmpty a -> (key, [a])) -> [NonEmpty a] -> [(key, [a])]
forall a b. (a -> b) -> [a] -> [b]
map (\NonEmpty a
xs -> (a -> key
key (NonEmpty a -> a
forall a. NonEmpty a -> a
head NonEmpty a
xs), NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty a
xs))
            ([NonEmpty a] -> [(key, [a])])
-> ([a] -> [NonEmpty a]) -> [a] -> [(key, [a])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> a -> Bool) -> [a] -> [NonEmpty a]
forall (f :: * -> *) a.
Foldable f =>
(a -> a -> Bool) -> f a -> [NonEmpty a]
groupBy ((a -> key) -> a -> a -> Bool
forall a b. Eq a => (b -> a) -> b -> b -> Bool
equating a -> key
key)
            ([a] -> [NonEmpty a]) -> ([a] -> [a]) -> [a] -> [NonEmpty a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> a -> Ordering) -> [a] -> [a]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ((a -> key) -> a -> a -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing a -> key
key)

dispTopVersions :: Int -> VersionRange -> [Version] -> Doc
dispTopVersions :: Int -> VersionRange -> [Version] -> Doc
dispTopVersions Int
n VersionRange
pref [Version]
vs =
         ([Doc] -> Doc
Disp.fsep ([Doc] -> Doc) -> ([Version] -> [Doc]) -> [Version] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
Disp.punctuate (Char -> Doc
Disp.char Char
',')
        ([Doc] -> [Doc]) -> ([Version] -> [Doc]) -> [Version] -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Version -> Doc) -> [Version] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (\Version
ver -> if Version -> Bool
ispref Version
ver then Version -> Doc
forall a. Pretty a => a -> Doc
pretty Version
ver else Doc -> Doc
parens (Version -> Doc
forall a. Pretty a => a -> Doc
pretty Version
ver))
        ([Version] -> [Doc])
-> ([Version] -> [Version]) -> [Version] -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Version] -> [Version]
forall a. Ord a => [a] -> [a]
sort ([Version] -> [Version])
-> ([Version] -> [Version]) -> [Version] -> [Version]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Version] -> [Version]
forall a. Int -> [a] -> [a]
take Int
n ([Version] -> [Version])
-> ([Version] -> [Version]) -> [Version] -> [Version]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Version -> Bool) -> [Version] -> [Version]
interestingVersions Version -> Bool
ispref
        ([Version] -> Doc) -> [Version] -> Doc
forall a b. (a -> b) -> a -> b
$ [Version]
vs)
    Doc -> Doc -> Doc
<+> Doc
trailingMessage

  where
    ispref :: Version -> Bool
ispref Version
ver = Version -> VersionRange -> Bool
withinRange Version
ver VersionRange
pref
    extra :: Int
extra = [Version] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Version]
vs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n
    trailingMessage :: Doc
trailingMessage
      | Int
extra Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = Doc
Disp.empty
      | Bool
otherwise  = Doc -> Doc
Disp.parens (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
Disp.text String
"and"
                               Doc -> Doc -> Doc
<+> Int -> Doc
Disp.int ([Version] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Version]
vs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n)
                               Doc -> Doc -> Doc
<+> if Int
extra Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 then String -> Doc
Disp.text String
"other"
                                                 else String -> Doc
Disp.text String
"others"

-- | Reorder a bunch of versions to put the most interesting / significant
-- versions first. A preferred version range is taken into account.
--
-- This may be used in a user interface to select a small number of versions
-- to present to the user, e.g.
--
-- > let selectVersions = sort . take 5 . interestingVersions pref
--
interestingVersions :: (Version -> Bool) -> [Version] -> [Version]
interestingVersions :: (Version -> Bool) -> [Version] -> [Version]
interestingVersions Version -> Bool
pref =
      (([Int], Bool) -> Version) -> [([Int], Bool)] -> [Version]
forall a b. (a -> b) -> [a] -> [b]
map ([Int] -> Version
mkVersion ([Int] -> Version)
-> (([Int], Bool) -> [Int]) -> ([Int], Bool) -> Version
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Int], Bool) -> [Int]
forall a b. (a, b) -> a
fst) ([([Int], Bool)] -> [Version])
-> ([Version] -> [([Int], Bool)]) -> [Version] -> [Version]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([Int], Bool) -> Bool) -> [([Int], Bool)] -> [([Int], Bool)]
forall a. (a -> Bool) -> [a] -> [a]
filter ([Int], Bool) -> Bool
forall a b. (a, b) -> b
snd
    ([([Int], Bool)] -> [([Int], Bool)])
-> ([Version] -> [([Int], Bool)]) -> [Version] -> [([Int], Bool)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[([Int], Bool)]] -> [([Int], Bool)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat  ([[([Int], Bool)]] -> [([Int], Bool)])
-> ([Version] -> [[([Int], Bool)]]) -> [Version] -> [([Int], Bool)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree ([Int], Bool) -> [[([Int], Bool)]]
forall a. Tree a -> [[a]]
Tree.levels
    (Tree ([Int], Bool) -> [[([Int], Bool)]])
-> ([Version] -> Tree ([Int], Bool))
-> [Version]
-> [[([Int], Bool)]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree ([Int], Bool) -> Tree ([Int], Bool)
forall a. Tree a -> Tree a
swizzleTree
    (Tree ([Int], Bool) -> Tree ([Int], Bool))
-> ([Version] -> Tree ([Int], Bool))
-> [Version]
-> Tree ([Int], Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Tree ([Int], Bool) -> Bool)
-> Tree ([Int], Bool) -> Tree ([Int], Bool)
forall a. (Tree a -> Bool) -> Tree a -> Tree a
reorderTree (\(Node ([Int]
v,Bool
_) Forest ([Int], Bool)
_) -> Version -> Bool
pref ([Int] -> Version
mkVersion [Int]
v))
    (Tree ([Int], Bool) -> Tree ([Int], Bool))
-> ([Version] -> Tree ([Int], Bool))
-> [Version]
-> Tree ([Int], Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree ([Int], Bool) -> Tree ([Int], Bool)
forall a. Tree a -> Tree a
reverseTree
    (Tree ([Int], Bool) -> Tree ([Int], Bool))
-> ([Version] -> Tree ([Int], Bool))
-> [Version]
-> Tree ([Int], Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [NonEmpty Int] -> Tree ([Int], Bool)
forall a. Eq a => [NonEmpty a] -> Tree ([a], Bool)
mkTree
    ([NonEmpty Int] -> Tree ([Int], Bool))
-> ([Version] -> [NonEmpty Int]) -> [Version] -> Tree ([Int], Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Version -> NonEmpty Int) -> [Version] -> [NonEmpty Int]
forall a b. (a -> b) -> [a] -> [b]
map ([Int] -> NonEmpty Int
forall a. Num a => [a] -> NonEmpty a
or0 ([Int] -> NonEmpty Int)
-> (Version -> [Int]) -> Version -> NonEmpty Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> [Int]
versionNumbers)

  where
    or0 :: [a] -> NonEmpty a
or0 []     = a
0 a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:| []
    or0 (a
x:[a]
xs) = a
x a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:| [a]
xs

    swizzleTree :: Tree a -> Tree a
swizzleTree = (Tree a -> (a, [Tree a])) -> Tree a -> Tree a
forall b a. (b -> (a, [b])) -> b -> Tree a
unfoldTree ([Tree a] -> Tree a -> (a, [Tree a])
forall a. [Tree a] -> Tree a -> (a, [Tree a])
spine [])
      where
        spine :: [Tree a] -> Tree a -> (a, [Tree a])
spine [Tree a]
ts' (Node a
x [])     = (a
x, [Tree a]
ts')
        spine [Tree a]
ts' (Node a
x (Tree a
t:[Tree a]
ts)) = [Tree a] -> Tree a -> (a, [Tree a])
spine (a -> [Tree a] -> Tree a
forall a. a -> Forest a -> Tree a
Node a
x [Tree a]
tsTree a -> [Tree a] -> [Tree a]
forall a. a -> [a] -> [a]
:[Tree a]
ts') Tree a
t

    reorderTree :: (Tree a -> Bool) -> Tree a -> Tree a
reorderTree Tree a -> Bool
_ (Node a
x []) = a -> [Tree a] -> Tree a
forall a. a -> Forest a -> Tree a
Node a
x []
    reorderTree Tree a -> Bool
p (Node a
x [Tree a]
ts) = a -> [Tree a] -> Tree a
forall a. a -> Forest a -> Tree a
Node a
x ([Tree a]
ts' [Tree a] -> [Tree a] -> [Tree a]
forall a. [a] -> [a] -> [a]
++ [Tree a]
ts'')
      where
        ([Tree a]
ts',[Tree a]
ts'') = (Tree a -> Bool) -> [Tree a] -> ([Tree a], [Tree a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition Tree a -> Bool
p ((Tree a -> Tree a) -> [Tree a] -> [Tree a]
forall a b. (a -> b) -> [a] -> [b]
map ((Tree a -> Bool) -> Tree a -> Tree a
reorderTree Tree a -> Bool
p) [Tree a]
ts)

    reverseTree :: Tree a -> Tree a
reverseTree (Node a
x Forest a
cs) = a -> Forest a -> Tree a
forall a. a -> Forest a -> Tree a
Node a
x (Forest a -> Forest a
forall a. [a] -> [a]
reverse ((Tree a -> Tree a) -> Forest a -> Forest a
forall a b. (a -> b) -> [a] -> [b]
map Tree a -> Tree a
reverseTree Forest a
cs))

    mkTree :: forall a. Eq a => [NonEmpty a] -> Tree ([a], Bool)
    mkTree :: [NonEmpty a] -> Tree ([a], Bool)
mkTree [NonEmpty a]
xs = ((Bool, [a], [NonEmpty a])
 -> (([a], Bool), [(Bool, [a], [NonEmpty a])]))
-> (Bool, [a], [NonEmpty a]) -> Tree ([a], Bool)
forall b a. (b -> (a, [b])) -> b -> Tree a
unfoldTree (Bool, [a], [NonEmpty a])
-> (([a], Bool), [(Bool, [a], [NonEmpty a])])
step (Bool
False, [], [NonEmpty a]
xs)
      where
        step :: (Bool, [a], [NonEmpty a]) -> (([a], Bool), [(Bool, [a], [NonEmpty a])])
        step :: (Bool, [a], [NonEmpty a])
-> (([a], Bool), [(Bool, [a], [NonEmpty a])])
step (Bool
node,[a]
ns,[NonEmpty a]
vs) =
          ( ([a] -> [a]
forall a. [a] -> [a]
reverse [a]
ns, Bool
node)
          , [ (([a] -> Bool) -> NonEmpty [a] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null NonEmpty [a]
vs', a
na -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
ns, ([a] -> Maybe (NonEmpty a)) -> [[a]] -> [NonEmpty a]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe [a] -> Maybe (NonEmpty a)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty (NonEmpty [a] -> [[a]]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty [a]
vs'))
            | (a
n, NonEmpty [a]
vs') <- [NonEmpty a] -> [(a, NonEmpty [a])]
groups [NonEmpty a]
vs
            ]
          )

        groups :: [NonEmpty a] -> [(a, NonEmpty [a])]
        groups :: [NonEmpty a] -> [(a, NonEmpty [a])]
groups = (NonEmpty (NonEmpty a) -> (a, NonEmpty [a]))
-> [NonEmpty (NonEmpty a)] -> [(a, NonEmpty [a])]
forall a b. (a -> b) -> [a] -> [b]
map (\NonEmpty (NonEmpty a)
g -> (NonEmpty a -> a
forall a. NonEmpty a -> a
head (NonEmpty (NonEmpty a) -> NonEmpty a
forall a. NonEmpty a -> a
head NonEmpty (NonEmpty a)
g), (NonEmpty a -> [a]) -> NonEmpty (NonEmpty a) -> NonEmpty [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NonEmpty a -> [a]
forall a. NonEmpty a -> [a]
tail NonEmpty (NonEmpty a)
g))
               ([NonEmpty (NonEmpty a)] -> [(a, NonEmpty [a])])
-> ([NonEmpty a] -> [NonEmpty (NonEmpty a)])
-> [NonEmpty a]
-> [(a, NonEmpty [a])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NonEmpty a -> NonEmpty a -> Bool)
-> [NonEmpty a] -> [NonEmpty (NonEmpty a)]
forall (f :: * -> *) a.
Foldable f =>
(a -> a -> Bool) -> f a -> [NonEmpty a]
groupBy ((NonEmpty a -> a) -> NonEmpty a -> NonEmpty a -> Bool
forall a b. Eq a => (b -> a) -> b -> b -> Bool
equating NonEmpty a -> a
forall a. NonEmpty a -> a
head)