List.hs 22.9 KB
Newer Older
1
2
-----------------------------------------------------------------------------
-- |
3
-- Module      :  Distribution.Client.List
4
-- Copyright   :  (c) David Himmelstrup 2005
5
--                    Duncan Coutts 2008-2011
6
7
-- License     :  BSD-like
--
8
-- Maintainer  :  cabal-devel@haskell.org
9
--
10
-- Search for and print information about packages
11
-----------------------------------------------------------------------------
12
module Distribution.Client.List (
13
  list, info
14
  ) where
15

16
import Distribution.Package
17
         ( PackageName(..), Package(..), packageName, packageVersion
Andres Löh's avatar
Andres Löh committed
18
         , Dependency(..), simplifyDependency )
19
import Distribution.ModuleName (ModuleName)
20
import Distribution.License (License)
21
import qualified Distribution.InstalledPackageInfo as Installed
22
import qualified Distribution.PackageDescription   as Source
23
24
25
26
import Distribution.PackageDescription
         ( Flag(..), FlagName(..) )
import Distribution.PackageDescription.Configuration
         ( flattenPackageDescription )
27

28
29
import Distribution.Simple.Compiler
        ( Compiler, PackageDBStack )
30
import Distribution.Simple.Program (ProgramConfiguration)
31
32
import Distribution.Simple.Utils
        ( equating, comparing, die, notice )
33
import Distribution.Simple.Setup (fromFlag)
34
import qualified Distribution.Simple.PackageIndex as InstalledPackageIndex
35
import qualified Distribution.Client.PackageIndex as PackageIndex
36
37
38
import Distribution.Version
         ( Version(..), VersionRange, withinRange, anyVersion
         , intersectVersionRanges, simplifyVersionRange )
39
40
41
42
43
import Distribution.Verbosity (Verbosity)
import Distribution.Text
         ( Text(disp), display )

import Distribution.Client.Types
Andres Löh's avatar
Andres Löh committed
44
         ( SourcePackage(..), Repo, SourcePackageDb(..) )
45
import Distribution.Client.Dependency.Types
46
         ( PackageConstraint(..), ExtDependency(..) )
47
48
import Distribution.Client.Targets
         ( UserTarget, resolveUserTargets, PackageSpecifier(..) )
49
import Distribution.Client.Setup
50
         ( GlobalFlags(..), ListFlags(..), InfoFlags(..) )
51
52
53
import Distribution.Client.Utils
         ( mergeBy, MergeResult(..) )
import Distribution.Client.IndexUtils as IndexUtils
54
         ( getSourcePackages, getInstalledPackages )
Duncan Coutts's avatar
Duncan Coutts committed
55
import Distribution.Client.FetchUtils
56
57
58
         ( isFetched )

import Data.List
59
         ( sortBy, groupBy, sort, nub, intersperse, maximumBy, partition )
60
import Data.Maybe
61
62
63
         ( listToMaybe, fromJust, fromMaybe, isJust )
import qualified Data.Map as Map
import Data.Tree as Tree
64
65
66
67
import Control.Monad
         ( MonadPlus(mplus), join )
import Control.Exception
         ( assert )
dterei's avatar
dterei committed
68
import Text.PrettyPrint as Disp
69
70
import System.Directory
         ( doesDirectoryExist )
71

72

73
74
75
76
77
78
79
80
81
82
-- |Returns list of packages matching a search strings
getPkgList :: Verbosity
           -> PackageDBStack
           -> [Repo]
           -> Compiler
           -> ProgramConfiguration
           -> ListFlags
           -> [String]
           -> IO [PackageDisplayInfo]
getPkgList verbosity packageDBs repos comp conf listFlags pats = do
83
84
85
    installedPkgIndex <- getInstalledPackages verbosity comp packageDBs conf
    sourcePkgDb       <- getSourcePackages    verbosity repos
    let sourcePkgIndex = packageIndex sourcePkgDb
86
        prefs name = fromMaybe anyVersion
87
                       (Map.lookup name (packagePreferences sourcePkgDb))
88

89
        pkgsInfo :: [(PackageName, [Installed.InstalledPackageInfo], [SourcePackage])]
90
91
        pkgsInfo
            -- gather info for all packages
