{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}

-- |
-- Module      : Docs.Tree
-- Description : The Tree Structure of a @Document@
-- License     : AGPL-3
-- Maintainer  : stu235271@mail.uni-kiel.de
--               stu236925@mail.uni-kiel.de
--
-- This module contains the definition of the tree structure of a @Document@.
module Docs.Tree
    ( Tree (..)
    , Node (..)
    , NodeHeader (..)
    , WithTitle (..)
    , treeMapM
    , withTextRevisions
    , filterMapNode
    ) where

import Data.Functor ((<&>))
import Data.Proxy (Proxy (Proxy))
import Data.Text (Text)

import GHC.Generics (Generic)

import Control.Lens ((&), (.~), (?~))
import Data.Aeson (FromJSON (..), ToJSON (..), (.:), (.=))
import qualified Data.Aeson as Aeson
import Data.Aeson.Types (Parser)
import qualified Data.HashMap.Strict.InsOrd as InsOrd
import Data.OpenApi
    ( NamedSchema (..)
    , OpenApiType (..)
    , Referenced (Inline)
    , Schema (..)
    , ToSchema (..)
    , declareSchemaRef
    , enum_
    , oneOf
    , properties
    , required
    , type_
    )

import Data.Maybe (mapMaybe)
import qualified Data.Text as Text
import Data.Typeable (typeRep)
import Docs.Hash (Hashable (..))
import Docs.TextElement (TextElement, TextElementID)
import qualified Docs.TextElement as TextElement
import Docs.TextRevision
    ( TextElementRevision (TextElementRevision)
    , TextRevision
    )

-- | Contains metdata for a tree node.
data NodeHeader = NodeHeader
    { NodeHeader -> Text
headerKind :: Text
    , NodeHeader -> Text
headerType :: Text
    , NodeHeader -> Maybe Text
heading :: Maybe Text
    }
    deriving (Int -> NodeHeader -> ShowS
[NodeHeader] -> ShowS
NodeHeader -> String
(Int -> NodeHeader -> ShowS)
-> (NodeHeader -> String)
-> ([NodeHeader] -> ShowS)
-> Show NodeHeader
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NodeHeader -> ShowS
showsPrec :: Int -> NodeHeader -> ShowS
$cshow :: NodeHeader -> String
show :: NodeHeader -> String
$cshowList :: [NodeHeader] -> ShowS
showList :: [NodeHeader] -> ShowS
Show, (forall x. NodeHeader -> Rep NodeHeader x)
-> (forall x. Rep NodeHeader x -> NodeHeader) -> Generic NodeHeader
forall x. Rep NodeHeader x -> NodeHeader
forall x. NodeHeader -> Rep NodeHeader x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. NodeHeader -> Rep NodeHeader x
from :: forall x. NodeHeader -> Rep NodeHeader x
$cto :: forall x. Rep NodeHeader x -> NodeHeader
to :: forall x. Rep NodeHeader x -> NodeHeader
Generic)

instance Hashable NodeHeader where
    updateHash :: Ctx -> NodeHeader -> Ctx
updateHash Ctx
ctx NodeHeader
nodeHeader =
        Ctx -> Maybe Text -> Ctx
forall a. Hashable a => Ctx -> a -> Ctx
updateHash
            ( Ctx -> Text -> Ctx
forall a. Hashable a => Ctx -> a -> Ctx
updateHash
                (Ctx -> Text -> Ctx
forall a. Hashable a => Ctx -> a -> Ctx
updateHash Ctx
ctx (NodeHeader -> Text
headerType NodeHeader
nodeHeader))
                (NodeHeader -> Text
headerKind NodeHeader
nodeHeader)
            )
            (NodeHeader -> Maybe Text
heading NodeHeader
nodeHeader)

instance ToJSON NodeHeader

instance FromJSON NodeHeader

instance ToSchema NodeHeader

