{-# OPTIONS_HADDOCK not-home #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DoAndIfThenElse #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-} -- MonadBase
#if __GLASGOW_HASKELL__ < 802
{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}
#endif
module Hedgehog.Internal.Tree (
    Tree
  , pattern Tree
  , TreeT(..)
  , runTree
  , mapTreeT
  , treeValue
  , treeChildren

  , Node
  , pattern Node
  , NodeT(..)
  , fromNodeT

  , unfold
  , unfoldForest

  , expand
  , prune

  , catMaybes
  , filter
  , mapMaybe
  , filterMaybeT
  , mapMaybeMaybeT
  , filterT
  , consChild
  , mapMaybeT
  , depth
  , interleave

  , render
  , renderT
  ) where

import           Control.Applicative (Alternative(..), liftA2)
import           Control.Monad (MonadPlus(..), guard, join)
import           Control.Monad.Base (MonadBase(..))
import           Control.Monad.Trans.Control ()
import           Control.Monad.Catch (MonadThrow(..), MonadCatch(..), Exception)
import           Control.Monad.Error.Class (MonadError(..))
import           Control.Monad.IO.Class (MonadIO(..))
import           Control.Monad.Morph (MFunctor(..), MMonad(..), generalize)
import           Control.Monad.Primitive (PrimMonad(..))
import           Control.Monad.Reader.Class (MonadReader(..))
import           Control.Monad.State.Class (MonadState(..))
import           Control.Monad.Trans.Class (MonadTrans(..))
import           Control.Monad.Trans.Maybe (MaybeT(..))
import           Control.Monad.Trans.Resource (MonadResource(..))
import           Control.Monad.Writer.Class (MonadWriter(..))
import           Control.Monad.Zip (MonadZip(..))

import           Data.Functor.Identity (Identity(..))
import           Data.Functor.Classes (Eq1(..))
import           Data.Functor.Classes (Show1(..), showsPrec1)
import           Data.Functor.Classes (showsUnaryWith, showsBinaryWith)
import qualified Data.List as List
import qualified Data.Maybe as Maybe

import           Hedgehog.Internal.Distributive
import           Control.Monad.Trans.Control (MonadBaseControl (..))

import           Prelude hiding (filter)

------------------------------------------------------------------------

-- | A rose tree.
--
type Tree =
  TreeT Identity

-- | Pattern to ease construction / deconstruction of pure trees.
--
pattern Tree :: NodeT Identity a -> Tree a
pattern $bTree :: forall a. NodeT Identity a -> Tree a
$mTree :: forall {r} {a}.
Tree a -> (NodeT Identity a -> r) -> ((# #) -> r) -> r
Tree node =
  TreeT (Identity node)
#if __GLASGOW_HASKELL__ >= 802
{-# COMPLETE Tree #-}
#endif

-- | An effectful tree, each node in the tree can have an effect before it is
--   produced.
--
newtype TreeT m a =
  TreeT {
      forall (m :: * -> *) a. TreeT m a -> m (NodeT m a)
runTreeT :: m (NodeT m a)
    }

instance MonadBaseControl b m => MonadBaseControl b (TreeT m) where
  type StM (TreeT m) a = StM m (NodeT m a)
  liftBaseWith :: forall a. (RunInBase (TreeT m) b -> b a) -> TreeT m a
liftBaseWith RunInBase (TreeT m) b -> b a
f = forall (m :: * -> *) a. m (NodeT m a) -> TreeT m a
TreeT forall a b. (a -> b) -> a -> b
$ forall (b :: * -> *) (m :: * -> *) a.
MonadBaseControl b m =>
(RunInBase m b -> b a) -> m a
liftBaseWith (\RunInBase m b
g -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RunInBase (TreeT m) b -> b a
f (RunInBase m b
g forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. TreeT m a -> m (NodeT m a)
runTreeT))
  restoreM :: forall a. StM (TreeT m) a -> TreeT m a
restoreM = forall (m :: * -> *) a. m (NodeT m a) -> TreeT m a
TreeT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (b :: * -> *) (m :: * -> *) a.
MonadBaseControl b m =>
StM m a -> m a
restoreM

-- | A node in a rose tree.
--
type Node =
  NodeT Identity
#if __GLASGOW_HASKELL__ >= 802
{-# COMPLETE Node #-}
#endif

-- | Pattern to ease construction / deconstruction of pure nodes.
--
pattern Node :: a -> [Tree a] -> Node a
pattern $bNode :: forall a. a -> [Tree a] -> Node a
$mNode :: forall {r} {a}. Node a -> (a -> [Tree a] -> r) -> ((# #) -> r) -> r
Node x xs =
  NodeT x xs

-- | A node in an effectful tree, as well as its unevaluated children.
--
data NodeT m a =
  NodeT {
      -- | The value at this 'NodeT' in the 'TreeT'.
      forall (m :: * -> *) a. NodeT m a -> a
nodeValue :: a

      -- | The children of this 'NodeT'.
    , forall (m :: * -> *) a. NodeT m a -> [TreeT m a]
nodeChildren :: [TreeT m a]
    } deriving (NodeT m a -> NodeT m a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (m :: * -> *) a.
(Eq a, Eq1 m) =>
NodeT m a -> NodeT m a -> Bool
/= :: NodeT m a -> NodeT m a -> Bool
$c/= :: forall (m :: * -> *) a.
(Eq a, Eq1 m) =>
NodeT m a -> NodeT m a -> Bool
== :: NodeT m a -> NodeT m a -> Bool
$c== :: forall (m :: * -> *) a.
(Eq a, Eq1 m) =>
NodeT m a -> NodeT m a -> Bool
Eq)

-- | Extracts the 'Node' from a 'Tree'.
--
runTree :: Tree a -> Node a
runTree :: forall a. Tree a -> Node a
runTree =
  forall a. Identity a -> a
runIdentity forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. TreeT m a -> m (NodeT m a)
runTreeT

-- | Map between 'TreeT' computations.
--
mapTreeT :: (m (NodeT m a) -> m (NodeT m a)) -> TreeT m a -> TreeT m a
mapTreeT :: forall (m :: * -> *) a.
(m (NodeT m a) -> m (NodeT m a)) -> TreeT m a -> TreeT m a
mapTreeT m (NodeT m a) -> m (NodeT m a)
f =
  forall (m :: * -> *) a. m (NodeT m a) -> TreeT m a
TreeT forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (NodeT m a) -> m (NodeT m a)
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. TreeT m a -> m (NodeT m a)
runTreeT

-- | Create a 'TreeT' from a 'NodeT'
--
fromNodeT :: Applicative m => NodeT m a -> TreeT m a
fromNodeT :: forall (m :: * -> *) a. Applicative m => NodeT m a -> TreeT m a
fromNodeT =
  forall (m :: * -> *) a. m (NodeT m a) -> TreeT m a
TreeT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure

-- | The value at the root of the 'Tree'.
--
treeValue :: Tree a -> a
treeValue :: forall a. Tree a -> a
treeValue =
  forall (m :: * -> *) a. NodeT m a -> a
nodeValue forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Tree a -> Node a
runTree

-- | The children of the 'Tree'.
--
treeChildren :: Tree a -> [Tree a]
treeChildren :: forall a. Tree a -> [Tree a]
treeChildren =
  forall (m :: * -> *) a. NodeT m a -> [TreeT m a]
nodeChildren forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Tree a -> Node a
runTree

-- | Create a tree from a value and an unfolding function.
--
unfold :: Monad m => (a -> [a]) -> a -> TreeT m a
unfold :: forall (m :: * -> *) a. Monad m => (a -> [a]) -> a -> TreeT m a
unfold a -> [a]
f a
x =
  forall (m :: * -> *) a. m (NodeT m a) -> TreeT m a
TreeT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
    forall (m :: * -> *) a. a -> [TreeT m a] -> NodeT m a
NodeT a
x (forall (m :: * -> *) a. Monad m => (a -> [a]) -> a -> [TreeT m a]
unfoldForest a -> [a]
f a
x)

-- | Create a forest from a value and an unfolding function.
--
unfoldForest :: Monad m => (a -> [a]) -> a -> [TreeT m a]
unfoldForest :: forall (m :: * -> *) a. Monad m => (a -> [a]) -> a -> [TreeT m a]
unfoldForest a -> [a]
f =
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (m :: * -> *) a. Monad m => (a -> [a]) -> a -> TreeT m a
unfold a -> [a]
f) forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [a]
f

-- | Expand a tree using an unfolding function.
--
expand :: Monad m => (a -> [a]) -> TreeT m a -> TreeT m a
expand :: forall (m :: * -> *) a.
Monad m =>
(a -> [a]) -> TreeT m a -> TreeT m a
expand a -> [a]
f TreeT m a
m =
  forall (m :: * -> *) a. m (NodeT m a) -> TreeT m a
TreeT forall a b. (a -> b) -> a -> b
$ do
    NodeT a
x [TreeT m a]
xs <- forall (m :: * -> *) a. TreeT m a -> m (NodeT m a)
runTreeT TreeT m a
m
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. a -> [TreeT m a] -> NodeT m a
NodeT a
x forall a b. (a -> b) -> a -> b
$
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (m :: * -> *) a.
Monad m =>
(a -> [a]) -> TreeT m a -> TreeT m a
expand a -> [a]
f) [TreeT m a]
xs forall a. [a] -> [a] -> [a]
++ forall (m :: * -> *) a. Monad m => (a -> [a]) -> a -> [TreeT m a]
unfoldForest a -> [a]
f a
x

-- | Throw away @n@ levels of a tree's children.
--
--   /@prune 0@ will throw away all of a tree's children./
--
prune :: Monad m => Int -> TreeT m a -> TreeT m a
prune :: forall (m :: * -> *) a. Monad m => Int -> TreeT m a -> TreeT m a
prune Int
n TreeT m a
m =
  if Int
n forall a. Ord a => a -> a -> Bool
<= Int
0 then
    forall (m :: * -> *) a. m (NodeT m a) -> TreeT m a
TreeT forall a b. (a -> b) -> a -> b
$ do
      NodeT a
x [TreeT m a]
_ <- forall (m :: * -> *) a. TreeT m a -> m (NodeT m a)
runTreeT TreeT m a
m
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. a -> [TreeT m a] -> NodeT m a
NodeT a
x []
  else
    forall (m :: * -> *) a. m (NodeT m a) -> TreeT m a
TreeT forall a b. (a -> b) -> a -> b
$ do
      NodeT a
x [TreeT m a]
xs0 <- forall (m :: * -> *) a. TreeT m a -> m (NodeT m a)
runTreeT TreeT m a
m
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. a -> [TreeT m a] -> NodeT m a
NodeT a
x forall a b. (a -> b) -> a -> b
$
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (m :: * -> *) a. Monad m => Int -> TreeT m a -> TreeT m a
prune (Int
n forall a. Num a => a -> a -> a
- Int
1)) [TreeT m a]
xs0

-- | Returns the depth of the deepest leaf node in the tree.
--
depth :: Tree a -> Int
depth :: forall a. Tree a -> Int
depth Tree a
m =
  let
    NodeT a
_ [Tree a]
xs =
      forall a. Tree a -> Node a
runTree Tree a
m

    n :: Int
n =
      if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Tree a]
xs then
        Int
0
      else
        forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Tree a -> Int
depth [Tree a]
xs)
  in
    Int
1 forall a. Num a => a -> a -> a
+ Int
n

-- | Takes a tree of 'Maybe's and returns a tree of all the 'Just' values.
--
--   If the root of the tree is 'Nothing' then 'Nothing' is returned.
--
catMaybes :: Tree (Maybe a) -> Maybe (Tree a)
catMaybes :: forall a. Tree (Maybe a) -> Maybe (Tree a)
catMaybes Tree (Maybe a)
m =
  let
    NodeT Maybe a
mx [Tree (Maybe a)]
mxs =
      forall a. Tree a -> Node a
runTree Tree (Maybe a)
m
  in
    case Maybe a
mx of
      Maybe a
Nothing -> do
        case forall a b. (a -> Maybe b) -> [a] -> [b]
Maybe.mapMaybe forall a. Tree (Maybe a) -> Maybe (Tree a)
catMaybes [Tree (Maybe a)]
mxs of
          [] ->
            forall a. Maybe a
Nothing
          Tree (NodeT a
x [Tree a]
xs0) : [Tree a]
xs1 ->
            forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. NodeT Identity a -> Tree a
Tree forall a b. (a -> b) -> a -> b
$
              forall a. a -> [Tree a] -> Node a
Node a
x ([Tree a]
xs0 forall a. [a] -> [a] -> [a]
++ [Tree a]
xs1)
      Just a
x ->
        forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. NodeT Identity a -> Tree a
Tree forall a b. (a -> b) -> a -> b
$
          forall a. a -> [Tree a] -> Node a
Node a
x (forall a b. (a -> Maybe b) -> [a] -> [b]
Maybe.mapMaybe forall a. Tree (Maybe a) -> Maybe (Tree a)
catMaybes [Tree (Maybe a)]
mxs)

fromPred :: (a -> Bool) -> a -> Maybe a
fromPred :: forall a. (a -> Bool) -> a -> Maybe a
fromPred a -> Bool
p a
a = a
a forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (f :: * -> *). Alternative f => Bool -> f ()
guard (a -> Bool
p a
a)

-- | Returns a tree containing only elements that match the predicate.
--
--   If the root of the tree does not match the predicate then 'Nothing' is
--   returned.
--
filter :: (a -> Bool) -> Tree a -> Maybe (Tree a)
filter :: forall a. (a -> Bool) -> Tree a -> Maybe (Tree a)
filter a -> Bool
p = forall a b. (a -> Maybe b) -> Tree a -> Maybe (Tree b)
mapMaybe (forall a. (a -> Bool) -> a -> Maybe a
fromPred a -> Bool
p)

mapMaybe :: (a -> Maybe b) -> Tree a -> Maybe (Tree b)
mapMaybe :: forall a b. (a -> Maybe b) -> Tree a -> Maybe (Tree b)
mapMaybe a -> Maybe b
p =
  forall a. Tree (Maybe a) -> Maybe (Tree a)
catMaybes forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  forall (m :: * -> *) a.
Monad m =>
TreeT (MaybeT m) a -> TreeT m (Maybe a)
runTreeMaybeT forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  forall a b.
(a -> Maybe b)
-> TreeT (MaybeT Identity) a -> TreeT (MaybeT Identity) b
mapMaybeMaybeT a -> Maybe b
p forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  forall {k} (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
       (b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
hoist forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift

runTreeMaybeT :: Monad m => TreeT (MaybeT m) a -> TreeT m (Maybe a)
runTreeMaybeT :: forall (m :: * -> *) a.
Monad m =>
TreeT (MaybeT m) a -> TreeT m (Maybe a)
runTreeMaybeT =
  forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  forall (g :: (* -> *) -> * -> *) (f :: (* -> *) -> * -> *)
       (m :: * -> *) a.
(MonadTransDistributive g, Transformer f g m) =>
g (f m) a -> f (g m) a
distributeT

-- | Returns a tree containing only elements that match the predicate.
--
--   If the root of the tree does not match the predicate then 'Nothing' is
--   returned.
--
filterMaybeT :: (a -> Bool) -> TreeT (MaybeT Identity) a -> TreeT (MaybeT Identity) a
filterMaybeT :: forall a.
(a -> Bool)
-> TreeT (MaybeT Identity) a -> TreeT (MaybeT Identity) a
filterMaybeT a -> Bool
p = forall a b.
(a -> Maybe b)
-> TreeT (MaybeT Identity) a -> TreeT (MaybeT Identity) b
mapMaybeMaybeT (forall a. (a -> Bool) -> a -> Maybe a
fromPred a -> Bool
p)

mapMaybeMaybeT :: (a -> Maybe b) -> TreeT (MaybeT Identity) a -> TreeT (MaybeT Identity) b
mapMaybeMaybeT :: forall a b.
(a -> Maybe b)
-> TreeT (MaybeT Identity) a -> TreeT (MaybeT Identity) b
mapMaybeMaybeT a -> Maybe b
p TreeT (MaybeT Identity) a
t =
  case forall (m :: * -> *) a.
Monad m =>
TreeT (MaybeT m) a -> TreeT m (Maybe a)
runTreeMaybeT TreeT (MaybeT Identity) a
t of
    Tree (Node Maybe a
Nothing [Tree (Maybe a)]
_) ->
      forall (m :: * -> *) a. m (NodeT m a) -> TreeT m a
TreeT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Identity a
Identity forall a b. (a -> b) -> a -> b
$ forall a. Maybe a
Nothing
    Tree (Node (Just a
x) [Tree (Maybe a)]
xs) ->
      case a -> Maybe b
p a
x of
        Maybe b
Nothing -> forall (m :: * -> *) a. m (NodeT m a) -> TreeT m a
TreeT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Identity a
Identity forall a b. (a -> b) -> a -> b
$ forall a. Maybe a
Nothing
        Just b
x' ->
          forall {k} (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
       (b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
hoist forall (m :: * -> *) a. Monad m => Identity a -> m a
generalize forall a b. (a -> b) -> a -> b
$
            forall a. NodeT Identity a -> Tree a
Tree forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> [Tree a] -> Node a
Node b
x' forall a b. (a -> b) -> a -> b
$
              forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall a b. (a -> Maybe b) -> Tree (Maybe a) -> [Tree b]
flattenTree a -> Maybe b
p) [Tree (Maybe a)]
xs

flattenTree :: (a -> Maybe b) -> Tree (Maybe a) -> [Tree b]
flattenTree :: forall a b. (a -> Maybe b) -> Tree (Maybe a) -> [Tree b]
flattenTree a -> Maybe b
p (Tree (Node Maybe a
mx [Tree (Maybe a)]
mxs0)) =
  let
    mxs :: [Tree b]
mxs =
      forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall a b. (a -> Maybe b) -> Tree (Maybe a) -> [Tree b]
flattenTree a -> Maybe b
p) [Tree (Maybe a)]
mxs0
  in
    case Maybe a
mx of
      Maybe a
Nothing -> [Tree b]
mxs
      Just a
x ->
        case a -> Maybe b
p a
x of
          Just b
x' ->
            [forall a. NodeT Identity a -> Tree a
Tree (forall a. a -> [Tree a] -> Node a
Node b
x' [Tree b]
mxs)]
          Maybe b
Nothing ->
            [Tree b]
mxs

-- | Returns a tree containing only elements that match the predicate.
--
--   When an element does not match the predicate its node is replaced with
--   'empty'.
--
filterT :: (Monad m, Alternative m) => (a -> Bool) -> TreeT m a -> TreeT m a
filterT :: forall (m :: * -> *) a.
(Monad m, Alternative m) =>
(a -> Bool) -> TreeT m a -> TreeT m a
filterT a -> Bool
p =
  forall (m :: * -> *) a b.
(Monad m, Alternative m) =>
(a -> Maybe b) -> TreeT m a -> TreeT m b
mapMaybeT (forall a. (a -> Bool) -> a -> Maybe a
fromPred a -> Bool
p)

mapMaybeT :: (Monad m, Alternative m) => (a -> Maybe b) -> TreeT m a -> TreeT m b
mapMaybeT :: forall (m :: * -> *) a b.
(Monad m, Alternative m) =>
(a -> Maybe b) -> TreeT m a -> TreeT m b
mapMaybeT a -> Maybe b
p TreeT m a
m =
  forall (m :: * -> *) a. m (NodeT m a) -> TreeT m a
TreeT forall a b. (a -> b) -> a -> b
$ do
    NodeT a
x [TreeT m a]
xs <- forall (m :: * -> *) a. TreeT m a -> m (NodeT m a)
runTreeT TreeT m a
m
    case a -> Maybe b
p a
x of
      Just b
x' ->
        forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
          forall (m :: * -> *) a. a -> [TreeT m a] -> NodeT m a
NodeT b
x' (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (m :: * -> *) a b.
(Monad m, Alternative m) =>
(a -> Maybe b) -> TreeT m a -> TreeT m b
mapMaybeT a -> Maybe b
p) [TreeT m a]
xs)
      Maybe b
Nothing ->
        forall (f :: * -> *) a. Alternative f => f a
empty

consChild :: (Monad m) => a -> TreeT m a -> TreeT m a
consChild :: forall (m :: * -> *) a. Monad m => a -> TreeT m a -> TreeT m a
consChild a
a TreeT m a
m =
  forall (m :: * -> *) a. m (NodeT m a) -> TreeT m a
TreeT forall a b. (a -> b) -> a -> b
$ do
    NodeT a
x [TreeT m a]
xs <- forall (m :: * -> *) a. TreeT m a -> m (NodeT m a)
runTreeT TreeT m a
m
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
      forall (m :: * -> *) a. a -> [TreeT m a] -> NodeT m a
NodeT a
x forall a b. (a -> b) -> a -> b
$
        forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a forall a. a -> [a] -> [a]
: [TreeT m a]
xs

------------------------------------------------------------------------

-- | All ways a list can be split
--
-- > splits [1,2,3]
-- > ==
-- > [ ([], 1, [2, 3])
--   , ([1], 2, [3])
--   , ([1, 2], 3, [])
--   ]
--
splits :: [a] -> [([a], a, [a])]
splits :: forall a. [a] -> [([a], a, [a])]
splits [a]
xs0 =
  let
    go :: [a] -> [b] -> [(a, b, [b])]
go (a
front : [a]
fronts) (b
x : [b]
xs) =
      (a
front, b
x, [b]
xs) forall a. a -> [a] -> [a]
: [a] -> [b] -> [(a, b, [b])]
go [a]
fronts [b]
xs
    go [a]
_ [b]
_ =
      []
  in
    forall {a} {b}. [a] -> [b] -> [(a, b, [b])]
go (forall a. [a] -> [[a]]
List.inits [a]
xs0) [a]
xs0

-- | @removes n@ computes all ways we can remove chunks of size @n@ from a list
--
-- Examples
--
-- > removes 1 [1..3] == [[2,3],[1,3],[1,2]]
-- > removes 2 [1..4] == [[3,4],[1,2]]
-- > removes 2 [1..5] == [[3,4,5],[1,2,5],[1,2,3,4]]
-- > removes 3 [1..5] == [[4,5],[1,2,3]]
--
-- Note that the last chunk we delete might have fewer elements than @n@.
removes :: forall a. Int -> [a] -> [[a]]
removes :: forall a. Int -> [a] -> [[a]]
removes Int
k = \[a]
xs -> [a] -> [[a]]
go [a]
xs
  where
    go :: [a] -> [[a]]
    go :: [a] -> [[a]]
go [] = []
    go [a]
xs = [a]
xs2 forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map ([a]
xs1 forall a. [a] -> [a] -> [a]
++) ([a] -> [[a]]
go [a]
xs2)
      where
        ([a]
xs1, [a]
xs2) = forall a. Int -> [a] -> ([a], [a])
splitAt Int
k [a]
xs

dropSome :: Monad m => [NodeT m a] -> [TreeT m [a]]
dropSome :: forall (m :: * -> *) a. Monad m => [NodeT m a] -> [TreeT m [a]]
dropSome [NodeT m a]
ts = do
  Int
n   <- forall a. (a -> Bool) -> [a] -> [a]
takeWhile (forall a. Ord a => a -> a -> Bool
> Int
0) forall a b. (a -> b) -> a -> b
$ forall a. (a -> a) -> a -> [a]
iterate (forall a. Integral a => a -> a -> a
`div` Int
2) (forall (t :: * -> *) a. Foldable t => t a -> Int
length [NodeT m a]
ts)
  [NodeT m a]
ts' <- forall a. Int -> [a] -> [[a]]
removes Int
n [NodeT m a]
ts
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. m (NodeT m a) -> TreeT m a
TreeT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => [NodeT m a] -> NodeT m [a]
interleave [NodeT m a]
ts'

shrinkOne :: Monad m => [NodeT m a] -> [TreeT m [a]]
shrinkOne :: forall (m :: * -> *) a. Monad m => [NodeT m a] -> [TreeT m [a]]
shrinkOne [NodeT m a]
ts = do
  ([NodeT m a]
xs, NodeT m a
y0, [NodeT m a]
zs) <- forall a. [a] -> [([a], a, [a])]
splits [NodeT m a]
ts
  TreeT m a
y1 <- forall (m :: * -> *) a. NodeT m a -> [TreeT m a]
nodeChildren NodeT m a
y0
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. m (NodeT m a) -> TreeT m a
TreeT forall a b. (a -> b) -> a -> b
$ do
    NodeT m a
y2 <- forall (m :: * -> *) a. TreeT m a -> m (NodeT m a)
runTreeT TreeT m a
y1
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
      forall (m :: * -> *) a. Monad m => [NodeT m a] -> NodeT m [a]
interleave ([NodeT m a]
xs forall a. [a] -> [a] -> [a]
++ [NodeT m a
y2] forall a. [a] -> [a] -> [a]
++ [NodeT m a]
zs)

interleave :: forall m a. Monad m => [NodeT m a] -> NodeT m [a]
interleave :: forall (m :: * -> *) a. Monad m => [NodeT m a] -> NodeT m [a]
interleave [NodeT m a]
ts =
  forall (m :: * -> *) a. a -> [TreeT m a] -> NodeT m a
NodeT (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (m :: * -> *) a. NodeT m a -> a
nodeValue [NodeT m a]
ts) forall a b. (a -> b) -> a -> b
$
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [
        forall (m :: * -> *) a. Monad m => [NodeT m a] -> [TreeT m [a]]
dropSome [NodeT m a]
ts
      , forall (m :: * -> *) a. Monad m => [NodeT m a] -> [TreeT m [a]]
shrinkOne [NodeT m a]
ts
      ]

------------------------------------------------------------------------

instance Foldable Tree where
  foldMap :: forall m a. Monoid m => (a -> m) -> Tree a -> m
foldMap a -> m
f (TreeT Identity (NodeT Identity a)
mx) =
    forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f (forall a. Identity a -> a
runIdentity Identity (NodeT Identity a)
mx)

instance Foldable Node where
  foldMap :: forall m a. Monoid m => (a -> m) -> Node a -> m
foldMap a -> m
f (NodeT a
x [TreeT Identity a]
xs) =
    a -> m
f a
x forall a. Monoid a => a -> a -> a
`mappend` forall a. Monoid a => [a] -> a
mconcat (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f) [TreeT Identity a]
xs)

instance Traversable Tree where
  traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Tree a -> f (Tree b)
traverse a -> f b
f (TreeT Identity (NodeT Identity a)
mx) =
    forall (m :: * -> *) a. m (NodeT m a) -> TreeT m a
TreeT forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
f) Identity (NodeT Identity a)
mx

