{-# language
    DeriveDataTypeable
  , DeriveFunctor
  , DeriveGeneric
  , DerivingStrategies
  , FlexibleInstances
  , GeneralizedNewtypeDeriving
  , InstanceSigs
  , MultiParamTypeClasses
  , PackageImports
  , PatternSynonyms
  , ScopedTypeVariables
  , TypeApplications
  , ViewPatterns
#-}

{-# options_ghc -Wall #-}

-- | <https://en.wikipedia.org/wiki/Rose_tree Rose Trees> are trees with
--   an unbounded number of branches per node. Each node contains a value
--   and zero or more subtrees.
module Rose
  ( Rose
  , pattern Rose
  , singleton
  , coiter
  , coiterW
  , unfold
  , unfoldM
  , telescoped
  , telescoped_
  , shoots
  , leaves
  ) where

import "base" Control.Monad.Zip (MonadZip)
import "base" Data.Coerce (coerce)
import "base" Data.Functor.Classes (Eq1, Ord1, Show1(..), Read1(..), readBinaryWith)
import qualified "base" Data.List as List
import "base" GHC.Generics (Generic, Generic1)
import qualified "base" GHC.Read as Read
import "base" GHC.Show (showSpace)
import "base" Text.ParserCombinators.ReadPrec (ReadPrec)
import qualified "base" Text.ParserCombinators.ReadPrec as Read
import qualified "base" Text.Read.Lex as Read
import "comonad" Control.Comonad (Comonad(..))
import "free" Control.Comonad.Cofree (Cofree(..), ComonadCofree(..))
import qualified "free" Control.Comonad.Cofree as Cofree

-- | A Rose tree. This type can be produced and consumed using the
--   @Rose@ pattern.
newtype Rose a = MkRose (Cofree [] a)
  deriving stock
    ( (forall x. Rose a -> Rep (Rose a) x)
-> (forall x. Rep (Rose a) x -> Rose a) -> Generic (Rose a)
forall x. Rep (Rose a) x -> Rose a
forall x. Rose a -> Rep (Rose a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Rose a) x -> Rose a
forall a x. Rose a -> Rep (Rose a) x
$cto :: forall a x. Rep (Rose a) x -> Rose a
$cfrom :: forall a x. Rose a -> Rep (Rose a) x
Generic
    , (forall a. Rose a -> Rep1 Rose a)
-> (forall a. Rep1 Rose a -> Rose a) -> Generic1 Rose
forall a. Rep1 Rose a -> Rose a
forall a. Rose a -> Rep1 Rose a
forall k (f :: k -> *).
(forall (a :: k). f a -> Rep1 f a)
-> (forall (a :: k). Rep1 f a -> f a) -> Generic1 f
$cto1 :: forall a. Rep1 Rose a -> Rose a
$cfrom1 :: forall a. Rose a -> Rep1 Rose a
Generic1
    )
  deriving newtype
    ( Functor Rose
a -> Rose a
Functor Rose
-> (forall a. a -> Rose a)
-> (forall a b. Rose (a -> b) -> Rose a -> Rose b)
-> (forall a b c. (a -> b -> c) -> Rose a -> Rose b -> Rose c)
-> (forall a b. Rose a -> Rose b -> Rose b)
-> (forall a b. Rose a -> Rose b -> Rose a)
-> Applicative Rose
Rose a -> Rose b -> Rose b
Rose a -> Rose b -> Rose a
Rose (a -> b) -> Rose a -> Rose b
(a -> b -> c) -> Rose a -> Rose b -> Rose c
forall a. a -> Rose a
forall a b. Rose a -> Rose b -> Rose a
forall a b. Rose a -> Rose b -> Rose b
forall a b. Rose (a -> b) -> Rose a -> Rose b
forall a b c. (a -> b -> c) -> Rose a -> Rose b -> Rose c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: Rose a -> Rose b -> Rose a
$c<* :: forall a b. Rose a -> Rose b -> Rose a
*> :: Rose a -> Rose b -> Rose b
$c*> :: forall a b. Rose a -> Rose b -> Rose b
liftA2 :: (a -> b -> c) -> Rose a -> Rose b -> Rose c
$cliftA2 :: forall a b c. (a -> b -> c) -> Rose a -> Rose b -> Rose c
<*> :: Rose (a -> b) -> Rose a -> Rose b
$c<*> :: forall a b. Rose (a -> b) -> Rose a -> Rose b
pure :: a -> Rose a
$cpure :: forall a. a -> Rose a
$cp1Applicative :: Functor Rose
Applicative
    , ComonadCofree []
    , Rose a -> Rose a -> Bool
(Rose a -> Rose a -> Bool)
-> (Rose a -> Rose a -> Bool) -> Eq (Rose a)
forall a. Eq a => Rose a -> Rose a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Rose a -> Rose a -> Bool
$c/= :: forall a. Eq a => Rose a -> Rose a -> Bool
== :: Rose a -> Rose a -> Bool
$c== :: forall a. Eq a => Rose a -> Rose a -> Bool
Eq
    , (a -> b -> Bool) -> Rose a -> Rose b -> Bool
(forall a b. (a -> b -> Bool) -> Rose a -> Rose b -> Bool)
-> Eq1 Rose
forall a b. (a -> b -> Bool) -> Rose a -> Rose b -> Bool
forall (f :: * -> *).
(forall a b. (a -> b -> Bool) -> f a -> f b -> Bool) -> Eq1 f
liftEq :: (a -> b -> Bool) -> Rose a -> Rose b -> Bool
$cliftEq :: forall a b. (a -> b -> Bool) -> Rose a -> Rose b -> Bool
Eq1
    , a -> Rose a -> Bool
Rose m -> m
Rose a -> [a]
Rose a -> Bool
Rose a -> Int
Rose a -> a
Rose a -> a
Rose a -> a
Rose a -> a
(a -> m) -> Rose a -> m
(a -> m) -> Rose a -> m
(a -> b -> b) -> b -> Rose a -> b
(a -> b -> b) -> b -> Rose a -> b
(b -> a -> b) -> b -> Rose a -> b
(b -> a -> b) -> b -> Rose a -> b
(a -> a -> a) -> Rose a -> a
(a -> a -> a) -> Rose a -> a
(forall m. Monoid m => Rose m -> m)
-> (forall m a. Monoid m => (a -> m) -> Rose a -> m)
-> (forall m a. Monoid m => (a -> m) -> Rose a -> m)
-> (forall a b. (a -> b -> b) -> b -> Rose a -> b)
-> (forall a b. (a -> b -> b) -> b -> Rose a -> b)
-> (forall b a. (b -> a -> b) -> b -> Rose a -> b)
-> (forall b a. (b -> a -> b) -> b -> Rose a -> b)
-> (forall a. (a -> a -> a) -> Rose a -> a)
-> (forall a. (a -> a -> a) -> Rose a -> a)
-> (forall a. Rose a -> [a])
-> (forall a. Rose a -> Bool)
-> (forall a. Rose a -> Int)
-> (forall a. Eq a => a -> Rose a -> Bool)
-> (forall a. Ord a => Rose a -> a)
-> (forall a. Ord a => Rose a -> a)
-> (forall a. Num a => Rose a -> a)
-> (forall a. Num a => Rose a -> a)
-> Foldable Rose
forall a. Eq a => a -> Rose a -> Bool
forall a. Num a => Rose a -> a
forall a. Ord a => Rose a -> a
forall m. Monoid m => Rose m -> m
forall a. Rose a -> Bool
forall a. Rose a -> Int
forall a. Rose a -> [a]
forall a. (a -> a -> a) -> Rose a -> a
forall m a. Monoid m => (a -> m) -> Rose a -> m
forall b a. (b -> a -> b) -> b -> Rose a -> b
forall a b. (a -> b -> b) -> b -> Rose a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: Rose a -> a
$cproduct :: forall a. Num a => Rose a -> a
sum :: Rose a -> a
$csum :: forall a. Num a => Rose a -> a
minimum :: Rose a -> a
$cminimum :: forall a. Ord a => Rose a -> a
maximum :: Rose a -> a
$cmaximum :: forall a. Ord a => Rose a -> a
elem :: a -> Rose a -> Bool
$celem :: forall a. Eq a => a -> Rose a -> Bool
length :: Rose a -> Int
$clength :: forall a. Rose a -> Int
null :: Rose a -> Bool
$cnull :: forall a. Rose a -> Bool
toList :: Rose a -> [a]
$ctoList :: forall a. Rose a -> [a]
foldl1 :: (a -> a -> a) -> Rose a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Rose a -> a
foldr1 :: (a -> a -> a) -> Rose a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> Rose a -> a
foldl' :: (b -> a -> b) -> b -> Rose a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Rose a -> b
foldl :: (b -> a -> b) -> b -> Rose a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Rose a -> b
foldr' :: (a -> b -> b) -> b -> Rose a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Rose a -> b
foldr :: (a -> b -> b) -> b -> Rose a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> Rose a -> b
foldMap' :: (a -> m) -> Rose a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Rose a -> m
foldMap :: (a -> m) -> Rose a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Rose a -> m
fold :: Rose m -> m
$cfold :: forall m. Monoid m => Rose m -> m
Foldable
    , a -> Rose b -> Rose a
(a -> b) -> Rose a -> Rose b
(forall a b. (a -> b) -> Rose a -> Rose b)
-> (forall a b. a -> Rose b -> Rose a) -> Functor Rose
forall a b. a -> Rose b -> Rose a
forall a b. (a -> b) -> Rose a -> Rose b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Rose b -> Rose a
$c<$ :: forall a b. a -> Rose b -> Rose a
fmap :: (a -> b) -> Rose a -> Rose b
$cfmap :: forall a b. (a -> b) -> Rose a -> Rose b
Functor
    , Applicative Rose
a -> Rose a
Applicative Rose
-> (forall a b. Rose a -> (a -> Rose b) -> Rose b)
-> (forall a b. Rose a -> Rose b -> Rose b)
-> (forall a. a -> Rose a)
-> Monad Rose
Rose a -> (a -> Rose b) -> Rose b
Rose a -> Rose b -> Rose b
forall a. a -> Rose a
forall a b. Rose a -> Rose b -> Rose b
forall a b. Rose a -> (a -> Rose b) -> Rose b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> Rose a
$creturn :: forall a. a -> Rose a
>> :: Rose a -> Rose b -> Rose b
$c>> :: forall a b. Rose a -> Rose b -> Rose b
>>= :: Rose a -> (a -> Rose b) -> Rose b
$c>>= :: forall a b. Rose a -> (a -> Rose b) -> Rose b
$cp1Monad :: Applicative Rose
Monad
    , Monad Rose
Monad Rose
-> (forall a b. Rose a -> Rose b -> Rose (a, b))
-> (forall a b c. (a -> b -> c) -> Rose a -> Rose b -> Rose c)
-> (forall a b. Rose (a, b) -> (Rose a, Rose b))
-> MonadZip Rose
Rose a -> Rose b -> Rose (a, b)
Rose (a, b) -> (Rose a, Rose b)
(a -> b -> c) -> Rose a -> Rose b -> Rose c
forall a b. Rose a -> Rose b -> Rose (a, b)
forall a b. Rose (a, b) -> (Rose a, Rose b)
forall a b c. (a -> b -> c) -> Rose a -> Rose b -> Rose c
forall (m :: * -> *).
Monad m
-> (forall a b. m a -> m b -> m (a, b))
-> (forall a b c. (a -> b -> c) -> m a -> m b -> m c)
-> (forall a b. m (a, b) -> (m a, m b))
-> MonadZip m
munzip :: Rose (a, b) -> (Rose a, Rose b)
$cmunzip :: forall a b. Rose (a, b) -> (Rose a, Rose b)
mzipWith :: (a -> b -> c) -> Rose a -> Rose b -> Rose c
$cmzipWith :: forall a b c. (a -> b -> c) -> Rose a -> Rose b -> Rose c
mzip :: Rose a -> Rose b -> Rose (a, b)
$cmzip :: forall a b. Rose a -> Rose b -> Rose (a, b)
$cp1MonadZip :: Monad Rose
MonadZip
    , Eq (Rose a)
Eq (Rose a)
-> (Rose a -> Rose a -> Ordering)
-> (Rose a -> Rose a -> Bool)
-> (Rose a -> Rose a -> Bool)
-> (Rose a -> Rose a -> Bool)
-> (Rose a -> Rose a -> Bool)
-> (Rose a -> Rose a -> Rose a)
-> (Rose a -> Rose a -> Rose a)
-> Ord (Rose a)
Rose a -> Rose a -> Bool
Rose a -> Rose a -> Ordering
Rose a -> Rose a -> Rose a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (Rose a)
forall a. Ord a => Rose a -> Rose a -> Bool
forall a. Ord a => Rose a -> Rose a -> Ordering
forall a. Ord a => Rose a -> Rose a -> Rose a
min :: Rose a -> Rose a -> Rose a
$cmin :: forall a. Ord a => Rose a -> Rose a -> Rose a
max :: Rose a -> Rose a -> Rose a
$cmax :: forall a. Ord a => Rose a -> Rose a -> Rose a
>= :: Rose a -> Rose a -> Bool
$c>= :: forall a. Ord a => Rose a -> Rose a -> Bool
> :: Rose a -> Rose a -> Bool
$c> :: forall a. Ord a => Rose a -> Rose a -> Bool
<= :: Rose a -> Rose a -> Bool
$c<= :: forall a. Ord a => Rose a -> Rose a -> Bool
< :: Rose a -> Rose a -> Bool
$c< :: forall a. Ord a => Rose a -> Rose a -> Bool
compare :: Rose a -> Rose a -> Ordering
$ccompare :: forall a. Ord a => Rose a -> Rose a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (Rose a)
Ord
    , Eq1 Rose
Eq1 Rose
-> (forall a b.
    (a -> b -> Ordering) -> Rose a -> Rose b -> Ordering)
-> Ord1 Rose
(a -> b -> Ordering) -> Rose a -> Rose b -> Ordering
forall a b. (a -> b -> Ordering) -> Rose a -> Rose b -> Ordering
forall (f :: * -> *).
Eq1 f
-> (forall a b. (a -> b -> Ordering) -> f a -> f b -> Ordering)
-> Ord1 f
liftCompare :: (a -> b -> Ordering) -> Rose a -> Rose b -> Ordering
$cliftCompare :: forall a b. (a -> b -> Ordering) -> Rose a -> Rose b -> Ordering
$cp1Ord1 :: Eq1 Rose
Ord1
    )

instance forall a. (Show a) => Show (Rose a) where
  showsPrec :: Int -> Rose a -> ShowS
  showsPrec :: Int -> Rose a -> ShowS
showsPrec Int
d (Rose a
a [Rose a]
as) = ShowS -> ShowS
forall a. a -> a
id
    (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
11)
    (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"Rose "
    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 a
a
    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
showSpace
    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Rose a] -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 [Rose a]
as

instance Show1 Rose where
  liftShowsPrec :: forall a. ()
    => (Int -> a -> ShowS)
    -> ([a] -> ShowS)
    -> Int
    -> Rose a
    -> ShowS
  liftShowsPrec :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> Rose a -> ShowS
liftShowsPrec Int -> a -> ShowS
sp [a] -> ShowS
sl = Int -> Rose a -> ShowS
go
    where
      goList :: [Rose a] -> ShowS
goList = (Int -> a -> ShowS) -> ([a] -> ShowS) -> [Rose a] -> ShowS
forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> [f a] -> ShowS
liftShowList Int -> a -> ShowS
sp [a] -> ShowS
sl
      go :: Int -> Rose a -> ShowS
go Int
p (Rose a
a [Rose a]
as) = ShowS -> ShowS
forall a. a -> a
id
        (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
11)
        (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"Rose "
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a -> ShowS
sp Int
11 a
a
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
showSpace
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Rose a -> ShowS)
-> ([Rose a] -> ShowS) -> Int -> [Rose a] -> ShowS
forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
liftShowsPrec Int -> Rose a -> ShowS
go [Rose a] -> ShowS
goList Int
11 [Rose a]
as

instance forall a. Read a => Read (Rose a) where
  readPrec :: ReadPrec (Rose a)
  readPrec :: ReadPrec (Rose a)
readPrec = ReadPrec (Rose a) -> ReadPrec (Rose a)
forall a. ReadPrec a -> ReadPrec a
Read.parens (ReadPrec (Rose a) -> ReadPrec (Rose a))
-> ReadPrec (Rose a) -> ReadPrec (Rose a)
forall a b. (a -> b) -> a -> b
$ Int -> ReadPrec (Rose a) -> ReadPrec (Rose a)
forall a. Int -> ReadPrec a -> ReadPrec a
Read.prec Int
10 (ReadPrec (Rose a) -> ReadPrec (Rose a))
-> ReadPrec (Rose a) -> ReadPrec (Rose a)
forall a b. (a -> b) -> a -> b
$ do
    Lexeme -> ReadPrec ()
Read.expectP (String -> Lexeme
Read.Ident String
"Rose")
    a
a <- ReadPrec a -> ReadPrec a
forall a. ReadPrec a -> ReadPrec a
Read.step ReadPrec a
forall a. Read a => ReadPrec a
Read.readPrec
    [Rose a]
as <- ReadPrec [Rose a] -> ReadPrec [Rose a]
forall a. ReadPrec a -> ReadPrec a
Read.step ReadPrec [Rose a]
forall a. Read a => ReadPrec a
Read.readPrec
    Rose a -> ReadPrec (Rose a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> [Rose a] -> Rose a
forall a. a -> [Rose a] -> Rose a
Rose a
a [Rose a]
as)

instance Read1 Rose where
  liftReadPrec :: forall a. ()
    => ReadPrec a
    -> ReadPrec [a]
    -> ReadPrec (Rose a)
  liftReadPrec :: ReadPrec a -> ReadPrec [a] -> ReadPrec (Rose a)
liftReadPrec ReadPrec a
rp ReadPrec [a]
rl = ReadPrec (Rose a) -> ReadPrec (Rose a)
forall a. ReadPrec a -> ReadPrec a
Read.parens
    (ReadPrec (Rose a) -> ReadPrec (Rose a))
-> ReadPrec (Rose a) -> ReadPrec (Rose a)
forall a b. (a -> b) -> a -> b
$ Int -> ReadPrec (Rose a) -> ReadPrec (Rose a)
forall a. Int -> ReadPrec a -> ReadPrec a
Read.prec Int
10
    (ReadPrec (Rose a) -> ReadPrec (Rose a))
-> ReadPrec (Rose a) -> ReadPrec (Rose a)
forall a b. (a -> b) -> a -> b
$ ReadPrec a
-> ReadPrec [Rose a]
-> String
-> (a -> [Rose a] -> Rose a)
-> ReadPrec (Rose a)
forall a b t.
ReadPrec a -> ReadPrec b -> String -> (a -> b -> t) -> ReadPrec t
readBinaryWith ReadPrec a
rp (ReadPrec (Rose a) -> ReadPrec [Rose a] -> ReadPrec [Rose a]
forall (f :: * -> *) a.
Read1 f =>
ReadPrec a -> ReadPrec [a] -> ReadPrec (f a)
liftReadPrec ReadPrec (Rose a)
goShoots ReadPrec [Rose a]
goLeaves) String
"Rose" a -> [Rose a] -> Rose a
forall a. a -> [Rose a] -> Rose a
Rose
    where
      goShoots :: ReadPrec (Rose a)
goShoots = do
        a
ra <- ReadPrec a
rp
        Rose a -> ReadPrec (Rose a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Rose a -> ReadPrec (Rose a)) -> Rose a -> ReadPrec (Rose a)
forall a b. (a -> b) -> a -> b
$ a -> Rose a
forall a. a -> Rose a
singleton a
ra
      goLeaves :: ReadPrec [Rose a]
goLeaves = do
        [a]
ras <- ReadPrec [a]
rl
        [Rose a] -> ReadPrec [Rose a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Rose a] -> ReadPrec [Rose a]) -> [Rose a] -> ReadPrec [Rose a]
forall a b. (a -> b) -> a -> b
$ (a -> Rose a) -> [a] -> [Rose a]
forall a b. (a -> b) -> [a] -> [b]
List.map a -> Rose a
forall a. a -> Rose a
singleton [a]
ras

instance Traversable Rose where
  traverse :: forall f a b. (Applicative f) => (a -> f b) -> Rose a -> f (Rose b)
  traverse :: (a -> f b) -> Rose a -> f (Rose b)
traverse a -> f b
f = (Cofree [] b -> Rose b) -> f (Cofree [] b) -> f (Rose b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Coercible (Cofree [] b) (Rose b) => Cofree [] b -> Rose b
coerce @(Cofree [] b) @(Rose b)) (f (Cofree [] b) -> f (Rose b))
-> (Rose a -> f (Cofree [] b)) -> Rose a -> f (Rose b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> f b) -> Cofree [] a -> f (Cofree [] b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
f (Cofree [] a -> f (Cofree [] b))
-> (Rose a -> Cofree [] a) -> Rose a -> f (Cofree [] b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rose a -> Cofree [] a
coerce
  {-# inline traverse #-}

instance Comonad Rose where
  extend :: (Rose a -> b) -> Rose a -> Rose b
extend Rose a -> b
f w :: Rose a
w@(MkRose Cofree [] a
c) = Cofree [] b -> Rose b
forall a. Cofree [] a -> Rose a
MkRose (Rose a -> b
f Rose a
w b -> [Cofree [] b] -> Cofree [] b
forall (f :: * -> *) a. a -> f (Cofree f a) -> Cofree f a
:< (Cofree [] a -> Cofree [] b) -> [Cofree [] a] -> [Cofree [] b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Cofree [] a -> b) -> Cofree [] a -> Cofree [] b
forall (w :: * -> *) a b. Comonad w => (w a -> b) -> w a -> w b
extend (Rose a -> b
f (Rose a -> b) -> (Cofree [] a -> Rose a) -> Cofree [] a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cofree [] a -> Rose a
forall a. Cofree [] a -> Rose a
MkRose)) (Cofree [] a -> [Cofree [] a]
forall (f :: * -> *) (w :: * -> *) a.
ComonadCofree f w =>
w a -> f (w a)
Cofree.unwrap Cofree [] a
c))
  duplicate :: Rose a -> Rose (Rose a)
duplicate w :: Rose a
w@(MkRose Cofree [] a
c) = Cofree [] (Rose a) -> Rose (Rose a)
forall a. Cofree [] a -> Rose a
MkRose (Rose a
w Rose a -> [Cofree [] (Rose a)] -> Cofree [] (Rose a)
forall (f :: * -> *) a. a -> f (Cofree f a) -> Cofree f a
:< (Cofree [] a -> Cofree [] (Rose a))
-> [Cofree [] a] -> [Cofree [] (Rose a)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Cofree [] a -> Rose a)
-> Cofree [] (Cofree [] a) -> Cofree [] (Rose a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Cofree [] a -> Rose a
forall a. Cofree [] a -> Rose a
MkRose (Cofree [] (Cofree [] a) -> Cofree [] (Rose a))
-> (Cofree [] a -> Cofree [] (Cofree [] a))
-> Cofree [] a
-> Cofree [] (Rose a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cofree [] a -> Cofree [] (Cofree [] a)
forall (w :: * -> *) a. Comonad w => w a -> w (w a)
duplicate) (Cofree [] a -> [Cofree [] a]
forall (f :: * -> *) (w :: * -> *) a.
ComonadCofree f w =>
w a -> f (w a)
Cofree.unwrap Cofree [] a
c))
  extract :: Rose a -> a
extract (MkRose (a
a :< [Cofree [] a]
_)) = a
a
  {-# inline extract #-}

pattern Rose :: a -> [Rose a] -> Rose a
pattern $bRose :: a -> [Rose a] -> Rose a
$mRose :: forall r a. Rose a -> (a -> [Rose a] -> r) -> (Void# -> r) -> r
Rose a as <- (pat -> (a, as))
  where
    Rose a
x [Rose a]
xs = Cofree [] a -> Rose a
forall a. Cofree [] a -> Rose a
MkRose (a
x a -> [Cofree [] a] -> Cofree [] a
forall (f :: * -> *) a. a -> f (Cofree f a) -> Cofree f a
:< [Rose a] -> [Cofree [] a]
coerce [Rose a]
xs)
{-# complete Rose #-}

pat :: Rose a -> (a, [Rose a])
pat :: Rose a -> (a, [Rose a])
pat (MkRose (a
a :< [Cofree [] a]
as)) = (a
a, [Cofree [] a] -> [Rose a]
coerce [Cofree [] a]
as)
{-# inline pat #-}

-- | Generate a singleton rose tree.
--   It has no leaves and one shoot.
--
-- >>> singleton @Int 3
-- Rose 3 []
singleton :: a -> Rose a
singleton :: a -> Rose a
singleton a
a = a -> [Rose a] -> Rose a
forall a. a -> [Rose a] -> Rose a
Rose a
a []
{-# inline singleton #-}

-- | Use coiteration to generate a
--   rose tree from a seed.
--
--   The coiteration terminates when
--   the generating function returns
--   an empty list:
--
-- >>> 'coiter' (\i -> if i > 3 then [] else [i + 1]) 0
-- Rose 0 [Rose 1 [Rose 2 [Rose 3 [Rose 4 []]]]]
--
--   An infinite, lazy generator for
--   the fibonacci sequence:
--
-- >>> take 10 $ map fst $ 'Data.Foldable.toList' $ 'coiter' (\(a, b) -> [(b, a + b)]) (0, 1)
coiter :: (a -> [a]) -> a -> Rose a
coiter :: (a -> [a]) -> a -> Rose a
coiter = ((a -> [a]) -> a -> Cofree [] a) -> (a -> [a]) -> a -> Rose a
coerce (a -> [a]) -> a -> Cofree [] a
forall (f :: * -> *) a. Functor f => (a -> f a) -> a -> Cofree f a
Cofree.coiter

-- | Like 'coiter' for comonadic values.
--
coiterW :: (Comonad w) => (w a -> [w a]) -> w a -> Rose a
coiterW :: (w a -> [w a]) -> w a -> Rose a
coiterW w a -> [w a]
f w a
w = Cofree [] a -> Rose a
forall a. Cofree [] a -> Rose a
MkRose ((w a -> [w a]) -> w a -> Cofree [] a
forall (w :: * -> *) (f :: * -> *) a.
(Comonad w, Functor f) =>
(w a -> f (w a)) -> w a -> Cofree f a
Cofree.coiterW w a -> [w a]
f w a
w)

-- | Unfold a rose tree from a seed.
unfold :: (b -> (a, [b])) -> b -> Rose a
unfold :: (b -> (a, [b])) -> b -> Rose a
unfold b -> (a, [b])
un b
seed = Cofree [] a -> Rose a
forall a. Cofree [] a -> Rose a
MkRose ((b -> (a, [b])) -> b -> Cofree [] a
forall (f :: * -> *) b a.
Functor f =>
(b -> (a, f b)) -> b -> Cofree f a
Cofree.unfold b -> (a, [b])
un b
seed)

-- | Unfold a rose tree from a seed, monadically.
unfoldM :: (Monad m) => (b -> m (a, [b])) -> b -> m (Rose a)
unfoldM :: (b -> m (a, [b])) -> b -> m (Rose a)
unfoldM b -> m (a, [b])
un b
seed = (Cofree [] a -> Rose a) -> m (Cofree [] a) -> m (Rose a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Cofree [] a -> Rose a
forall a. Cofree [] a -> Rose a
MkRose ((b -> m (a, [b])) -> b -> m (Cofree [] a)
forall (f :: * -> *) (m :: * -> *) b a.
(Traversable f, Monad m) =>
(b -> m (a, f b)) -> b -> m (Cofree f a)
Cofree.unfoldM b -> m (a, [b])
un b
seed)

-- | This is a lens that can be used to read or write from the target of 'extract'.
--
--   Using @^.@ from the @lens@ package:
--
-- @
-- foo ^. '_extract' == 'extract' foo
-- @
--
-- For more lenses see the @lens@ package
--
-- @
-- '_extract' :: Lens' ('Rose' a) a
-- @
_extract :: (Functor f) => (a -> f a) -> Rose a -> f (Rose a)
_extract :: (a -> f a) -> Rose a -> f (Rose a)
_extract a -> f a
f (MkRose Cofree [] a
a) = (Cofree [] a -> Rose a) -> f (Cofree [] a) -> f (Rose a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Cofree [] a -> Rose a
forall a. Cofree [] a -> Rose a
MkRose ((a -> f a) -> Cofree [] a -> f (Cofree [] a)
forall (f :: * -> *) a (g :: * -> *).
Functor f =>
(a -> f a) -> Cofree g a -> f (Cofree g a)
Cofree._extract a -> f a
f Cofree [] a
a)

-- | This is a lens that can be used to read or write to the tails of a rose tree.
--
--   Using @^.@ from the @lens@ package:
--
-- @
-- foo ^. '_unwrap' == 'unwrap' foo
-- @
--
-- For more lenses see the @lens@ package
--
-- @
-- '_unwrap' :: Lens' ('Rose' a) ['Rose' a]
-- @
_unwrap :: (Functor f)
  => ([Rose a] -> f [Rose a])
  -> Rose a
  -> f (Rose a)
_unwrap :: ([Rose a] -> f [Rose a]) -> Rose a -> f (Rose a)
_unwrap [Rose a] -> f [Rose a]
f (Rose a
a [Rose a]
as) = (a -> [Rose a] -> Rose a
forall a. a -> [Rose a] -> Rose a
Rose a
a) ([Rose a] -> Rose a) -> f [Rose a] -> f (Rose a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Rose a] -> f [Rose a]
f [Rose a]
as

-- | Construct an @Lens@ into a rose tree given a list of lenses into the base functor.
--
--   When the input list is empty, this is equivalent to '_extract'.
--   When the input list is non-empty, this composes the input lenses
--   with '_unwrap' to walk through the rose tree before using
--   '_extract' to get the element at the final location.
--
-- For more on lenses see the @lens@ package on hackage.
--
-- @telescoped :: [Lens' ['Rose' a] ('Rose' a)]      -> Lens' ('Rose' a) a@
--
-- @telescoped :: [Traversal' ['Rose' a] ('Rose' a)] -> Traversal' ('Rose' a) a@
--
-- @telescoped :: [Getter ['Rose' a] ('Rose' a)]     -> Getter ('Rose' a) a@
--
-- @telescoped :: [Fold ['Rose' a] ('Rose' a)]       -> Fold ('Rose' a) a@
--
-- @telescoped :: [Setter' ['Rose' a] ('Rose' a)]    -> Setter' ('Rose' a) a@
telescoped :: (Functor f)
  => [(Rose a -> f (Rose a)) -> [Rose a] -> f [Rose a]]
  -> (a -> f a)
  -> Rose a
  -> f (Rose a)
telescoped :: [(Rose a -> f (Rose a)) -> [Rose a] -> f [Rose a]]
-> (a -> f a) -> Rose a -> f (Rose a)
telescoped = (((Rose a -> f (Rose a)) -> [Rose a] -> f [Rose a])
 -> ((a -> f a) -> Rose a -> f (Rose a))
 -> (a -> f a)
 -> Rose a
 -> f (Rose a))
-> ((a -> f a) -> Rose a -> f (Rose a))
-> [(Rose a -> f (Rose a)) -> [Rose a] -> f [Rose a]]
-> (a -> f a)
-> Rose a
-> f (Rose a)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(Rose a -> f (Rose a)) -> [Rose a] -> f [Rose a]
l (a -> f a) -> Rose a -> f (Rose a)
r -> ([Rose a] -> f [Rose a]) -> Rose a -> f (Rose a)
forall (f :: * -> *) a.
Functor f =>
([Rose a] -> f [Rose a]) -> Rose a -> f (Rose a)
_unwrap (([Rose a] -> f [Rose a]) -> Rose a -> f (Rose a))
-> ((a -> f a) -> [Rose a] -> f [Rose a])
-> (a -> f a)
-> Rose a
-> f (Rose a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rose a -> f (Rose a)) -> [Rose a] -> f [Rose a]
l ((Rose a -> f (Rose a)) -> [Rose a] -> f [Rose a])
-> ((a -> f a) -> Rose a -> f (Rose a))
-> (a -> f a)
-> [Rose a]
-> f [Rose a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> f a) -> Rose a -> f (Rose a)
r) (a -> f a) -> Rose a -> f (Rose a)
forall (f :: * -> *) a.
Functor f =>
(a -> f a) -> Rose a -> f (Rose a)
_extract

-- | Construct an @Lens@ into a rose tree given a list of lenses into the base functor.
--
--   The only difference between this and 'telescoped' is that 'telescoped' focuses on a single value, but this focuses on the entire remaining subtree.
--   When the input list is empty, this is equivalent to 'id'.
--   When the input list is non-empty, this composes the input lenses
--   with '_unwrap' to walk through the rose tree.
--
-- For more on lenses see the @lens@ package on hackage.
--
-- @telescoped :: [Lens' ['Rose' a] ('Rose' a)]      -> Lens' ('Rose' a) ('Rose' a)@
--
-- @telescoped :: [Traversal' ['Rose' a] ('Rose' a)] -> Traversal' ('Rose' a) ('Rose' a)@
--
-- @telescoped :: [Getter ['Rose' a] ('Rose' a)]     -> Getter ('Rose' a) ('Rose' a)@
--
-- @telescoped :: [Fold ['Rose' a] ('Rose' a)]       -> Fold ('Rose' a) ('Rose' a)@
--
-- @telescoped :: [Setter' ['Rose' a] ('Rose' a)]    -> Setter' ('Rose' a) ('Rose' a)@
telescoped_ :: (Functor f)
  => [(Rose a -> f (Rose a)) -> [Rose a] -> f [Rose a]]
  -> (Rose a -> f (Rose a))
  -> Rose a
  -> f (Rose a)
telescoped_ :: [(Rose a -> f (Rose a)) -> [Rose a] -> f [Rose a]]
-> (Rose a -> f (Rose a)) -> Rose a -> f (Rose a)
telescoped_ = (((Rose a -> f (Rose a)) -> [Rose a] -> f [Rose a])
 -> ((Rose a -> f (Rose a)) -> Rose a -> f (Rose a))
 -> (Rose a -> f (Rose a))
 -> Rose a
 -> f (Rose a))
-> ((Rose a -> f (Rose a)) -> Rose a -> f (Rose a))
-> [(Rose a -> f (Rose a)) -> [Rose a] -> f [Rose a]]
-> (Rose a -> f (Rose a))
-> Rose a
-> f (Rose a)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(Rose a -> f (Rose a)) -> [Rose a] -> f [Rose a]
l (Rose a -> f (Rose a)) -> Rose a -> f (Rose a)
r -> ([Rose a] -> f [Rose a]) -> Rose a -> f (Rose a)
forall (f :: * -> *) a.
Functor f =>
([Rose a] -> f [Rose a]) -> Rose a -> f (Rose a)
_unwrap (([Rose a] -> f [Rose a]) -> Rose a -> f (Rose a))
-> ((Rose a -> f (Rose a)) -> [Rose a] -> f [Rose a])
-> (Rose a -> f (Rose a))
-> Rose a
-> f (Rose a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rose a -> f (Rose a)) -> [Rose a] -> f [Rose a]
l ((Rose a -> f (Rose a)) -> [Rose a] -> f [Rose a])
-> ((Rose a -> f (Rose a)) -> Rose a -> f (Rose a))
-> (Rose a -> f (Rose a))
-> [Rose a]
-> f [Rose a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rose a -> f (Rose a)) -> Rose a -> f (Rose a)
r) (Rose a -> f (Rose a)) -> Rose a -> f (Rose a)
forall a. a -> a
id

-- | A @Traversal'@ that gives access to all non-leaf elements of a rose tree,
--   where non-leaf is defined as @x@ from @Rose x xs@ where @null xs@ is @False@.
--
--   Because this doesn't give access to all values in the rose tree, it cannot be used to change types (use 'traverse' for that).
shoots :: (Applicative f)
  => (a -> f a)
  -> Rose a
  -> f (Rose a)
shoots :: (a -> f a) -> Rose a -> f (Rose a)
shoots a -> f a
f = Rose a -> f (Rose a)
go
  where
    go :: Rose a -> f (Rose a)
go r :: Rose a
r@(Rose a
a [Rose a]
as)
      | [Rose a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Rose a]
as = Rose a -> f (Rose a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Rose a
r
      | Bool
otherwise = a -> [Rose a] -> Rose a
forall a. a -> [Rose a] -> Rose a
Rose (a -> [Rose a] -> Rose a) -> f a -> f ([Rose a] -> Rose a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f a
f a
a f ([Rose a] -> Rose a) -> f [Rose a] -> f (Rose a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Rose a -> f (Rose a)) -> [Rose a] -> f [Rose a]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Rose a -> f (Rose a)
go [Rose a]
as

-- | A @Traversal'@ that gives access to all leaf elements of a rose tree, where
--   leaf is defined as @x@ from @Rose x xs@ where @null xs@ is @True@.
--
--   Because this doesn't give access to all values in the rose tree, it cannot
--   be used to change types (use 'traverse' for that).
leaves :: (Applicative f)
  => (a -> f a)
  -> Rose a
  -> f (Rose a)
leaves :: (a -> f a) -> Rose a -> f (Rose a)
leaves a -> f a
f = Rose a -> f (Rose a)
go
  where
    go :: Rose a -> f (Rose a)
go (Rose a
a [Rose a]
as)
      | [Rose a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Rose a]
as = ((a -> [Rose a] -> Rose a) -> [Rose a] -> a -> Rose a
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> [Rose a] -> Rose a
forall a. a -> [Rose a] -> Rose a
Rose [Rose a]
as) (a -> Rose a) -> f a -> f (Rose a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f a
f a
a
      | Bool
otherwise = a -> [Rose a] -> Rose a
forall a. a -> [Rose a] -> Rose a
Rose a
a ([Rose a] -> Rose a) -> f [Rose a] -> f (Rose a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Rose a -> f (Rose a)) -> [Rose a] -> f [Rose a]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Rose a -> f (Rose a)
go [Rose a]
as