{-# LANGUAGE DeriveGeneric #-}

-- |
-- Module      : Docs.MetaTree
-- Description : Tree With Metadata
-- License     : AGPL-3
-- Maintainer  : stu235271@mail.uni-kiel.de
--               stu236925@mail.uni-kiel.de
--
-- This module contains the definition of a tree with additional meta data
-- such as labels, titles and allowed edit actions.
module Docs.MetaTree
    ( MetaNode (..)
    , MetaTree (..)
    , Meta (..)
    , TocEntry (..)
    , TreeWithMetaData (..)
    , TreeRevisionWithMetaData (..)
    ) where

import Data.Text (Text)

import GHC.Generics (Generic)

import Data.Aeson (FromJSON, ToJSON)
import Data.Map (Map)
import Data.OpenApi (ToSchema)
import Docs.Tree (NodeHeader)
import Docs.TreeRevision (TreeRevisionHeader)
import qualified Language.Lsd.AST.Common as LSD
import qualified Language.Lsd.AST.Type as LSD
import qualified Language.Ltml.HTML.Common as HTML

-- | Like "Docs.TreeRevision.TreeRevision", but with ✨metadata✨.
data TreeRevisionWithMetaData a
    = TreeRevisionWithMetaData
    { forall a. TreeRevisionWithMetaData a -> TreeRevisionHeader
revisionHeader :: TreeRevisionHeader
    -- ^ the tree revision meta data
    , forall a. TreeRevisionWithMetaData a -> TreeWithMetaData a
revision :: TreeWithMetaData a
    -- ^ tre revisions content
    }
    deriving ((forall x.
 TreeRevisionWithMetaData a -> Rep (TreeRevisionWithMetaData a) x)
-> (forall x.
    Rep (TreeRevisionWithMetaData a) x -> TreeRevisionWithMetaData a)
-> Generic (TreeRevisionWithMetaData a)
forall x.
Rep (TreeRevisionWithMetaData a) x -> TreeRevisionWithMetaData a
forall x.
TreeRevisionWithMetaData a -> Rep (TreeRevisionWithMetaData a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x.
Rep (TreeRevisionWithMetaData a) x -> TreeRevisionWithMetaData a
forall a x.
TreeRevisionWithMetaData a -> Rep (TreeRevisionWithMetaData a) x
$cfrom :: forall a x.
TreeRevisionWithMetaData a -> Rep (TreeRevisionWithMetaData a) x
from :: forall x.
TreeRevisionWithMetaData a -> Rep (TreeRevisionWithMetaData a) x
$cto :: forall a x.
Rep (TreeRevisionWithMetaData a) x -> TreeRevisionWithMetaData a
to :: forall x.
Rep (TreeRevisionWithMetaData a) x -> TreeRevisionWithMetaData a
Generic)

instance (ToJSON a) => ToJSON (TreeRevisionWithMetaData a)

instance (FromJSON a) => FromJSON (TreeRevisionWithMetaData a)

instance (ToSchema a) => ToSchema (TreeRevisionWithMetaData a)

instance Functor TreeRevisionWithMetaData where
    fmap :: forall a b.
(a -> b)
-> TreeRevisionWithMetaData a -> TreeRevisionWithMetaData b
fmap a -> b
f TreeRevisionWithMetaData a
rev = TreeRevisionWithMetaData a
rev {revision = f <$> revision rev}

-- | Wrapper around the root of a tree, but with ✨metadata✨.
data TreeWithMetaData a
    = TreeWithMetaData
    { forall a. TreeWithMetaData a -> Meta a
root :: Meta a
    -- ^ the root of the tree
    , forall a. TreeWithMetaData a -> Map FullTypeName ProperTypeMeta
metaMap :: Map LSD.FullTypeName LSD.ProperTypeMeta
    -- ^ map of allowed edit actions i guess
    }
    deriving ((forall x. TreeWithMetaData a -> Rep (TreeWithMetaData a) x)
-> (forall x. Rep (TreeWithMetaData a) x -> TreeWithMetaData a)
-> Generic (TreeWithMetaData a)
forall x. Rep (TreeWithMetaData a) x -> TreeWithMetaData a
forall x. TreeWithMetaData a -> Rep (TreeWithMetaData a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (TreeWithMetaData a) x -> TreeWithMetaData a
forall a x. TreeWithMetaData a -> Rep (TreeWithMetaData a) x
$cfrom :: forall a x. TreeWithMetaData a -> Rep (TreeWithMetaData a) x
from :: forall x. TreeWithMetaData a -> Rep (TreeWithMetaData a) x
$cto :: forall a x. Rep (TreeWithMetaData a) x -> TreeWithMetaData a
to :: forall x. Rep (TreeWithMetaData a) x -> TreeWithMetaData a
Generic)

instance (ToJSON a) => ToJSON (TreeWithMetaData a)

instance (FromJSON a) => FromJSON (TreeWithMetaData a)

instance (ToSchema a) => ToSchema (TreeWithMetaData a)

instance Functor TreeWithMetaData where
    fmap :: forall a b. (a -> b) -> TreeWithMetaData a -> TreeWithMetaData b
fmap a -> b
f TreeWithMetaData a
tree' = TreeWithMetaData a
tree' {root = f <$> root tree'}

-- | Like "Docs.Tree.Node", but with ✨metadata✨.
data MetaNode a
    = MetaNode
    { forall a. MetaNode a -> NodeHeader
header :: NodeHeader
    -- ^ metadata for the node
    , forall a. MetaNode a -> [Meta a]
children :: [Meta a]
    -- ^ children of the node
    }
    deriving ((forall x. MetaNode a -> Rep (MetaNode a) x)
-> (forall x. Rep (MetaNode a) x -> MetaNode a)
-> Generic (MetaNode a)
forall x. Rep (MetaNode a) x -> MetaNode a
forall x. MetaNode a -> Rep (MetaNode a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (MetaNode a) x -> MetaNode a
forall a x. MetaNode a -> Rep (MetaNode a) x
$cfrom :: forall a x. MetaNode a -> Rep (MetaNode a) x
from :: forall x. MetaNode a -> Rep (MetaNode a) x
$cto :: forall a x. Rep (MetaNode a) x -> MetaNode a
to :: forall x. Rep (MetaNode a) x -> MetaNode a
Generic)

instance (ToJSON a) => ToJSON (MetaNode a)

instance (FromJSON a) => FromJSON (MetaNode a)

instance (ToSchema a) => ToSchema (MetaNode a)

-- | Information on how the node should be displayed in the Table of Contents.
data TocEntry = TocEntry
    { TocEntry -> Maybe Text
label :: Maybe Text
    -- ^ the label of the node
    , TocEntry -> Result (Maybe Text)
title :: HTML.Result (Maybe Text)
    -- ^ the title the node should by displayed as in the ToC
    }
    deriving ((forall x. TocEntry -> Rep TocEntry x)
-> (forall x. Rep TocEntry x -> TocEntry) -> Generic TocEntry
forall x. Rep TocEntry x -> TocEntry
forall x. TocEntry -> Rep TocEntry x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TocEntry -> Rep TocEntry x
from :: forall x. TocEntry -> Rep TocEntry x
$cto :: forall x. Rep TocEntry x -> TocEntry
to :: forall x. Rep TocEntry x -> TocEntry
Generic)

instance ToJSON TocEntry

instance FromJSON TocEntry

instance ToSchema TocEntry

-- | Wrapper around a @MetaTree@, but with ✨metadata✨.
data Meta a = Meta
    { forall a. Meta a -> TocEntry
meta :: TocEntry
    , forall a. Meta a -> MetaTree a
tree :: MetaTree a
    }
    deriving ((forall x. Meta a -> Rep (Meta a) x)
-> (forall x. Rep (Meta a) x -> Meta a) -> Generic (Meta a)
forall x. Rep (Meta a) x -> Meta a
forall x. Meta a -> Rep (Meta a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Meta a) x -> Meta a
forall a x. Meta a -> Rep (Meta a) x
$cfrom :: forall a x. Meta a -> Rep (Meta a) x
from :: forall x. Meta a -> Rep (Meta a) x
$cto :: forall a x. Rep (Meta a) x -> Meta a
to :: forall x. Rep (Meta a) x -> Meta a
Generic)

instance (ToJSON a) => ToJSON (Meta a)

instance (FromJSON a) => FromJSON (Meta a)

instance (ToSchema a) => ToSchema (Meta a)

-- | Like "Docs.Tree.Tree", but with ✨metadata✨.
data MetaTree a
    = MetaTree (MetaNode a)
    | MetaLeaf a
    deriving ((forall x. MetaTree a -> Rep (MetaTree a) x)
-> (forall x. Rep (MetaTree a) x -> MetaTree a)
-> Generic (MetaTree a)
forall x. Rep (MetaTree a) x -> MetaTree a
forall x. MetaTree a -> Rep (MetaTree a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (MetaTree a) x -> MetaTree a
forall a x. MetaTree a -> Rep (MetaTree a) x
$cfrom :: forall a x. MetaTree a -> Rep (MetaTree a) x
from :: forall x. MetaTree a -> Rep (MetaTree a) x
$cto :: forall a x. Rep (MetaTree a) x -> MetaTree a
to :: forall x. Rep (MetaTree a) x -> MetaTree a
Generic)

instance (ToJSON a) => ToJSON (MetaTree a)

instance (FromJSON a) => FromJSON (MetaTree a)

instance (ToSchema a) => ToSchema (MetaTree a)

instance Functor MetaNode where
    fmap :: forall a b. (a -> b) -> MetaNode a -> MetaNode b
fmap a -> b
f (MetaNode NodeHeader
nodeHeader [Meta a]
edge) = NodeHeader -> [Meta b] -> MetaNode b
forall a. NodeHeader -> [Meta a] -> MetaNode a
MetaNode NodeHeader
nodeHeader ([Meta b] -> MetaNode b) -> [Meta b] -> MetaNode b
forall a b. (a -> b) -> a -> b
$ (a -> b
f (a -> b) -> Meta a -> Meta b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (Meta a -> Meta b) -> [Meta a] -> [Meta b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Meta a]
edge

instance Functor MetaTree where
    fmap :: forall a b. (a -> b) -> MetaTree a -> MetaTree b
fmap a -> b
f (MetaTree MetaNode a
node) = MetaNode b -> MetaTree b
forall a. MetaNode a -> MetaTree a
MetaTree (MetaNode b -> MetaTree b) -> MetaNode b -> MetaTree b
forall a b. (a -> b) -> a -> b
$ a -> b
f (a -> b) -> MetaNode a -> MetaNode b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MetaNode a
node
    fmap a -> b
f (MetaLeaf a
x) = b -> MetaTree b
forall a. a -> MetaTree a
MetaLeaf (b -> MetaTree b) -> b -> MetaTree b
forall a b. (a -> b) -> a -> b
$ a -> b
f a
x

instance Functor Meta where
    fmap :: forall a b. (a -> b) -> Meta a -> Meta b
fmap a -> b
f (Meta TocEntry
label' MetaTree a
tree') = TocEntry -> MetaTree b -> Meta b
forall a. TocEntry -> MetaTree a -> Meta a
Meta TocEntry
label' (MetaTree b -> Meta b) -> MetaTree b -> Meta b
forall a b. (a -> b) -> a -> b
$ a -> b
f (a -> b) -> MetaTree a -> MetaTree b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MetaTree a
tree'

instance Foldable Meta where
    foldMap :: forall m a. Monoid m => (a -> m) -> Meta a -> m
foldMap a -> m
f (Meta TocEntry
_ MetaTree a
tree') = (a -> m) -> MetaTree a -> m
forall m a. Monoid m => (a -> m) -> MetaTree a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f MetaTree a
tree'

instance Foldable MetaNode where
    foldMap :: forall m a. Monoid m => (a -> m) -> MetaNode a -> m
foldMap a -> m
f (MetaNode NodeHeader
_ [Meta a]
edges) = (Meta a -> m) -> [Meta a] -> m
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((a -> m) -> Meta a -> m
forall m a. Monoid m => (a -> m) -> Meta a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f) [Meta a]
edges

instance Foldable MetaTree where
    foldMap :: forall m a. Monoid m => (a -> m) -> MetaTree a -> m
foldMap a -> m
f (MetaLeaf a
a) = a -> m
f a
a
    foldMap a -> m
f (MetaTree MetaNode a
node) = (a -> m) -> MetaNode a -> m
forall m a. Monoid m => (a -> m) -> MetaNode a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f MetaNode a
node

instance Traversable Meta where
    traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Meta a -> f (Meta b)
traverse a -> f b
f (Meta TocEntry
label' MetaTree a
tree') = TocEntry -> MetaTree b -> Meta b
forall a. TocEntry -> MetaTree a -> Meta a
Meta TocEntry
label' (MetaTree b -> Meta b) -> f (MetaTree b) -> f (Meta b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f b) -> MetaTree a -> f (MetaTree b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> MetaTree a -> f (MetaTree b)
traverse a -> f b
f MetaTree a
tree'

instance Traversable MetaNode where
    traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> MetaNode a -> f (MetaNode b)
traverse a -> f b
f (MetaNode NodeHeader
label' [Meta a]
edges) = NodeHeader -> [Meta b] -> MetaNode b
forall a. NodeHeader -> [Meta a] -> MetaNode a
MetaNode NodeHeader
label' ([Meta b] -> MetaNode b) -> f [Meta b] -> f (MetaNode b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Meta a -> f (Meta b)) -> [Meta a] -> f [Meta b]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse ((a -> f b) -> Meta a -> f (Meta b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Meta a -> f (Meta b)
traverse a -> f b
f) [Meta a]
edges

instance Traversable MetaTree where
    traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> MetaTree a -> f (MetaTree b)
traverse a -> f b
f (MetaLeaf a
a) = b -> MetaTree b
forall a. a -> MetaTree a
MetaLeaf (b -> MetaTree b) -> f b -> f (MetaTree b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
a
    traverse a -> f b
f (MetaTree MetaNode a
node) = MetaNode b -> MetaTree b
forall a. MetaNode a -> MetaTree a
MetaTree (MetaNode b -> MetaTree b) -> f (MetaNode b) -> f (MetaTree b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f b) -> MetaNode a -> f (MetaNode b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> MetaNode a -> f (MetaNode b)
traverse a -> f b
f MetaNode a
node