{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TypeFamilies #-}

module Cursor.Tree.Types
  ( TreeCursor (..),
    treeCursorAboveL,
    treeCursorCurrentL,
    treeCursorBelowL,
    treeCursorCurrentSubTreeL,
    TreeAbove (..),
    treeAboveLeftsL,
    treeAboveAboveL,
    treeAboveNodeL,
    treeAboveRightsL,
    TreeCursorSelection (..),

    -- * CTree
    CTree (..),
    makeCTree,
    cTree,
    rebuildCTree,
    CForest (..),
    makeCForest,
    cForest,
    rebuildCForest,
    emptyCForest,
    openForest,
    closedForest,
    lengthCForest,
    unpackCForest,
  )
where

import Control.DeepSeq
import Data.List.NonEmpty (NonEmpty (..))
import qualified Data.List.NonEmpty as NE
import Data.Tree
import Data.Validity
import Data.Validity.Tree ()
import GHC.Generics (Generic)
import Lens.Micro

data TreeCursor a b = TreeCursor
  { TreeCursor a b -> Maybe (TreeAbove b)
treeAbove :: !(Maybe (TreeAbove b)),
    TreeCursor a b -> a
treeCurrent :: !a,
    TreeCursor a b -> CForest b
treeBelow :: !(CForest b)
  }
  deriving (Int -> TreeCursor a b -> ShowS
[TreeCursor a b] -> ShowS
TreeCursor a b -> String
(Int -> TreeCursor a b -> ShowS)
-> (TreeCursor a b -> String)
-> ([TreeCursor a b] -> ShowS)
-> Show (TreeCursor a b)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall a b. (Show b, Show a) => Int -> TreeCursor a b -> ShowS
forall a b. (Show b, Show a) => [TreeCursor a b] -> ShowS
forall a b. (Show b, Show a) => TreeCursor a b -> String
showList :: [TreeCursor a b] -> ShowS
$cshowList :: forall a b. (Show b, Show a) => [TreeCursor a b] -> ShowS
show :: TreeCursor a b -> String
$cshow :: forall a b. (Show b, Show a) => TreeCursor a b -> String
showsPrec :: Int -> TreeCursor a b -> ShowS
$cshowsPrec :: forall a b. (Show b, Show a) => Int -> TreeCursor a b -> ShowS
Show, TreeCursor a b -> TreeCursor a b -> Bool
(TreeCursor a b -> TreeCursor a b -> Bool)
-> (TreeCursor a b -> TreeCursor a b -> Bool)
-> Eq (TreeCursor a b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a b.
(Eq b, Eq a) =>
TreeCursor a b -> TreeCursor a b -> Bool
/= :: TreeCursor a b -> TreeCursor a b -> Bool
$c/= :: forall a b.
(Eq b, Eq a) =>
TreeCursor a b -> TreeCursor a b -> Bool
== :: TreeCursor a b -> TreeCursor a b -> Bool
$c== :: forall a b.
(Eq b, Eq a) =>
TreeCursor a b -> TreeCursor a b -> Bool
Eq, (forall x. TreeCursor a b -> Rep (TreeCursor a b) x)
-> (forall x. Rep (TreeCursor a b) x -> TreeCursor a b)
-> Generic (TreeCursor a b)
forall x. Rep (TreeCursor a b) x -> TreeCursor a b
forall x. TreeCursor a b -> Rep (TreeCursor a b) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a b x. Rep (TreeCursor a b) x -> TreeCursor a b
forall a b x. TreeCursor a b -> Rep (TreeCursor a b) x
$cto :: forall a b x. Rep (TreeCursor a b) x -> TreeCursor a b
$cfrom :: forall a b x. TreeCursor a b -> Rep (TreeCursor a b) x
Generic)

instance (Validity a, Validity b) => Validity (TreeCursor a b)

instance (NFData a, NFData b) => NFData (TreeCursor a b)

treeCursorAboveL :: Lens' (TreeCursor a b) (Maybe (TreeAbove b))
treeCursorAboveL :: (Maybe (TreeAbove b) -> f (Maybe (TreeAbove b)))
-> TreeCursor a b -> f (TreeCursor a b)
treeCursorAboveL = (TreeCursor a b -> Maybe (TreeAbove b))
-> (TreeCursor a b -> Maybe (TreeAbove b) -> TreeCursor a b)
-> Lens
     (TreeCursor a b)
     (TreeCursor a b)
     (Maybe (TreeAbove b))
     (Maybe (TreeAbove b))
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens TreeCursor a b -> Maybe (TreeAbove b)
forall a b. TreeCursor a b -> Maybe (TreeAbove b)
treeAbove ((TreeCursor a b -> Maybe (TreeAbove b) -> TreeCursor a b)
 -> Lens
      (TreeCursor a b)
      (TreeCursor a b)
      (Maybe (TreeAbove b))
      (Maybe (TreeAbove b)))
-> (TreeCursor a b -> Maybe (TreeAbove b) -> TreeCursor a b)
-> Lens
     (TreeCursor a b)
     (TreeCursor a b)
     (Maybe (TreeAbove b))
     (Maybe (TreeAbove b))
forall a b. (a -> b) -> a -> b
$ \TreeCursor a b
tc Maybe (TreeAbove b)
ta -> TreeCursor a b
tc {treeAbove :: Maybe (TreeAbove b)
treeAbove = Maybe (TreeAbove b)
ta}

treeCursorCurrentL :: Lens (TreeCursor a b) (TreeCursor a' b) a a'
treeCursorCurrentL :: (a -> f a') -> TreeCursor a b -> f (TreeCursor a' b)
treeCursorCurrentL = (TreeCursor a b -> a)
-> (TreeCursor a b -> a' -> TreeCursor a' b)
-> Lens (TreeCursor a b) (TreeCursor a' b) a a'
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens TreeCursor a b -> a
forall a b. TreeCursor a b -> a
treeCurrent ((TreeCursor a b -> a' -> TreeCursor a' b)
 -> Lens (TreeCursor a b) (TreeCursor a' b) a a')
-> (TreeCursor a b -> a' -> TreeCursor a' b)
-> Lens (TreeCursor a b) (TreeCursor a' b) a a'
forall a b. (a -> b) -> a -> b
$ \TreeCursor a b
tc a'
a -> TreeCursor a b
tc {treeCurrent :: a'
treeCurrent = a'
a}

treeCursorBelowL :: Lens' (TreeCursor a b) (CForest b)
treeCursorBelowL :: (CForest b -> f (CForest b))
-> TreeCursor a b -> f (TreeCursor a b)
treeCursorBelowL = (TreeCursor a b -> CForest b)
-> (TreeCursor a b -> CForest b -> TreeCursor a b)
-> Lens (TreeCursor a b) (TreeCursor a b) (CForest b) (CForest b)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens TreeCursor a b -> CForest b
forall a b. TreeCursor a b -> CForest b
treeBelow ((TreeCursor a b -> CForest b -> TreeCursor a b)
 -> Lens (TreeCursor a b) (TreeCursor a b) (CForest b) (CForest b))
-> (TreeCursor a b -> CForest b -> TreeCursor a b)
-> Lens (TreeCursor a b) (TreeCursor a b) (CForest b) (CForest b)
forall a b. (a -> b) -> a -> b
$ \TreeCursor a b
tc CForest b
tb -> TreeCursor a b
tc {treeBelow :: CForest b
treeBelow = CForest b
tb}

treeCursorCurrentSubTreeL :: Lens (TreeCursor a b) (TreeCursor a' b) (a, CForest b) (a', CForest b)
treeCursorCurrentSubTreeL :: ((a, CForest b) -> f (a', CForest b))
-> TreeCursor a b -> f (TreeCursor a' b)
treeCursorCurrentSubTreeL =
  (TreeCursor a b -> (a, CForest b))
-> (TreeCursor a b -> (a', CForest b) -> TreeCursor a' b)
-> Lens
     (TreeCursor a b) (TreeCursor a' b) (a, CForest b) (a', CForest b)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (\TreeCursor a b
tc -> (TreeCursor a b -> a
forall a b. TreeCursor a b -> a
treeCurrent TreeCursor a b
tc, TreeCursor a b -> CForest b
forall a b. TreeCursor a b -> CForest b
treeBelow TreeCursor a b
tc)) (\TreeCursor a b
tc (a'
a, CForest b
cf) -> TreeCursor a b
tc {treeCurrent :: a'
treeCurrent = a'
a, treeBelow :: CForest b
treeBelow = CForest b
cf})

data TreeAbove b = TreeAbove
  { TreeAbove b -> [CTree b]
treeAboveLefts :: ![CTree b], -- In reverse order
    TreeAbove b -> Maybe (TreeAbove b)
treeAboveAbove :: !(Maybe (TreeAbove b)),
    TreeAbove b -> b
treeAboveNode :: !b,
    TreeAbove b -> [CTree b]
treeAboveRights :: ![CTree b]
  }
  deriving (Int -> TreeAbove b -> ShowS
[TreeAbove b] -> ShowS
TreeAbove b -> String
(Int -> TreeAbove b -> ShowS)
-> (TreeAbove b -> String)
-> ([TreeAbove b] -> ShowS)
-> Show (TreeAbove b)
forall b. Show b => Int -> TreeAbove b -> ShowS
forall b. Show b => [TreeAbove b] -> ShowS
forall b. Show b => TreeAbove b -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TreeAbove b] -> ShowS
$cshowList :: forall b. Show b => [TreeAbove b] -> ShowS
show :: TreeAbove b -> String
$cshow :: forall b. Show b => TreeAbove b -> String
showsPrec :: Int -> TreeAbove b -> ShowS
$cshowsPrec :: forall b. Show b => Int -> TreeAbove b -> ShowS
Show, TreeAbove b -> TreeAbove b -> Bool
(TreeAbove b -> TreeAbove b -> Bool)
-> (TreeAbove b -> TreeAbove b -> Bool) -> Eq (TreeAbove b)
forall b. Eq b => TreeAbove b -> TreeAbove b -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TreeAbove b -> TreeAbove b -> Bool
$c/= :: forall b. Eq b => TreeAbove b -> TreeAbove b -> Bool
== :: TreeAbove b -> TreeAbove b -> Bool
$c== :: forall b. Eq b => TreeAbove b -> TreeAbove b -> Bool
Eq, (forall x. TreeAbove b -> Rep (TreeAbove b) x)
-> (forall x. Rep (TreeAbove b) x -> TreeAbove b)
-> Generic (TreeAbove b)
forall x. Rep (TreeAbove b) x -> TreeAbove b
forall x. TreeAbove b -> Rep (TreeAbove b) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall b x. Rep (TreeAbove b) x -> TreeAbove b
forall b x. TreeAbove b -> Rep (TreeAbove b) x
$cto :: forall b x. Rep (TreeAbove b) x -> TreeAbove b
$cfrom :: forall b x. TreeAbove b -> Rep (TreeAbove b) x
Generic, a -> TreeAbove b -> TreeAbove a
(a -> b) -> TreeAbove a -> TreeAbove b
(forall a b. (a -> b) -> TreeAbove a -> TreeAbove b)
-> (forall a b. a -> TreeAbove b -> TreeAbove a)
-> Functor TreeAbove
forall a b. a -> TreeAbove b -> TreeAbove a
forall a b. (a -> b) -> TreeAbove a -> TreeAbove b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> TreeAbove b -> TreeAbove a
$c<$ :: forall a b. a -> TreeAbove b -> TreeAbove a
fmap :: (a -> b) -> TreeAbove a -> TreeAbove b
$cfmap :: forall a b. (a -> b) -> TreeAbove a -> TreeAbove b
Functor)

instance Validity b => Validity (TreeAbove b)

instance NFData b => NFData (TreeAbove b)

treeAboveLeftsL :: Lens' (TreeAbove b) [CTree b]
treeAboveLeftsL :: ([CTree b] -> f [CTree b]) -> TreeAbove b -> f (TreeAbove b)
treeAboveLeftsL = (TreeAbove b -> [CTree b])
-> (TreeAbove b -> [CTree b] -> TreeAbove b)
-> Lens (TreeAbove b) (TreeAbove b) [CTree b] [CTree b]
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens TreeAbove b -> [CTree b]
forall b. TreeAbove b -> [CTree b]
treeAboveLefts ((TreeAbove b -> [CTree b] -> TreeAbove b)
 -> Lens (TreeAbove b) (TreeAbove b) [CTree b] [CTree b])
-> (TreeAbove b -> [CTree b] -> TreeAbove b)
-> Lens (TreeAbove b) (TreeAbove b) [CTree b] [CTree b]
forall a b. (a -> b) -> a -> b
$ \TreeAbove b
ta [CTree b]
tal -> TreeAbove b
ta {treeAboveLefts :: [CTree b]
treeAboveLefts = [CTree b]
tal}

treeAboveAboveL :: Lens' (TreeAbove b) (Maybe (TreeAbove b))
treeAboveAboveL :: (Maybe (TreeAbove b) -> f (Maybe (TreeAbove b)))
-> TreeAbove b -> f (TreeAbove b)
treeAboveAboveL = (TreeAbove b -> Maybe (TreeAbove b))
-> (TreeAbove b -> Maybe (TreeAbove b) -> TreeAbove b)
-> Lens
     (TreeAbove b)
     (TreeAbove b)
     (Maybe (TreeAbove b))
     (Maybe (TreeAbove b))
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens TreeAbove b -> Maybe (TreeAbove b)
forall b. TreeAbove b -> Maybe (TreeAbove b)
treeAboveAbove ((TreeAbove b -> Maybe (TreeAbove b) -> TreeAbove b)
 -> Lens
      (TreeAbove b)
      (TreeAbove b)
      (Maybe (TreeAbove b))
      (Maybe (TreeAbove b)))
-> (TreeAbove b -> Maybe (TreeAbove b) -> TreeAbove b)
-> Lens
     (TreeAbove b)
     (TreeAbove b)
     (Maybe (TreeAbove b))
     (Maybe (TreeAbove b))
forall a b. (a -> b) -> a -> b
$ \TreeAbove b
ta Maybe (TreeAbove b)
taa -> TreeAbove b
ta {treeAboveAbove :: Maybe (TreeAbove b)
treeAboveAbove = Maybe (TreeAbove b)
taa}

treeAboveNodeL :: Lens' (TreeAbove b) b
treeAboveNodeL :: (b -> f b) -> TreeAbove b -> f (TreeAbove b)
treeAboveNodeL = (TreeAbove b -> b)
-> (TreeAbove b -> b -> TreeAbove b)
-> Lens (TreeAbove b) (TreeAbove b) b b
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens TreeAbove b -> b
forall b. TreeAbove b -> b
treeAboveNode ((TreeAbove b -> b -> TreeAbove b)
 -> Lens (TreeAbove b) (TreeAbove b) b b)
-> (TreeAbove b -> b -> TreeAbove b)
-> Lens (TreeAbove b) (TreeAbove b) b b
forall a b. (a -> b) -> a -> b
$ \TreeAbove b
ta b
a -> TreeAbove b
ta {treeAboveNode :: b
treeAboveNode = b
a}

treeAboveRightsL :: Lens' (TreeAbove b) [CTree b]
treeAboveRightsL :: ([CTree b] -> f [CTree b]) -> TreeAbove b -> f (TreeAbove b)
treeAboveRightsL = (TreeAbove b -> [CTree b])
-> (TreeAbove b -> [CTree b] -> TreeAbove b)
-> Lens (TreeAbove b) (TreeAbove b) [CTree b] [CTree b]
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens TreeAbove b -> [CTree b]
forall b. TreeAbove b -> [CTree b]
treeAboveRights ((TreeAbove b -> [CTree b] -> TreeAbove b)
 -> Lens (TreeAbove b) (TreeAbove b) [CTree b] [CTree b])
-> (TreeAbove b -> [CTree b] -> TreeAbove b)
-> Lens (TreeAbove b) (TreeAbove b) [CTree b] [CTree b]
forall a b. (a -> b) -> a -> b
$ \TreeAbove b
ta [CTree b]
tar -> TreeAbove b
ta {treeAboveRights :: [CTree b]
treeAboveRights = [CTree b]
tar}

data TreeCursorSelection
  = SelectNode
  | SelectChild !Int !TreeCursorSelection
  deriving (Int -> TreeCursorSelection -> ShowS
[TreeCursorSelection] -> ShowS
TreeCursorSelection -> String
(Int -> TreeCursorSelection -> ShowS)
-> (TreeCursorSelection -> String)
-> ([TreeCursorSelection] -> ShowS)
-> Show TreeCursorSelection
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TreeCursorSelection] -> ShowS
$cshowList :: [TreeCursorSelection] -> ShowS
show :: TreeCursorSelection -> String
$cshow :: TreeCursorSelection -> String
showsPrec :: Int -> TreeCursorSelection -> ShowS
$cshowsPrec :: Int -> TreeCursorSelection -> ShowS
Show, TreeCursorSelection -> TreeCursorSelection -> Bool
(TreeCursorSelection -> TreeCursorSelection -> Bool)
-> (TreeCursorSelection -> TreeCursorSelection -> Bool)
-> Eq TreeCursorSelection
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TreeCursorSelection -> TreeCursorSelection -> Bool
$c/= :: TreeCursorSelection -> TreeCursorSelection -> Bool
== :: TreeCursorSelection -> TreeCursorSelection -> Bool
$c== :: TreeCursorSelection -> TreeCursorSelection -> Bool
Eq, (forall x. TreeCursorSelection -> Rep TreeCursorSelection x)
-> (forall x. Rep TreeCursorSelection x -> TreeCursorSelection)
-> Generic TreeCursorSelection
forall x. Rep TreeCursorSelection x -> TreeCursorSelection
forall x. TreeCursorSelection -> Rep TreeCursorSelection x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TreeCursorSelection x -> TreeCursorSelection
$cfrom :: forall x. TreeCursorSelection -> Rep TreeCursorSelection x
Generic)

instance Validity TreeCursorSelection

instance NFData TreeCursorSelection

data CTree a
  = CNode !a (CForest a)
  deriving (Int -> CTree a -> ShowS
[CTree a] -> ShowS
CTree a -> String
(Int -> CTree a -> ShowS)
-> (CTree a -> String) -> ([CTree a] -> ShowS) -> Show (CTree a)
forall a. Show a => Int -> CTree a -> ShowS
forall a. Show a => [CTree a] -> ShowS
forall a. Show a => CTree a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CTree a] -> ShowS
$cshowList :: forall a. Show a => [CTree a] -> ShowS
show :: CTree a -> String
$cshow :: forall a. Show a => CTree a -> String
showsPrec :: Int -> CTree a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> CTree a -> ShowS
Show, CTree a -> CTree a -> Bool
(CTree a -> CTree a -> Bool)
-> (CTree a -> CTree a -> Bool) -> Eq (CTree a)
forall a. Eq a => CTree a -> CTree a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CTree a -> CTree a -> Bool
$c/= :: forall a. Eq a => CTree a -> CTree a -> Bool
== :: CTree a -> CTree a -> Bool
$c== :: forall a. Eq a => CTree a -> CTree a -> Bool
Eq, (forall x. CTree a -> Rep (CTree a) x)
-> (forall x. Rep (CTree a) x -> CTree a) -> Generic (CTree a)
forall x. Rep (CTree a) x -> CTree a
forall x. CTree a -> Rep (CTree a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (CTree a) x -> CTree a
forall a x. CTree a -> Rep (CTree a) x
$cto :: forall a x. Rep (CTree a) x -> CTree a
$cfrom :: forall a x. CTree a -> Rep (CTree a) x
Generic, a -> CTree b -> CTree a
(a -> b) -> CTree a -> CTree b
(forall a b. (a -> b) -> CTree a -> CTree b)
-> (forall a b. a -> CTree b -> CTree a) -> Functor CTree
forall a b. a -> CTree b -> CTree a
forall a b. (a -> b) -> CTree a -> CTree b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> CTree b -> CTree a
$c<$ :: forall a b. a -> CTree b -> CTree a
fmap :: (a -> b) -> CTree a -> CTree b
$cfmap :: forall a b. (a -> b) -> CTree a -> CTree b
Functor)

instance Validity a => Validity (CTree a)

instance NFData a => NFData (CTree a)

makeCTree :: Tree a -> CTree a
makeCTree :: Tree a -> CTree a
makeCTree = Bool -> Tree a -> CTree a
forall a. Bool -> Tree a -> CTree a
cTree Bool
False

cTree :: Bool -> Tree a -> CTree a
cTree :: Bool -> Tree a -> CTree a
cTree Bool
b (Node a
v Forest a
f) = a -> CForest a -> CTree a
forall a. a -> CForest a -> CTree a
CNode a
v (CForest a -> CTree a) -> CForest a -> CTree a
forall a b. (a -> b) -> a -> b
$ Bool -> Forest a -> CForest a
forall a. Bool -> Forest a -> CForest a
cForest Bool
b Forest a
f

rebuildCTree :: CTree a -> Tree a
rebuildCTree :: CTree a -> Tree a
rebuildCTree (CNode a
v CForest a
cf) = a -> Forest a -> Tree a
forall a. a -> Forest a -> Tree a
Node a
v (Forest a -> Tree a) -> Forest a -> Tree a
forall a b. (a -> b) -> a -> b
$ CForest a -> Forest a
forall a. CForest a -> Forest a
rebuildCForest CForest a
cf

data CForest a
  = EmptyCForest
  | ClosedForest !(NonEmpty (Tree a))
  | OpenForest !(NonEmpty (CTree a))
  deriving (Int -> CForest a -> ShowS
[CForest a] -> ShowS
CForest a -> String
(Int -> CForest a -> ShowS)
-> (CForest a -> String)
-> ([CForest a] -> ShowS)
-> Show (CForest a)
forall a. Show a => Int -> CForest a -> ShowS
forall a. Show a => [CForest a] -> ShowS
forall a. Show a => CForest a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CForest a] -> ShowS
$cshowList :: forall a. Show a => [CForest a] -> ShowS
show :: CForest a -> String
$cshow :: forall a. Show a => CForest a -> String
showsPrec :: Int -> CForest a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> CForest a -> ShowS
Show, CForest a -> CForest a -> Bool
(CForest a -> CForest a -> Bool)
-> (CForest a -> CForest a -> Bool) -> Eq (CForest a)
forall a. Eq a => CForest a -> CForest a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CForest a -> CForest a -> Bool
$c/= :: forall a. Eq a => CForest a -> CForest a -> Bool
== :: CForest a -> CForest a -> Bool
$c== :: forall a. Eq a => CForest a -> CForest a -> Bool
Eq, (forall x. CForest a -> Rep (CForest a) x)
-> (forall x. Rep (CForest a) x -> CForest a)
-> Generic (CForest a)
forall x. Rep (CForest a) x -> CForest a
forall x. CForest a -> Rep (CForest a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (CForest a) x -> CForest a
forall a x. CForest a -> Rep (CForest a) x
$cto :: forall a x. Rep (CForest a) x -> CForest a
$cfrom :: forall a x. CForest a -> Rep (CForest a) x
Generic, a -> CForest b -> CForest a
(a -> b) -> CForest a -> CForest b
(forall a b. (a -> b) -> CForest a -> CForest b)
-> (forall a b. a -> CForest b -> CForest a) -> Functor CForest
forall a b. a -> CForest b -> CForest a
forall a b. (a -> b) -> CForest a -> CForest b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> CForest b -> CForest a
$c<$ :: forall a b. a -> CForest b -> CForest a
fmap :: (a -> b) -> CForest a -> CForest b
$cfmap :: forall a b. (a -> b) -> CForest a -> CForest b
Functor)

instance Validity a => Validity (CForest a)

instance NFData a => NFData (CForest a)

makeCForest :: Forest a -> CForest a
makeCForest :: Forest a -> CForest a
makeCForest = Bool -> Forest a -> CForest a
forall a. Bool -> Forest a -> CForest a
cForest Bool
True

cForest :: Bool -> Forest a -> CForest a
cForest :: Bool -> Forest a -> CForest a
cForest Bool
b Forest a
f =
  if Bool
b
    then [CTree a] -> CForest a
forall a. [CTree a] -> CForest a
openForest ([CTree a] -> CForest a) -> [CTree a] -> CForest a
forall a b. (a -> b) -> a -> b
$ (Tree a -> CTree a) -> Forest a -> [CTree a]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> Tree a -> CTree a
forall a. Bool -> Tree a -> CTree a
cTree Bool
b) Forest a
f
    else Forest a -> CForest a
forall a. [Tree a] -> CForest a
closedForest Forest a
f

rebuildCForest :: CForest a -> Forest a
rebuildCForest :: CForest a -> Forest a
rebuildCForest CForest a
EmptyCForest = []
rebuildCForest (ClosedForest NonEmpty (Tree a)
f) = NonEmpty (Tree a) -> Forest a
forall a. NonEmpty a -> [a]
NE.toList NonEmpty (Tree a)
f
rebuildCForest (OpenForest NonEmpty (CTree a)
ct) = NonEmpty (Tree a) -> Forest a
forall a. NonEmpty a -> [a]
NE.toList (NonEmpty (Tree a) -> Forest a) -> NonEmpty (Tree a) -> Forest a
forall a b. (a -> b) -> a -> b
$ (CTree a -> Tree a) -> NonEmpty (CTree a) -> NonEmpty (Tree a)
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NE.map CTree a -> Tree a
forall a. CTree a -> Tree a
rebuildCTree NonEmpty (CTree a)
ct

emptyCForest :: CForest a
emptyCForest :: CForest a
emptyCForest = CForest a
forall a. CForest a
EmptyCForest

openForest :: [CTree a] -> CForest a
openForest :: [CTree a] -> CForest a
openForest [CTree a]
ts = CForest a
-> (NonEmpty (CTree a) -> CForest a)
-> Maybe (NonEmpty (CTree a))
-> CForest a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe CForest a
forall a. CForest a
emptyCForest NonEmpty (CTree a) -> CForest a
forall a. NonEmpty (CTree a) -> CForest a
OpenForest (Maybe (NonEmpty (CTree a)) -> CForest a)
-> Maybe (NonEmpty (CTree a)) -> CForest a
forall a b. (a -> b) -> a -> b
$ [CTree a] -> Maybe (NonEmpty (CTree a))
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty [CTree a]
ts

closedForest :: [Tree a] -> CForest a
closedForest :: [Tree a] -> CForest a
closedForest [Tree a]
ts = CForest a
-> (NonEmpty (Tree a) -> CForest a)
-> Maybe (NonEmpty (Tree a))
-> CForest a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe CForest a
forall a. CForest a
emptyCForest NonEmpty (Tree a) -> CForest a
forall a. NonEmpty (Tree a) -> CForest a
ClosedForest (Maybe (NonEmpty (Tree a)) -> CForest a)
-> Maybe (NonEmpty (Tree a)) -> CForest a
forall a b. (a -> b) -> a -> b
$ [Tree a] -> Maybe (NonEmpty (Tree a))
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty [Tree a]
ts

lengthCForest :: CForest a -> Int
lengthCForest :: CForest a -> Int
lengthCForest CForest a
EmptyCForest = Int
0
lengthCForest (ClosedForest NonEmpty (Tree a)
ts) = NonEmpty (Tree a) -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length NonEmpty (Tree a)
ts
lengthCForest (OpenForest NonEmpty (CTree a)
ts) = NonEmpty (CTree a) -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length NonEmpty (CTree a)
ts

unpackCForest :: CForest a -> [CTree a]
unpackCForest :: CForest a -> [CTree a]
unpackCForest CForest a
EmptyCForest = []
unpackCForest (ClosedForest NonEmpty (Tree a)
ts) = NonEmpty (CTree a) -> [CTree a]
forall a. NonEmpty a -> [a]
NE.toList (NonEmpty (CTree a) -> [CTree a])
-> NonEmpty (CTree a) -> [CTree a]
forall a b. (a -> b) -> a -> b
$ (Tree a -> CTree a) -> NonEmpty (Tree a) -> NonEmpty (CTree a)
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NE.map Tree a -> CTree a
forall a. Tree a -> CTree a
makeCTree NonEmpty (Tree a)
ts
unpackCForest (OpenForest NonEmpty (CTree a)
ts) = NonEmpty (CTree a) -> [CTree a]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty (CTree a)
ts