92
93
          | null pats = mergePackages (InstalledPackageIndex.allPackages installedPkgIndex)
                                      (         PackageIndex.allPackages sourcePkgIndex)
94
95

            -- gather info for packages matching search term
96
97
          | otherwise = mergePackages (matchingPackages InstalledPackageIndex.searchByNameSubstring installedPkgIndex)
                                      (matchingPackages (\ idx n -> concatMap snd (PackageIndex.searchByNameSubstring idx n)) sourcePkgIndex)
98
99
100

        matches :: [PackageDisplayInfo]
        matches = [ mergePackageInfo pref
101
102
                      installedPkgs sourcePkgs selectedPkg False
                  | (pkgname, installedPkgs, sourcePkgs) <- pkgsInfo
103
104
                  , not onlyInstalled || not (null installedPkgs)
                  , let pref        = prefs pkgname
105
                        selectedPkg = latestWithPref pref sourcePkgs ]
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
    return matches
  where
    onlyInstalled = fromFlag (listInstalled listFlags)
    matchingPackages search index =
      [ pkg
      | pat <- pats
      , pkg <- search index pat ]


-- |Show information about packages
list :: Verbosity
     -> PackageDBStack
     -> [Repo]
     -> Compiler
     -> ProgramConfiguration
     -> ListFlags
     -> [String]
     -> IO ()
list verbosity packageDBs repos comp conf listFlags pats = do
    matches <- getPkgList verbosity packageDBs repos comp conf listFlags pats
Lennart Kolmodin's avatar
Lennart Kolmodin committed
126

127
128
    if simpleOutput
      then putStr $ unlines
129
             [ display (pkgName pkg) ++ " " ++ display version
130
131
132
133
             | pkg <- matches
             , version <- if onlyInstalled
                            then              installedVersions pkg
                            else nub . sort $ installedVersions pkg
134
                                           ++ sourceVersions    pkg ]
135
136
             -- Note: this only works because for 'list', one cannot currently
             -- specify any version constraints, so listing all installed
137
             -- and source ones works.
138
139
      else
        if null matches
140
            then notice verbosity "No matches found."
141
            else putStr $ unlines (map showPackageSummaryInfo matches)
142
143
144
  where
    onlyInstalled = fromFlag (listInstalled listFlags)
    simpleOutput  = fromFlag (listSimpleOutput listFlags)
145

146
info :: Verbosity
147
     -> PackageDBStack
148
149
150
     -> [Repo]
     -> Compiler
     -> ProgramConfiguration
151
     -> GlobalFlags
152
     -> InfoFlags
153
     -> [UserTarget]
154
     -> IO ()
refold's avatar
refold committed
155
156
157
info verbosity _ _ _ _ _ _ [] =
    notice verbosity "No packages requested. Nothing to do."

158
159
160
info verbosity packageDBs repos comp conf
     globalFlags _listFlags userTargets = do

161
162
163
    installedPkgIndex <- getInstalledPackages verbosity comp packageDBs conf
    sourcePkgDb   <- getSourcePackages    verbosity repos
    let sourcePkgIndex = packageIndex sourcePkgDb
164
        prefs name = fromMaybe anyVersion
165
                       (Map.lookup name (packagePreferences sourcePkgDb))
166
167
168

        -- Users may specify names of packages that are only installed, not
        -- just available source packages, so we must resolve targets using
169
170
        -- the combination of installed and source packages.
    let sourcePkgs' = PackageIndex.fromList
171
172
                    $ map packageId (InstalledPackageIndex.allPackages installedPkgIndex)
                   ++ map packageId (         PackageIndex.allPackages sourcePkgIndex)
173
    pkgSpecifiers <- resolveUserTargets verbosity
174
175
                       (fromFlag $ globalWorldFile globalFlags)
                       sourcePkgs' userTargets
176
177
178
179

    pkgsinfo      <- sequence
                       [ do pkginfo <- either die return $
                                         gatherPkgInfo prefs
180
181
                                           installedPkgIndex sourcePkgIndex
                                           pkgSpecifier
182
183
184
185
186
187
                            updateFileSystemPackageDetails pkginfo
                       | pkgSpecifier <- pkgSpecifiers ]

    putStr $ unlines (map showPackageDetailedInfo pkgsinfo)

  where
