{-# 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 <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for Maybe (Compiler, ProgramDb)
mcompprogdb 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 <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [String]
pats 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  -> forall (m :: * -> *) a. Monad m => a -> m a
return Regex
r
            Left WrapError
err -> forall a. Verbosity -> String -> IO a
die' Verbosity
verbosity forall a b. (a -> b) -> a -> b
$ String
"Failed to compile regex " forall a. [a] -> [a] -> [a]
++ String
pat forall a. [a] -> [a] -> [a]
++ String
": " forall a. [a] -> [a] -> [a]
++ 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 = forall a. a -> Maybe a -> a
fromMaybe VersionRange
anyVersion
                       (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 = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (forall {regex} {source} {t} {a}.
RegexLike regex source =>
(t -> (source -> Bool) -> [a]) -> [regex] -> t -> [a]
matchingPackages forall a. PackageIndex a -> (String -> Bool) -> [a]
InstalledPackageIndex.searchWithPredicate [Regex]
regexps) Maybe InstalledPackageIndex
installedPkgIndex
              matchingSource :: [UnresolvedSourcePackage]
matchingSource    = forall {regex} {source} {t} {a}.
RegexLike regex source =>
(t -> (source -> Bool) -> [a]) -> [regex] -> t -> [a]
matchingPackages (\ PackageIndex UnresolvedSourcePackage
idx String -> Bool
n -> forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a b. (a, b) -> b
snd (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
          | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Regex]
regexps = [InstalledPackageInfo]
-> [UnresolvedSourcePackage]
-> [(PackageName, [InstalledPackageInfo],
     [UnresolvedSourcePackage])]
mergePackages
                           (forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] forall a. PackageIndex a -> [a]
InstalledPackageIndex.allPackages Maybe InstalledPackageIndex
installedPkgIndex)
                           (         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 (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [InstalledPackageInfo]
installedPkgs)
                  , let pref :: VersionRange
pref        = PackageName -> VersionRange
prefs PackageName
pkgname
                        selectedPkg :: Maybe UnresolvedSourcePackage
selectedPkg = forall pkg. Package pkg => VersionRange -> [pkg] -> Maybe pkg
latestWithPref VersionRange
pref [UnresolvedSourcePackage]
sourcePkgs ]
    forall (m :: * -> *) a. Monad m => a -> m a
return [PackageDisplayInfo]
matches
  where
    onlyInstalled :: Bool
onlyInstalled   = forall a. a -> Flag a -> a
fromFlagOrDefault Bool
False (ListFlags -> Flag Bool
listInstalled ListFlags
listFlags)
    caseInsensitive :: Bool
caseInsensitive = forall a. a -> Flag a -> a
fromFlagOrDefault Bool
True (ListFlags -> Flag Bool
listCaseInsensitive ListFlags
listFlags)

    compOption :: CompOption
compOption | Bool
caseInsensitive = CompOption
Regex.compExtended 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 (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 forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines
             [ forall a. Pretty a => a -> String
prettyShow (PackageDisplayInfo -> PackageName
pkgName PackageDisplayInfo
pkg) forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ 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 forall a. Eq a => [a] -> [a]
nub forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => [a] -> [a]
sort forall a b. (a -> b) -> a -> b
$ PackageDisplayInfo -> [Version]
installedVersions PackageDisplayInfo
pkg
                                           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 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 forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines (forall a b. (a -> b) -> [a] -> [b]
map PackageDisplayInfo -> String
showPackageSummaryInfo [PackageDisplayInfo]
matches)
  where
    onlyInstalled :: Bool
onlyInstalled = forall a. WithCallStack (Flag a -> a)
fromFlag (ListFlags -> Flag Bool
listInstalled ListFlags
listFlags)
    simpleOutput :: Bool
simpleOutput  = 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 = forall a. a -> Maybe a -> a
fromMaybe VersionRange
anyVersion
                       (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' = forall pkg. Package pkg => [pkg] -> PackageIndex pkg
PackageIndex.fromList
                    forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall pkg. Package pkg => pkg -> PackageIdentifier
packageId
                      (forall a. PackageIndex a -> [a]
InstalledPackageIndex.allPackages InstalledPackageIndex
installedPkgIndex)
                   forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map forall pkg. Package pkg => pkg -> PackageIdentifier
packageId
                      (forall pkg. PackageIndex pkg -> [pkg]
PackageIndex.allPackages PackageIndex UnresolvedSourcePackage
sourcePkgIndex)
    [PackageSpecifier UnresolvedSourcePackage]
pkgSpecifiers <- forall pkg.
Package pkg =>
Verbosity
-> RepoContext
-> PackageIndex pkg
-> [UserTarget]
-> IO [PackageSpecifier UnresolvedSourcePackage]
resolveUserTargets Verbosity
verbosity RepoContext
repoCtxt
                       PackageIndex PackageIdentifier
sourcePkgs' [UserTarget]
userTargets

    [PackageDisplayInfo]
pkgsinfo      <- forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA
                       [ do PackageDisplayInfo
pkginfo <- forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a. Verbosity -> String -> IO a
die' Verbosity
verbosity) forall (m :: * -> *) a. Monad m => a -> m a
return 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 forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines (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)
      | forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([(Version, [InstalledPackageInfo])]
selectedInstalledPkgs) Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([UnresolvedSourcePackage]
selectedSourcePkgs)
      = forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String
"There is no available version of " forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> String
prettyShow PackageName
name
            forall a. [a] -> [a] -> [a]
++ String
" that satisfies "
            forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> String
prettyShow (VersionRange -> VersionRange
simplifyVersionRange VersionRange
verConstraint)

      | Bool
otherwise
      = forall a b. b -> Either a b
Right 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    = forall pkg.
Package pkg =>
PackageIndex pkg -> PackageName -> VersionRange -> [pkg]
PackageIndex.lookupDependency PackageIndex UnresolvedSourcePackage
sourcePkgIndex
                                PackageName
name VersionRange
verConstraint
        selectedSourcePkg' :: Maybe UnresolvedSourcePackage
selectedSourcePkg'    = 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 (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [VersionRange]
verConstraints)
        verConstraint :: VersionRange
verConstraint  = 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) =
        forall a b. b -> Either a b
Right 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          = forall pkg. Package pkg => pkg -> PackageName
packageName UnresolvedSourcePackage
pkg
        selectedPkg :: Maybe UnresolvedSourcePackage
selectedPkg   = 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 = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a b. (a, b) -> b
snd (forall a. PackageIndex a -> PackageName -> [(Version, [a])]
InstalledPackageIndex.lookupPackageName
                                   InstalledPackageIndex
installedPkgIndex PackageName
name)
    sourcePkgs :: [UnresolvedSourcePackage]
sourcePkgs    = 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}) forall a b. (a -> b) -> a -> b
$
     Char -> Doc
char Char
'*' Doc -> Doc -> Doc
<+> forall a. Pretty a => a -> Doc
pretty (PackageDisplayInfo -> PackageName
pkgName PackageDisplayInfo
pkginfo)
     Doc -> Doc -> Doc
$+$
     (Int -> Doc -> Doc
nest Int
4 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 -> forall a. Pretty a => a -> Doc
pretty (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
<+> forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a. Pretty a => a -> Doc
pretty 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}) forall a b. (a -> b) -> a -> b
$
   Char -> Doc
char Char
'*' Doc -> Doc -> Doc
<+> forall a. Pretty a => a -> Doc
pretty (PackageDisplayInfo -> PackageName
pkgName PackageDisplayInfo
pkginfo)
            Doc -> Doc -> Doc
<<>> forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc
Disp.empty (\Version
v -> Char -> Doc
char Char
'-' Doc -> Doc -> Doc
Disp.<> forall a. Pretty a => a -> Doc
pretty Version
v) (PackageDisplayInfo -> Maybe Version
selectedVersion PackageDisplayInfo
pkginfo)
            Doc -> Doc -> Doc
<+> String -> Doc
text (forall a. Int -> a -> [a]
replicate (Int
16 forall a. Num a => a -> a -> a
- forall (t :: * -> *) a. Foldable t => t a -> Int
length (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 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     forall {t :: * -> *} {a} {a}. Foldable t => t a -> Maybe (Maybe a)
hideIfNull  String -> Doc
reflowParagraphs
   , forall {t}.
String
-> (PackageDisplayInfo -> t)
-> (t -> Maybe (Maybe String))
-> (t -> Doc)
-> Doc
entry String
"Versions available" PackageDisplayInfo -> [Version]
sourceVersions
           (forall {t} {a}. (t -> Bool) -> a -> t -> Maybe (Maybe a)
altText 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))
   , forall {t}.
String
-> (PackageDisplayInfo -> t)
-> (t -> Maybe (Maybe String))
-> (t -> Doc)
-> Doc
entry String
"Versions installed" PackageDisplayInfo -> [Version]
installedVersions
           (forall {t} {a}. (t -> Bool) -> a -> t -> Maybe (Maybe a)
altText 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     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   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  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     forall {t :: * -> *} {a} {a}. Foldable t => t a -> Maybe (Maybe a)
hideIfNull     String -> Doc
text
   , forall {t}.
String
-> (PackageDisplayInfo -> t)
-> (t -> Maybe (Maybe String))
-> (t -> Doc)
-> Doc
entry String
"License"       PackageDisplayInfo -> Either License License
license      forall {b} {a}. b -> Maybe a
alwaysShow     (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a. Pretty a => a -> Doc
pretty forall a. Pretty a => a -> Doc
pretty)
   , String
-> (PackageDisplayInfo -> ShortText)
-> (String -> Maybe (Maybe String))
-> (String -> Doc)
-> Doc
entryST String
"Author"        PackageDisplayInfo -> ShortText
author       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   forall {t :: * -> *} {a} {a}. Foldable t => t a -> Maybe (Maybe a)
hideIfNull     String -> Doc
reflowLines
   , forall {t}.
String
-> (PackageDisplayInfo -> t)
-> (t -> Maybe (Maybe String))
-> (t -> Doc)
-> Doc
entry String
"Source repo"   PackageDisplayInfo -> String
sourceRepo   forall {a}. [a] -> Maybe (Maybe String)
orNotSpecified String -> Doc
text
   , forall {t}.
String
-> (PackageDisplayInfo -> t)
-> (t -> Maybe (Maybe String))
-> (t -> Doc)
-> Doc
entry String
"Executables"   PackageDisplayInfo -> [UnqualComponentName]
executables  forall {t :: * -> *} {a} {a}. Foldable t => t a -> Maybe (Maybe a)
hideIfNull     (forall {a}. (a -> Doc) -> [a] -> Doc
commaSep forall a. Pretty a => a -> Doc
pretty)
   , forall {t}.
String
-> (PackageDisplayInfo -> t)
-> (t -> Maybe (Maybe String))
-> (t -> Doc)
-> Doc
entry String
"Flags"         PackageDisplayInfo -> [PackageFlag]
flags        forall {t :: * -> *} {a} {a}. Foldable t => t a -> Maybe (Maybe a)
hideIfNull     (forall {a}. (a -> Doc) -> [a] -> Doc
commaSep PackageFlag -> Doc
dispFlag)
   , forall {t}.
String
-> (PackageDisplayInfo -> t)
-> (t -> Maybe (Maybe String))
-> (t -> Doc)
-> Doc
entry String
"Dependencies"  PackageDisplayInfo -> [ExtDependency]
dependencies forall {t :: * -> *} {a} {a}. Foldable t => t a -> Maybe (Maybe a)
hideIfNull     (forall {a}. (a -> Doc) -> [a] -> Doc
commaSep ExtDependency -> Doc
dispExtDep)
   , forall {t}.
String
-> (PackageDisplayInfo -> t)
-> (t -> Maybe (Maybe String))
-> (t -> Doc)
-> Doc
entry String
"Documentation" PackageDisplayInfo -> String
haddockHtml  forall {t :: * -> *} {a}. Foldable t => t a -> Maybe (Maybe String)
showIfInstalled String -> Doc
text
   , forall {t}.
String
-> (PackageDisplayInfo -> t)
-> (t -> Maybe (Maybe String))
-> (t -> Doc)
-> Doc
entry String
"Cached"        PackageDisplayInfo -> Bool
haveTarball  forall {b} {a}. b -> Maybe a
alwaysShow     Bool -> Doc
dispYesNo
   , if Bool -> Bool
not (PackageDisplayInfo -> Bool
hasLib PackageDisplayInfo
pkginfo) then forall a. Monoid a => a
mempty else
     String -> Doc
text String
"Modules:" Doc -> Doc -> Doc
$+$ Int -> Doc -> Doc
nest Int
4 ([Doc] -> Doc
vcat (forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pretty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => [a] -> [a]
sort forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageDisplayInfo -> [ModuleName]
modules 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      -> 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 (forall a. Int -> a -> [a]
replicate (Int
13 forall a. Num a => a -> a -> a
- 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 = forall {t}.
String
-> (PackageDisplayInfo -> t)
-> (t -> Maybe (Maybe String))
-> (t -> Doc)
-> Doc
entry String
fname (ShortText -> String
ShortText.fromShortText forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageDisplayInfo -> ShortText
field)

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

    alwaysShow :: b -> Maybe a
alwaysShow = forall a b. a -> b -> a
const forall a. Maybe a
normal
    hideIfNull :: t a -> Maybe (Maybe a)
hideIfNull t a
v = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null t a
v then forall {a}. Maybe (Maybe a)
hide else forall a. Maybe a
normal
    showIfInstalled :: t a -> Maybe (Maybe String)
showIfInstalled t a
v
      | Bool -> Bool
not Bool
isInstalled = forall {a}. Maybe (Maybe a)
hide
      | forall (t :: * -> *) a. Foldable t => t a -> Bool
null t a
v          = forall {a}. a -> Maybe (Maybe a)
replace String
"[ Not installed ]"
      | Bool
otherwise       = 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 forall {a}. a -> Maybe (Maybe a)
replace a
msg else forall a. Maybe a
normal
    orNotSpecified :: [a] -> Maybe (Maybe String)
orNotSpecified = forall {t} {a}. (t -> Bool) -> a -> t -> Maybe (Maybe a)
altText 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
Disp.punctuate (Char -> Doc
Disp.char Char
',') forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map a -> Doc
f
    dispFlag :: PackageFlag -> Doc
dispFlag = String -> Doc
text forall b c a. (b -> c) -> (a -> b) -> a -> c
. FlagName -> String
unFlagName 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) = forall a. Pretty a => a -> Doc
pretty Dependency
dep
    dispExtDep (InstalledDependency UnitId
dep) = forall a. Pretty a => a -> Doc
pretty UnitId
dep

    isInstalled :: Bool
isInstalled = Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null (PackageDisplayInfo -> [Version]
installedVersions PackageDisplayInfo
pkginfo))
    hasExes :: Bool
hasExes = forall (t :: * -> *) a. Foldable t => t a -> Int
length (PackageDisplayInfo -> [UnqualComponentName]
executables PackageDisplayInfo
pkginfo) 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                        = forall a. Monoid a => a
mempty


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

reflowLines :: String -> Doc
reflowLines :: String -> Doc
reflowLines = [Doc] -> Doc
vcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map String -> Doc
text 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 =
  forall a. (?callStack::CallStack) => Bool -> a -> a
assert (forall (t :: * -> *) a. Foldable t => t a -> Int
length [InstalledPackageInfo]
installedPkgs forall a. Num a => a -> a -> a
+ forall (t :: * -> *) a. Foldable t => t a -> Int
length [UnresolvedSourcePackage]
sourcePkgs forall a. Ord a => a -> a -> Bool
> Int
0) forall a b. (a -> b) -> a -> b
$
  PackageDisplayInfo {
    pkgName :: PackageName
pkgName           = forall {a} {a} {a}. (a -> a) -> Maybe a -> (a -> a) -> Maybe a -> a
combine forall pkg. Package pkg => pkg -> PackageName
packageName Maybe PackageDescription
source
                                forall pkg. Package pkg => pkg -> PackageName
packageName Maybe InstalledPackageInfo
installed,
    selectedVersion :: Maybe Version
selectedVersion   = if Bool
showVer then forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall pkg. Package pkg => pkg -> Version
packageVersion Maybe UnresolvedSourcePackage
selectedPkg
                                   else forall a. Maybe a
Nothing,
    selectedSourcePkg :: Maybe UnresolvedSourcePackage
selectedSourcePkg = Maybe UnresolvedSourcePackage
sourceSelected,
    installedVersions :: [Version]
installedVersions = forall a b. (a -> b) -> [a] -> [b]
map forall pkg. Package pkg => pkg -> Version
packageVersion [InstalledPackageInfo]
installedPkgs,
    sourceVersions :: [Version]
sourceVersions    = forall a b. (a -> b) -> [a] -> [b]
map forall pkg. Package pkg => pkg -> Version
packageVersion [UnresolvedSourcePackage]
sourcePkgs,
    preferredVersions :: VersionRange
preferredVersions = VersionRange
versionPref,

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

    sourceSelected :: Maybe UnresolvedSourcePackage
sourceSelected
      | forall a. Maybe a -> Bool
isJust Maybe UnresolvedSourcePackage
selectedPkg = Maybe UnresolvedSourcePackage
selectedPkg
      | Bool
otherwise          = forall pkg. Package pkg => VersionRange -> [pkg] -> Maybe pkg
latestWithPref VersionRange
versionPref [UnresolvedSourcePackage]
sourcePkgs
    sourceGeneric :: Maybe GenericPackageDescription
sourceGeneric = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall loc. SourcePackage loc -> GenericPackageDescription
srcpkgDescription Maybe UnresolvedSourcePackage
sourceSelected
    source :: Maybe PackageDescription
source        = 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   <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False) (UnresolvedPkgLoc -> IO Bool
isFetched forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall loc. SourcePackage loc -> loc
srcpkgSource)
                     (PackageDisplayInfo -> Maybe UnresolvedSourcePackage
selectedSourcePkg PackageDisplayInfo
pkginfo)
  Bool
docsExist <- String -> IO Bool
doesDirectoryExist (PackageDisplayInfo -> String
haddockHtml PackageDisplayInfo
pkginfo)
  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 :: forall pkg. Package pkg => VersionRange -> [pkg] -> Maybe pkg
latestWithPref VersionRange
_    []   = forall a. Maybe a
Nothing
latestWithPref VersionRange
pref [pkg]
pkgs = forall a. a -> Maybe a
Just (forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
maximumBy (forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing forall {p}. Package p => p -> (Bool, Version)
prefThenVersion) [pkg]
pkgs)
  where
    prefThenVersion :: p -> (Bool, Version)
prefThenVersion p
pkg = let ver :: Version
ver = 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 =
    forall a b. (a -> b) -> [a] -> [b]
map forall {a} {a} {a}. MergeResult (a, [a]) (a, [a]) -> (a, [a], [a])
collect
  forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b -> Ordering) -> [a] -> [b] -> [MergeResult a b]
mergeBy (\(PackageName, [InstalledPackageInfo])
i (PackageName, [UnresolvedSourcePackage])
a -> forall a b. (a, b) -> a
fst (PackageName, [InstalledPackageInfo])
i forall a. Ord a => a -> a -> Ordering
`compare` forall a b. (a, b) -> a
fst (PackageName, [UnresolvedSourcePackage])
a)
            (forall key a. Ord key => (a -> key) -> [a] -> [(key, [a])]
groupOn forall pkg. Package pkg => pkg -> PackageName
packageName [InstalledPackageInfo]
installedPkgs)
            (forall key a. Ord key => (a -> key) -> [a] -> [(key, [a])]
groupOn 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 = forall a b. (a -> b) -> [a] -> [b]
map (\NonEmpty a
xs -> (a -> key
key (forall a. NonEmpty a -> a
head NonEmpty a
xs), forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty a
xs))
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a.
Foldable f =>
(a -> a -> Bool) -> f a -> [NonEmpty a]
groupBy (forall a b. Eq a => (b -> a) -> b -> b -> Bool
equating a -> key
key)
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
Disp.punctuate (Char -> Doc
Disp.char Char
',')
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (\Version
ver -> if Version -> Bool
ispref Version
ver then forall a. Pretty a => a -> Doc
pretty Version
ver else Doc -> Doc
parens (forall a. Pretty a => a -> Doc
pretty Version
ver))
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => [a] -> [a]
sort forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
n forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Version -> Bool) -> [Version] -> [Version]
interestingVersions Version -> Bool
ispref
        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 = forall (t :: * -> *) a. Foldable t => t a -> Int
length [Version]
vs forall a. Num a => a -> a -> a
- Int
n
    trailingMessage :: Doc
trailingMessage
      | Int
extra forall a. Ord a => a -> a -> Bool
<= Int
0 = Doc
Disp.empty
      | Bool
otherwise  = Doc -> Doc
Disp.parens forall a b. (a -> b) -> a -> b
$ String -> Doc
Disp.text String
"and"
                               Doc -> Doc -> Doc
<+> Int -> Doc
Disp.int (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Version]
vs forall a. Num a => a -> a -> a
- Int
n)
                               Doc -> Doc -> Doc
<+> if Int
extra 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 =
      forall a b. (a -> b) -> [a] -> [b]
map ([Int] -> Version
mkVersion forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter forall a b. (a, b) -> b
snd
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Tree a -> [[a]]
Tree.levels
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. Tree a -> Tree a
swizzleTree
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. Tree a -> Tree a
reverseTree
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => [NonEmpty a] -> Tree ([a], Bool)
mkTree
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall {a}. Num a => [a] -> NonEmpty a
or0 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> [Int]
versionNumbers)

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

    swizzleTree :: Tree a -> Tree a
swizzleTree = forall b a. (b -> (a, [b])) -> b -> Tree a
unfoldTree (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 (forall a. a -> [Tree a] -> Tree a
Node a
x [Tree a]
tsforall 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 []) = forall a. a -> [Tree a] -> Tree a
Node a
x []
    reorderTree Tree a -> Bool
p (Node a
x [Tree a]
ts) = forall a. a -> [Tree a] -> Tree a
Node a
x ([Tree a]
ts' forall a. [a] -> [a] -> [a]
++ [Tree a]
ts'')
      where
        ([Tree a]
ts',[Tree a]
ts'') = forall a. (a -> Bool) -> [a] -> ([a], [a])
partition Tree a -> Bool
p (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) = forall a. a -> [Tree a] -> Tree a
Node a
x (forall a. [a] -> [a]
reverse (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 = 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) =
          ( (forall a. [a] -> [a]
reverse [a]
ns, Bool
node)
          , [ (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any forall (t :: * -> *) a. Foldable t => t a -> Bool
null NonEmpty [a]
vs', a
nforall a. a -> [a] -> [a]
:[a]
ns, forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe forall a. [a] -> Maybe (NonEmpty a)
nonEmpty (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 = forall a b. (a -> b) -> [a] -> [b]
map (\NonEmpty (NonEmpty a)
g -> (forall a. NonEmpty a -> a
head (forall a. NonEmpty a -> a
head NonEmpty (NonEmpty a)
g), forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. NonEmpty a -> [a]
tail NonEmpty (NonEmpty a)
g))
               forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a.
Foldable f =>
(a -> a -> Bool) -> f a -> [NonEmpty a]
groupBy (forall a b. Eq a => (b -> a) -> b -> b -> Bool
equating forall a. NonEmpty a -> a
head)