StructuredPaired.hs

-- | 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 (Read,Show,Eq,Ord,Generic)
makePrisms ''SPForest

instance Bifunctor SPForest where
  first f = \case
    SPR r     → SPR (f r)
    SPT l t r → SPT l (first f t) r
    SPJ xs    → SPJ (map (first f) xs)
    SPE       → SPE
  {-# Inlinable first #-}
  second g = \case
    SPR r     → SPR r
    SPT l t r → SPT (g l) (second g t) (g r)
    SPJ xs    → SPJ (map (second g) xs)
    SPE       → SPE
  {-# Inlinable second #-}
  bimap f g = \case
    SPR r     → SPR (f r)
    SPT l t r → SPT (g l) (bimap f g t) (g r)
    SPJ xs    → SPJ (map (bimap f g) xs)
    SPE       → SPE
  {-# Inlinable bimap #-}

instance Bifoldable SPForest where
  bifoldMap f g = \case
    SPR r     → f r
    SPT l t r → g l <> bifoldMap f g t <> g r
    SPJ xs    → error "Bifoldable" -- mconcatMap (bifoldMap f g) xs
    SPE       → mempty
  {-# Inlinable bifoldMap #-}

instance Bitraversable SPForest where
  bitraverse f g = \case
    SPR r     → SPR <$> f r
    SPT l t r → SPT <$> g l <*> bitraverse f g t <*> g r
    SPJ xs    → error "Bitraversable" -- SPJ <$> bitraverse f g l <*> bitraverse f g r
    SPE       → pure SPE
  {-# Inlinable bitraverse #-}



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

toStaticForest ∷ SPForest r t → Forest p v a
toStaticForest = undefined