188
189
190
191
192
    gatherPkgInfo :: (PackageName -> VersionRange) ->
                     InstalledPackageIndex.PackageIndex ->
                     PackageIndex.PackageIndex SourcePackage ->
                     PackageSpecifier SourcePackage ->
                     Either String PackageDisplayInfo
193
194
    gatherPkgInfo prefs installedPkgIndex sourcePkgIndex (NamedPackage name constraints)
      | null (selectedInstalledPkgs) && null (selectedSourcePkgs)
195
196
197
198
199
200
      = Left $ "There is no available version of " ++ display name
            ++ " that satisfies "
            ++ display (simplifyVersionRange verConstraint)

      | otherwise
      = Right $ mergePackageInfo pref installedPkgs
Andres Löh's avatar
Andres Löh committed
201
                                 sourcePkgs  selectedSourcePkg'
202
203
                                 showPkgVersion
      where
204
205
        (pref, installedPkgs, sourcePkgs) =
          sourcePkgsInfo prefs name installedPkgIndex sourcePkgIndex
206

207
        selectedInstalledPkgs = InstalledPackageIndex.lookupDependency installedPkgIndex
208
                                    (Dependency name verConstraint)
209
        selectedSourcePkgs    =          PackageIndex.lookupDependency sourcePkgIndex
210
                                    (Dependency name verConstraint)
Andres Löh's avatar
Andres Löh committed
211
        selectedSourcePkg'    = latestWithPref pref selectedSourcePkgs
212
213
214
215
216

                         -- display a specific package version if the user
                         -- supplied a non-trivial version constraint
        showPkgVersion = not (null verConstraints)
        verConstraint  = foldr intersectVersionRanges anyVersion verConstraints
217
        verConstraints = [ vr | PackageConstraintVersion _ vr <- constraints ]
218

219
220
    gatherPkgInfo prefs installedPkgIndex sourcePkgIndex (SpecificSourcePackage pkg) =
        Right $ mergePackageInfo pref installedPkgs sourcePkgs
221
222
223
224
                                 selectedPkg True
      where
        name          = packageName pkg
        selectedPkg   = Just pkg
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
        (pref, installedPkgs, sourcePkgs) =
          sourcePkgsInfo prefs name installedPkgIndex sourcePkgIndex

sourcePkgsInfo ::
  (PackageName -> VersionRange)
  -> PackageName
  -> InstalledPackageIndex.PackageIndex
  -> PackageIndex.PackageIndex SourcePackage
  -> (VersionRange, [Installed.InstalledPackageInfo], [SourcePackage])
sourcePkgsInfo prefs name installedPkgIndex sourcePkgIndex =
  (pref, installedPkgs, sourcePkgs)
  where
    pref          = prefs name
    installedPkgs = concatMap snd (InstalledPackageIndex.lookupPackageName installedPkgIndex name)
    sourcePkgs    =                         PackageIndex.lookupPackageName sourcePkgIndex name
240

241

242
243
244
245
-- | The info that we can display for each package. It is information per
-- package name and covers all installed and avilable versions.
--
data PackageDisplayInfo = PackageDisplayInfo {
246
247
    pkgName           :: PackageName,
    selectedVersion   :: Maybe Version,
248
    selectedSourcePkg :: Maybe SourcePackage,
249
    installedVersions :: [Version],
250
    sourceVersions    :: [Version],
251
    preferredVersions :: VersionRange,
252
    homepage          :: String,
253
254
    bugReports        :: String,
    sourceRepo        :: String,
255
    synopsis          :: String,
256
257
258
259
260
    description       :: String,
    category          :: String,
    license           :: License,
    author            :: String,
    maintainer        :: String,
261
    dependencies      :: [ExtDependency],
262
    flags             :: [Flag],
263
264
    hasLib            :: Bool,
    hasExe            :: Bool,
265
266
267
268
    executables       :: [String],
    modules           :: [ModuleName],
    haddockHtml       :: FilePath,
    haveTarball       :: Bool
269
  }
270

