{-# LANGUAGE DeriveGeneric #-}

-- |
-- Module      : Docs.Comment
-- Description : Comment Types for Document Management
-- License     : AGPL-3
-- Maintainer  : stu235271@mail.uni-kiel.de
--               stu236925@mail.uni-kiel.de
--
-- This module contains schemas and utility functions for comments.
module Docs.Comment
    ( CommentID (..)
    , Status (..)
    , Comment (..)
    , Message (..)
    , CommentRef (..)
    , CommentAnchor (..)
    , Range (start, end)
    , Anchor (Anchor, row, col)
    , range
    , prettyPrintCommentRef
    ) where

import Control.Lens ((&))
import Control.Lens.Operators ((?~))
import Data.Aeson (FromJSON (parseJSON), ToJSON (toJSON))
import Data.OpenApi
    ( HasExclusiveMinimum (exclusiveMinimum)
    , HasMinimum (minimum_)
    , OpenApiType (OpenApiInteger)
    , ToParamSchema (toParamSchema)
    , ToSchema (declareNamedSchema)
    )
import Data.OpenApi.Lens (HasType (..))
import Data.Proxy (Proxy (Proxy))
import Data.Text (Text)
import Data.Time (UTCTime)
import Data.Vector (Vector)
import Docs.TextElement (TextElementRef, prettyPrintTextElementRef)
import Docs.UserRef (UserRef)
import GHC.Generics (Generic)
import GHC.Int (Int64)
import Servant (FromHttpApiData (parseUrlPiece))

-- | References a comment of a @TextElement@
data CommentRef = CommentRef TextElementRef CommentID
    deriving ((forall x. CommentRef -> Rep CommentRef x)
-> (forall x. Rep CommentRef x -> CommentRef) -> Generic CommentRef
forall x. Rep CommentRef x -> CommentRef
forall x. CommentRef -> Rep CommentRef x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CommentRef -> Rep CommentRef x
from :: forall x. CommentRef -> Rep CommentRef x
$cto :: forall x. Rep CommentRef x -> CommentRef
to :: forall x. Rep CommentRef x -> CommentRef
Generic)

instance ToJSON CommentRef

instance FromJSON CommentRef

instance ToSchema CommentRef

-- | Obtain a human readable representation of a @CommentRef@
prettyPrintCommentRef :: CommentRef -> String
prettyPrintCommentRef :: CommentRef -> String
prettyPrintCommentRef (CommentRef TextElementRef
textElementRef CommentID
id_) =
    TextElementRef -> String
prettyPrintTextElementRef TextElementRef
textElementRef String -> String -> String
forall a. [a] -> [a] -> [a]
++ CommentID -> String
forall a. Show a => a -> String
show CommentID
id_

-- | Unique identifier for a comment
newtype CommentID = CommentID
    { CommentID -> Int64
unCommentID :: Int64
    }
    deriving (Int -> CommentID -> String -> String
[CommentID] -> String -> String
CommentID -> String
(Int -> CommentID -> String -> String)
-> (CommentID -> String)
-> ([CommentID] -> String -> String)
-> Show CommentID
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> CommentID -> String -> String
showsPrec :: Int -> CommentID -> String -> String
$cshow :: CommentID -> String
show :: CommentID -> String
$cshowList :: [CommentID] -> String -> String
showList :: [CommentID] -> String -> String
Show, CommentID -> CommentID -> Bool
(CommentID -> CommentID -> Bool)
-> (CommentID -> CommentID -> Bool) -> Eq CommentID
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CommentID -> CommentID -> Bool
== :: CommentID -> CommentID -> Bool
$c/= :: CommentID -> CommentID -> Bool
/= :: CommentID -> CommentID -> Bool
Eq, Eq CommentID
Eq CommentID =>
(CommentID -> CommentID -> Ordering)
-> (CommentID -> CommentID -> Bool)
-> (CommentID -> CommentID -> Bool)
-> (CommentID -> CommentID -> Bool)
-> (CommentID -> CommentID -> Bool)
-> (CommentID -> CommentID -> CommentID)
-> (CommentID -> CommentID -> CommentID)
-> Ord CommentID
CommentID -> CommentID -> Bool
CommentID -> CommentID -> Ordering
CommentID -> CommentID -> CommentID
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CommentID -> CommentID -> Ordering
compare :: CommentID -> CommentID -> Ordering
$c< :: CommentID -> CommentID -> Bool
< :: CommentID -> CommentID -> Bool
$c<= :: CommentID -> CommentID -> Bool
<= :: CommentID -> CommentID -> Bool
$c> :: CommentID -> CommentID -> Bool
> :: CommentID -> CommentID -> Bool
$c>= :: CommentID -> CommentID -> Bool
>= :: CommentID -> CommentID -> Bool
$cmax :: CommentID -> CommentID -> CommentID
max :: CommentID -> CommentID -> CommentID
$cmin :: CommentID -> CommentID -> CommentID
min :: CommentID -> CommentID -> CommentID
Ord)

instance ToJSON CommentID where
    toJSON :: CommentID -> Value
toJSON = Int64 -> Value
forall a. ToJSON a => a -> Value
toJSON (Int64 -> Value) -> (CommentID -> Int64) -> CommentID -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CommentID -> Int64
unCommentID

instance FromJSON CommentID where
    parseJSON :: Value -> Parser CommentID
parseJSON = (Int64 -> CommentID) -> Parser Int64 -> Parser CommentID
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int64 -> CommentID
CommentID (Parser Int64 -> Parser CommentID)
-> (Value -> Parser Int64) -> Value -> Parser CommentID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser Int64
forall a. FromJSON a => Value -> Parser a
parseJSON

instance ToSchema CommentID where
    declareNamedSchema :: Proxy CommentID -> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy CommentID
_ = Proxy Int64 -> Declare (Definitions Schema) NamedSchema
forall a.
ToSchema a =>
Proxy a -> Declare (Definitions Schema) NamedSchema
declareNamedSchema (Proxy Int64
forall {k} (t :: k). Proxy t
Proxy :: Proxy Int64)

instance ToParamSchema CommentID where
    toParamSchema :: Proxy CommentID -> Schema
toParamSchema Proxy CommentID
_ =
        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
OpenApiInteger
            Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe Scientific -> Identity (Maybe Scientific))
