-- | A semi-specialized forest structure with the following atomic elements:
-- (i) unstructured regions of type @a@, (ii) binary paired regions of type
-- @(b,b)@ with a recursing tree (or insertion between the two @b@'s), (iii)
-- juxtaposition of two elements, and (iv) an empty structure.

module Data.Forest.StructuredPaired where

import Control.Lens
import Data.Bifoldable
import Data.Bifunctor
import Data.Bitraversable
import Data.Monoid
import GHC.Generics (Generic)

import Data.Forest.Static



-- | A structured forest.

data SPForest r t
  -- | An (unstructured) region with the structured forest. In case @r@ forms a
  -- monoid @SPJ (SPR a) (SPR b) `equiv` SPR (a<>b)@ should hold.
  = SPR r
  -- | A tree within the forest brackets the forest on the left and right side
  -- with elements of type @t@.
  | SPT t (SPForest r t) t
  -- | Juxtaposition of two forests. This allows for simple concatenation of
  -- forests. In particular, there is no particular position, while lists
  -- prefer @x:xs@ vs @xs++[x]@.
  | SPJ [SPForest r t]
  -- | An empty forest. @SPJ SPE SPE `equiv` SPE@ should hold.
  | SPE
  deriving (ReadPrec [SPForest r t]
ReadPrec (SPForest r t)
ReadS [SPForest r t]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall r t. (Read r, Read t) => ReadPrec [SPForest r t]
forall r t. (Read r, Read t) => ReadPrec (SPForest r t)
forall r t. (Read r, Read t) => Int -> ReadS (SPForest r t)
forall r t. (Read r, Read t) => ReadS [SPForest r t]
readListPrec :: ReadPrec [SPForest r t]
$creadListPrec :: forall r t. (Read r, Read t) => ReadPrec [SPForest r t]
readPrec :: ReadPrec (SPForest r t)
$creadPrec :: forall r t. (Read r, Read t) => ReadPrec (SPForest r t)
readList :: ReadS [SPForest r t]
$creadList :: forall r t. (Read r, Read t) => ReadS [SPForest r t]
readsPrec :: Int -> ReadS (SPForest r t)
$creadsPrec :: forall r t. (Read r, Read t) => Int -> ReadS (SPForest r t)
Read,Int -> SPForest r t -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall r t. (Show r, Show t) => Int -> SPForest r t -> ShowS
forall r t. (Show r, Show t) => [SPForest r t] -> ShowS
forall r t. (Show r, Show t) => SPForest r t -> String
showList :: [SPForest r t] -> ShowS
$cshowList :: forall r t. (Show r, Show t) => [SPForest r t] -> ShowS
show :: SPForest r t -> String
$cshow :: forall r t. (Show r, Show t) => SPForest r t -> String
showsPrec :: Int -> SPForest r t -> ShowS
$cshowsPrec :: forall r t. (Show r, Show t) => Int -> SPForest r t -> ShowS
Show,SPForest r t -> SPForest r t -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall r t. (Eq r, Eq t) => SPForest r t -> SPForest r t -> Bool
/= :: SPForest r t -> SPForest r t -> Bool
$c/= :: forall r t. (Eq r, Eq t) => SPForest r t -> SPForest r t -> Bool
== :: SPForest r t -> SPForest r t -> Bool
$c== :: forall r t. (Eq r, Eq t) => SPForest r t -> SPForest r t -> Bool
Eq,SPForest r t -> SPForest r t -> Ordering
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 {r} {t}. (Ord r, Ord t) => Eq (SPForest r t)
forall r t. (Ord r, Ord t) => SPForest r t -> SPForest r t -> Bool
forall r t.
(Ord r, Ord t) =>
SPForest r t -> SPForest r t -> Ordering
forall r t.
(Ord r, Ord t) =>
SPForest r t -> SPForest r t -> SPForest r t
min :: SPForest r t -> SPForest r t -> SPForest r t
$cmin :: forall r t.
(Ord r, Ord t) =>
SPForest r t -> SPForest r t -> SPForest r t
max :: SPForest r t -> SPForest r t -> SPForest r t
$cmax :: forall r t.
(Ord r, Ord t) =>
SPForest r t -> SPForest r t -> SPForest r t
>= :: SPForest r t -> SPForest r t -> Bool
$c>= :: forall r t. (Ord r, Ord t) => SPForest r t -> SPForest r t -> Bool
> :: SPForest r t -> SPForest r t -> Bool
$c> :: forall r t. (Ord r, Ord t) => SPForest r t -> SPForest r t -> Bool
<= :: SPForest r t -> SPForest r t -> Bool
$c<= :: forall r t. (Ord r, Ord t) => SPForest r t -> SPForest r t -> Bool
< :: SPForest r t -> SPForest r t -> Bool
$c< :: forall r t. (Ord r, Ord t) => SPForest r t -> SPForest r t -> Bool
compare :: SPForest r t -> SPForest r t -> Ordering
$ccompare :: forall r t.
(Ord r, Ord t) =>
SPForest r t -> SPForest r t -> Ordering
Ord,forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall r t x. Rep (SPForest r t) x -> SPForest r t
forall r t x. SPForest r t -> Rep (SPForest r t) x
$cto :: forall r t x. Rep (SPForest r t) x -> SPForest r t
$cfrom :: forall r t x. SPForest r t -> Rep (SPForest r t) x
Generic)
makePrisms ''SPForest

instance Functor (SPForest r) where
  fmap :: forall a b. (a -> b) -> SPForest r a -> SPForest r b
fmap a -> b
f = \case
    SPR r
r     → forall r t. r -> SPForest r t
SPR r
r
    SPT a
l SPForest r a
t a
r → forall r t. t -> SPForest r t -> t -> SPForest r t
SPT (a -> b
f a
l) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f SPForest r a
t) (a -> b
f a
r)
    SPJ [SPForest r a]
