{-# 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 #-}
#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
, 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)
type Tree =
TreeT Identity
pattern Tree :: NodeT Identity a -> Tree a
pattern $bTree :: NodeT Identity a -> Tree a
$mTree :: forall r a. Tree a -> (NodeT Identity a -> r) -> (Void# -> r) -> r
Tree node =
TreeT (Identity node)
#if __GLASGOW_HASKELL__ >= 802
{-# COMPLETE Tree #-}
#endif
newtype TreeT m a =
TreeT {
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 :: (RunInBase (TreeT m) b -> b a) -> TreeT m a
liftBaseWith f :: RunInBase (TreeT m) b -> b a
f = m (NodeT m a) -> TreeT m a
forall (m :: * -> *) a. m (NodeT m a) -> TreeT m a
TreeT (m (NodeT m a) -> TreeT m a) -> m (NodeT m a) -> TreeT m a
forall a b. (a -> b) -> a -> b
$ (RunInBase m b -> b (NodeT m a)) -> m (NodeT m a)
forall (b :: * -> *) (m :: * -> *) a.
MonadBaseControl b m =>
(RunInBase m b -> b a) -> m a
liftBaseWith (\g :: RunInBase m b
g -> a -> NodeT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> NodeT m a) -> b a -> b (NodeT m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RunInBase (TreeT m) b -> b a
f (m (NodeT m a) -> b (StM m (NodeT m a))
RunInBase m b
g (m (NodeT m a) -> b (StM m (NodeT m a)))
-> (TreeT m a -> m (NodeT m a))
-> TreeT m a
-> b (StM m (NodeT m a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TreeT m a -> m (NodeT m a)
forall (m :: * -> *) a. TreeT m a -> m (NodeT m a)
runTreeT))
restoreM :: StM (TreeT m) a -> TreeT m a
restoreM = m (NodeT m a) -> TreeT m a
forall (m :: * -> *) a. m (NodeT m a) -> TreeT m a
TreeT (m (NodeT m a) -> TreeT m a)
-> (StM m (NodeT m a) -> m (NodeT m a))
-> StM m (NodeT m a)
-> TreeT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StM m (NodeT m a) -> m (NodeT m a)
forall (b :: * -> *) (m :: * -> *) a.
MonadBaseControl b m =>
StM m a -> m a
restoreM
type Node =
NodeT Identity
#if __GLASGOW_HASKELL__ >= 802
{-# COMPLETE Node #-}
#endif
pattern Node :: a -> [Tree a] -> Node a
pattern $bNode :: a -> [Tree a] -> Node a
$mNode :: forall r a. Node a -> (a -> [Tree a] -> r) -> (Void# -> r) -> r
Node x xs =
NodeT x xs
data NodeT m a =
NodeT {
NodeT m a -> a
nodeValue :: a
, NodeT m a -> [TreeT m a]
nodeChildren :: [TreeT m a]
} deriving (NodeT m a -> NodeT m a -> Bool
(NodeT m a -> NodeT m a -> Bool)
-> (NodeT m a -> NodeT m a -> Bool) -> Eq (NodeT m a)
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)
runTree :: Tree a -> Node a
runTree :: Tree a -> Node a
runTree =
Identity (Node a) -> Node a
forall a. Identity a -> a
runIdentity (Identity (Node a) -> Node a)
-> (Tree a -> Identity (Node a)) -> Tree a -> Node a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree a -> Identity (Node a)
forall (m :: * -> *) a. TreeT m a -> m (NodeT m a)
runTreeT
mapTreeT :: (m (NodeT m a) -> m (NodeT m a)) -> TreeT m a -> TreeT m a
mapTreeT :: (m (NodeT m a) -> m (NodeT m a)) -> TreeT m a -> TreeT m a
mapTreeT f :: m (NodeT m a) -> m (NodeT m a)
f =
m (NodeT m a) -> TreeT m a
forall (m :: * -> *) a. m (NodeT m a) -> TreeT m a
TreeT (m (NodeT m a) -> TreeT m a)
-> (TreeT m a -> m (NodeT m a)) -> TreeT m a -> TreeT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (NodeT m a) -> m (NodeT m a)
f (m (NodeT m a) -> m (NodeT m a))
-> (TreeT m a -> m (NodeT m a)) -> TreeT m a -> m (NodeT m a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TreeT m a -> m (NodeT m a)
forall (m :: * -> *) a. TreeT m a -> m (NodeT m a)
runTreeT
fromNodeT :: Applicative m => NodeT m a -> TreeT m a
fromNodeT :: NodeT m a -> TreeT m a
fromNodeT =
m (NodeT m a) -> TreeT m a
forall (m :: * -> *) a. m (NodeT m a) -> TreeT m a
TreeT (m (NodeT m a) -> TreeT m a)
-> (NodeT m a -> m (NodeT m a)) -> NodeT m a -> TreeT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodeT m a -> m (NodeT m a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure
treeValue :: Tree a -> a
treeValue :: Tree a -> a
treeValue =
NodeT Identity a -> a
forall (m :: * -> *) a. NodeT m a -> a
nodeValue (NodeT Identity a -> a)
-> (Tree a -> NodeT Identity a) -> Tree a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree a -> NodeT Identity a
forall a. Tree a -> Node a
runTree
treeChildren :: Tree a -> [Tree a]
treeChildren :: Tree a -> [Tree a]
treeChildren =
NodeT Identity a -> [Tree a]
forall (m :: * -> *) a. NodeT m a -> [TreeT m a]
nodeChildren (NodeT Identity a -> [Tree a])
-> (Tree a -> NodeT Identity a) -> Tree a -> [Tree a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree a -> NodeT Identity a
forall a. Tree a -> Node a
runTree
unfold :: Monad m => (a -> [a]) -> a -> TreeT m a
unfold :: (a -> [a]) -> a -> TreeT m a
unfold f :: a -> [a]
f x :: a
x =
m (NodeT m a) -> TreeT m a
forall (m :: * -> *) a. m (NodeT m a) -> TreeT m a
TreeT (m (NodeT m a) -> TreeT m a)
-> (NodeT m a -> m (NodeT m a)) -> NodeT m a -> TreeT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodeT m a -> m (NodeT m a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NodeT m a -> TreeT m a) -> NodeT m a -> TreeT m a
forall a b. (a -> b) -> a -> b
$
a -> [TreeT m a] -> NodeT m a
forall (m :: * -> *) a. a -> [TreeT m a] -> NodeT m a
NodeT a
x ((a -> [a]) -> a -> [TreeT m a]
forall (m :: * -> *) a. Monad m => (a -> [a]) -> a -> [TreeT m a]
unfoldForest a -> [a]
f a
x)
unfoldForest :: Monad m => (a -> [a]) -> a -> [TreeT m a]
unfoldForest :: (a -> [a]) -> a -> [TreeT m a]
unfoldForest f :: a -> [a]
f =
(a -> TreeT m a) -> [a] -> [TreeT m a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> [a]) -> a -> TreeT m a
forall (m :: * -> *) a. Monad m => (a -> [a]) -> a -> TreeT m a
unfold a -> [a]
f) ([a] -> [TreeT m a]) -> (a -> [a]) -> a -> [TreeT m a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [a]
f
expand :: Monad m => (a -> [a]) -> TreeT m a -> TreeT m a
expand :: (a -> [a]) -> TreeT m a -> TreeT m a
expand f :: a -> [a]
f m :: TreeT m a
m =
m (NodeT m a) -> TreeT m a
forall (m :: * -> *) a. m (NodeT m a) -> TreeT m a
TreeT (m (NodeT m a) -> TreeT m a) -> m (NodeT m a) -> TreeT m a
forall a b. (a -> b) -> a -> b
$ do
NodeT x :: a
x xs :: [TreeT m a]
xs <- TreeT m a -> m (NodeT m a)
forall (m :: * -> *) a. TreeT m a -> m (NodeT m a)
runTreeT TreeT m a
m
NodeT m a -> m (NodeT m a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NodeT m a -> m (NodeT m a))
-> ([TreeT m a] -> NodeT m a) -> [TreeT m a] -> m (NodeT m a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [TreeT m a] -> NodeT m a
forall (m :: * -> *) a. a -> [TreeT m a] -> NodeT m a
NodeT a
x ([TreeT m a] -> m (NodeT m a)) -> [TreeT m a] -> m (NodeT m a)
forall a b. (a -> b) -> a -> b
$
(TreeT m a -> TreeT m a) -> [TreeT m a] -> [TreeT m a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> [a]) -> TreeT m a -> TreeT m a
forall (m :: * -> *) a.
Monad m =>
(a -> [a]) -> TreeT m a -> TreeT m a
expand a -> [a]
f) [TreeT m a]
xs [TreeT m a] -> [TreeT m a] -> [TreeT m a]
forall a. [a] -> [a] -> [a]
++ (a -> [a]) -> a -> [TreeT m a]
forall (m :: * -> *) a. Monad m => (a -> [a]) -> a -> [TreeT m a]
unfoldForest a -> [a]
f a
x
prune :: Monad m => Int -> TreeT m a -> TreeT m a
prune :: Int -> TreeT m a -> TreeT m a
prune n :: Int
n m :: TreeT m a
m =
if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0 then
m (NodeT m a) -> TreeT m a
forall (m :: * -> *) a. m (NodeT m a) -> TreeT m a
TreeT (m (NodeT m a) -> TreeT m a) -> m (NodeT m a) -> TreeT m a
forall a b. (a -> b) -> a -> b
$ do
NodeT x :: a
x _ <- TreeT m a -> m (NodeT m a)
forall (m :: * -> *) a. TreeT m a -> m (NodeT m a)
runTreeT TreeT m a
m
NodeT m a -> m (NodeT m a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NodeT m a -> m (NodeT m a)) -> NodeT m a -> m (NodeT m a)
forall a b. (a -> b) -> a -> b
$ a -> [TreeT m a] -> NodeT m a
forall (m :: * -> *) a. a -> [TreeT m a] -> NodeT m a
NodeT a
x []
else
m (NodeT m a) -> TreeT m a
forall (m :: * -> *) a. m (NodeT m a) -> TreeT m a
TreeT (m (NodeT m a) -> TreeT m a) -> m (NodeT m a) -> TreeT m a
forall a b. (a -> b) -> a -> b
$ do
NodeT x :: a
x xs0 :: [TreeT m a]
xs0 <- TreeT m a -> m (NodeT m a)
forall (m :: * -> *) a. TreeT m a -> m (NodeT m a)
runTreeT TreeT m a
m
NodeT m a -> m (NodeT m a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NodeT m a -> m (NodeT m a))
-> ([TreeT m a] -> NodeT m a) -> [TreeT m a] -> m (NodeT m a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [TreeT m a] -> NodeT m a
forall (m :: * -> *) a. a -> [TreeT m a] -> NodeT m a
NodeT a
x ([TreeT m a] -> m (NodeT m a)) -> [TreeT m a] -> m (NodeT m a)
forall a b. (a -> b) -> a -> b
$
(TreeT m a -> TreeT m a) -> [TreeT m a] -> [TreeT m a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> TreeT m a -> TreeT m a
forall (m :: * -> *) a. Monad m => Int -> TreeT m a -> TreeT m a
prune (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1)) [TreeT m a]
xs0
depth :: Tree a -> Int
depth :: Tree a -> Int
depth m :: Tree a
m =
let
NodeT _ xs :: [Tree a]
xs =
Tree a -> NodeT Identity a
forall a. Tree a -> Node a
runTree Tree a
m
n :: Int
n =
if [Tree a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Tree a]
xs then
0
else
[Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ((Tree a -> Int) -> [Tree a] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Tree a -> Int
forall a. Tree a -> Int
depth [Tree a]
xs)
in
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n
catMaybes :: Tree (Maybe a) -> Maybe (Tree a)
catMaybes :: Tree (Maybe a) -> Maybe (Tree a)
catMaybes m :: Tree (Maybe a)
m =
let
NodeT mx :: Maybe a
mx mxs :: [Tree (Maybe a)]
mxs =
Tree (Maybe a) -> NodeT Identity (Maybe a)
forall a. Tree a -> Node a
runTree Tree (Maybe a)
m
in
case Maybe a
mx of
Nothing -> do
case (Tree (Maybe a) -> Maybe (Tree a)) -> [Tree (Maybe a)] -> [Tree a]
forall a b. (a -> Maybe b) -> [a] -> [b]
Maybe.mapMaybe Tree (Maybe a) -> Maybe (Tree a)
forall a. Tree (Maybe a) -> Maybe (Tree a)
catMaybes [Tree (Maybe a)]
mxs of
[] ->
Maybe (Tree a)
forall a. Maybe a
Nothing
Tree (NodeT x :: a
x xs0 :: [Tree a]
xs0) : xs1 :: [Tree a]
xs1 ->
Tree a -> Maybe (Tree a)
forall a. a -> Maybe a
Just (Tree a -> Maybe (Tree a))
-> (NodeT Identity a -> Tree a)
-> NodeT Identity a
-> Maybe (Tree a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodeT Identity a -> Tree a
forall a. NodeT Identity a -> Tree a
Tree (NodeT Identity a -> Maybe (Tree a))
-> NodeT Identity a -> Maybe (Tree a)
forall a b. (a -> b) -> a -> b
$
a -> [Tree a] -> NodeT Identity a
forall a. a -> [Tree a] -> Node a
Node a
x ([Tree a]
xs0 [Tree a] -> [Tree a] -> [Tree a]
forall a. [a] -> [a] -> [a]
++ [Tree a]
xs1)
Just x :: a
x ->
Tree a -> Maybe (Tree a)
forall a. a -> Maybe a
Just (Tree a -> Maybe (Tree a))
-> (NodeT Identity a -> Tree a)
-> NodeT Identity a
-> Maybe (Tree a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodeT Identity a -> Tree a
forall a. NodeT Identity a -> Tree a
Tree (NodeT Identity a -> Maybe (Tree a))
-> NodeT Identity a -> Maybe (Tree a)
forall a b. (a -> b) -> a -> b
$
a -> [Tree a] -> NodeT Identity a
forall a. a -> [Tree a] -> Node a
Node a
x ((Tree (Maybe a) -> Maybe (Tree a)) -> [Tree (Maybe a)] -> [Tree a]
forall a b. (a -> Maybe b) -> [a] -> [b]
Maybe.mapMaybe Tree (Maybe a) -> Maybe (Tree a)
forall a. Tree (Maybe a) -> Maybe (Tree a)
catMaybes [Tree (Maybe a)]
mxs)
fromPred :: (a -> Bool) -> a -> Maybe a
fromPred :: (a -> Bool) -> a -> Maybe a
fromPred p :: a -> Bool
p a :: a
a = a
a a -> Maybe () -> Maybe a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (a -> Bool
p a
a)
filter :: (a -> Bool) -> Tree a -> Maybe (Tree a)
filter :: (a -> Bool) -> Tree a -> Maybe (Tree a)
filter p :: a -> Bool
p = (a -> Maybe a) -> Tree a -> Maybe (Tree a)
forall a b. (a -> Maybe b) -> Tree a -> Maybe (Tree b)
mapMaybe ((a -> Bool) -> a -> Maybe a
forall a. (a -> Bool) -> a -> Maybe a
fromPred a -> Bool
p)
mapMaybe :: (a -> Maybe b) -> Tree a -> Maybe (Tree b)
mapMaybe :: (a -> Maybe b) -> Tree a -> Maybe (Tree b)
mapMaybe p :: a -> Maybe b
p =
Tree (Maybe b) -> Maybe (Tree b)
forall a. Tree (Maybe a) -> Maybe (Tree a)
catMaybes (Tree (Maybe b) -> Maybe (Tree b))
-> (Tree a -> Tree (Maybe b)) -> Tree a -> Maybe (Tree b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
TreeT (MaybeT Identity) b -> Tree (Maybe b)
forall (m :: * -> *) a.
Monad m =>
TreeT (MaybeT m) a -> TreeT m (Maybe a)
runTreeMaybeT (TreeT (MaybeT Identity) b -> Tree (Maybe b))
-> (Tree a -> TreeT (MaybeT Identity) b)
-> Tree a
-> Tree (Maybe b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(a -> Maybe b)
-> TreeT (MaybeT Identity) a -> TreeT (MaybeT Identity) b
forall a b.
(a -> Maybe b)
-> TreeT (MaybeT Identity) a -> TreeT (MaybeT Identity) b
mapMaybeMaybeT a -> Maybe b
p (TreeT (MaybeT Identity) a -> TreeT (MaybeT Identity) b)
-> (Tree a -> TreeT (MaybeT Identity) a)
-> Tree a
-> TreeT (MaybeT Identity) b
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(forall a. Identity a -> MaybeT Identity a)
-> Tree a -> TreeT (MaybeT Identity) a
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. Identity a -> MaybeT Identity a
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 :: TreeT (MaybeT m) a -> TreeT m (Maybe a)
runTreeMaybeT =
MaybeT (TreeT m) a -> TreeT m (Maybe a)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT (TreeT m) a -> TreeT m (Maybe a))
-> (TreeT (MaybeT m) a -> MaybeT (TreeT m) a)
-> TreeT (MaybeT m) a
-> TreeT m (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
TreeT (MaybeT m) a -> MaybeT (TreeT m) a
forall (g :: (* -> *) -> * -> *) (f :: (* -> *) -> * -> *)
(m :: * -> *) a.
(MonadTransDistributive g, Transformer f g m) =>
g (f m) a -> f (g m) a
distributeT
filterMaybeT :: (a -> Bool) -> TreeT (MaybeT Identity) a -> TreeT (MaybeT Identity) a
filterMaybeT :: (a -> Bool)
-> TreeT (MaybeT Identity) a -> TreeT (MaybeT Identity) a
filterMaybeT p :: a -> Bool
p = (a -> Maybe a)
-> TreeT (MaybeT Identity) a -> TreeT (MaybeT Identity) a
forall a b.
(a -> Maybe b)
-> TreeT (MaybeT Identity) a -> TreeT (MaybeT Identity) b
mapMaybeMaybeT ((a -> Bool) -> a -> Maybe a
forall a. (a -> Bool) -> a -> Maybe a
fromPred a -> Bool
p)
mapMaybeMaybeT :: (a -> Maybe b) -> TreeT (MaybeT Identity) a -> TreeT (MaybeT Identity) b
mapMaybeMaybeT :: (a -> Maybe b)
-> TreeT (MaybeT Identity) a -> TreeT (MaybeT Identity) b
mapMaybeMaybeT p :: a -> Maybe b
p t :: TreeT (MaybeT Identity) a
t =
case TreeT (MaybeT Identity) a -> TreeT Identity (Maybe a)
forall (m :: * -> *) a.
Monad m =>
TreeT (MaybeT m) a -> TreeT m (Maybe a)
runTreeMaybeT TreeT (MaybeT Identity) a
t of
Tree (Node Nothing _) ->
MaybeT Identity (NodeT (MaybeT Identity) b)
-> TreeT (MaybeT Identity) b
forall (m :: * -> *) a. m (NodeT m a) -> TreeT m a
TreeT (MaybeT Identity (NodeT (MaybeT Identity) b)
-> TreeT (MaybeT Identity) b)
-> (Maybe (NodeT (MaybeT Identity) b)
-> MaybeT Identity (NodeT (MaybeT Identity) b))
-> Maybe (NodeT (MaybeT Identity) b)
-> TreeT (MaybeT Identity) b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity (Maybe (NodeT (MaybeT Identity) b))
-> MaybeT Identity (NodeT (MaybeT Identity) b)
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (Identity (Maybe (NodeT (MaybeT Identity) b))
-> MaybeT Identity (NodeT (MaybeT Identity) b))
-> (Maybe (NodeT (MaybeT Identity) b)
-> Identity (Maybe (NodeT (MaybeT Identity) b)))
-> Maybe (NodeT (MaybeT Identity) b)
-> MaybeT Identity (NodeT (MaybeT Identity) b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (NodeT (MaybeT Identity) b)
-> Identity (Maybe (NodeT (MaybeT Identity) b))
forall a. a -> Identity a
Identity (Maybe (NodeT (MaybeT Identity) b) -> TreeT (MaybeT Identity) b)
-> Maybe (NodeT (MaybeT Identity) b) -> TreeT (MaybeT Identity) b
forall a b. (a -> b) -> a -> b
$ Maybe (NodeT (MaybeT Identity) b)
forall a. Maybe a
Nothing
Tree (Node (Just x :: a
x) xs :: [TreeT Identity (Maybe a)]
xs) ->
case a -> Maybe b
p a
x of
Nothing -> MaybeT Identity (NodeT (MaybeT Identity) b)
-> TreeT (MaybeT Identity) b
forall (m :: * -> *) a. m (NodeT m a) -> TreeT m a
TreeT (MaybeT Identity (NodeT (MaybeT Identity) b)
-> TreeT (MaybeT Identity) b)
-> (Maybe (NodeT (MaybeT Identity) b)
-> MaybeT Identity (NodeT (MaybeT Identity) b))
-> Maybe (NodeT (MaybeT Identity) b)
-> TreeT (MaybeT Identity) b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity (Maybe (NodeT (MaybeT Identity) b))
-> MaybeT Identity (NodeT (MaybeT Identity) b)
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (Identity (Maybe (NodeT (MaybeT Identity) b))
-> MaybeT Identity (NodeT (MaybeT Identity) b))
-> (Maybe (NodeT (MaybeT Identity) b)
-> Identity (Maybe (NodeT (MaybeT Identity) b)))
-> Maybe (NodeT (MaybeT Identity) b)
-> MaybeT Identity (NodeT (MaybeT Identity) b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (NodeT (MaybeT Identity) b)
-> Identity (Maybe (NodeT (MaybeT Identity) b))
forall a. a -> Identity a
Identity (Maybe (NodeT (MaybeT Identity) b) -> TreeT (MaybeT Identity) b)
-> Maybe (NodeT (MaybeT Identity) b) -> TreeT (MaybeT Identity) b
forall a b. (a -> b) -> a -> b
$ Maybe (NodeT (MaybeT Identity) b)
forall a. Maybe a
Nothing
Just x' :: b
x' ->
(forall a. Identity a -> MaybeT Identity a)
-> TreeT Identity b -> TreeT (MaybeT Identity) 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 a. Identity a -> MaybeT Identity a
forall (m :: * -> *) a. Monad m => Identity a -> m a
generalize (TreeT Identity b -> TreeT (MaybeT Identity) b)
-> TreeT Identity b -> TreeT (MaybeT Identity) b
forall a b. (a -> b) -> a -> b
$
NodeT Identity b -> TreeT Identity b
forall a. NodeT Identity a -> Tree a
Tree (NodeT Identity b -> TreeT Identity b)
-> ([TreeT Identity b] -> NodeT Identity b)
-> [TreeT Identity b]
-> TreeT Identity b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> [TreeT Identity b] -> NodeT Identity b
forall a. a -> [Tree a] -> Node a
Node b
x' ([TreeT Identity b] -> TreeT Identity b)
-> [TreeT Identity b] -> TreeT Identity b
forall a b. (a -> b) -> a -> b
$
(TreeT Identity (Maybe a) -> [TreeT Identity b])
-> [TreeT Identity (Maybe a)] -> [TreeT Identity b]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((a -> Maybe b) -> TreeT Identity (Maybe a) -> [TreeT Identity b]
forall a b. (a -> Maybe b) -> Tree (Maybe a) -> [Tree b]
flattenTree a -> Maybe b
p) [TreeT Identity (Maybe a)]
xs
flattenTree :: (a -> Maybe b) -> Tree (Maybe a) -> [Tree b]
flattenTree :: (a -> Maybe b) -> Tree (Maybe a) -> [Tree b]
flattenTree p :: a -> Maybe b
p (Tree (Node mx :: Maybe a
mx mxs0 :: [Tree (Maybe a)]
mxs0)) =
let
mxs :: [Tree b]
mxs =
(Tree (Maybe a) -> [Tree b]) -> [Tree (Maybe a)] -> [Tree b]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((a -> Maybe b) -> Tree (Maybe a) -> [Tree b]
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
Nothing -> [Tree b]
mxs
Just x :: a
x ->
case a -> Maybe b
p a
x of
Just x' :: b
x' ->
[NodeT Identity b -> Tree b
forall a. NodeT Identity a -> Tree a
Tree (b -> [Tree b] -> NodeT Identity b
forall a. a -> [Tree a] -> Node a
Node b
x' [Tree b]
mxs)]
Nothing ->
[Tree b]
mxs
filterT :: (Monad m, Alternative m) => (a -> Bool) -> TreeT m a -> TreeT m a
filterT :: (a -> Bool) -> TreeT m a -> TreeT m a
filterT p :: a -> Bool
p =
(a -> Maybe a) -> TreeT m a -> TreeT m a
forall (m :: * -> *) a b.
(Monad m, Alternative m) =>
(a -> Maybe b) -> TreeT m a -> TreeT m b
mapMaybeT ((a -> Bool) -> a -> Maybe a
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 :: (a -> Maybe b) -> TreeT m a -> TreeT m b
mapMaybeT p :: a -> Maybe b
p m :: TreeT m a
m =
m (NodeT m b) -> TreeT m b
forall (m :: * -> *) a. m (NodeT m a) -> TreeT m a
TreeT (m (NodeT m b) -> TreeT m b) -> m (NodeT m b) -> TreeT m b
forall a b. (a -> b) -> a -> b
$ do
NodeT x :: a
x xs :: [TreeT m a]
xs <- TreeT m a -> m (NodeT m a)
forall (m :: * -> *) a. TreeT m a -> m (NodeT m a)
runTreeT TreeT m a
m
case a -> Maybe b
p a
x of
Just x' :: b
x' ->
NodeT m b -> m (NodeT m b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NodeT m b -> m (NodeT m b)) -> NodeT m b -> m (NodeT m b)
forall a b. (a -> b) -> a -> b
$
b -> [TreeT m b] -> NodeT m b
forall (m :: * -> *) a. a -> [TreeT m a] -> NodeT m a
NodeT b
x' ((TreeT m a -> TreeT m b) -> [TreeT m a] -> [TreeT m b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> Maybe b) -> TreeT m a -> TreeT m b
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)
Nothing ->
m (NodeT m b)
forall (f :: * -> *) a. Alternative f => f a
empty
splits :: [a] -> [([a], a, [a])]
splits :: [a] -> [([a], a, [a])]
splits xs0 :: [a]
xs0 =
let
go :: [a] -> [b] -> [(a, b, [b])]
go (front :: a
front : fronts :: [a]
fronts) (x :: b
x : xs :: [b]
xs) =
(a
front, b
x, [b]
xs) (a, b, [b]) -> [(a, b, [b])] -> [(a, b, [b])]
forall a. a -> [a] -> [a]
: [a] -> [b] -> [(a, b, [b])]
go [a]
fronts [b]
xs
go _ _ =
[]
in
[[a]] -> [a] -> [([a], a, [a])]
forall a b. [a] -> [b] -> [(a, b, [b])]
go ([a] -> [[a]]
forall a. [a] -> [[a]]
List.inits [a]
xs0) [a]
xs0
removes :: forall a. Int -> [a] -> [[a]]
removes :: Int -> [a] -> [[a]]
removes k :: Int
k = \xs :: [a]
xs -> [a] -> [[a]]
go [a]
xs
where
go :: [a] -> [[a]]
go :: [a] -> [[a]]
go [] = []
go xs :: [a]
xs = [a]
xs2 [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: ([a] -> [a]) -> [[a]] -> [[a]]
forall a b. (a -> b) -> [a] -> [b]
map ([a]
xs1 [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++) ([a] -> [[a]]
go [a]
xs2)
where
(xs1 :: [a]
xs1, xs2 :: [a]
xs2) = Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
k [a]
xs
dropSome :: Monad m => [NodeT m a] -> [TreeT m [a]]
dropSome :: [NodeT m a] -> [TreeT m [a]]
dropSome ts :: [NodeT m a]
ts = do
Int
n <- (Int -> Bool) -> [Int] -> [Int]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0) ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ (Int -> Int) -> Int -> [Int]
forall a. (a -> a) -> a -> [a]
iterate (Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` 2) ([NodeT m a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [NodeT m a]
ts)
[NodeT m a]
ts' <- Int -> [NodeT m a] -> [[NodeT m a]]
forall a. Int -> [a] -> [[a]]
removes Int
n [NodeT m a]
ts
TreeT m [a] -> [TreeT m [a]]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TreeT m [a] -> [TreeT m [a]])
-> (NodeT m [a] -> TreeT m [a]) -> NodeT m [a] -> [TreeT m [a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (NodeT m [a]) -> TreeT m [a]
forall (m :: * -> *) a. m (NodeT m a) -> TreeT m a
TreeT (m (NodeT m [a]) -> TreeT m [a])
-> (NodeT m [a] -> m (NodeT m [a])) -> NodeT m [a] -> TreeT m [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodeT m [a] -> m (NodeT m [a])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NodeT m [a] -> [TreeT m [a]]) -> NodeT m [a] -> [TreeT m [a]]
forall a b. (a -> b) -> a -> b
$ [NodeT m a] -> NodeT m [a]
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 :: [NodeT m a] -> [TreeT m [a]]
shrinkOne ts :: [NodeT m a]
ts = do
(xs :: [NodeT m a]
xs, y0 :: NodeT m a
y0, zs :: [NodeT m a]
zs) <- [NodeT m a] -> [([NodeT m a], NodeT m a, [NodeT m a])]
forall a. [a] -> [([a], a, [a])]
splits [NodeT m a]
ts
TreeT m a
y1 <- NodeT m a -> [TreeT m a]
forall (m :: * -> *) a. NodeT m a -> [TreeT m a]
nodeChildren NodeT m a
y0
TreeT m [a] -> [TreeT m [a]]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TreeT m [a] -> [TreeT m [a]])
-> (m (NodeT m [a]) -> TreeT m [a])
-> m (NodeT m [a])
-> [TreeT m [a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (NodeT m [a]) -> TreeT m [a]
forall (m :: * -> *) a. m (NodeT m a) -> TreeT m a
TreeT (m (NodeT m [a]) -> [TreeT m [a]])
-> m (NodeT m [a]) -> [TreeT m [a]]
forall a b. (a -> b) -> a -> b
$ do
NodeT m a
y2 <- TreeT m a -> m (NodeT m a)
forall (m :: * -> *) a. TreeT m a -> m (NodeT m a)
runTreeT TreeT m a
y1
NodeT m [a] -> m (NodeT m [a])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NodeT m [a] -> m (NodeT m [a])) -> NodeT m [a] -> m (NodeT m [a])
forall a b. (a -> b) -> a -> b
$
[NodeT m a] -> NodeT m [a]
forall (m :: * -> *) a. Monad m => [NodeT m a] -> NodeT m [a]
interleave ([NodeT m a]
xs [NodeT m a] -> [NodeT m a] -> [NodeT m a]
forall a. [a] -> [a] -> [a]
++ [NodeT m a
y2] [NodeT m a] -> [NodeT m a] -> [NodeT m a]
forall a. [a] -> [a] -> [a]
++ [NodeT m a]
zs)
interleave :: forall m a. Monad m => [NodeT m a] -> NodeT m [a]
interleave :: [NodeT m a] -> NodeT m [a]
interleave ts :: [NodeT m a]
ts =
[a] -> [TreeT m [a]] -> NodeT m [a]
forall (m :: * -> *) a. a -> [TreeT m a] -> NodeT m a
NodeT ((NodeT m a -> a) -> [NodeT m a] -> [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NodeT m a -> a
forall (m :: * -> *) a. NodeT m a -> a
nodeValue [NodeT m a]
ts) ([TreeT m [a]] -> NodeT m [a]) -> [TreeT m [a]] -> NodeT m [a]
forall a b. (a -> b) -> a -> b
$
[[TreeT m [a]]] -> [TreeT m [a]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [
[NodeT m a] -> [TreeT m [a]]
forall (m :: * -> *) a. Monad m => [NodeT m a] -> [TreeT m [a]]
dropSome [NodeT m a]
ts
, [NodeT m a] -> [TreeT m [a]]
forall (m :: * -> *) a. Monad m => [NodeT m a] -> [TreeT m [a]]
shrinkOne [NodeT m a]
ts
]
instance Foldable Tree where
foldMap :: (a -> m) -> Tree a -> m
foldMap f :: a -> m
f (TreeT mx :: Identity (NodeT Identity a)
mx) =
(a -> m) -> NodeT Identity a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f (Identity (NodeT Identity a) -> NodeT Identity a
forall a. Identity a -> a
runIdentity Identity (NodeT Identity a)
mx)
instance Foldable Node where
foldMap :: (a -> m) -> Node a -> m
foldMap f :: a -> m
f (NodeT x :: a
x xs :: [TreeT Identity a]
xs) =
a -> m
f a
x m -> m -> m
forall a. Monoid a => a -> a -> a
`mappend` [m] -> m
forall a. Monoid a => [a] -> a
mconcat ((TreeT Identity a -> m) -> [TreeT Identity a] -> [m]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> m) -> TreeT Identity a -> m
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 :: (a -> f b) -> Tree a -> f (Tree b)
traverse f :: a -> f b
f (TreeT mx :: Identity (NodeT Identity a)
mx) =
Identity (NodeT Identity b) -> Tree b
forall (m :: * -> *) a. m (NodeT m a) -> TreeT m a
TreeT (Identity (NodeT Identity b) -> Tree b)
-> f (Identity (NodeT Identity b)) -> f (Tree b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (NodeT Identity a -> f (NodeT Identity b))
-> Identity (NodeT Identity a) -> f (Identity (NodeT Identity b))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((a -> f b) -> NodeT Identity a -> f (NodeT Identity b)
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 :: (a -> f b) -> Node a -> f (Node b)
traverse f :: a -> f b
f (NodeT x :: a
x xs :: [TreeT Identity a]
xs) =
b -> [TreeT Identity b] -> Node b
forall (m :: * -> *) a. a -> [TreeT m a] -> NodeT m a
NodeT (b -> [TreeT Identity b] -> Node b)
-> f b -> f ([TreeT Identity b] -> Node b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
x f ([TreeT Identity b] -> Node b)
-> f [TreeT Identity b] -> f (Node b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (TreeT Identity a -> f (TreeT Identity b))
-> [TreeT Identity a] -> f [TreeT Identity b]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((a -> f b) -> TreeT Identity a -> f (TreeT Identity b)
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
instance (Eq1 m, Eq a) => Eq (TreeT m a) where
TreeT m0 :: m (NodeT m a)
m0 == :: TreeT m a -> TreeT m a -> Bool
== TreeT m1 :: m (NodeT m a)
m1 =
(NodeT m a -> NodeT m a -> Bool)
-> m (NodeT m a) -> m (NodeT m a) -> Bool
forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq NodeT m a -> NodeT m a -> Bool
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 :: (a -> b) -> NodeT m a -> NodeT m b
fmap f :: a -> b
f (NodeT x :: a
x xs :: [TreeT m a]
xs) =
b -> [TreeT m b] -> NodeT m b
forall (m :: * -> *) a. a -> [TreeT m a] -> NodeT m a
NodeT (a -> b
f a
x) ((TreeT m a -> TreeT m b) -> [TreeT m a] -> [TreeT m b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> TreeT m a -> TreeT m b
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 :: (a -> b) -> TreeT m a -> TreeT m b
fmap f :: a -> b
f =
m (NodeT m b) -> TreeT m b
forall (m :: * -> *) a. m (NodeT m a) -> TreeT m a
TreeT (m (NodeT m b) -> TreeT m b)
-> (TreeT m a -> m (NodeT m b)) -> TreeT m a -> TreeT m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NodeT m a -> NodeT m b) -> m (NodeT m a) -> m (NodeT m b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> NodeT m a -> NodeT m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) (m (NodeT m a) -> m (NodeT m b))
-> (TreeT m a -> m (NodeT m a)) -> TreeT m a -> m (NodeT m b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TreeT m a -> m (NodeT m a)
forall (m :: * -> *) a. TreeT m a -> m (NodeT m a)
runTreeT
instance Applicative m => Applicative (NodeT m) where
pure :: a -> NodeT m a
pure x :: a
x =
a -> [TreeT m a] -> NodeT m a
forall (m :: * -> *) a. a -> [TreeT m a] -> NodeT m a
NodeT a
x []
<*> :: NodeT m (a -> b) -> NodeT m a -> NodeT m b
(<*>) (NodeT ab :: a -> b
ab tabs :: [TreeT m (a -> b)]
tabs) na :: NodeT m a
na@(NodeT a :: a
a tas :: [TreeT m a]
tas) =
b -> [TreeT m b] -> NodeT m b
forall (m :: * -> *) a. a -> [TreeT m a] -> NodeT m a
NodeT (a -> b
ab a
a) ([TreeT m b] -> NodeT m b) -> [TreeT m b] -> NodeT m b
forall a b. (a -> b) -> a -> b
$
(TreeT m (a -> b) -> TreeT m b)
-> [TreeT m (a -> b)] -> [TreeT m b]
forall a b. (a -> b) -> [a] -> [b]
map (TreeT m (a -> b) -> TreeT m a -> TreeT m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (NodeT m a -> TreeT m a
forall (m :: * -> *) a. Applicative m => NodeT m a -> TreeT m a
fromNodeT NodeT m a
na)) [TreeT m (a -> b)]
tabs [TreeT m b] -> [TreeT m b] -> [TreeT m b]
forall a. [a] -> [a] -> [a]
++ (TreeT m a -> TreeT m b) -> [TreeT m a] -> [TreeT m b]
forall a b. (a -> b) -> [a] -> [b]
map ((a -> b) -> TreeT m a -> TreeT m b
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 :: a -> TreeT m a
pure =
m (NodeT m a) -> TreeT m a
forall (m :: * -> *) a. m (NodeT m a) -> TreeT m a
TreeT (m (NodeT m a) -> TreeT m a)
-> (a -> m (NodeT m a)) -> a -> TreeT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodeT m a -> m (NodeT m a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NodeT m a -> m (NodeT m a))
-> (a -> NodeT m a) -> a -> m (NodeT m a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> NodeT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
<*> :: TreeT m (a -> b) -> TreeT m a -> TreeT m b
(<*>) (TreeT mab :: m (NodeT m (a -> b))
mab) (TreeT ma :: m (NodeT m a)
ma) =
m (NodeT m b) -> TreeT m b
forall (m :: * -> *) a. m (NodeT m a) -> TreeT m a
TreeT (m (NodeT m b) -> TreeT m b) -> m (NodeT m b) -> TreeT m b
forall a b. (a -> b) -> a -> b
$
(NodeT m (a -> b) -> NodeT m a -> NodeT m b)
-> m (NodeT m (a -> b)) -> m (NodeT m a) -> m (NodeT m b)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 NodeT m (a -> b) -> NodeT m a -> NodeT m b
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 :: a -> NodeT m a
return =
a -> NodeT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
>>= :: NodeT m a -> (a -> NodeT m b) -> NodeT m b
(>>=) (NodeT x :: a
x xs :: [TreeT m a]
xs) k :: a -> NodeT m b
k =
case a -> NodeT m b
k a
x of
NodeT y :: b
y ys :: [TreeT m b]
ys ->
b -> [TreeT m b] -> NodeT m b
forall (m :: * -> *) a. a -> [TreeT m a] -> NodeT m a
NodeT b
y ([TreeT m b] -> NodeT m b) -> [TreeT m b] -> NodeT m b
forall a b. (a -> b) -> a -> b
$
(TreeT m a -> TreeT m b) -> [TreeT m a] -> [TreeT m b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (m (NodeT m b) -> TreeT m b
forall (m :: * -> *) a. m (NodeT m a) -> TreeT m a
TreeT (m (NodeT m b) -> TreeT m b)
-> (TreeT m a -> m (NodeT m b)) -> TreeT m a -> TreeT m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NodeT m a -> NodeT m b) -> m (NodeT m a) -> m (NodeT m b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (NodeT m a -> (a -> NodeT m b) -> NodeT m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> NodeT m b
k) (m (NodeT m a) -> m (NodeT m b))
-> (TreeT m a -> m (NodeT m a)) -> TreeT m a -> m (NodeT m b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TreeT m a -> m (NodeT m a)
forall (m :: * -> *) a. TreeT m a -> m (NodeT m a)
runTreeT) [TreeT m a]
xs [TreeT m b] -> [TreeT m b] -> [TreeT m b]
forall a. [a] -> [a] -> [a]
++ [TreeT m b]
ys
instance Monad m => Monad (TreeT m) where
return :: a -> TreeT m a
return =
a -> TreeT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
>>= :: TreeT m a -> (a -> TreeT m b) -> TreeT m b
(>>=) m :: TreeT m a
m k :: a -> TreeT m b
k =
m (NodeT m b) -> TreeT m b
forall (m :: * -> *) a. m (NodeT m a) -> TreeT m a
TreeT (m (NodeT m b) -> TreeT m b) -> m (NodeT m b) -> TreeT m b
forall a b. (a -> b) -> a -> b
$ do
NodeT x :: a
x xs :: [TreeT m a]
xs <- TreeT m a -> m (NodeT m a)
forall (m :: * -> *) a. TreeT m a -> m (NodeT m a)
runTreeT TreeT m a
m
NodeT y :: b
y ys :: [TreeT m b]
ys <- TreeT m b -> m (NodeT m b)
forall (m :: * -> *) a. TreeT m a -> m (NodeT m a)
runTreeT (a -> TreeT m b
k a
x)
NodeT m b -> m (NodeT m b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NodeT m b -> m (NodeT m b))
-> ([TreeT m b] -> NodeT m b) -> [TreeT m b] -> m (NodeT m b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> [TreeT m b] -> NodeT m b
forall (m :: * -> *) a. a -> [TreeT m a] -> NodeT m a
NodeT b
y ([TreeT m b] -> m (NodeT m b)) -> [TreeT m b] -> m (NodeT m b)
forall a b. (a -> b) -> a -> b
$
(TreeT m a -> TreeT m b) -> [TreeT m a] -> [TreeT m b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (TreeT m a -> (a -> TreeT m b) -> TreeT m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> TreeT m b
k) [TreeT m a]
xs [TreeT m b] -> [TreeT m b] -> [TreeT m b]
forall a. [a] -> [a] -> [a]
++ [TreeT m b]
ys
instance Alternative m => Alternative (TreeT m) where
empty :: TreeT m a
empty =
m (NodeT m a) -> TreeT m a
forall (m :: * -> *) a. m (NodeT m a) -> TreeT m a
TreeT m (NodeT m a)
forall (f :: * -> *) a. Alternative f => f a
empty
<|> :: TreeT m a -> TreeT m a -> TreeT m a
(<|>) x :: TreeT m a
x y :: TreeT m a
y =
m (NodeT m a) -> TreeT m a
forall (m :: * -> *) a. m (NodeT m a) -> TreeT m a
TreeT (TreeT m a -> m (NodeT m a)
forall (m :: * -> *) a. TreeT m a -> m (NodeT m a)
runTreeT TreeT m a
x m (NodeT m a) -> m (NodeT m a) -> m (NodeT m a)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TreeT m a -> m (NodeT m a)
forall (m :: * -> *) a. TreeT m a -> m (NodeT m a)
runTreeT TreeT m a
y)
instance MonadPlus m => MonadPlus (TreeT m) where
mzero :: TreeT m a
mzero =
m (NodeT m a) -> TreeT m a
forall (m :: * -> *) a. m (NodeT m a) -> TreeT m a
TreeT m (NodeT m a)
forall (m :: * -> *) a. MonadPlus m => m a
mzero
mplus :: TreeT m a -> TreeT m a -> TreeT m a
mplus x :: TreeT m a
x y :: TreeT m a
y =
m (NodeT m a) -> TreeT m a
forall (m :: * -> *) a. m (NodeT m a) -> TreeT m a
TreeT (TreeT m a -> m (NodeT m a)
forall (m :: * -> *) a. TreeT m a -> m (NodeT m a)
runTreeT TreeT m a
x m (NodeT m a) -> m (NodeT m a) -> m (NodeT m a)
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` TreeT m a -> m (NodeT m a)
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 :: TreeT f a -> TreeT f b -> TreeT f (a, b)
zipTreeT l0 :: TreeT f a
l0@(TreeT left :: f (NodeT f a)
left) r0 :: TreeT f b
r0@(TreeT right :: f (NodeT f b)
right) =
f (NodeT f (a, b)) -> TreeT f (a, b)
forall (m :: * -> *) a. m (NodeT m a) -> TreeT m a
TreeT (f (NodeT f (a, b)) -> TreeT f (a, b))
-> f (NodeT f (a, b)) -> TreeT f (a, b)
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
a ls :: [TreeT f a]
ls) (NodeT b :: b
b rs :: [TreeT f b]
rs) =
(a, b) -> [TreeT f (a, b)] -> NodeT f (a, b)
forall (m :: * -> *) a. a -> [TreeT m a] -> NodeT m a
NodeT (a
a, b
b) ([TreeT f (a, b)] -> NodeT f (a, b))
-> [TreeT f (a, b)] -> NodeT f (a, b)
forall a b. (a -> b) -> a -> b
$
[[TreeT f (a, b)]] -> [TreeT f (a, b)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [
[TreeT f a -> TreeT f b -> TreeT f (a, b)
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]
, [TreeT f a -> TreeT f b -> TreeT f (a, b)
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 (NodeT f a -> NodeT f b -> NodeT f (a, b))
-> f (NodeT f a) -> f (NodeT f b -> NodeT f (a, b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (NodeT f a)
left f (NodeT f b -> NodeT f (a, b))
-> f (NodeT f b) -> f (NodeT f (a, b))
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 :: TreeT m a -> TreeT m b -> TreeT m (a, b)
mzip =
TreeT m a -> TreeT m b -> TreeT m (a, b)
forall (f :: * -> *) a b.
Applicative f =>
TreeT f a -> TreeT f b -> TreeT f (a, b)
zipTreeT
instance MonadTrans TreeT where
lift :: m a -> TreeT m a
lift f :: m a
f =
m (NodeT m a) -> TreeT m a
forall (m :: * -> *) a. m (NodeT m a) -> TreeT m a
TreeT (m (NodeT m a) -> TreeT m a) -> m (NodeT m a) -> TreeT m a
forall a b. (a -> b) -> a -> b
$
(a -> NodeT m a) -> m a -> m (NodeT m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\x :: a
x -> a -> [TreeT m a] -> NodeT m a
forall (m :: * -> *) a. a -> [TreeT m a] -> NodeT m a
NodeT a
x []) m a
f
instance MFunctor NodeT where
hoist :: (forall a. m a -> n a) -> NodeT m b -> NodeT n b
hoist f :: forall a. m a -> n a
f (NodeT x :: b
x xs :: [TreeT m b]
xs) =
b -> [TreeT n b] -> NodeT n b
forall (m :: * -> *) a. a -> [TreeT m a] -> NodeT m a
NodeT b
x ((TreeT m b -> TreeT n b) -> [TreeT m b] -> [TreeT n b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((forall a. m a -> n a) -> TreeT m b -> TreeT n 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 a. m a -> n a
f) [TreeT m b]
xs)
instance MFunctor TreeT where
hoist :: (forall a. m a -> n a) -> TreeT m b -> TreeT n b
hoist f :: forall a. m a -> n a
f (TreeT m :: m (NodeT m b)
m) =
n (NodeT n b) -> TreeT n b
forall (m :: * -> *) a. m (NodeT m a) -> TreeT m a
TreeT (n (NodeT n b) -> TreeT n b)
-> (m (NodeT n b) -> n (NodeT n b)) -> m (NodeT n b) -> TreeT n b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (NodeT n b) -> n (NodeT n b)
forall a. m a -> n a
f (m (NodeT n b) -> TreeT n b) -> m (NodeT n b) -> TreeT n b
forall a b. (a -> b) -> a -> b
$ (NodeT m b -> NodeT n b) -> m (NodeT m b) -> m (NodeT n b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((forall a. m a -> n a) -> NodeT m b -> NodeT n 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 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 :: (t (NodeT t b) -> TreeT m (NodeT t b)) -> NodeT t b -> NodeT m b
embedNodeT f :: t (NodeT t b) -> TreeT m (NodeT t b)
f (NodeT x :: b
x xs :: [TreeT t b]
xs) =
b -> [TreeT m b] -> NodeT m b
forall (m :: * -> *) a. a -> [TreeT m a] -> NodeT m a
NodeT b
x ((TreeT t b -> TreeT m b) -> [TreeT t b] -> [TreeT m b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((t (NodeT t b) -> TreeT m (NodeT t b)) -> TreeT t b -> TreeT m b
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 :: (t (NodeT t b) -> TreeT m (NodeT t b)) -> TreeT t b -> TreeT m b
embedTreeT f :: t (NodeT t b) -> TreeT m (NodeT t b)
f (TreeT m :: t (NodeT t b)
m) =
m (NodeT m b) -> TreeT m b
forall (m :: * -> *) a. m (NodeT m a) -> TreeT m a
TreeT (m (NodeT m b) -> TreeT m b)
-> (NodeT t b -> m (NodeT m b)) -> NodeT t b -> TreeT m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodeT m b -> m (NodeT m b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NodeT m b -> m (NodeT m b))
-> (NodeT t b -> NodeT m b) -> NodeT t b -> m (NodeT m b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (t (NodeT t b) -> TreeT m (NodeT t b)) -> NodeT t b -> NodeT m b
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 t b -> TreeT m b) -> TreeT m (NodeT t b) -> TreeT m b
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 a. m a -> TreeT n a) -> TreeT m b -> TreeT n b
embed f :: forall a. m a -> TreeT n a
f m :: TreeT m b
m =
(m (NodeT m b) -> TreeT n (NodeT m b)) -> TreeT m b -> TreeT n b
forall (m :: * -> *) (t :: * -> *) b.
Monad m =>
(t (NodeT t b) -> TreeT m (NodeT t b)) -> TreeT t b -> TreeT m b
embedTreeT m (NodeT m b) -> TreeT n (NodeT m b)
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 :: NodeT (t m) a -> t (TreeT m) a
distributeNodeT (NodeT x :: a
x xs :: [TreeT (t m) a]
xs) =
t (TreeT m) (t (TreeT m) a) -> t (TreeT m) a
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (t (TreeT m) (t (TreeT m) a) -> t (TreeT m) a)
-> ([TreeT m (t (TreeT m) a)] -> t (TreeT m) (t (TreeT m) a))
-> [TreeT m (t (TreeT m) a)]
-> t (TreeT m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TreeT m (t (TreeT m) a) -> t (TreeT m) (t (TreeT m) a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (TreeT m (t (TreeT m) a) -> t (TreeT m) (t (TreeT m) a))
-> ([TreeT m (t (TreeT m) a)] -> TreeT m (t (TreeT m) a))
-> [TreeT m (t (TreeT m) a)]
-> t (TreeT m) (t (TreeT m) a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodeT m (t (TreeT m) a) -> TreeT m (t (TreeT m) a)
forall (m :: * -> *) a. Applicative m => NodeT m a -> TreeT m a
fromNodeT (NodeT m (t (TreeT m) a) -> TreeT m (t (TreeT m) a))
-> ([TreeT m (t (TreeT m) a)] -> NodeT m (t (TreeT m) a))
-> [TreeT m (t (TreeT m) a)]
-> TreeT m (t (TreeT m) a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t (TreeT m) a
-> [TreeT m (t (TreeT m) a)] -> NodeT m (t (TreeT m) a)
forall (m :: * -> *) a. a -> [TreeT m a] -> NodeT m a
NodeT (a -> t (TreeT m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x) ([TreeT m (t (TreeT m) a)] -> t (TreeT m) a)
-> [TreeT m (t (TreeT m) a)] -> t (TreeT m) a
forall a b. (a -> b) -> a -> b
$
(TreeT (t m) a -> TreeT m (t (TreeT m) a))
-> [TreeT (t m) a] -> [TreeT m (t (TreeT m) a)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (t (TreeT m) a -> TreeT m (t (TreeT m) a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (t (TreeT m) a -> TreeT m (t (TreeT m) a))
-> (TreeT (t m) a -> t (TreeT m) a)
-> TreeT (t m) a
-> TreeT m (t (TreeT m) a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TreeT (t m) a -> t (TreeT m) a
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 :: TreeT (t m) a -> t (TreeT m) a
distributeTreeT x :: TreeT (t m) a
x =
NodeT (t m) a -> t (TreeT m) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
Transformer t TreeT m =>
NodeT (t m) a -> t (TreeT m) a
distributeNodeT (NodeT (t m) a -> t (TreeT m) a)
-> t (TreeT m) (NodeT (t m) a) -> t (TreeT m) a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (forall a. m a -> TreeT m a)
-> t m (NodeT (t m) a) -> t (TreeT m) (NodeT (t m) a)
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 -> TreeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (TreeT (t m) a -> t m (NodeT (t m) a)
forall (m :: * -> *) a. TreeT m a -> m (NodeT m a)
runTreeT TreeT (t m) a
x)
instance MonadTransDistributive TreeT where
distributeT :: TreeT (f m) a -> f (TreeT m) a
distributeT =
TreeT (f m) a -> f (TreeT m) a
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 :: (State# (PrimState (TreeT m))
-> (# State# (PrimState (TreeT m)), a #))
-> TreeT m a
primitive =
m a -> TreeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> TreeT m a)
-> ((State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a)
-> (State# (PrimState m) -> (# State# (PrimState m), a #))
-> TreeT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive
instance MonadIO m => MonadIO (TreeT m) where
liftIO :: IO a -> TreeT m a
liftIO =
m a -> TreeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> TreeT m a) -> (IO a -> m a) -> IO a -> TreeT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
instance MonadBase b m => MonadBase b (TreeT m) where
liftBase :: b α -> TreeT m α
liftBase =
m α -> TreeT m α
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m α -> TreeT m α) -> (b α -> m α) -> b α -> TreeT m α
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b α -> m α
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase
instance MonadThrow m => MonadThrow (TreeT m) where
throwM :: e -> TreeT m a
throwM =
m a -> TreeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> TreeT m a) -> (e -> m a) -> e -> TreeT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> m a
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 :: (e -> TreeT m a) -> NodeT m a -> NodeT m a
handleNodeT onErr :: e -> TreeT m a
onErr (NodeT x :: a
x xs :: [TreeT m a]
xs) =
a -> [TreeT m a] -> NodeT m a
forall (m :: * -> *) a. a -> [TreeT m a] -> NodeT m a
NodeT a
x ([TreeT m a] -> NodeT m a) -> [TreeT m a] -> NodeT m a
forall a b. (a -> b) -> a -> b
$
(TreeT m a -> TreeT m a) -> [TreeT m a] -> [TreeT m a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((e -> TreeT m a) -> TreeT m a -> TreeT m a
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 :: (e -> TreeT m a) -> TreeT m a -> TreeT m a
handleTreeT onErr :: e -> TreeT m a
onErr m :: TreeT m a
m =
m (NodeT m a) -> TreeT m a
forall (m :: * -> *) a. m (NodeT m a) -> TreeT m a
TreeT (m (NodeT m a) -> TreeT m a)
-> (m (NodeT m a) -> m (NodeT m a)) -> m (NodeT m a) -> TreeT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NodeT m a -> NodeT m a) -> m (NodeT m a) -> m (NodeT m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((e -> TreeT m a) -> NodeT m a -> NodeT m a
forall e (m :: * -> *) a.
(Exception e, MonadCatch m) =>
(e -> TreeT m a) -> NodeT m a -> NodeT m a
handleNodeT e -> TreeT m a
onErr) (m (NodeT m a) -> TreeT m a) -> m (NodeT m a) -> TreeT m a
forall a b. (a -> b) -> a -> b
$
m (NodeT m a) -> (e -> m (NodeT m a)) -> m (NodeT m a)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
catch (TreeT m a -> m (NodeT m a)
forall (m :: * -> *) a. TreeT m a -> m (NodeT m a)
runTreeT TreeT m a
m) (TreeT m a -> m (NodeT m a)
forall (m :: * -> *) a. TreeT m a -> m (NodeT m a)
runTreeT (TreeT m a -> m (NodeT m a))
-> (e -> TreeT m a) -> e -> m (NodeT m a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> TreeT m a
onErr)
instance MonadCatch m => MonadCatch (TreeT m) where
catch :: TreeT m a -> (e -> TreeT m a) -> TreeT m a
catch =
((e -> TreeT m a) -> TreeT m a -> TreeT m a)
-> TreeT m a -> (e -> TreeT m a) -> TreeT m a
forall a b c. (a -> b -> c) -> b -> a -> c
flip (e -> TreeT m a) -> TreeT m a -> TreeT m a
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 :: (r -> r) -> NodeT m a -> NodeT m a
localNodeT f :: r -> r
f (NodeT x :: a
x xs :: [TreeT m a]
xs) =
a -> [TreeT m a] -> NodeT m a
forall (m :: * -> *) a. a -> [TreeT m a] -> NodeT m a
NodeT a
x ([TreeT m a] -> NodeT m a) -> [TreeT m a] -> NodeT m a
forall a b. (a -> b) -> a -> b
$
(TreeT m a -> TreeT m a) -> [TreeT m a] -> [TreeT m a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((r -> r) -> TreeT m a -> TreeT m a
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 :: (r -> r) -> TreeT m a -> TreeT m a
localTreeT f :: r -> r
f (TreeT m :: m (NodeT m a)
m) =
m (NodeT m a) -> TreeT m a
forall (m :: * -> *) a. m (NodeT m a) -> TreeT m a
TreeT (m (NodeT m a) -> TreeT m a) -> m (NodeT m a) -> TreeT m a
forall a b. (a -> b) -> a -> b
$
NodeT m a -> m (NodeT m a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NodeT m a -> m (NodeT m a))
-> (NodeT m a -> NodeT m a) -> NodeT m a -> m (NodeT m a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (r -> r) -> NodeT m a -> NodeT m a
forall r (m :: * -> *) a.
MonadReader r m =>
(r -> r) -> NodeT m a -> NodeT m a
localNodeT r -> r
f (NodeT m a -> m (NodeT m a)) -> m (NodeT m a) -> m (NodeT m a)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (r -> r) -> m (NodeT m a) -> m (NodeT m a)
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 =
m r -> TreeT m r
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m r
forall r (m :: * -> *). MonadReader r m => m r
ask
local :: (r -> r) -> TreeT m a -> TreeT m a
local =
(r -> r) -> TreeT m a -> TreeT m a
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 =
m s -> TreeT m s
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m s
forall s (m :: * -> *). MonadState s m => m s
get
put :: s -> TreeT m ()
put =
m () -> TreeT m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> TreeT m ()) -> (s -> m ()) -> s -> TreeT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put
state :: (s -> (a, s)) -> TreeT m a
state =
m a -> TreeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> TreeT m a)
-> ((s -> (a, s)) -> m a) -> (s -> (a, s)) -> TreeT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (s -> (a, s)) -> m a
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 :: w -> NodeT m a -> NodeT m (a, w)
listenNodeT w :: w
w (NodeT x :: a
x xs :: [TreeT m a]
xs) =
(a, w) -> [TreeT m (a, w)] -> NodeT m (a, w)
forall (m :: * -> *) a. a -> [TreeT m a] -> NodeT m a
NodeT (a
x, w
w) ([TreeT m (a, w)] -> NodeT m (a, w))
-> [TreeT m (a, w)] -> NodeT m (a, w)
forall a b. (a -> b) -> a -> b
$
(TreeT m a -> TreeT m (a, w)) -> [TreeT m a] -> [TreeT m (a, w)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (w -> TreeT m a -> TreeT m (a, w)
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 :: w -> TreeT m a -> TreeT m (a, w)
listenTreeT w0 :: w
w0 (TreeT m :: m (NodeT m a)
m) =
m (NodeT m (a, w)) -> TreeT m (a, w)
forall (m :: * -> *) a. m (NodeT m a) -> TreeT m a
TreeT (m (NodeT m (a, w)) -> TreeT m (a, w))
-> m (NodeT m (a, w)) -> TreeT m (a, w)
forall a b. (a -> b) -> a -> b
$ do
(x :: NodeT m a
x, w :: w
w) <- m (NodeT m a) -> m (NodeT m a, w)
forall w (m :: * -> *) a. MonadWriter w m => m a -> m (a, w)
listen m (NodeT m a)
m
NodeT m (a, w) -> m (NodeT m (a, w))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NodeT m (a, w) -> m (NodeT m (a, w)))
-> NodeT m (a, w) -> m (NodeT m (a, w))
forall a b. (a -> b) -> a -> b
$ w -> NodeT m a -> NodeT m (a, w)
forall w (m :: * -> *) a.
MonadWriter w m =>
w -> NodeT m a -> NodeT m (a, w)
listenNodeT (w -> w -> w
forall a. Monoid a => a -> a -> a
mappend w
w0 w
w) NodeT m a
x
passNodeT :: MonadWriter w m => NodeT m (a, w -> w) -> NodeT m a
passNodeT :: NodeT m (a, w -> w) -> NodeT m a
passNodeT (NodeT (x :: a
x, _) xs :: [TreeT m (a, w -> w)]
xs) =
a -> [TreeT m a] -> NodeT m a
forall (m :: * -> *) a. a -> [TreeT m a] -> NodeT m a
NodeT a
x ([TreeT m a] -> NodeT m a) -> [TreeT m a] -> NodeT m a
forall a b. (a -> b) -> a -> b
$
(TreeT m (a, w -> w) -> TreeT m a)
-> [TreeT m (a, w -> w)] -> [TreeT m a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TreeT m (a, w -> w) -> TreeT m a
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 :: TreeT m (a, w -> w) -> TreeT m a
passTreeT (TreeT m :: m (NodeT m (a, w -> w))
m) =
m (NodeT m a) -> TreeT m a
forall (m :: * -> *) a. m (NodeT m a) -> TreeT m a
TreeT (m (NodeT m a) -> TreeT m a) -> m (NodeT m a) -> TreeT m a
forall a b. (a -> b) -> a -> b
$
NodeT m a -> m (NodeT m a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NodeT m a -> m (NodeT m a))
-> (NodeT m (a, w -> w) -> NodeT m a)
-> NodeT m (a, w -> w)
-> m (NodeT m a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodeT m (a, w -> w) -> NodeT m a
forall w (m :: * -> *) a.
MonadWriter w m =>
NodeT m (a, w -> w) -> NodeT m a
passNodeT (NodeT m (a, w -> w) -> m (NodeT m a))
-> m (NodeT m (a, w -> w)) -> m (NodeT m a)
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 :: (a, w) -> TreeT m a
writer =
m a -> TreeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> TreeT m a) -> ((a, w) -> m a) -> (a, w) -> TreeT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, w) -> m a
forall w (m :: * -> *) a. MonadWriter w m => (a, w) -> m a
writer
tell :: w -> TreeT m ()
tell =
m () -> TreeT m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> TreeT m ()) -> (w -> m ()) -> w -> TreeT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. w -> m ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell
listen :: TreeT m a -> TreeT m (a, w)
listen =
w -> TreeT m a -> TreeT m (a, w)
forall w (m :: * -> *) a.
MonadWriter w m =>
w -> TreeT m a -> TreeT m (a, w)
listenTreeT w
forall a. Monoid a => a
mempty
pass :: TreeT m (a, w -> w) -> TreeT m a
pass =
TreeT m (a, w -> w) -> TreeT m a
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 :: (e -> TreeT m a) -> NodeT m a -> NodeT m a
handleErrorNodeT onErr :: e -> TreeT m a
onErr (NodeT x :: a
x xs :: [TreeT m a]
xs) =
a -> [TreeT m a] -> NodeT m a
forall (m :: * -> *) a. a -> [TreeT m a] -> NodeT m a
NodeT a
x ([TreeT m a] -> NodeT m a) -> [TreeT m a] -> NodeT m a
forall a b. (a -> b) -> a -> b
$
(TreeT m a -> TreeT m a) -> [TreeT m a] -> [TreeT m a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((e -> TreeT m a) -> TreeT m a -> TreeT m a
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 :: (e -> TreeT m a) -> TreeT m a -> TreeT m a
handleErrorTreeT onErr :: e -> TreeT m a
onErr m :: TreeT m a
m =
m (NodeT m a) -> TreeT m a
forall (m :: * -> *) a. m (NodeT m a) -> TreeT m a
TreeT (m (NodeT m a) -> TreeT m a)
-> (m (NodeT m a) -> m (NodeT m a)) -> m (NodeT m a) -> TreeT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NodeT m a -> NodeT m a) -> m (NodeT m a) -> m (NodeT m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((e -> TreeT m a) -> NodeT m a -> NodeT m a
forall e (m :: * -> *) a.
MonadError e m =>
(e -> TreeT m a) -> NodeT m a -> NodeT m a
handleErrorNodeT e -> TreeT m a
onErr) (m (NodeT m a) -> TreeT m a) -> m (NodeT m a) -> TreeT m a
forall a b. (a -> b) -> a -> b
$
m (NodeT m a) -> (e -> m (NodeT m a)) -> m (NodeT m a)
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError (TreeT m a -> m (NodeT m a)
forall (m :: * -> *) a. TreeT m a -> m (NodeT m a)
runTreeT TreeT m a
m) (TreeT m a -> m (NodeT m a)
forall (m :: * -> *) a. TreeT m a -> m (NodeT m a)
runTreeT (TreeT m a -> m (NodeT m a))
-> (e -> TreeT m a) -> e -> m (NodeT m a)
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 :: e -> TreeT m a
throwError =
m a -> TreeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> TreeT m a) -> (e -> m a) -> e -> TreeT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError
catchError :: TreeT m a -> (e -> TreeT m a) -> TreeT m a
catchError =
((e -> TreeT m a) -> TreeT m a -> TreeT m a)
-> TreeT m a -> (e -> TreeT m a) -> TreeT m a
forall a b c. (a -> b -> c) -> b -> a -> c
flip (e -> TreeT m a) -> TreeT m a -> TreeT m a
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 :: ResourceT IO a -> TreeT m a
liftResourceT =
m a -> TreeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> TreeT m a)
-> (ResourceT IO a -> m a) -> ResourceT IO a -> TreeT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ResourceT IO a -> m a
forall (m :: * -> *) a. MonadResource m => ResourceT IO a -> m a
liftResourceT
instance (Show1 m, Show a) => Show (NodeT m a) where
showsPrec :: Int -> NodeT m a -> ShowS
showsPrec =
Int -> NodeT m a -> ShowS
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 =
Int -> TreeT m a -> ShowS
forall (f :: * -> *) a. (Show1 f, Show a) => Int -> f a -> ShowS
showsPrec1
instance Show1 m => Show1 (NodeT m) where
liftShowsPrec :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> NodeT m a -> ShowS
liftShowsPrec sp :: Int -> a -> ShowS
sp sl :: [a] -> ShowS
sl d :: Int
d (NodeT x :: a
x xs :: [TreeT m a]
xs) =
let
sp1 :: Int -> TreeT m a -> ShowS
sp1 =
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> TreeT m a -> ShowS
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 =
(Int -> a -> ShowS) -> ([a] -> ShowS) -> [TreeT m a] -> ShowS
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 =
(Int -> TreeT m a -> ShowS)
-> ([TreeT m a] -> ShowS) -> Int -> [TreeT m a] -> ShowS
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
(Int -> a -> ShowS)
-> (Int -> [TreeT m a] -> ShowS)
-> String
-> Int
-> a
-> [TreeT m a]
-> ShowS
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 "NodeT" Int
d a
x [TreeT m a]
xs
instance Show1 m => Show1 (TreeT m) where
liftShowsPrec :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> TreeT m a -> ShowS
liftShowsPrec sp :: Int -> a -> ShowS
sp sl :: [a] -> ShowS
sl d :: Int
d (TreeT m :: m (NodeT m a)
m) =
let
sp1 :: Int -> NodeT m a -> ShowS
sp1 =
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> NodeT m a -> ShowS
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 =
(Int -> a -> ShowS) -> ([a] -> ShowS) -> [NodeT m a] -> ShowS
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 =
(Int -> NodeT m a -> ShowS)
-> ([NodeT m a] -> ShowS) -> Int -> m (NodeT m a) -> ShowS
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
(Int -> m (NodeT m a) -> ShowS)
-> String -> Int -> m (NodeT m a) -> ShowS
forall a. (Int -> a -> ShowS) -> String -> Int -> a -> ShowS
showsUnaryWith Int -> m (NodeT m a) -> ShowS
sp2 "TreeT" Int
d m (NodeT m a)
m
renderTreeTLines :: Monad m => TreeT m String -> m [String]
renderTreeTLines :: TreeT m String -> m [String]
renderTreeTLines (TreeT m :: m (NodeT m String)
m) = do
NodeT x :: String
x xs0 :: [TreeT m String]
xs0 <- m (NodeT m String)
m
[String]
xs <- [TreeT m String] -> m [String]
forall (m :: * -> *). Monad m => [TreeT m String] -> m [String]
renderForestLines [TreeT m String]
xs0
[String] -> m [String]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([String] -> m [String]) -> [String] -> m [String]
forall a b. (a -> b) -> a -> b
$
String -> [String]
lines (ShowS
renderNodeT String
x) [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
xs
renderNodeT :: String -> String
renderNodeT :: ShowS
renderNodeT xs :: String
xs =
case String
xs of
[_] ->
' ' Char -> ShowS
forall a. a -> [a] -> [a]
: String
xs
_ ->
String
xs
renderForestLines :: Monad m => [TreeT m String] -> m [String]
renderForestLines :: [TreeT m String] -> m [String]
renderForestLines xs0 :: [TreeT m String]
xs0 =
let
shift :: [a] -> [a] -> [[a]] -> [[a]]
shift hd :: [a]
hd other :: [a]
other =
([a] -> [a] -> [a]) -> [[a]] -> [[a]] -> [[a]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
(++) ([a]
hd [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: [a] -> [[a]]
forall a. a -> [a]
repeat [a]
other)
in
case [TreeT m String]
xs0 of
[] ->
[String] -> m [String]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
[x :: TreeT m String
x] -> do
[String]
s <- TreeT m String -> m [String]
forall (m :: * -> *). Monad m => TreeT m String -> m [String]
renderTreeTLines TreeT m String
x
[String] -> m [String]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([String] -> m [String]) -> [String] -> m [String]
forall a b. (a -> b) -> a -> b
$
String -> String -> [String] -> [String]
forall a. [a] -> [a] -> [[a]] -> [[a]]
shift " └╼" " " [String]
s
x :: TreeT m String
x : xs :: [TreeT m String]
xs -> do
[String]
s <- TreeT m String -> m [String]
forall (m :: * -> *). Monad m => TreeT m String -> m [String]
renderTreeTLines TreeT m String
x
[String]
ss <- [TreeT m String] -> m [String]
forall (m :: * -> *). Monad m => [TreeT m String] -> m [String]
renderForestLines [TreeT m String]
xs
[String] -> m [String]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([String] -> m [String]) -> [String] -> m [String]
forall a b. (a -> b) -> a -> b
$
String -> String -> [String] -> [String]
forall a. [a] -> [a] -> [[a]] -> [[a]]
shift " ├╼" " │ " [String]
s [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
ss
render :: Tree String -> String
render :: Tree String -> String
render =
Identity String -> String
forall a. Identity a -> a
runIdentity (Identity String -> String)
-> (Tree String -> Identity String) -> Tree String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree String -> Identity String
forall (m :: * -> *). Monad m => TreeT m String -> m String
renderT
renderT :: Monad m => TreeT m String -> m String
renderT :: TreeT m String -> m String
renderT =
([String] -> String) -> m [String] -> m String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [String] -> String
unlines (m [String] -> m String)
-> (TreeT m String -> m [String]) -> TreeT m String -> m String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TreeT m String -> m [String]
forall (m :: * -> *). Monad m => TreeT m String -> m [String]
renderTreeTLines