-> Schema -> Identity Schema
forall s a. HasMinimum s a => Lens' s a
Lens' Schema (Maybe Scientific)
minimum_
                ((Maybe Scientific -> Identity (Maybe Scientific))
 -> Schema -> Identity Schema)
-> Scientific -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Scientific
0
            Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe Bool -> Identity (Maybe Bool)) -> Schema -> Identity Schema
forall s a. HasExclusiveMinimum s a => Lens' s a
Lens' Schema (Maybe Bool)
exclusiveMinimum
                ((Maybe Bool -> Identity (Maybe Bool))
 -> Schema -> Identity Schema)
-> Bool -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Bool
False

instance FromHttpApiData CommentID where
    parseUrlPiece :: Text -> Either Text CommentID
parseUrlPiece = (Int64 -> CommentID
CommentID (Int64 -> CommentID) -> Either Text Int64 -> Either Text CommentID
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (Either Text Int64 -> Either Text CommentID)
-> (Text -> Either Text Int64) -> Text -> Either Text CommentID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either Text Int64
forall a. FromHttpApiData a => Text -> Either Text a
parseUrlPiece

-- | Wether a comment is still open or resolved
data Status
    = Open
    | Resolved UTCTime
    deriving ((forall x. Status -> Rep Status x)
-> (forall x. Rep Status x -> Status) -> Generic Status
forall x. Rep Status x -> Status
forall x. Status -> Rep Status x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Status -> Rep Status x
from :: forall x. Status -> Rep Status x
$cto :: forall x. Rep Status x -> Status
to :: forall x. Rep Status x -> Status
Generic)

instance ToJSON Status

instance FromJSON Status

instance ToSchema Status

-- | An existing comment present in the database
data Comment = Comment
    { Comment -> CommentID
identifier :: CommentID
    , Comment -> Status
status :: Status
    , Comment -> Message
message :: Message
    , Comment -> Vector Message
replies :: Vector Message
    }
    deriving ((forall x. Comment -> Rep Comment x)
-> (forall x. Rep Comment x -> Comment) -> Generic Comment
forall x. Rep Comment x -> Comment
forall x. Comment -> Rep Comment x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Comment -> Rep Comment x
from :: forall x. Comment -> Rep Comment x
$cto :: forall x. Rep Comment x -> Comment
to :: forall x. Rep Comment x -> Comment
Generic)

instance ToJSON Comment

instance FromJSON Comment

instance ToSchema Comment

-- | The message of a comment or a reply
data Message = Message
    { Message -> UserRef
author :: UserRef
    , Message -> UTCTime
timestamp :: UTCTime
    , Message -> Text
content :: Text
    }
    deriving ((forall x. Message -> Rep Message x)
-> (forall x. Rep Message x -> Message) -> Generic Message
forall x. Rep Message x -> Message
forall x. Message -> Rep Message x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Message -> Rep Message x
from :: forall x. Message -> Rep Message x
$cto :: forall x. Rep Message x -> Message
to :: forall x. Rep Message x -> Message
Generic)

instance ToJSON Message

instance FromJSON Message

instance ToSchema Message

-- | Ties a comment to a specific text passage
data CommentAnchor = CommentAnchor
    { CommentAnchor -> CommentID
comment :: CommentID
    , CommentAnchor -> Range
anchor :: Range
    }
    deriving ((forall x. CommentAnchor -> Rep CommentAnchor x)
-> (forall x. Rep CommentAnchor x -> CommentAnchor)
-> Generic CommentAnchor
forall x. Rep CommentAnchor x -> CommentAnchor
forall x. CommentAnchor -> Rep CommentAnchor x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CommentAnchor -> Rep CommentAnchor x
from :: forall x. CommentAnchor -> Rep CommentAnchor x
$cto :: forall x. Rep CommentAnchor x -> CommentAnchor
to :: forall x. Rep CommentAnchor x -> CommentAnchor
Generic, CommentAnchor -> CommentAnchor -> Bool
(CommentAnchor -> CommentAnchor -> Bool)
-> (CommentAnchor -> CommentAnchor -> Bool) -> Eq CommentAnchor
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CommentAnchor -> CommentAnchor -> Bool
== :: CommentAnchor -> CommentAnchor -> Bool
$c/= :: CommentAnchor -> CommentAnchor -> Bool
/= :: CommentAnchor -> CommentAnchor -> Bool
Eq, Eq CommentAnchor
Eq CommentAnchor =>
(CommentAnchor -> CommentAnchor -> Ordering)
-> (CommentAnchor -> CommentAnchor -> Bool)
-> (CommentAnchor -> CommentAnchor -> Bool)
-> (CommentAnchor -> CommentAnchor -> Bool)
-> (CommentAnchor -> CommentAnchor -> Bool)
-> (CommentAnchor -> CommentAnchor -> CommentAnchor)
-> (CommentAnchor -> CommentAnchor -> CommentAnchor)
-> Ord CommentAnchor
CommentAnchor -> CommentAnchor -> Bool
CommentAnchor -> CommentAnchor -> Ordering
CommentAnchor -> CommentAnchor -> CommentAnchor
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CommentAnchor -> CommentAnchor -> Ordering
compare :: CommentAnchor -> CommentAnchor -> Ordering
$c< :: CommentAnchor -> CommentAnchor -> Bool
< :: CommentAnchor -> CommentAnchor -> Bool
$c<= :: CommentAnchor -> CommentAnchor -> Bool
<= :: CommentAnchor -> CommentAnchor -> Bool
$c> :: CommentAnchor -> CommentAnchor -> Bool
> :: CommentAnchor -> CommentAnchor -> Bool
$c>= :: CommentAnchor -> CommentAnchor -> Bool
>= :: CommentAnchor -> CommentAnchor -> Bool
$cmax :: CommentAnchor -> CommentAnchor -> CommentAnchor
max :: CommentAnchor -> CommentAnchor -> CommentAnchor
$cmin :: CommentAnchor -> CommentAnchor -> CommentAnchor
min :: CommentAnchor -> CommentAnchor -> CommentAnchor
Ord)

instance ToJSON CommentAnchor

instance FromJSON CommentAnchor

instance ToSchema CommentAnchor

-- | Text location
data Anchor = Anchor
    { Anchor -> Int64
col :: Int64
    , Anchor -> Int64
row :: Int64
    }
    deriving ((forall x. Anchor -> Rep Anchor x)
-> (forall x. Rep Anchor x -> Anchor) -> Generic Anchor
forall x. Rep Anchor x -> Anchor
forall x. Anchor -> Rep Anchor x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Anchor -> Rep Anchor x
from :: forall x. Anchor -> Rep Anchor x
$cto :: forall x. Rep Anchor x -> Anchor
to :: forall x. Rep Anchor x -> Anchor
Generic, Anchor -> Anchor -> Bool
(Anchor -> Anchor -> Bool)
-> (Anchor -> Anchor -> Bool) -> Eq Anchor
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Anchor -> Anchor -> Bool
== :: Anchor -> Anchor -> Bool
$c/= :: Anchor -> Anchor -> Bool
/= :: Anchor -> Anchor -> Bool
Eq)

instance ToJSON Anchor

instance FromJSON Anchor

instance ToSchema Anchor

instance Ord Anchor where
    compare :: Anchor -> Anchor -> Ordering
compare Anchor
a Anchor
b = case Int64 -> Int64 -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Anchor -> Int64
row Anchor
a) (Anchor -> Int64
row Anchor
b) of
        Ordering