instance Traversable Node where
  traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Node a -> f (Node b)
traverse a -> f b
f (NodeT a
x [TreeT Identity a]
xs) =
    forall (m :: * -> *) a. a -> [TreeT m a] -> NodeT m a
NodeT forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
x forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
f) [TreeT Identity a]
xs

------------------------------------------------------------------------
-- NodeT/TreeT instances

instance (Eq1 m, Eq a) => Eq (TreeT m a) where
  TreeT m (NodeT m a)
m0 == :: TreeT m a -> TreeT m a -> Bool
== TreeT m (NodeT m a)
m1 =
    forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq forall a. Eq a => a -> a -> Bool
(==) m (NodeT m a)
m0 m (NodeT m a)
m1

instance Functor m => Functor (NodeT m) where
  fmap :: forall a b. (a -> b) -> NodeT m a -> NodeT m b
fmap a -> b
f (NodeT a
x [TreeT m a]
xs) =
    forall (m :: * -> *) a. a -> [TreeT m a] -> NodeT m a
NodeT (a -> b
f a
x) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) [TreeT m a]
xs)

instance Functor m => Functor (TreeT m) where
  fmap :: forall a b. (a -> b) -> TreeT m a -> TreeT m b
fmap a -> b
f =
    forall (m :: * -> *) a. m (NodeT m a) -> TreeT m a
