{-# 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 Distribution.Client.Compat.Prelude
import Prelude ()

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

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

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.FetchUtils
  ( isFetched
  )
import Distribution.Client.IndexUtils as IndexUtils
  ( getInstalledPackages
  , getSourcePackages
  )
import Distribution.Client.Setup
  ( GlobalFlags (..)
  , InfoFlags (..)
  , ListFlags (..)
  , RepoContext (..)
  )
import Distribution.Client.Targets
  ( UserTarget
  , resolveUserTargets
  )
import Distribution.Client.Types
  ( PackageSpecifier (..)
  , SourcePackageDb (..)
  , UnresolvedSourcePackage
  )
import Distribution.Client.Utils
  ( MergeResult (..)
  , mergeBy
  )

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

import Distribution.Client.Errors
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
  -> PackageDBStackCWD
  -> RepoContext
  -> Maybe (Compiler, ProgramDb)
  -> ListFlags
  -> [String]
  -> IO [PackageDisplayInfo]
getPkgList :: Verbosity
-> PackageDBStackCWD
-> RepoContext
-> Maybe (Compiler, ProgramDb)
-> ListFlags
-> [String]
-> IO [PackageDisplayInfo]
getPkgList Verbosity
verbosity PackageDBStackCWD
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
-> PackageDBStackCWD
-> ProgramDb
-> IO InstalledPackageIndex
getInstalledPackages Verbosity
verbosity Compiler
comp PackageDBStackCWD
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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Regex
r
      Left WrapError
err -> Verbosity -> CabalInstallException -> IO Regex
forall a1 a.
(?callStack::CallStack, Show a1, Typeable a1,
 Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity (CabalInstallException -> IO Regex)
-> CabalInstallException -> IO Regex
forall a b. (a -> b) -> a -> b
$ String -> WrapError -> CabalInstallException
GetPkgList String
pat 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 a. [a] -> 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 a. [a] -> 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 a. a -> IO a
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
  -> PackageDBStackCWD
  -> RepoContext
  -> Maybe (Compiler, ProgramDb)
  -> ListFlags
  -> [String]
  -> IO ()
list :: Verbosity
-> PackageDBStackCWD
-> RepoContext
-> Maybe (Compiler, ProgramDb)
-> ListFlags
-> [String]
-> IO ()
list Verbosity
verbosity PackageDBStackCWD
packageDBs RepoContext
repos Maybe (Compiler, ProgramDb)
mcompProgdb ListFlags
listFlags [String]
pats = do
  [PackageDisplayInfo]
matches <- Verbosity
-> PackageDBStackCWD
-> RepoContext
-> Maybe (Compiler, ProgramDb)
-> ListFlags
-> [String]
-> IO [PackageDisplayInfo]
getPkgList Verbosity
verbosity PackageDBStackCWD
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
          ]
    else -- Note: this only works because for 'list', one cannot currently
    -- specify any version constraints, so listing all installed
    -- and source ones works.

      if [PackageDisplayInfo] -> Bool
forall a. [a] -> 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
  -> PackageDBStackCWD
  -> RepoContext
  -> Compiler
  -> ProgramDb
  -> GlobalFlags
  -> InfoFlags
  -> [UserTarget]
  -> IO ()
info :: Verbosity
-> PackageDBStackCWD
-> RepoContext
-> Compiler
-> ProgramDb
-> GlobalFlags
-> InfoFlags
-> [UserTarget]
-> IO ()
info Verbosity
verbosity PackageDBStackCWD
_ RepoContext
_ Compiler
_ ProgramDb
_ GlobalFlags
_ InfoFlags
_ [] =
  Verbosity -> String -> IO ()
notice Verbosity
verbosity String
"No packages requested. Nothing to do."
info
  Verbosity
verbosity
  PackageDBStackCWD
packageDBs
  RepoContext
repoCtxt
  Compiler
comp
  ProgramDb
progdb
  GlobalFlags
_
  InfoFlags
_listFlags
  [UserTarget]
userTargets = do
    InstalledPackageIndex
installedPkgIndex <- Verbosity
-> Compiler
-> PackageDBStackCWD
-> ProgramDb
-> IO InstalledPackageIndex
getInstalledPackages Verbosity
verbosity Compiler
comp PackageDBStackCWD
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)
forall (f :: * -> *) a. Applicative f => [f a] -> f [a]
sequenceA
        [ do
          PackageDisplayInfo
pkginfo <-
            (CabalInstallException -> IO PackageDisplayInfo)
-> (PackageDisplayInfo -> IO PackageDisplayInfo)
-> Either CabalInstallException PackageDisplayInfo
-> IO PackageDisplayInfo
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Verbosity -> CabalInstallException -> IO PackageDisplayInfo
forall a1 a.
(?callStack::CallStack, Show a1, Typeable a1,
 Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity) PackageDisplayInfo -> IO PackageDisplayInfo
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either CabalInstallException PackageDisplayInfo
 -> IO PackageDisplayInfo)
-> Either CabalInstallException PackageDisplayInfo
-> IO PackageDisplayInfo
forall a b. (a -> b) -> a -> b
$
              (PackageName -> VersionRange)