-- | A node of a tree.
data Node a = Node
    { forall a. Node a -> NodeHeader
header :: NodeHeader
    -- ^ information about this node
    , forall a. Node a -> [Tree a]
children :: [Tree a]
    -- ^ the children of this node
    }
    deriving ((forall x. Node a -> Rep (Node a) x)
-> (forall x. Rep (Node a) x -> Node a) -> Generic (Node a)
forall x. Rep (Node a) x -> Node a
forall x. Node a -> Rep (Node a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Node a) x -> Node a
forall a x. Node a -> Rep (Node a) x
$cfrom :: forall a x. Node a -> Rep (Node a) x
from :: forall x. Node a -> Rep (Node a) x
$cto :: forall a x. Rep (Node a) x -> Node a
to :: forall x. Rep (Node a) x -> Node a
Generic)

instance (ToJSON a) => ToJSON (Node a)

instance (FromJSON a) => FromJSON (Node a)

instance (ToSchema a) => ToSchema (Node a)

-- | A tree. Either a tree or a leaf.
data Tree a
    = Tree (Node a)
    | Leaf a

instance (ToJSON a) => ToJSON (Tree a) where
    toJSON :: Tree a -> Value
toJSON (Tree Node a
node) = [Pair] -> Value
Aeson.object [Key
"type" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"tree" :: Text), Key
"node" Key -> Node a -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Node a
node]
    toJSON (Leaf a
leaf) = [Pair] -> Value
Aeson.object [Key
"type" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"leaf" :: Text), Key
"leaf" Key -> a -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= a
leaf]

instance (FromJSON a) => FromJSON (Tree a) where
    parseJSON :: Value -> Parser (Tree a)
parseJSON = String -> (Object -> Parser (Tree a)) -> Value -> Parser (Tree a)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"Tree" ((Object -> Parser (Tree a)) -> Value -> Parser (Tree a))
-> (Object -> Parser (Tree a)) -> Value -> Parser (Tree a)
forall a b. (a -> b) -> a -> b
$ \Object
obj -> do
        Text
ty <- Object
obj Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type" :: Parser Text
        case Text
ty of
            Text
"tree" -> Node a -> Tree a
forall a. Node a -> Tree a
Tree (Node a -> Tree a) -> Parser (Node a) -> Parser (Tree a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Key -> Parser (Node a)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"node"
            Text
"leaf" -> a -> Tree a
forall a. a -> Tree a
Leaf (a -> Tree a) -> Parser a -> Parser (Tree a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Key -> Parser a
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"leaf"
            Text
_ -> String -> Parser (Tree a)
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser (Tree a)) -> String -> Parser (Tree a)
forall a b. (a -> b) -> a -> b
$ String
"Unknown Tree type: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
ty

instance (ToSchema a) => ToSchema (Tree a) where
    declareNamedSchema :: Proxy (Tree a) -> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy (Tree a)
_ = do
        Referenced Schema
nodeSchema <- Proxy (Node a) -> Declare (Definitions Schema) (Referenced Schema)
forall a.
ToSchema a =>
Proxy a -> Declare (Definitions Schema) (Referenced Schema)
declareSchemaRef (Proxy (Node a)
forall {k} (t :: k). Proxy t
Proxy :: Proxy (Node a))
        Referenced Schema
leafSchema <- Proxy a -> Declare (Definitions Schema) (Referenced Schema)
forall a.
ToSchema a =>
Proxy a -> Declare (Definitions Schema) (Referenced Schema)
declareSchemaRef (Proxy a
forall {k} (t :: k). Proxy t
Proxy :: Proxy a)

        NamedSchema -> Declare (Definitions Schema) NamedSchema
forall a. a -> DeclareT (Definitions Schema) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (NamedSchema -> Declare (Definitions Schema) NamedSchema)
-> NamedSchema -> Declare (Definitions Schema) NamedSchema
forall a b. (a -> b) -> a -> b
$
            Maybe Text -> Schema -> NamedSchema
NamedSchema (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ String -> Text
withTypeName String
"Tree") (Schema -> NamedSchema) -> Schema -> NamedSchema
forall a b. (a -> b) -> a -> b
$
                Schema
forall a. Monoid a => a
mempty
                    Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe OpenApiType -> Identity (Maybe OpenApiType))