xs    → forall r t. [SPForest r t] -> SPForest r t
SPJ (forall a b. (a -> b) -> [a] -> [b]
map (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) [SPForest r a]
xs)
    SPForest r a
SPE       → forall r t. SPForest r t
SPE
  {-# Inlinable fmap #-}

instance Foldable (SPForest r) where
  foldMap :: forall m a. Monoid m => (a -> m) -> SPForest r a -> m
foldMap = forall (p :: * -> * -> *) m a b.
(Bifoldable p, Monoid m) =>
(a -> m) -> (b -> m) -> p a b -> m
bifoldMap (forall a b. a -> b -> a
const forall a. Monoid a => a
mempty)
  {-# Inlinable foldMap #-}

instance Traversable (SPForest r) where
  traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> SPForest r a -> f (SPForest r b)
traverse = forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse forall (f :: * -> *) a. Applicative f => a -> f a
pure
  {-# Inlinable traverse #-}

instance Bifunctor SPForest where
  first :: forall a b c. (a -> b) -> SPForest a c -> SPForest b c
first a -> b
f = \case
    SPR a
r     → forall r t. r -> SPForest r t
SPR (a -> b
f a
r)
    SPT c
l SPForest a c
t c
r → forall r t. t -> SPForest r t -> t -> SPForest r t
SPT c
l (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first a -> b
f SPForest a c
t) c
r
    SPJ [SPForest a c]
xs    → forall r t. [SPForest r t] -> SPForest r t
SPJ (forall a b. (a -> b) -> [a] -> [b]
map (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first a -> b
f) [SPForest a c]
xs)
    SPForest a c
SPE       → forall r t. SPForest r t
SPE
  {-# Inlinable first #-}
  second :: forall b c a. (b -> c) -> SPForest a b -> SPForest a c
second = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
  {-# Inlinable second #-}
  bimap :: forall a b c d.
(a -> b) -> (c -> d) -> SPForest a c -> SPForest b d
bimap a -> b
f c -> d
g = \case
    SPR a
r     → forall r t. r -> SPForest r t
SPR (a -> b
f a
r)
    SPT c
l SPForest a c
t c
r → forall r t. t -> SPForest r t -> t -> SPForest r t
SPT (c -> d
g c
l) (forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap a -> b
f c -> d
g SPForest a c
t) (c -> d
g c
r)
    SPJ [SPForest a c]
xs    → forall r t. [SPForest r t] -> SPForest r t
SPJ (forall a b. (a -> b) -> [a] -> [b]
map (forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap a -> b
f c -> d
g) [SPForest a c]
xs)
    SPForest a c
SPE       → forall r t. SPForest r t
SPE
  {-# Inlinable bimap #-}

instance Bifoldable SPForest where
  bifoldMap :: forall m a b. Monoid m => (a -> m) -> (b -> m) -> SPForest a b -> m
bifoldMap a -> m
f b -> m
g = \case
    SPR a
r     → a -> m
f a
r
    SPT b
l SPForest a b
t b
r → b -> m
g b
l forall a. Semigroup a => a -> a -> a
<> forall (p :: * -> * -> *) m a b.
(Bifoldable p, Monoid m) =>
(a -> m) -> (b -> m) -> p a b -> m
bifoldMap a -> m
f b -> m
g SPForest a b
t forall a. Semigroup a => a -> a -> a
<> b -> m
g b
r
    SPJ [SPForest a b]
xs    → forall a. HasCallStack => String -> a
error String
"Bifoldable" -- mconcatMap (bifoldMap f g) xs
    SPForest a b
SPE       → forall a. Monoid a => a
mempty
  {-# Inlinable bifoldMap #-}

instance Bitraversable SPForest where
  bitraverse :: forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c) -> (b -> f d) -> SPForest a b -> f (SPForest c d)
bitraverse a -> f c
f b -> f d
g = \case
    SPR a
r     → forall r t. r -> SPForest r t
SPR forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f c
f a
r
    SPT b
l SPForest a b
t b
r → forall r t. t -> SPForest r t -> t -> SPForest r t
SPT forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> b -> f d
g b
l forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse a -> f c
f b -> f d
g SPForest a b
t forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> b -> f d
g b
r
    SPJ [SPForest a b]
xs    → forall a. HasCallStack => String -> a
error String
"Bitraversable" -- SPJ <$> bitraverse f g l <*> bitraverse f g r
    SPForest a b
SPE       → forall (f :: * -> *) a. Applicative f => a -> f a
pure forall r t. SPForest r t
SPE
  {-# Inlinable bitraverse #-}



-- | Structured Forests can be transformed into static forests.
--
-- TODO types involved!

toStaticForest ∷ SPForest r t → Forest p v a
toStaticForest :: forall r t (p :: TreeOrder) (v :: * -> *) a.
SPForest r t -> Forest p v a
toStaticForest = forall a. HasCallStack => a
undefined