TreeT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. TreeT m a -> m (NodeT m a)
runTreeT

instance Applicative m => Applicative (NodeT m) where
  pure :: forall a. a -> NodeT m a
pure a
x =
    forall (m :: * -> *) a. a -> [TreeT m a] -> NodeT m a
NodeT a
x []
  <*> :: forall a b. NodeT m (a -> b) -> NodeT m a -> NodeT m b
(<*>) (NodeT a -> b
ab [TreeT m (a -> b)]
tabs) na :: NodeT m a
na@(NodeT a
a [TreeT m a]
tas) =
    forall (m :: * -> *) a. a -> [TreeT m a] -> NodeT m a
NodeT (a -> b
ab a
a) forall a b. (a -> b) -> a -> b
$
      forall a b. (a -> b) -> [a] -> [b]
map (forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall (m :: * -> *) a. Applicative m => NodeT m a -> TreeT m a
fromNodeT NodeT m a
na)) [TreeT m (a -> b)]
tabs forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
ab) [TreeT m a]
tas

instance Applicative m => Applicative (TreeT m) where
  pure :: forall a. a -> TreeT m a
pure =
    forall (m :: * -> *) a. m (NodeT m a) -> TreeT m a
TreeT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure
  <*> :: forall a b. TreeT m (a -> b) -> TreeT m a -> TreeT m b