-> Schema -> Identity Schema
forall s a. HasType s a => Lens' s a
Lens' Schema (Maybe OpenApiType)
type_ ((Maybe OpenApiType -> Identity (Maybe OpenApiType))
 -> Schema -> Identity Schema)
-> OpenApiType -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ OpenApiType
OpenApiObject
                    Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe [Referenced Schema] -> Identity (Maybe [Referenced Schema]))
-> Schema -> Identity Schema
forall s a. HasOneOf s a => Lens' s a
Lens' Schema (Maybe [Referenced Schema])
oneOf
                        ((Maybe [Referenced Schema]
  -> Identity (Maybe [Referenced Schema]))
 -> Schema -> Identity Schema)
-> [Referenced Schema] -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ [ Schema -> Referenced Schema
forall a. a -> Referenced a
Inline (Schema -> Referenced Schema) -> Schema -> Referenced Schema
forall a b. (a -> b) -> a -> b
$
                                Schema
forall a. Monoid a => a
mempty
                                    Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe OpenApiType -> Identity (Maybe OpenApiType))
-> Schema -> Identity Schema
forall s a. HasType s a => Lens' s a
Lens' Schema (Maybe OpenApiType)
type_ ((Maybe OpenApiType -> Identity (Maybe OpenApiType))
 -> Schema -> Identity Schema)
-> OpenApiType -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ OpenApiType
OpenApiObject
                                    Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (InsOrdHashMap Text (Referenced Schema)
 -> Identity (InsOrdHashMap Text (Referenced Schema)))
-> Schema -> Identity Schema
forall s a. HasProperties s a => Lens' s a
Lens' Schema (InsOrdHashMap Text (Referenced Schema))
properties
                                        ((InsOrdHashMap Text (Referenced Schema)
  -> Identity (InsOrdHashMap Text (Referenced Schema)))
 -> Schema -> Identity Schema)
-> InsOrdHashMap Text (Referenced Schema) -> Schema -> Schema
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [(Text, Referenced Schema)]
-> InsOrdHashMap Text (Referenced Schema)
forall k v. (Eq k, Hashable k) => [(k, v)] -> InsOrdHashMap k v
InsOrd.fromList
                                            [ (Text
"type", Schema -> Referenced Schema
forall a. a -> Referenced a
Inline (Schema -> Referenced Schema) -> Schema -> Referenced Schema
forall a b. (a -> b) -> a -> b
$ Text -> Schema
schemaConstText Text
"tree")
                                            , (Text
"node", Referenced Schema
nodeSchema)
                                            ]
                                    Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& ([Text] -> Identity [Text]) -> Schema -> Identity Schema
forall s a. HasRequired s a => Lens' s a
Lens' Schema [Text]
required (([Text] -> Identity [Text]) -> Schema -> Identity Schema)
-> [Text] -> Schema -> Schema
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Text
"type", Text
"with"]
                           , Schema -> Referenced Schema
forall a. a -> Referenced a
Inline (Schema -> Referenced Schema) -> Schema -> Referenced Schema
forall a b. (a -> b) -> a -> b
$
                                Schema
forall a. Monoid a => a
mempty
                                    Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe OpenApiType -> Identity (Maybe OpenApiType))
-> Schema -> Identity Schema
forall s a. HasType s a => Lens' s a
Lens' Schema (Maybe OpenApiType)
type_ ((Maybe OpenApiType -> Identity (Maybe OpenApiType))
 -> Schema -> Identity Schema)
-> OpenApiType -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ OpenApiType
OpenApiObject
                                    Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (InsOrdHashMap Text (Referenced Schema)
 -> Identity (InsOrdHashMap Text (Referenced Schema)))
