{-# 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
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
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. 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
Trueforall a. a -> [a] -> [a]
:) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) forall a. a -> a
id (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RoseTree -> [Bool] -> [Bool]
toBools' [RoseTree]
cs) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool
Falseforall a. a -> [a] -> [a]
:)

size :: RoseTree -> Int
size :: RoseTree -> Int
size (RoseTree [RoseTree]
cs) = Int
1 forall a. Num a => a -> a -> a
+ forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (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 forall a. Num a => a -> a -> a
+ forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RoseTree -> Int
depth [RoseTree]
cs)