(<*>) (TreeT m (NodeT m (a -> b))
mab) (TreeT m (NodeT m a)
ma) =
    forall (m :: * -> *) a. m (NodeT m a) -> TreeT m a
TreeT forall a b. (a -> b) -> a -> b
$
      forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>) m (NodeT m (a -> b))
mab m (NodeT m a)
ma

instance Monad m => Monad (NodeT m) where
  return :: forall a. a -> NodeT m a
return =
    forall (f :: * -> *) a. Applicative f => a -> f a
pure

  >>= :: forall a b. NodeT m a -> (a -> NodeT m b) -> NodeT m b
(>>=) (NodeT a
x [TreeT m a]
xs) a -> NodeT m b
k =
    case a -> NodeT m b
k a
x of
      NodeT b
y [TreeT m b]
ys ->
        forall (m :: * -> *) a. a -> [TreeT m a] -> NodeT m a
NodeT b
y forall a b. (a -> b) -> a -> b
$
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (m :: * -> *) a. m (NodeT m a) -> TreeT m a
TreeT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> NodeT m b
k) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. TreeT m a -> m (NodeT m a)
runTreeT) [TreeT m a]
xs forall a. [a] -> [a] -> [a]
++ [TreeT m b]
ys

instance Monad m => Monad (TreeT m) where
  return :: forall a. a -> TreeT m a