-> Schema -> Identity Schema
forall s a. HasProperties s a => Lens' s a
Lens' Schema (InsOrdHashMap Text (Referenced Schema))
properties
                                        ((InsOrdHashMap Text (Referenced Schema)
  -> Identity (InsOrdHashMap Text (Referenced Schema)))
 -> Schema -> Identity Schema)
-> InsOrdHashMap Text (Referenced Schema) -> Schema -> Schema
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [(Text, Referenced Schema)]
-> InsOrdHashMap Text (Referenced Schema)
forall k v. (Eq k, Hashable k) => [(k, v)] -> InsOrdHashMap k v
InsOrd.fromList
                                            [ (Text
"type", Schema -> Referenced Schema
forall a. a -> Referenced a
Inline (Schema -> Referenced Schema) -> Schema -> Referenced Schema
forall a b. (a -> b) -> a -> b
$ Text -> Schema
schemaConstText Text
"leaf")
                                            , (Text
"leaf", Referenced Schema
leafSchema)
                                            ]
                                    Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& ([Text] -> Identity [Text]) -> Schema -> Identity Schema
forall s a. HasRequired s a => Lens' s a
Lens' Schema [Text]
required (([Text] -> Identity [Text]) -> Schema -> Identity Schema)
-> [Text] -> Schema -> Schema
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Text
"type", Text
"newRevision"]
                           ]
      where
        schemaConstText :: Text -> Schema
        schemaConstText :: Text -> Schema
schemaConstText Text
val =
            Schema
forall a. Monoid a => a
mempty
                Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe OpenApiType -> Identity (Maybe OpenApiType))
-> Schema -> Identity Schema
forall s a. HasType s a => Lens' s a
Lens' Schema (Maybe OpenApiType)
type_ ((Maybe OpenApiType -> Identity (Maybe OpenApiType))
 -> Schema -> Identity Schema)
-> OpenApiType -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ OpenApiType
OpenApiString
                Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe [Value] -> Identity (Maybe [Value]))
-> Schema -> Identity Schema
forall s a. HasEnum s a => Lens' s a
Lens' Schema (Maybe [Value])
enum_ ((Maybe [Value] -> Identity (Maybe [Value]))
 -> Schema -> Identity Schema)
-> [Value] -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ [Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
val]
        withTypeName :: String -> Text
withTypeName String
s = String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
typeName
        typeName :: String
typeName = TypeRep -> String
forall a. Show a => a -> String
show (TypeRep -> String) -> TypeRep -> String
forall a b. (a -> b) -> a -> b
$ Proxy a -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (Proxy a
forall {k} (t :: k). Proxy t
Proxy :: Proxy a)

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

instance Functor Tree where
    fmap :: forall a b. (a -> b) -> Tree a -> Tree b
fmap a -> b
f (Tree Node a
node) = Node b -> Tree b
forall a. Node a -> Tree a
Tree (Node b -> Tree b) -> Node b -> Tree b
forall a b. (a -> b) -> a -> b
$ a -> b
f (a -> b) -> Node a -> Node b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Node a
node
    fmap a -> b
f (Leaf a
x) = b -> Tree b
forall a. a -> Tree a
Leaf (b -> Tree b) -> b -> Tree b
forall a b. (a -> b) -> a -> b
$ a -> b
f a
x

instance Foldable Node where
    foldMap :: forall m a. Monoid m => (a -> m) -> Node a -> m
foldMap a -> m
f (Node NodeHeader
_ [Tree a]
edges) = (Tree a -> m) -> [Tree 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) -> Tree a -> m
forall m a. Monoid m => (a -> m) -> Tree a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f) [Tree a]
edges

instance Foldable Tree where
    foldMap :: forall m a. Monoid m => (a -> m) -> Tree a -> m
foldMap a -> m
f (Leaf a
a) = a -> m
f a
a
    foldMap a -> m
f (Tree Node a
node) = (a -> m) -> Node a -> m
forall m a. Monoid m => (a -> m) -> Node a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f Node a
node

instance Traversable Node where
    traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Node a -> f (Node b)