EQ -> Int64 -> Int64 -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Anchor -> Int64
col Anchor
a) (Anchor -> Int64
col Anchor
b)
        Ordering
ordering -> Ordering
ordering

-- | Text passage
data Range = Range
    { Range -> Anchor
start :: Anchor
    , Range -> Anchor
end :: Anchor
    }
    deriving ((forall x. Range -> Rep Range x)
-> (forall x. Rep Range x -> Range) -> Generic Range
forall x. Rep Range x -> Range
forall x. Range -> Rep Range x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Range -> Rep Range x
from :: forall x. Range -> Rep Range x
$cto :: forall x. Rep Range x -> Range
to :: forall x. Rep Range x -> Range
Generic, Range -> Range -> Bool
(Range -> Range -> Bool) -> (Range -> Range -> Bool) -> Eq Range
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Range -> Range -> Bool
== :: Range -> Range -> Bool
$c/= :: Range -> Range -> Bool
/= :: Range -> Range -> Bool
Eq, Eq Range
Eq Range =>
(Range -> Range -> Ordering)
-> (Range -> Range -> Bool)
-> (Range -> Range -> Bool)
-> (Range -> Range -> Bool)
-> (Range -> Range -> Bool)
-> (Range -> Range -> Range)
-> (Range -> Range -> Range)
-> Ord Range
Range -> Range -> Bool
Range -> Range -> Ordering
Range -> Range -> Range
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Range -> Range -> Ordering
compare :: Range -> Range -> Ordering
$c< :: Range -> Range -> Bool
< :: Range -> Range -> Bool
$c<= :: Range -> Range -> Bool
<= :: Range -> Range -> Bool
$c> :: Range -> Range -> Bool
> :: Range -> Range -> Bool
$c>= :: Range -> Range -> Bool
>= :: Range -> Range -> Bool
$cmax :: Range -> Range -> Range
max :: Range -> Range -> Range
$cmin :: Range -> Range -> Range
min :: Range -> Range -> Range
Ord)

instance ToJSON Range

instance FromJSON Range

instance ToSchema Range

-- | Constructor for @Range@.
-- Order of anchors does not matter.
range :: Anchor -> Anchor -> Range
range :: Anchor -> Anchor -> Range
range Anchor
a Anchor
b
    | Anchor
a Anchor -> Anchor -> Bool
forall a. Ord a => a -> a -> Bool
<= Anchor
b = Anchor -> Anchor -> Range
Range Anchor
a Anchor
b
    | Bool
otherwise = Anchor -> Anchor -> Range
Range Anchor
b Anchor
a