271
showPackageSummaryInfo :: PackageDisplayInfo -> String
272
showPackageSummaryInfo pkginfo =
273
  renderStyle (style {lineLength = 80, ribbonsPerLine = 1}) $
274
     char '*' <+> disp (pkgName pkginfo)
275
     $+$
276
     (nest 4 $ vcat [
277
       maybeShow (synopsis pkginfo) "Synopsis:" reflowParagraphs
278
     , text "Default available version:" <+>
279
       case selectedSourcePkg pkginfo of
280
         Nothing  -> text "[ Not available from any configured repository ]"
281
         Just pkg -> disp (packageVersion pkg)
282
283
284
285
286
287
     , text "Installed versions:" <+>
       case installedVersions pkginfo of
         []  | hasLib pkginfo -> text "[ Not installed ]"
             | otherwise      -> text "[ Unknown ]"
         versions             -> dispTopVersions 4
                                   (preferredVersions pkginfo) versions
288
     , maybeShow (homepage pkginfo) "Homepage:" text
289
     , text "License: " <+> text (display (license pkginfo))
290
291
     ])
     $+$ text ""
292
  where
293
294
    maybeShow [] _ _ = empty
    maybeShow l  s f = text s <+> (f l)
295
296

showPackageDetailedInfo :: PackageDisplayInfo -> String
297
showPackageDetailedInfo pkginfo =
298
  renderStyle (style {lineLength = 80, ribbonsPerLine = 1}) $
299
300
301
   char '*' <+> disp (pkgName pkginfo)
            <>  maybe empty (\v -> char '-' <> disp v) (selectedVersion pkginfo)
            <+> text (replicate (16 - length (display (pkgName pkginfo))) ' ')
302
            <>  parens pkgkind
303
304
   $+$
   (nest 4 $ vcat [
305
     entry "Synopsis"      synopsis     hideIfNull     reflowParagraphs
306
   , entry "Versions available" sourceVersions
307
308
309
310
311
312
           (altText null "[ Not available from server ]")
           (dispTopVersions 9 (preferredVersions pkginfo))
   , entry "Versions installed" installedVersions
           (altText null (if hasLib pkginfo then "[ Not installed ]"
                                            else "[ Unknown ]"))
           (dispTopVersions 4 (preferredVersions pkginfo))
313
314
   , entry "Homepage"      homepage     orNotSpecified text
   , entry "Bug reports"   bugReports   orNotSpecified text
315
   , entry "Description"   description  hideIfNull     reflowParagraphs
316
   , entry "Category"      category     hideIfNull     text
317
   , entry "License"       license      alwaysShow     disp
318
319
320
321
   , entry "Author"        author       hideIfNull     reflowLines
   , entry "Maintainer"    maintainer   hideIfNull     reflowLines
   , entry "Source repo"   sourceRepo   orNotSpecified text
   , entry "Executables"   executables  hideIfNull     (commaSep text)
322
323
324
   , entry "Flags"         flags        hideIfNull     (commaSep dispFlag)
   , entry "Dependencies"  dependencies hideIfNull     (commaSep disp)
   , entry "Documentation" haddockHtml  showIfInstalled text
325
326
327
   , entry "Cached"        haveTarball  alwaysShow     dispYesNo
   , if not (hasLib pkginfo) then empty else
     text "Modules:" $+$ nest 4 (vcat (map disp . sort . modules $ pkginfo))
328
329
330
   ])
   $+$ text ""
  where
331
332
    entry fname field cond format = case cond (field pkginfo) of
      Nothing           -> label <+> format (field pkginfo)
333
334
335
336
337
338
339
340
341
      Just Nothing      -> empty
      Just (Just other) -> label <+> text other
      where
        label   = text fname <> char ':' <> padding
        padding = text (replicate (13 - length fname ) ' ')

    normal      = Nothing
    hide        = Just Nothing
    replace msg = Just (Just msg)
342

343
344
345
346
347
348
    alwaysShow = const normal
    hideIfNull v = if null v then hide else normal
    showIfInstalled v
      | not isInstalled = hide
      | null v          = replace "[ Not installed ]"
      | otherwise       = normal
349
350
351
    altText nul msg v = if nul v then replace msg else normal
    orNotSpecified = altText null "[ Not specified ]"

