{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}

-- |
-- Module      : Docs.DocumentHistory
-- Description : Datatypes Representing a Documents History
-- License     : AGPL-3
-- Maintainer  : stu235271@mail.uni-kiel.de
--               stu236925@mail.uni-kiel.de
--
-- This module contains data type definitions representing the history
-- (meaning chronological overview of revisions) of a @Document@
module Docs.DocumentHistory
    ( DocumentHistory (..)
    , DocumentHistoryItem (..)
    ) where

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 Docs.Document (DocumentID)
import Docs.TextElement (TextElementID)
import Docs.TextRevision (TextRevisionHeader)
import Docs.TreeRevision (TreeRevisionHeader)

-- | An item in the @Document@s history.
-- This represents a generic revision.
-- This revision can either be a @Tree@ or a @TextElement@ revision.
data DocumentHistoryItem
    = Tree TreeRevisionHeader
    | Text TextElementID TextRevisionHeader

instance ToJSON DocumentHistoryItem where
    toJSON :: DocumentHistoryItem -> Value
toJSON (Tree TreeRevisionHeader
header) =
        [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
"header" Key -> TreeRevisionHeader -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= TreeRevisionHeader
header
            ]
    toJSON (Text TextElementID
textID TextRevisionHeader
header) =
        [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
"text" :: Text)
            , Key
"text" Key -> TextElementID -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= TextElementID
textID
            , Key
"header" Key -> TextRevisionHeader -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= TextRevisionHeader
header
            ]

instance FromJSON DocumentHistoryItem where
    parseJSON :: Value -> Parser DocumentHistoryItem
parseJSON = [Char]
-> (Object -> Parser DocumentHistoryItem)
-> Value
-> Parser DocumentHistoryItem
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject [Char]
"DocumentHistoryItem" ((Object -> Parser DocumentHistoryItem)
 -> Value -> Parser DocumentHistoryItem)
-> (Object -> Parser DocumentHistoryItem)
-> Value
-> Parser DocumentHistoryItem
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" -> TreeRevisionHeader -> DocumentHistoryItem
Tree (TreeRevisionHeader -> DocumentHistoryItem)
-> Parser TreeRevisionHeader -> Parser DocumentHistoryItem
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Key -> Parser TreeRevisionHeader
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"header"
            Text
"text" -> TextElementID -> TextRevisionHeader -> DocumentHistoryItem
Text (TextElementID -> TextRevisionHeader -> DocumentHistoryItem)
-> Parser TextElementID
-> Parser (TextRevisionHeader -> DocumentHistoryItem)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Key -> Parser TextElementID
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"text" Parser (TextRevisionHeader -> DocumentHistoryItem)
-> Parser TextRevisionHeader -> Parser DocumentHistoryItem
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Key -> Parser TextRevisionHeader
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"header"
            Text
_ -> [Char] -> Parser DocumentHistoryItem
forall a. [Char] -> Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> Parser DocumentHistoryItem)
-> [Char] -> Parser DocumentHistoryItem
forall a b. (a -> b) -> a -> b
$ [Char]
"Unknown DocumentHistoryItem type: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
forall a. Show a => a -> [Char]
show Text
ty

instance ToSchema DocumentHistoryItem where
    declareNamedSchema :: Proxy DocumentHistoryItem
-> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy DocumentHistoryItem
_ = do
        Referenced Schema
treeHeaderSchema <- Proxy TreeRevisionHeader
-> Declare (Definitions Schema) (Referenced Schema)
forall a.
ToSchema a =>
Proxy a -> Declare (Definitions Schema) (Referenced Schema)
declareSchemaRef (Proxy TreeRevisionHeader
forall {k} (t :: k). Proxy t
Proxy :: Proxy TreeRevisionHeader)
        Referenced Schema
textHeaderSchema <- Proxy TextRevisionHeader
-> Declare (Definitions Schema) (Referenced Schema)
forall a.
ToSchema a =>
Proxy a -> Declare (Definitions Schema) (Referenced Schema)
declareSchemaRef (Proxy TextRevisionHeader
forall {k} (t :: k). Proxy t
Proxy :: Proxy TextRevisionHeader)
        Referenced Schema
textSchema <- Proxy TextElementID
-> Declare (Definitions Schema) (Referenced Schema)
forall a.
ToSchema a =>
Proxy a -> Declare (Definitions Schema) (Referenced Schema)
declareSchemaRef (Proxy TextElementID
forall {k} (t :: k). Proxy t
Proxy :: Proxy TextElementID)
        let treeVariant :: Schema
treeVariant =
                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
"header", Referenced Schema
treeHeaderSchema)
                            ]
                    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
"header"]
        let textVariant :: Schema
textVariant =
                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
"text")
                            , (Text
"text", Referenced Schema
textSchema)
                            , (Text
"header", Referenced Schema
textHeaderSchema)
                            ]
                    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
"text", Text
"header"]
        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
"DocumentHistoryItem") (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
treeVariant
                           , Schema -> Referenced Schema
forall a. a -> Referenced a
Inline Schema
textVariant
                           ]
      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]

-- | Chronological overview of a @Document@s history of revisions.
data DocumentHistory = DocumentHistory
    { DocumentHistory -> DocumentID
document :: DocumentID
    , DocumentHistory -> [DocumentHistoryItem]
history :: [DocumentHistoryItem]
    }
    deriving ((forall x. DocumentHistory -> Rep DocumentHistory x)
-> (forall x. Rep DocumentHistory x -> DocumentHistory)
-> Generic DocumentHistory
forall x. Rep DocumentHistory x -> DocumentHistory
forall x. DocumentHistory -> Rep DocumentHistory x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DocumentHistory -> Rep DocumentHistory x
from :: forall x. DocumentHistory -> Rep DocumentHistory x
$cto :: forall x. Rep DocumentHistory x -> DocumentHistory
to :: forall x. Rep DocumentHistory x -> DocumentHistory
Generic)

instance ToJSON DocumentHistory

instance FromJSON DocumentHistory

instance ToSchema DocumentHistory