traverse a -> f b
f (Node NodeHeader
label [Tree a]
edges) = NodeHeader -> [Tree b] -> Node b
forall a. NodeHeader -> [Tree a] -> Node a
Node NodeHeader
label ([Tree b] -> Node b) -> f [Tree b] -> f (Node b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Tree a -> f (Tree b)) -> [Tree a] -> f [Tree 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) -> Tree a -> f (Tree 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) -> Tree a -> f (Tree b)
traverse a -> f b
f) [Tree a]
edges

instance Traversable Tree where
    traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Tree a -> f (Tree b)
traverse a -> f b
f (Leaf a
a) = b -> Tree b
forall a. a -> Tree a
Leaf (b -> Tree b) -> f b -> f (Tree b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
a
    traverse a -> f b
f (Tree Node a
node) = Node b -> Tree b
forall a. Node a -> Tree a
Tree (Node b -> Tree b) -> f (Node b) -> f (Tree b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f b) -> Node a -> f (Node 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) -> Node a -> f (Node b)
traverse a -> f b
f Node a
node

-- | Takes a tree and emplaces concrete text revision.
-- | The text revions are obtained via the specified getter function.
withTextRevisions
    :: (Monad m)
    => (TextElementID -> m (Maybe TextRevision))
    -- ^ (potentially effectful) function for obtaining a text revision
    -> Node TextElement
    -- ^ document structure tree
    -> m (Node TextElementRevision)
    -- ^ document structure tree with concrete text revisions
withTextRevisions :: forall (m :: * -> *).
Monad m =>
(TextElementID -> m (Maybe TextRevision))
-> Node TextElement -> m (Node TextElementRevision)
withTextRevisions TextElementID -> m (Maybe TextRevision)
getTextRevision = Node TextElement -> m (Node TextElementRevision)
withTextRevisions'
  where
    withTextRevisions' :: Node TextElement -> m (Node TextElementRevision)
withTextRevisions' (Node NodeHeader
metaData [Tree TextElement]
children') =
        (Tree TextElement -> m (Tree TextElementRevision))
-> [Tree TextElement] -> m [Tree TextElementRevision]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Tree TextElement -> m (Tree TextElementRevision)
treeWithTextRevisions [Tree TextElement]
children' m [Tree TextElementRevision]
-> ([Tree TextElementRevision] -> Node TextElementRevision)
-> m (Node TextElementRevision)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> NodeHeader
-> [Tree TextElementRevision] -> Node TextElementRevision
forall a. NodeHeader -> [Tree a] -> Node a
Node NodeHeader
metaData
    treeWithTextRevisions :: Tree TextElement -> m (Tree TextElementRevision)
treeWithTextRevisions (Tree Node TextElement
node) = Node TextElement -> m (Node TextElementRevision)
withTextRevisions' Node TextElement
node m (Node TextElementRevision)
-> (Node TextElementRevision -> Tree TextElementRevision)
-> m (Tree TextElementRevision)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Node TextElementRevision -> Tree TextElementRevision
forall a. Node a -> Tree a
Tree
    treeWithTextRevisions (Leaf TextElement
textElement) =
        TextElementID -> m (Maybe TextRevision)
getTextRevision (TextElement -> TextElementID
TextElement.identifier TextElement
textElement)
            m (Maybe TextRevision)
-> (Maybe TextRevision -> Tree TextElementRevision)
-> m (Tree TextElementRevision)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> TextElementRevision -> Tree TextElementRevision
forall a. a -> Tree a
Leaf (TextElementRevision -> Tree TextElementRevision)
-> (Maybe TextRevision -> TextElementRevision)
-> Maybe TextRevision
-> Tree TextElementRevision
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextElement -> Maybe TextRevision -> TextElementRevision
TextElementRevision TextElement
textElement

-- | Basically @mapM@ for a tree
treeMapM
    :: (Monad m)
    => (a -> m b)
    -> Node a
    -> m (Node b)
treeMapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Node a -> m (Node b)
treeMapM a -> m b
getTextRevision = Node a -> m (Node b)
withTextRevisions'
  where
    withTextRevisions' :: Node a -> m (Node b)
withTextRevisions' (Node NodeHeader
metaData [Tree a]
children') =
        (Tree a -> m (Tree b)) -> [Tree a] -> m [Tree b]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Tree a -> m (Tree b)
treeWithTextRevisions [Tree a]
children' m [Tree b] -> ([Tree b] -> Node b) -> m (Node b)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> NodeHeader -> [Tree b] -> Node b
forall a. NodeHeader -> [Tree a] -> Node a
Node NodeHeader
metaData
    treeWithTextRevisions :: Tree a -> m (Tree b)
treeWithTextRevisions (Tree Node a
node) = Node a -> m (Node b)
withTextRevisions' Node a
node m (Node b) -> (Node b -> Tree b) -> m (Tree b)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Node b -> Tree b
forall a. Node a -> Tree a
Tree
    treeWithTextRevisions (Leaf a
x) =
        a -> m b
getTextRevision a
x
            m b -> (b -> Tree b) -> m (Tree b)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> b -> Tree b
forall a. a -> Tree a
Leaf

-- | Basically @fmap@ for the root node of a tree.
filterMapNode :: (a -> Maybe b) -> Node a -> Node b
filterMapNode :: forall a b. (a -> Maybe b) -> Node a -> Node b
filterMapNode a -> Maybe b
f (Node NodeHeader
header' [Tree a]
children') = NodeHeader -> [Tree b] -> Node b
forall a. NodeHeader -> [Tree a] -> Node a
Node NodeHeader
header' ([Tree b] -> Node b) -> [Tree b] -> Node b
forall a b. (a -> b) -> a -> b
$ (Tree a -> Maybe (Tree b)) -> [Tree a] -> [Tree b]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Tree a -> Maybe (Tree b)
tree [Tree a]
children'
  where
    tree :: Tree a -> Maybe (Tree b)
tree (Tree Node a
n) = Tree b -> Maybe (Tree b)
forall a. a -> Maybe a
Just (Tree b -> Maybe (Tree b)) -> Tree b -> Maybe (Tree b)
forall a b. (a -> b) -> a -> b
$ Node b -> Tree b
forall a. Node a -> Tree a
Tree (Node b -> Tree b) -> Node b -> Tree b
forall a b. (a -> b) -> a -> b
$ (a -> Maybe b) -> Node a -> Node b
forall a b. (a -> Maybe b) -> Node a -> Node b
filterMapNode a -> Maybe b
f Node a
n
    tree (Leaf a
l) = b -> Tree b
forall a. a -> Tree a
Leaf (b -> Tree b) -> Maybe b -> Maybe (Tree b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> Maybe b
f a
l

-- | Wrapper type to add a title to an element.
data WithTitle a = WithTitle
    { forall a. WithTitle a -> Text
title :: Text
    , forall a. WithTitle a -> a
content :: a
    }
    deriving ((forall x. WithTitle a -> Rep (WithTitle a) x)
-> (forall x. Rep (WithTitle a) x -> WithTitle a)
-> Generic (WithTitle a)
forall x. Rep (WithTitle a) x -> WithTitle a
forall x. WithTitle a -> Rep (WithTitle a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (WithTitle a) x -> WithTitle a
forall a x. WithTitle a -> Rep (WithTitle a) x
$cfrom :: forall a x. WithTitle a -> Rep (WithTitle a) x
from :: forall x. WithTitle a -> Rep (WithTitle a) x
$cto :: forall a x. Rep (WithTitle a) x -> WithTitle a
to :: forall x. Rep (WithTitle a) x -> WithTitle a
Generic)

instance (ToJSON a) => ToJSON (WithTitle a)

instance (FromJSON a) => FromJSON (WithTitle a)

instance (ToSchema a) => ToSchema (WithTitle a)