return =
    forall (f :: * -> *) a. Applicative f => a -> f a
pure

  >>= :: forall a b. TreeT m a -> (a -> TreeT m b) -> TreeT m b
(>>=) TreeT m a
m a -> TreeT m b
k =
    forall (m :: * -> *) a. m (NodeT m a) -> TreeT m a
TreeT forall a b. (a -> b) -> a -> b
$ do
      NodeT a
x [TreeT m a]
xs <- forall (m :: * -> *) a. TreeT m a -> m (NodeT m a)
runTreeT TreeT m a
m
      NodeT b
y [TreeT m b]
ys <- forall (m :: * -> *) a. TreeT m a -> m (NodeT m a)
runTreeT (a -> TreeT m b
k a
x)
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. a -> [TreeT m a] -> NodeT m a
NodeT b
y forall a b. (a -> b) -> a -> b
$
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> TreeT m b
k) [TreeT m a]
xs forall a. [a] -> [a] -> [a]
++ [TreeT m b]
ys

instance Alternative m => Alternative (TreeT m) where
  empty :: forall a. TreeT m a
empty =
    forall (m :: * -> *) a. m (NodeT m a) -> TreeT m a
TreeT forall (f :: * -> *) a. Alternative f => f a
empty
  <|> :: forall a. TreeT m a -> TreeT m a -> TreeT m a
(<|>) TreeT m a
x TreeT m a
y =
    forall (m :: * -> *) a. m (NodeT m a) -> TreeT m a
TreeT (forall (m :: * -> *) a. TreeT m a -> m (NodeT m a)
runTreeT TreeT m a
x forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *) a. TreeT m a -> m (NodeT m a)
runTreeT TreeT m a
y)

instance MonadPlus m => MonadPlus (TreeT m) where
  mzero :: forall a. TreeT m a
mzero =
    forall (m :: * -> *) a. m (NodeT m a) -> TreeT m a
TreeT forall (m :: * -> *) a. MonadPlus m => m a
mzero
  mplus :: forall a. TreeT m a -> TreeT m a -> TreeT m a
mplus TreeT m a
x TreeT m a
y =
    forall (m :: * -> *) a. m (NodeT m a) -> TreeT m a
