{-# LANGUAGE DeriveGeneric #-}

module HaskellWorks.Data.BalancedParens.Internal.RoseTree
  ( RoseTree(..)
  , toBools
  , toBools'
  , size
  , depth
  ) where

import GHC.Generics

newtype RoseTree = RoseTree
  { RoseTree -> [RoseTree]
children :: [RoseTree]
  } deriving (RoseTree -> RoseTree -> Bool
(RoseTree -> RoseTree -> Bool)
-> (RoseTree -> RoseTree -> Bool) -> Eq RoseTree
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RoseTree -> RoseTree -> Bool
$c/= :: RoseTree -> RoseTree -> Bool
== :: RoseTree -> RoseTree -> Bool
$c== :: RoseTree -> RoseTree -> Bool
Eq, Int -> RoseTree -> ShowS
[RoseTree] -> ShowS
RoseTree -> String
(Int -> RoseTree -> ShowS)
-> (RoseTree -> String) -> ([RoseTree] -> ShowS) -> Show RoseTree
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RoseTree] -> ShowS
$cshowList :: [RoseTree] -> ShowS
show :: RoseTree -> String
$cshow :: RoseTree -> String
showsPrec :: Int -> RoseTree -> ShowS
$cshowsPrec :: Int -> RoseTree -> ShowS
Show, (forall x. RoseTree -> Rep RoseTree x)
-> (forall x. Rep RoseTree x -> RoseTree) -> Generic RoseTree
forall x. Rep RoseTree x -> RoseTree
forall x. RoseTree -> Rep RoseTree x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RoseTree x -> RoseTree
$cfrom :: forall x. RoseTree -> Rep RoseTree x
Generic)

toBools :: RoseTree -> [Bool]
toBools :: RoseTree -> [Bool]
toBools RoseTree
rt = RoseTree -> [Bool] -> [Bool]
toBools' RoseTree
rt []

toBools' :: RoseTree -> [Bool] -> [Bool]
toBools' :: RoseTree -> [Bool] -> [Bool]
toBools' (RoseTree [RoseTree]
cs) = (Bool
TrueBool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
:) ([Bool] -> [Bool]) -> ([Bool] -> [Bool]) -> [Bool] -> [Bool]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([Bool] -> [Bool]) -> ([Bool] -> [Bool]) -> [Bool] -> [Bool])
-> ([Bool] -> [Bool]) -> [[Bool] -> [Bool]] -> [Bool] -> [Bool]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ([Bool] -> [Bool]) -> ([Bool] -> [Bool]) -> [Bool] -> [Bool]
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) [Bool] -> [Bool]
forall a. a -> a
id ((RoseTree -> [Bool] -> [Bool]) -> [RoseTree] -> [[Bool] -> [Bool]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RoseTree -> [Bool] -> [Bool]
toBools' [RoseTree]
cs) ([Bool] -> [Bool]) -> ([Bool] -> [Bool]) -> [Bool] -> [Bool]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool
FalseBool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
:)

size :: RoseTree -> Int
size :: RoseTree -> Int
size (RoseTree [RoseTree]
cs) = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ((RoseTree -> Int) -> [RoseTree] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RoseTree -> Int
size [RoseTree]
cs)

depth :: RoseTree -> Int
depth :: RoseTree -> Int
depth (RoseTree [RoseTree]
cs) = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ((RoseTree -> Int) -> [RoseTree] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RoseTree -> Int
depth [RoseTree]
cs)