{-# LANGUAGE ScopedTypeVariables #-}

module Language.Ltml.Tree
    ( FlaggedTree
    , TypedTree (..)
    , Tree (..)
    , flaggedTreeMap
    , FlaggedInputTree
    , TypedInputTree
    , InputTree
    , FlaggedInputTree'
    , TypedInputTree'
    , InputTree'
    , FlaggedMetaTree
    , TypedMetaTree
    , MetaTree
    )
where

import Data.Text (Text)
import Language.Lsd.AST.Common (KindName, TypeName)
import Language.Ltml.Common (Flagged, flagMap)
import Language.Ltml.HTML.Common (RenderedTocEntry)

type FlaggedTree flag a b = Flagged flag (TypedTree flag a b)

data TypedTree flag a b
    = TypedTree
        KindName
        TypeName
        (Tree flag a b)
    deriving (Int -> TypedTree flag a b -> ShowS
[TypedTree flag a b] -> ShowS
TypedTree flag a b -> String
(Int -> TypedTree flag a b -> ShowS)
-> (TypedTree flag a b -> String)
-> ([TypedTree flag a b] -> ShowS)
-> Show (TypedTree flag a b)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall flag a b.
(Show a, Show flag, Show b) =>
Int -> TypedTree flag a b -> ShowS
forall flag a b.
(Show a, Show flag, Show b) =>
[TypedTree flag a b] -> ShowS
forall flag a b.
(Show a, Show flag, Show b) =>
TypedTree flag a b -> String
$cshowsPrec :: forall flag a b.
(Show a, Show flag, Show b) =>
Int -> TypedTree flag a b -> ShowS
showsPrec :: Int -> TypedTree flag a b -> ShowS
$cshow :: forall flag a b.
(Show a, Show flag, Show b) =>
TypedTree flag a b -> String
show :: TypedTree flag a b -> String
$cshowList :: forall flag a b.
(Show a, Show flag, Show b) =>
[TypedTree flag a b] -> ShowS
showList :: [TypedTree flag a b] -> ShowS
Show)

data Tree flag a b
    = Tree
        a
        [FlaggedTree flag a b]
    | Leaf b
    deriving (Int -> Tree flag a b -> ShowS
[Tree flag a b] -> ShowS
Tree flag a b -> String
(Int -> Tree flag a b -> ShowS)
-> (Tree flag a b -> String)
-> ([Tree flag a b] -> ShowS)
-> Show (Tree flag a b)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall flag a b.
(Show a, Show flag, Show b) =>
Int -> Tree flag a b -> ShowS
forall flag a b.
(Show a, Show flag, Show b) =>
[Tree flag a b] -> ShowS
forall flag a b.
(Show a, Show flag, Show b) =>
Tree flag a b -> String
$cshowsPrec :: forall flag a b.
(Show a, Show flag, Show b) =>
Int -> Tree flag a b -> ShowS
showsPrec :: Int -> Tree flag a b -> ShowS
$cshow :: forall flag a b.
(Show a, Show flag, Show b) =>
Tree flag a b -> String
show :: Tree flag a b -> String
$cshowList :: forall flag a b.
(Show a, Show flag, Show b) =>
[Tree flag a b] -> ShowS
showList :: [Tree flag a b] -> ShowS
Show)

flaggedTreeMap
    :: forall fl fl' a a' b b'
     . (fl -> fl')
    -> (a -> a')
    -> (b -> b')
    -> FlaggedTree fl a b
    -> FlaggedTree fl' a' b'
flaggedTreeMap :: forall fl fl' a a' b b'.
(fl -> fl')
-> (a -> a')
-> (b -> b')
-> FlaggedTree fl a b
-> FlaggedTree fl' a' b'
flaggedTreeMap fl -> fl'
flagF a -> a'
innerF b -> b'
leafF = FlaggedTree fl a b -> FlaggedTree fl' a' b'
flaggedTreeF
  where
    flaggedTreeF :: FlaggedTree fl a b -> FlaggedTree fl' a' b'
    flaggedTreeF :: FlaggedTree fl a b -> FlaggedTree fl' a' b'
flaggedTreeF FlaggedTree fl a b
tree = TypedTree fl a b -> TypedTree fl' a' b'
typedTreeF (TypedTree fl a b -> TypedTree fl' a' b')
-> Flagged fl' (TypedTree fl a b) -> FlaggedTree fl' a' b'
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (fl -> fl') -> FlaggedTree fl a b -> Flagged fl' (TypedTree fl a b)
forall fl fl' a. (fl -> fl') -> Flagged fl a -> Flagged fl' a
flagMap fl -> fl'
flagF FlaggedTree fl a b
tree

    typedTreeF :: TypedTree fl a b -> TypedTree fl' a' b'
    typedTreeF :: TypedTree fl a b -> TypedTree fl' a' b'
typedTreeF (TypedTree KindName
k TypeName
t Tree fl a b
tree) = KindName -> TypeName -> Tree fl' a' b' -> TypedTree fl' a' b'
forall flag a b.
KindName -> TypeName -> Tree flag a b -> TypedTree flag a b
TypedTree KindName
k TypeName
t (Tree fl' a' b' -> TypedTree fl' a' b')
-> Tree fl' a' b' -> TypedTree fl' a' b'
forall a b. (a -> b) -> a -> b
$ Tree fl a b -> Tree fl' a' b'
treeF Tree fl a b
tree

    treeF :: Tree fl a b -> Tree fl' a' b'
    treeF :: Tree fl a b -> Tree fl' a' b'
treeF (Tree a
x [FlaggedTree fl a b]
trees) = a' -> [FlaggedTree fl' a' b'] -> Tree fl' a' b'
forall flag a b. a -> [FlaggedTree flag a b] -> Tree flag a b
Tree (a -> a'
innerF a
x) ([FlaggedTree fl' a' b'] -> Tree fl' a' b')
-> [FlaggedTree fl' a' b'] -> Tree fl' a' b'
forall a b. (a -> b) -> a -> b
$ (FlaggedTree fl a b -> FlaggedTree fl' a' b')
-> [FlaggedTree fl a b] -> [FlaggedTree fl' a' b']
forall a b. (a -> b) -> [a] -> [b]
map FlaggedTree fl a b -> FlaggedTree fl' a' b'
flaggedTreeF [FlaggedTree fl a b]
trees
    treeF (Leaf b
leaf) = b' -> Tree fl' a' b'
forall flag a b. b -> Tree flag a b
Leaf (b' -> Tree fl' a' b') -> b' -> Tree fl' a' b'
forall a b. (a -> b) -> a -> b
$ b -> b'
leafF b
leaf

type FlaggedInputTree flag = FlaggedTree flag (Maybe Text) Text
type TypedInputTree flag = TypedTree flag (Maybe Text) Text
type InputTree flag = Tree flag (Maybe Text) Text

-- | A tree with textual nodes that can be parsed to obtain an LTML tree.
--   See `Language.Ltml.Common.Flagged'` on the semantics of the boolean flag.
type FlaggedInputTree' = FlaggedInputTree Bool

type TypedInputTree' = TypedInputTree Bool
type InputTree' = InputTree Bool

-- | A tree containing metadata, to be sent to the frontend.
--   The type parameter is typically an identifier type.
type FlaggedMetaTree id = FlaggedTree id RenderedTocEntry RenderedTocEntry

type TypedMetaTree id = TypedTree id RenderedTocEntry RenderedTocEntry
type MetaTree id = Tree id RenderedTocEntry RenderedTocEntry