TreeT (forall (m :: * -> *) a. TreeT m a -> m (NodeT m a)
runTreeT TreeT m a
x forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` forall (m :: * -> *) a. TreeT m a -> m (NodeT m a)
runTreeT TreeT m a
y)

zipTreeT :: forall f a b. Applicative f => TreeT f a -> TreeT f b -> TreeT f (a, b)
zipTreeT :: forall (f :: * -> *) a b.
Applicative f =>
TreeT f a -> TreeT f b -> TreeT f (a, b)
zipTreeT l0 :: TreeT f a
l0@(TreeT f (NodeT f a)
left) r0 :: TreeT f b
r0@(TreeT f (NodeT f b)
right) =
  forall (m :: * -> *) a. m (NodeT m a) -> TreeT m a
TreeT forall a b. (a -> b) -> a -> b
$
    let
      zipNodeT :: NodeT f a -> NodeT f b -> NodeT f (a, b)
      zipNodeT :: NodeT f a -> NodeT f b -> NodeT f (a, b)
zipNodeT (NodeT a
a [TreeT f a]
ls) (NodeT b
b [TreeT f b]
rs) =
          forall (m :: * -> *) a. a -> [TreeT m a] -> NodeT m a
NodeT (a
a, b
b) forall a b. (a -> b) -> a -> b
$
            forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [
                [forall (f :: * -> *) a b.
Applicative f =>
TreeT f a -> TreeT f b -> TreeT f (a, b)
zipTreeT TreeT f a
l1 TreeT f b
r0 | TreeT f a
l1 <- [TreeT f a]
ls]
              , [forall (f :: * -> *) a b.
Applicative f =>
TreeT f a -> TreeT f b -> TreeT f (a, b)
zipTreeT TreeT f a
l0 TreeT f b
r1 | TreeT f b
r1 <- [TreeT f b]
rs]
              ]
    in
      NodeT f a -> NodeT f b -> NodeT f (a, b)
zipNodeT forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (NodeT f a)
left forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f (NodeT f b)
right

instance Monad m => MonadZip (TreeT m) where
  mzip :: forall a b. TreeT m a -> TreeT m b -> TreeT m (a, b)
mzip =
    forall (f :: * -> *) a b.
Applicative f =>
TreeT f a -> TreeT f b -> TreeT f (a, b)
zipTreeT

instance MonadTrans TreeT where
  lift :: forall (m :: * -> *) a. Monad m => m a -> TreeT m a
lift m a
f =
    forall (m :: * -> *) a. m (NodeT m a) -> TreeT m a
TreeT forall a b. (a -> b) -> a -> b
$
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\a
x -> forall (m :: * -> *) a. a -> [TreeT m a] -> NodeT m a
NodeT a
x []) m a
f

instance MFunctor NodeT where
  hoist :: forall (m :: * -> *) (n :: * -> *) b.
Monad m =>
(forall a. m a -> n a) -> NodeT m b -> NodeT n b
hoist forall a. m a -> n a
f (NodeT b
x [TreeT m b]
xs) =
    forall (m :: * -> *) a. a -> [TreeT m a] -> NodeT m a
NodeT b
x (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall {k} (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
       (b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
hoist forall a. m a -> n a
f) [TreeT m b]
xs)

instance MFunctor TreeT where
  hoist :: forall (m :: * -> *) (n :: * -> *) b.
Monad m =>
(forall a. m a -> n a) -> TreeT m b -> TreeT n b
hoist forall a. m a -> n a
f (TreeT m (NodeT m b)
m) =
    forall (m :: * -> *) a. m (NodeT m a) -> TreeT m a
TreeT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. m a -> n a
f forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall {k} (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
       (b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
hoist forall a. m a -> n a
f) m (NodeT m b)
m

embedNodeT :: Monad m => (t (NodeT t b) -> TreeT m (NodeT t b)) -> NodeT t b -> NodeT m b
embedNodeT :: forall (m :: * -> *) (t :: * -> *) b.
Monad m =>
(t (NodeT t b) -> TreeT m (NodeT t b)) -> NodeT t b -> NodeT m b
embedNodeT t (NodeT t b) -> TreeT m (NodeT t b)
f (NodeT b
x [TreeT t b]
xs) =
  forall (m :: * -> *) a. a -> [TreeT m a] -> NodeT m a
NodeT b
x (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (m :: * -> *) (t :: * -> *) b.
Monad m =>
(t (NodeT t b) -> TreeT m (NodeT t b)) -> TreeT t b -> TreeT m b
embedTreeT t (NodeT t b) -> TreeT m (NodeT t b)
f) [TreeT t b]
xs)

embedTreeT :: Monad m => (t (NodeT t b) -> TreeT m (NodeT t b)) -> TreeT t b -> TreeT m b
embedTreeT :: forall (m :: * -> *) (t :: * -> *) b.
Monad m =>
(t (NodeT t b) -> TreeT m (NodeT t b)) -> TreeT t b -> TreeT m b
embedTreeT t (NodeT t b) -> TreeT m (NodeT t b)
f (TreeT t (NodeT t b)
m) =
  forall (m :: * -> *) a. m (NodeT m a) -> TreeT m a
TreeT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) (t :: * -> *) b.
Monad m =>
(t (NodeT t b) -> TreeT m (NodeT t b)) -> NodeT t b -> NodeT m b
embedNodeT t (NodeT t b) -> TreeT m (NodeT t b)
f forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< t (NodeT t b) -> TreeT m (NodeT t b)
f t (NodeT t b)
m

instance MMonad TreeT where
  embed :: forall (n :: * -> *) (m :: * -> *) b.
Monad n =>
(forall a. m a -> TreeT n a) -> TreeT m b -> TreeT n b
embed forall a. m a -> TreeT n a
f TreeT m b
m =
    forall (m :: * -> *) (t :: * -> *) b.
Monad m =>
(t (NodeT t b) -> TreeT m (NodeT t b)) -> TreeT t b -> TreeT m b
embedTreeT forall a. m a -> TreeT n a
f TreeT m b
m

distributeNodeT :: Transformer t TreeT m => NodeT (t m) a -> t (TreeT m) a
distributeNodeT :: forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
Transformer t TreeT m =>
NodeT (t m) a -> t (TreeT m) a
distributeNodeT (NodeT a
x [TreeT (t m) a]
xs) =
  forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Applicative m => NodeT m a -> TreeT m a
fromNodeT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. a -> [TreeT m a] -> NodeT m a
NodeT (forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x) forall a b. (a -> b) -> a -> b
$
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
Transformer t TreeT m =>
TreeT (t m) a -> t (TreeT m) a
distributeTreeT) [TreeT (t m) a]
xs

distributeTreeT :: Transformer t TreeT m => TreeT (t m) a -> t (TreeT m) a
distributeTreeT :: forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
Transformer t TreeT m =>
TreeT (t m) a -> t (TreeT m) a
distributeTreeT TreeT (t m) a
x =
  forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
Transformer t TreeT m =>
NodeT (t m) a -> t (TreeT m) a
distributeNodeT forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall {k} (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
       (b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
hoist forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall (m :: * -> *) a. TreeT m a -> m (NodeT m a)
runTreeT TreeT (t m) a
x)

instance MonadTransDistributive TreeT where
  distributeT :: forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
Transformer t TreeT m =>
TreeT (t m) a -> t (TreeT m) a
distributeT =
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
Transformer t TreeT m =>
TreeT (t m) a -> t (TreeT m) a
distributeTreeT

instance PrimMonad m => PrimMonad (TreeT m) where
  type PrimState (TreeT m) =
    PrimState m
  primitive :: forall a.
(State# (PrimState (TreeT m))
 -> (# State# (PrimState (TreeT m)), a #))
-> TreeT m a
primitive =
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive

instance MonadIO m => MonadIO (TreeT m) where
  liftIO :: forall a. IO a -> TreeT m a
liftIO =
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO

instance MonadBase b m => MonadBase b (TreeT m) where
  liftBase :: forall α. b α -> TreeT m α
liftBase =
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase

instance MonadThrow m => MonadThrow (TreeT m) where
  throwM :: forall e a. Exception e => e -> TreeT m a
throwM =
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM

handleNodeT :: (Exception e, MonadCatch m) => (e -> TreeT m a) -> NodeT m a -> NodeT m a
handleNodeT :: forall e (m :: * -> *) a.
(Exception e, MonadCatch m) =>
(e -> TreeT m a) -> NodeT m a -> NodeT m a
handleNodeT e -> TreeT m a
onErr (NodeT a
x [TreeT m a]
xs) =
  forall (m :: * -> *) a. a -> [TreeT m a] -> NodeT m a
NodeT a
x forall a b. (a -> b) -> a -> b
$
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall e (m :: * -> *) a.
(Exception e, MonadCatch m) =>
(e -> TreeT m a) -> TreeT m a -> TreeT m a
handleTreeT e -> TreeT m a
onErr) [TreeT m a]
xs

handleTreeT :: (Exception e, MonadCatch m) => (e -> TreeT m a) -> TreeT m a -> TreeT m a
handleTreeT :: forall e (m :: * -> *) a.
(Exception e, MonadCatch m) =>
(e -> TreeT m a) -> TreeT m a -> TreeT m a
handleTreeT e -> TreeT m a
onErr TreeT m a
m =
  forall (m :: * -> *) a. m (NodeT m a) -> TreeT m a
TreeT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall e (m :: * -> *) a.
(Exception e, MonadCatch m) =>
(e -> TreeT m a) -> NodeT m a -> NodeT m a
handleNodeT e -> TreeT m a
onErr) forall a b. (a -> b) -> a -> b
$
    forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
catch (forall (m :: * -> *) a. TreeT m a -> m (NodeT m a)
runTreeT TreeT m a
m) (forall (m :: * -> *) a. TreeT m a -> m (NodeT m a)
runTreeT forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> TreeT m a
onErr)

instance MonadCatch m => MonadCatch (TreeT m) where
  catch :: forall e a.
Exception e =>
TreeT m a -> (e -> TreeT m a) -> TreeT m a
catch =
    forall a b c. (a -> b -> c) -> b -> a -> c
flip forall e (m :: * -> *) a.
(Exception e, MonadCatch m) =>
(e -> TreeT m a) -> TreeT m a -> TreeT m a
handleTreeT

localNodeT :: MonadReader r m => (r -> r) -> NodeT m a -> NodeT m a
localNodeT :: forall r (m :: * -> *) a.
MonadReader r m =>
(r -> r) -> NodeT m a -> NodeT m a
localNodeT r -> r
f (NodeT a
x [TreeT m a]
xs) =
  forall (m :: * -> *) a. a -> [TreeT m a] -> NodeT m a
NodeT a
x forall a b. (a -> b) -> a -> b
$
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall r (m :: * -> *) a.
MonadReader r m =>
(r -> r) -> TreeT m a -> TreeT m a
localTreeT r -> r
f) [TreeT m a]
xs

localTreeT :: MonadReader r m => (r -> r) -> TreeT m a -> TreeT m a
localTreeT :: forall r (m :: * -> *) a.
MonadReader r m =>
(r -> r) -> TreeT m a -> TreeT m a
localTreeT r -> r
f (TreeT m (NodeT m a)
m) =
  forall (m :: * -> *) a. m (NodeT m a) -> TreeT m a
TreeT forall a b. (a -> b) -> a -> b
$
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r (m :: * -> *) a.
MonadReader r m =>
(r -> r) -> NodeT m a -> NodeT m a
localNodeT r -> r
f forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local r -> r
f m (NodeT m a)
m

instance MonadReader r m => MonadReader r (TreeT m) where
  ask :: TreeT m r
ask =
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall r (m :: * -> *). MonadReader r m => m r
ask
  local :: forall a. (r -> r) -> TreeT m a -> TreeT m a
local =
    forall r (m :: * -> *) a.
MonadReader r m =>
(r -> r) -> TreeT m a -> TreeT m a
localTreeT

instance MonadState s m => MonadState s (TreeT m) where
  get :: TreeT m s
get =
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall s (m :: * -> *). MonadState s m => m s
get
  put :: s -> TreeT m ()
put =
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *). MonadState s m => s -> m ()
put
  state :: forall a. (s -> (a, s)) -> TreeT m a
state =
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state

listenNodeT :: MonadWriter w m => w -> NodeT m a -> NodeT m (a, w)
listenNodeT :: forall w (m :: * -> *) a.
MonadWriter w m =>
w -> NodeT m a -> NodeT m (a, w)
listenNodeT w
w (NodeT a
x [TreeT m a]
xs) =
  forall (m :: * -> *) a. a -> [TreeT m a] -> NodeT m a
NodeT (a
x, w
w) forall a b. (a -> b) -> a -> b
$
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall w (m :: * -> *) a.
MonadWriter w m =>
w -> TreeT m a -> TreeT m (a, w)
listenTreeT w
w) [TreeT m a]
xs

listenTreeT :: MonadWriter w m => w -> TreeT m a -> TreeT m (a, w)
listenTreeT :: forall w (m :: * -> *) a.
MonadWriter w m =>
w -> TreeT m a -> TreeT m (a, w)
listenTreeT w
w0 (TreeT m (NodeT m a)
m) =
  forall (m :: * -> *) a. m (NodeT m a) -> TreeT m a
TreeT forall a b. (a -> b) -> a -> b
$ do
    (NodeT m a
x, w
w) <- forall w (m :: * -> *) a. MonadWriter w m => m a -> m (a, w)
listen m (NodeT m a)
m
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall w (m :: * -> *) a.
MonadWriter w m =>
w -> NodeT m a -> NodeT m (a, w)
listenNodeT (forall a. Monoid a => a -> a -> a
mappend w
w0 w
w) NodeT m a
x

-- FIXME This just throws away the writer modification function.
passNodeT :: MonadWriter w m => NodeT m (a, w -> w) -> NodeT m a
passNodeT :: forall w (m :: * -> *) a.
MonadWriter w m =>
NodeT m (a, w -> w) -> NodeT m a
passNodeT (NodeT (a
x, w -> w
_) [TreeT m (a, w -> w)]
xs) =
  forall (m :: * -> *) a. a -> [TreeT m a] -> NodeT m a
NodeT a
x forall a b. (a -> b) -> a -> b
$
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall w (m :: * -> *) a.
MonadWriter w m =>
TreeT m (a, w -> w) -> TreeT m a
passTreeT [TreeT m (a, w -> w)]
xs

passTreeT :: MonadWriter w m => TreeT m (a, w -> w) -> TreeT m a
passTreeT :: forall w (m :: * -> *) a.
MonadWriter w m =>
TreeT m (a, w -> w) -> TreeT m a
passTreeT (TreeT m (NodeT m (a, w -> w))
m) =
  forall (m :: * -> *) a. m (NodeT m a) -> TreeT m a
TreeT forall a b. (a -> b) -> a -> b
$
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall w (m :: * -> *) a.
MonadWriter w m =>
NodeT m (a, w -> w) -> NodeT m a
passNodeT forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m (NodeT m (a, w -> w))
m

instance MonadWriter w m => MonadWriter w (TreeT m) where
  writer :: forall a. (a, w) -> TreeT m a
writer =
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall w (m :: * -> *) a. MonadWriter w m => (a, w) -> m a
writer
  tell :: w -> TreeT m ()
tell =
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell
  listen :: forall a. TreeT m a -> TreeT m (a, w)
listen =
    forall w (m :: * -> *) a.
MonadWriter w m =>
w -> TreeT m a -> TreeT m (a, w)
listenTreeT forall a. Monoid a => a
mempty
  pass :: forall a. TreeT m (a, w -> w) -> TreeT m a
pass =
    forall w (m :: * -> *) a.
MonadWriter w m =>
TreeT m (a, w -> w) -> TreeT m a
passTreeT

handleErrorNodeT :: MonadError e m => (e -> TreeT m a) -> NodeT m a -> NodeT m a
handleErrorNodeT :: forall e (m :: * -> *) a.
MonadError e m =>
(e -> TreeT m a) -> NodeT m a -> NodeT m a
handleErrorNodeT e -> TreeT m a
onErr (NodeT a
x [TreeT m a]
xs) =
  forall (m :: * -> *) a. a -> [TreeT m a] -> NodeT m a
NodeT a
x forall a b. (a -> b) -> a -> b
$
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall e (m :: * -> *) a.
MonadError e m =>
(e -> TreeT m a) -> TreeT m a -> TreeT m a
handleErrorTreeT e -> TreeT m a
onErr) [TreeT m a]
xs

handleErrorTreeT :: MonadError e m => (e -> TreeT m a) -> TreeT m a -> TreeT m a
handleErrorTreeT :: forall e (m :: * -> *) a.
MonadError e m =>
(e -> TreeT m a) -> TreeT m a -> TreeT m a
handleErrorTreeT e -> TreeT m a
onErr TreeT m a
m =
  forall (m :: * -> *) a. m (NodeT m a) -> TreeT m a
TreeT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall e (m :: * -> *) a.
MonadError e m =>
(e -> TreeT m a) -> NodeT m a -> NodeT m a
handleErrorNodeT e -> TreeT m a
onErr) forall a b. (a -> b) -> a -> b
$
    forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError (forall (m :: * -> *) a. TreeT m a -> m (NodeT m a)
runTreeT TreeT m a
m) (forall (m :: * -> *) a. TreeT m a -> m (NodeT m a)
runTreeT forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> TreeT m a
onErr)

instance MonadError e m => MonadError e (TreeT m) where
  throwError :: forall a. e -> TreeT m a
throwError =
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError
  catchError :: forall a. TreeT m a -> (e -> TreeT m a) -> TreeT m a
catchError =
    forall a b c. (a -> b -> c) -> b -> a -> c
flip forall e (m :: * -> *) a.
MonadError e m =>
(e -> TreeT m a) -> TreeT m a -> TreeT m a
handleErrorTreeT

instance MonadResource m => MonadResource (TreeT m) where
  liftResourceT :: forall a. ResourceT IO a -> TreeT m a
liftResourceT =
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadResource m => ResourceT IO a -> m a
liftResourceT

------------------------------------------------------------------------
-- Show/Show1 instances

instance (Show1 m, Show a) => Show (NodeT m a) where
  showsPrec :: Int -> NodeT m a -> ShowS
showsPrec =
    forall (f :: * -> *) a. (Show1 f, Show a) => Int -> f a -> ShowS
showsPrec1

instance (Show1 m, Show a) => Show (TreeT m a) where
  showsPrec :: Int -> TreeT m a -> ShowS
showsPrec =
    forall (f :: * -> *) a. (Show1 f, Show a) => Int -> f a -> ShowS
showsPrec1

instance Show1 m => Show1 (NodeT m) where
  liftShowsPrec :: forall a.
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> NodeT m a -> ShowS
liftShowsPrec Int -> a -> ShowS
sp [a] -> ShowS
sl Int
d (NodeT a
x [TreeT m a]
xs) =
    let
      sp1 :: Int -> TreeT m a -> ShowS
sp1 =
        forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
liftShowsPrec Int -> a -> ShowS
sp [a] -> ShowS
sl

      sl1 :: [TreeT m a] -> ShowS
sl1 =
        forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> [f a] -> ShowS
liftShowList Int -> a -> ShowS
sp [a] -> ShowS
sl

      sp2 :: Int -> [TreeT m a] -> ShowS
sp2 =
        forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
liftShowsPrec Int -> TreeT m a -> ShowS
sp1 [TreeT m a] -> ShowS
sl1
    in
      forall a b.
(Int -> a -> ShowS)
-> (Int -> b -> ShowS) -> String -> Int -> a -> b -> ShowS
showsBinaryWith Int -> a -> ShowS
sp Int -> [TreeT m a] -> ShowS
sp2 String
"NodeT" Int
d a
x [TreeT m a]
xs

instance Show1 m => Show1 (TreeT m) where
  liftShowsPrec :: forall a.
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> TreeT m a -> ShowS
liftShowsPrec Int -> a -> ShowS
sp [a] -> ShowS
sl Int
d (TreeT m (NodeT m a)
m) =
    let
      sp1 :: Int -> NodeT m a -> ShowS
sp1 =
        forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
liftShowsPrec Int -> a -> ShowS
sp [a] -> ShowS
sl

      sl1 :: [NodeT m a] -> ShowS
sl1 =
        forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> [f a] -> ShowS
liftShowList Int -> a -> ShowS
sp [a] -> ShowS
sl

      sp2 :: Int -> m (NodeT m a) -> ShowS
sp2 =
        forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
liftShowsPrec Int -> NodeT m a -> ShowS
sp1 [NodeT m a] -> ShowS
sl1
    in
      forall a. (Int -> a -> ShowS) -> String -> Int -> a -> ShowS
showsUnaryWith Int -> m (NodeT m a) -> ShowS
sp2 String
"TreeT" Int
d m (NodeT m a)
m

------------------------------------------------------------------------
-- Pretty Printing

--
-- Rendering implementation based on the one from containers/Data.Tree
--

renderTreeTLines :: Monad m => TreeT m String -> m [String]
renderTreeTLines :: forall (m :: * -> *). Monad m => TreeT m String -> m [String]
renderTreeTLines (TreeT m (NodeT m String)
m) = do
  NodeT String
x [TreeT m String]
xs0 <- m (NodeT m String)
m
  [String]
xs <- forall (m :: * -> *). Monad m => [TreeT m String] -> m [String]
renderForestLines [TreeT m String]
xs0
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
    String -> [String]
lines (ShowS
renderNodeT String
x) forall a. [a] -> [a] -> [a]
++ [String]
xs

renderNodeT :: String -> String
renderNodeT :: ShowS
renderNodeT String
xs =
  case String
xs of
    [Char
_] ->
      Char
' ' forall a. a -> [a] -> [a]
: String
xs
    String
_ ->
      String
xs

renderForestLines :: Monad m => [TreeT m String] -> m [String]
renderForestLines :: forall (m :: * -> *). Monad m => [TreeT m String] -> m [String]
renderForestLines [TreeT m String]
xs0 =
  let
    shift :: [a] -> [a] -> [[a]] -> [[a]]
shift [a]
hd [a]
other =
      forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall a. [a] -> [a] -> [a]
(++) ([a]
hd forall a. a -> [a] -> [a]
: forall a. a -> [a]
repeat [a]
other)
  in
    case [TreeT m String]
xs0 of
      [] ->
        forall (f :: * -> *) a. Applicative f => a -> f a
pure []

      [TreeT m String
x] -> do
        [String]
s <- forall (m :: * -> *). Monad m => TreeT m String -> m [String]
renderTreeTLines TreeT m String
x
        forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
          forall {a}. [a] -> [a] -> [[a]] -> [[a]]
shift String
" └╼" String
"   " [String]
s

      TreeT m String
x : [TreeT m String]
xs -> do
        [String]
s <- forall (m :: * -> *). Monad m => TreeT m String -> m [String]
renderTreeTLines TreeT m String
x
        [String]
ss <- forall (m :: * -> *). Monad m => [TreeT m String] -> m [String]
renderForestLines [TreeT m String]
xs
        forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
          forall {a}. [a] -> [a] -> [[a]] -> [[a]]
shift String
" ├╼" String
" │ " [String]
s forall a. [a] -> [a] -> [a]
++ [String]
ss

-- | Render a tree of strings.
--
render :: Tree String -> String
render :: Tree String -> String
render =
  forall a. Identity a -> a
runIdentity forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). Monad m => TreeT m String -> m String
renderT

-- | Render a tree of strings, note that this forces all the delayed effects in
--   the tree.
--
renderT :: Monad m => TreeT m String -> m String
renderT :: forall (m :: * -> *). Monad m => TreeT m String -> m String
renderT =
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [String] -> String
unlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). Monad m => TreeT m String -> m [String]
renderTreeTLines