352
353
354
355
356
    commaSep f = Disp.fsep . Disp.punctuate (Disp.char ',') . map f
    dispFlag f = case flagName f of FlagName n -> text n
    dispYesNo True  = text "Yes"
    dispYesNo False = text "No"

357
358
359
360
361
362
363
364
365
    isInstalled = not (null (installedVersions pkginfo))
    hasExes = length (executables pkginfo) >= 2
    --TODO: exclude non-buildable exes
    pkgkind | hasLib pkginfo && hasExes        = text "programs and library"
            | hasLib pkginfo && hasExe pkginfo = text "program and library"
            | hasLib pkginfo                   = text "library"
            | hasExes                          = text "programs"
            | hasExe pkginfo                   = text "program"
            | otherwise                        = empty
366

367

368
369
370
371
372
373
374
375
376
377
378
reflowParagraphs :: String -> Doc
reflowParagraphs =
    vcat
  . intersperse (text "")                    -- re-insert blank lines
  . map (fsep . map text . concatMap words)  -- reflow paragraphs
  . filter (/= [""])
  . groupBy (\x y -> "" `notElem` [x,y])     -- break on blank lines
  . lines

reflowLines :: String -> Doc
reflowLines = vcat . map text . lines
379
380
381
382
383
384
385
386

-- | 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.
--
387
mergePackageInfo :: VersionRange
388
                 -> [Installed.InstalledPackageInfo]
389
390
                 -> [SourcePackage]
                 -> Maybe SourcePackage
391
                 -> Bool
392
                 -> PackageDisplayInfo
393
394
mergePackageInfo versionPref installedPkgs sourcePkgs selectedPkg showVer =
  assert (length installedPkgs + length sourcePkgs > 0) $
395
  PackageDisplayInfo {
396
    pkgName           = combine packageName source
397
398
399
                                packageName installed,
    selectedVersion   = if showVer then fmap packageVersion selectedPkg
                                   else Nothing,
400
    selectedSourcePkg = sourceSelected,
401
    installedVersions = map packageVersion installedPkgs,
402
    sourceVersions    = map packageVersion sourcePkgs,
403
404
    preferredVersions = versionPref,

405
    license      = combine Source.license       source
406
                           Installed.license    installed,
407
    maintainer   = combine Source.maintainer    source
408
                           Installed.maintainer installed,
409
    author       = combine Source.author        source
410
                           Installed.author     installed,
411
    homepage     = combine Source.homepage      source
412
                           Installed.homepage   installed,
413
    bugReports   = maybe "" Source.bugReports source,
414
    sourceRepo   = fromMaybe "" . join
415
416
417
418
                 . fmap (uncons Nothing Source.repoLocation
                       . sortBy (comparing Source.repoKind)
                       . Source.sourceRepos)
                 $ source,
419
                    --TODO: installed package info is missing synopsis
420
421
    synopsis     = maybe "" Source.synopsis      source,
    description  = combine Source.description    source
422
                           Installed.description installed,
423
    category     = combine Source.category       source
424
                           Installed.category    installed,
425
    flags        = maybe [] Source.genPackageFlags sourceGeneric,
426
427
    hasLib       = isJust installed
                || fromMaybe False
428
                   (fmap (isJust . Source.condLibrary) sourceGeneric),
429
    hasExe       = fromMaybe False
430
431
                   (fmap (not . null . Source.condExecutables) sourceGeneric),
    executables  = map fst (maybe [] Source.condExecutables sourceGeneric),
432
    modules      = combine Installed.exposedModules installed
433
434
                           (maybe [] Source.exposedModules
                                   . Source.library) source,
435
436
    dependencies = combine (map (SourceDependency . simplifyDependency) . Source.buildDepends) source
                           (map InstalledDependency . Installed.depends) installed,
437
438
    haddockHtml  = fromMaybe "" . join
                 . fmap (listToMaybe . Installed.haddockHTMLs)
439
                 $ installed,
440
    haveTarball  = False
441
442
  }
  where
443
    combine f x g y  = fromJust (fmap f x `mplus` fmap g y)
444
445
    installed :: Maybe Installed.InstalledPackageInfo
    installed = latestWithPref versionPref installedPkgs