-> InstalledPackageIndex
-> PackageIndex UnresolvedSourcePackage
-> PackageSpecifier UnresolvedSourcePackage
-> Either CabalInstallException 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 CabalInstallException PackageDisplayInfo
      gatherPkgInfo :: (PackageName -> VersionRange)
-> InstalledPackageIndex
-> PackageIndex UnresolvedSourcePackage
-> PackageSpecifier UnresolvedSourcePackage
-> Either CabalInstallException PackageDisplayInfo
gatherPkgInfo
        PackageName -> VersionRange
prefs
        InstalledPackageIndex
installedPkgIndex
        PackageIndex UnresolvedSourcePackage
sourcePkgIndex
        (NamedPackage PackageName
name [PackageProperty]
props)
          | [(Version, [InstalledPackageInfo])] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([(Version, [InstalledPackageInfo])]
selectedInstalledPkgs) Bool -> Bool -> Bool
&& [UnresolvedSourcePackage] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([UnresolvedSourcePackage]
selectedSourcePkgs) =
              CabalInstallException
-> Either CabalInstallException PackageDisplayInfo
forall a b. a -> Either a b
Left (CabalInstallException
 -> Either CabalInstallException PackageDisplayInfo)
-> CabalInstallException
-> Either CabalInstallException PackageDisplayInfo
forall a b. (a -> b) -> a -> b
$ PackageName -> VersionRange -> CabalInstallException
GatherPkgInfo PackageName
name (VersionRange -> VersionRange
simplifyVersionRange VersionRange
verConstraint)
          | Bool
otherwise =
              PackageDisplayInfo
-> Either CabalInstallException PackageDisplayInfo
forall a b. b -> Either a b
Right (PackageDisplayInfo
 -> Either CabalInstallException PackageDisplayInfo)
-> PackageDisplayInfo
-> Either CabalInstallException 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 a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [VersionRange]
verConstraints)
            verConstraint :: VersionRange
verConstraint = (VersionRange -> VersionRange -> VersionRange)
-> VersionRange -> [VersionRange] -> VersionRange
forall a b. (a -> b -> b) -> b -> [a] -> b
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 CabalInstallException PackageDisplayInfo
forall a b. b -> Either a b
Right (PackageDisplayInfo
 -> Either CabalInstallException PackageDisplayInfo)
-> PackageDisplayInfo
-> Either CabalInstallException 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 = 80, ribbonsPerLine = 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
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 = 80, ribbonsPerLine = 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 a. [a] -> 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
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 a. [a] -> 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 a. [a] -> 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 a. [a] -> 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 a. 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 a. 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 a. [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 a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (PackageDisplayInfo -> [Version]
installedVersions PackageDisplayInfo
pkginfo))
    hasExes :: Bool
hasExes = [UnqualComponentName] -> Int
forall a. [a] -> 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 a. [a] -> 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 a. [a] -> 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
      { 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 a b. (a -> b) -> Maybe a -> Maybe b
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 a b. (a -> b) -> Maybe a -> Maybe b
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 a. [a] -> 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 a b. (a -> b) -> Maybe a -> Maybe b
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 a b. (a -> b) -> Maybe a -> Maybe b
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 a. 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 a b. (a -> b) -> Maybe a -> Maybe b
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 a b. (a -> b) -> Maybe a -> Maybe b
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 a b. (a -> b) -> Maybe a -> Maybe b
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 :: forall b a. 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 a. a -> IO a
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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return
    PackageDisplayInfo
pkginfo
      { haveTarball = fetched
      , haddockHtml = if docsExist then haddockHtml pkginfo else ""
      }

latestWithPref :: Package pkg => VersionRange -> [pkg] -> Maybe pkg
latestWithPref :: forall pkg. Package pkg => 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 {p}. Package p => p -> (Bool, Version)
prefThenVersion) [pkg]
pkgs)
  where
    prefThenVersion :: p -> (Bool, Version)
prefThenVersion p
pkg =
      let ver :: Version
ver = p -> Version
forall pkg. Package pkg => pkg -> Version
packageVersion p
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 :: forall key a. Ord key => (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 a. 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 a. [a] -> 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 a. [a] -> 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
_) [Tree ([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 -> [Tree a] -> Tree a
Node a
x [Tree a]
ts Tree 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 -> [Tree 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 -> [Tree 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 [Tree a]
cs) = a -> [Tree a] -> Tree a
forall a. a -> [Tree a] -> Tree a
Node a
x ([Tree a] -> [Tree a]
forall a. [a] -> [a]
reverse ((Tree a -> Tree a) -> [Tree a] -> [Tree a]
forall a b. (a -> b) -> [a] -> [b]
map Tree a -> Tree a
reverseTree [Tree a]
cs))

    mkTree :: forall a. Eq a => [NonEmpty a] -> Tree ([a], Bool)
    mkTree :: forall a. Eq a => [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 a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null NonEmpty [a]
vs', a
n a -> [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 a. 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 a b. (a -> b) -> NonEmpty a -> NonEmpty b
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)