List.hs 23 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
    matchingPackages search index =
147
148
      [ pkg
      | pat <- pats
149
      , pkg <- search index pat ]
150

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

163
164
165
info verbosity packageDBs repos comp conf
     globalFlags _listFlags userTargets = do

166
167
168
    installedPkgIndex <- getInstalledPackages verbosity comp packageDBs conf
    sourcePkgDb   <- getSourcePackages    verbosity repos
    let sourcePkgIndex = packageIndex sourcePkgDb
169
        prefs name = fromMaybe anyVersion
170
                       (Map.lookup name (packagePreferences sourcePkgDb))
171
172
173

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

    pkgsinfo      <- sequence
                       [ do pkginfo <- either die return $
                                         gatherPkgInfo prefs
185
186
                                           installedPkgIndex sourcePkgIndex
                                           pkgSpecifier
187
188
189
190
191
192
                            updateFileSystemPackageDetails pkginfo
                       | pkgSpecifier <- pkgSpecifiers ]

    putStr $ unlines (map showPackageDetailedInfo pkgsinfo)

  where
193
194
195
196
197
    gatherPkgInfo :: (PackageName -> VersionRange) ->
                     InstalledPackageIndex.PackageIndex ->
                     PackageIndex.PackageIndex SourcePackage ->
                     PackageSpecifier SourcePackage ->
                     Either String PackageDisplayInfo
198
199
    gatherPkgInfo prefs installedPkgIndex sourcePkgIndex (NamedPackage name constraints)
      | null (selectedInstalledPkgs) && null (selectedSourcePkgs)
200
201
202
203
204
205
      = 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
206
                                 sourcePkgs  selectedSourcePkg'
207
208
                                 showPkgVersion
      where
209
210
        (pref, installedPkgs, sourcePkgs) =
          sourcePkgsInfo prefs name installedPkgIndex sourcePkgIndex
211

212
        selectedInstalledPkgs = InstalledPackageIndex.lookupDependency installedPkgIndex
213
                                    (Dependency name verConstraint)
214
        selectedSourcePkgs    =          PackageIndex.lookupDependency sourcePkgIndex
215
                                    (Dependency name verConstraint)
Andres Löh's avatar
Andres Löh committed
216
        selectedSourcePkg'    = latestWithPref pref selectedSourcePkgs
217
218
219
220
221

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

224
225
    gatherPkgInfo prefs installedPkgIndex sourcePkgIndex (SpecificSourcePackage pkg) =
        Right $ mergePackageInfo pref installedPkgs sourcePkgs
226
227
228
229
                                 selectedPkg True
      where
        name          = packageName pkg
        selectedPkg   = Just pkg
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
        (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
245

246

247
248
249
250
-- | 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 {
251
252
    pkgName           :: PackageName,
    selectedVersion   :: Maybe Version,
253
    selectedSourcePkg :: Maybe SourcePackage,
254
    installedVersions :: [Version],
255
    sourceVersions    :: [Version],
256
    preferredVersions :: VersionRange,
257
    homepage          :: String,
258
259
    bugReports        :: String,
    sourceRepo        :: String,
260
    synopsis          :: String,
261
262
263
264
265
    description       :: String,
    category          :: String,
    license           :: License,
    author            :: String,
    maintainer        :: String,
266
    dependencies      :: [ExtDependency],
267
    flags             :: [Flag],
268
269
    hasLib            :: Bool,
    hasExe            :: Bool,
270
271
272
273
    executables       :: [String],
    modules           :: [ModuleName],
    haddockHtml       :: FilePath,
    haveTarball       :: Bool
274
  }
275

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

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

348
349
350
351
352
353
    alwaysShow = const normal
    hideIfNull v = if null v then hide else normal
    showIfInstalled v
      | not isInstalled = hide
      | null v          = replace "[ Not installed ]"
      | otherwise       = normal
354
355
356
    altText nul msg v = if nul v then replace msg else normal
    orNotSpecified = altText null "[ Not specified ]"

357
358
359
360
361
    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"

362
363
364
365
366
367
368
369
370
    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
371

372

373
374
375
376
377
378
379
380
381
382
383
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
384
385
386
387
388
389
390
391

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

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

452
    sourceSelected
453
      | isJust selectedPkg = selectedPkg
454
455
456
      | otherwise          = latestWithPref versionPref sourcePkgs
    sourceGeneric = fmap packageDescription sourceSelected
    source        = fmap flattenPackageDescription sourceGeneric
457

458
459
460
461
    uncons :: b -> (a -> b) -> [a] -> b
    uncons z _ []    = z
    uncons _ f (x:_) = f x

462

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

477
478
479
480
481
482
483
484
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)


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

groupOn :: Ord key => (a -> key) -> [a] -> [(key,[a])]
groupOn key = map (\xs -> (key (head xs), xs))
            . groupBy (equating key)
            . sortBy (comparing key)
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
562
563
564
565
566

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)