446

447
    sourceSelected
448
      | isJust selectedPkg = selectedPkg
449
450
451
      | otherwise          = latestWithPref versionPref sourcePkgs
    sourceGeneric = fmap packageDescription sourceSelected
    source        = fmap flattenPackageDescription sourceGeneric
452

453
454
455
456
    uncons :: b -> (a -> b) -> [a] -> b
    uncons z _ []    = z
    uncons _ f (x:_) = f x

457

458
459
460
461
462
-- | 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
463
updateFileSystemPackageDetails pkginfo = do
464
  fetched   <- maybe (return False) (isFetched . packageSource)
465
                     (selectedSourcePkg pkginfo)
466
467
468
469
470
  docsExist <- doesDirectoryExist (haddockHtml pkginfo)
  return pkginfo {
    haveTarball = fetched,
    haddockHtml = if docsExist then haddockHtml pkginfo else ""
  }
471

472
473
474
475
476
477
478
479
latestWithPref :: Package pkg => VersionRange -> [pkg] -> Maybe pkg
latestWithPref _    []   = Nothing
latestWithPref pref pkgs = Just (maximumBy (comparing prefThenVersion) pkgs)
  where
    prefThenVersion pkg = let ver = packageVersion pkg
                           in (withinRange ver pref, ver)


480
-- | Rearrange installed and source packages into groups referring to the
481
482
483
-- same package by name. In the result pairs, the lists are guaranteed to not
-- both be empty.
--
484
mergePackages :: [Installed.InstalledPackageInfo]
485
              -> [SourcePackage]
486
              -> [( PackageName
487
                  , [Installed.InstalledPackageInfo]
488
489
                  , [SourcePackage] )]
mergePackages installedPkgs sourcePkgs =
490
    map collect
491
  $ mergeBy (\i a -> fst i `compare` fst a)
492
493
            (groupOn packageName installedPkgs)
            (groupOn packageName sourcePkgs)
494
  where
495
496
497
    collect (OnlyInLeft  (name,is)         ) = (name, is, [])
    collect (    InBoth  (_,is)   (name,as)) = (name, is, as)
    collect (OnlyInRight          (name,as)) = (name, [], as)
498
499
500
501
502

groupOn :: Ord key => (a -> key) -> [a] -> [(key,[a])]
groupOn key = map (\xs -> (key (head xs), xs))
            . groupBy (equating key)
            . sortBy (comparing key)
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561

dispTopVersions :: Int -> VersionRange -> [Version] -> Doc
dispTopVersions n pref vs =
         (Disp.fsep . Disp.punctuate (Disp.char ',')
        . map (\ver -> if ispref ver then disp ver else parens (disp ver))
        . sort . take n . interestingVersions ispref
        $ vs)
    <+> trailingMessage

  where
    ispref ver = withinRange ver pref
    extra = length vs - n
    trailingMessage
      | extra <= 0 = Disp.empty
      | otherwise  = Disp.parens $ Disp.text "and"
                               <+> Disp.int (length vs - n)
                               <+> if extra == 1 then Disp.text "other"
                                                 else Disp.text "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 pref =
      map ((\ns -> Version ns []) . fst) . filter snd
    . concat  . Tree.levels
    . swizzleTree
    . reorderTree (\(Node (v,_) _) -> pref (Version v []))
    . reverseTree
    . mkTree
    . map versionBranch

  where
    swizzleTree = unfoldTree (spine [])
      where
        spine ts' (Node x [])     = (x, ts')
        spine ts' (Node x (t:ts)) = spine (Node x ts:ts') t

    reorderTree _ (Node x []) = Node x []
    reorderTree p (Node x ts) = Node x (ts' ++ ts'')
      where
        (ts',ts'') = partition p (map (reorderTree p) ts)

    reverseTree (Node x cs) = Node x (reverse (map reverseTree cs))

    mkTree xs = unfoldTree step (False, [], xs)
      where
        step (node,ns,vs) =
          ( (reverse ns, node)
          , [ (any null vs', n:ns, filter (not . null) vs')
            | (n, vs') <- groups vs ]
          )
        groups = map (\g -> (head (head g), map tail g))
               . groupBy (equating head)