{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TupleSections #-}

module Docs.Hasql.Statements
    ( now
    , createDocument
    , getDocument
    , getDocuments
    , getDocumentsBy
    , createTextElement
    , getTextElement
    , updateTextRevision
    , createTextRevision
    , getTextRevision
    , getLatestTextRevisionID
    , getTextElementRevision
    , getTreeNode
    , putTreeNode
    , putTreeEdge
    , putTreeRevision
    , getTreeRevision
    , getTreeRevisionHistory
    , getTextRevisionHistory
    , getTextElementIDsForDocument
    , getTreeEdgesByParent
    , getDocumentRevisionHistory
    , existsDocument
    , existsTreeRevision
    , existsTextElement
    , existsTextRevision
    , hasPermission
    , isGroupAdmin
    , createComment
    , getComments
    , createReply
    , getReplies
    , putCommentAnchor
    , getCommentAnchors
    , deleteCommentAnchorsExcept
    , resolveComment
    , existsComment
    , getLogs
    , logMessage
    , getRevisionKey
    , updateLatestTitle
    , createDraftTextRevision
    , getDraftTextRevision
    , deleteDraftTextRevision
    , getDraftCommentAnchors
    , putDraftCommentAnchors
    ) where

import Control.Applicative ((<|>))
import Data.Bifunctor (Bifunctor (first), bimap)
import Data.ByteString (ByteString)
import Data.Profunctor (lmap, rmap)
import Data.Text (Text)
import Data.Time (UTCTime)
import Data.Tuple.Curry (uncurryN)
import Data.UUID (UUID)
import Data.Vector (Vector, mapMaybe)
import GHC.Int (Int64)

import Hasql.Statement (Statement)
import Hasql.TH
    ( maybeStatement
    , resultlessStatement
    , singletonStatement
    , vectorStatement
    )

import UserManagement.DocumentPermission (Permission)
import UserManagement.Group (GroupID)
import UserManagement.User (UserID)

import Data.Aeson (ToJSON (toJSON))
import qualified Data.Aeson as Aeson
import Data.Aeson.Types (parseJSON, parseMaybe)
import Data.Functor ((<&>))
import Data.Maybe (fromMaybe)
import qualified Data.Text as Text
import qualified Data.Vector as Vector
import Docs.Comment
    ( Anchor (Anchor)
    , Comment (Comment)
    , CommentAnchor (CommentAnchor)
    , CommentID (CommentID, unCommentID)
    , CommentRef (CommentRef)
    , Message (Message)
    )
import qualified Docs.Comment as Comment
import Docs.Document (Document (Document), DocumentID (..))
import qualified Docs.Document as Document
import Docs.DocumentHistory (DocumentHistoryItem)
import qualified Docs.DocumentHistory as DocumentHistory
import Docs.Hash (Hash (..))
import Docs.Hasql.TreeEdge
    ( TreeEdge
    , TreeEdgeChild (..)
    , TreeEdgeChildRef (..)
    )
import qualified Docs.Hasql.TreeEdge as TreeEdge
import Docs.Revision
    ( RevisionID (unRevisionID)
    , RevisionKey (RevisionKey)
    , RevisionSelector
    , latestRevisionAsOf
    , specificRevision
    )
import qualified Docs.Revision as Revision
import Docs.TextElement
    ( TextElement (TextElement)
    , TextElementID (..)
    , TextElementKind
    , TextElementRef (..)
    , TextElementType
    )
import qualified Docs.TextElement as TextElement
import Docs.TextRevision
    ( DraftRevision (DraftRevision)
    , DraftRevisionHeader (DraftRevisionHeader)
    , DraftRevisionID (..)
    , TextElementRevision (TextElementRevision)
    , TextRevision (TextRevision)
    , TextRevisionHeader (TextRevisionHeader)
    , TextRevisionID (..)
    , TextRevisionRef (..)
    , TextRevisionSelector (..)
    , latestTextRevisionAsOf
    , specificTextRevision
    )
import qualified Docs.TextRevision as TextRevision
import Docs.Tree (Node, NodeHeader (NodeHeader))
import qualified Docs.Tree as Tree
import Docs.TreeRevision
    ( TreeRevision (TreeRevision)
    , TreeRevisionHeader (TreeRevisionHeader)
    , TreeRevisionID (..)
    , TreeRevisionRef (..)
    , latestTreeRevisionAsOf
    , specificTreeRevision
    )
import qualified Docs.TreeRevision as TreeRevision
import Docs.UserRef (UserRef (UserRef))
import qualified Docs.UserRef as UserRef
import Logging.Logs (LogMessage (LogMessage), Severity (..), Source (..))
import qualified Logging.Logs as Logs
import Logging.Scope (Scope (Scope, unScope))

now :: Statement () UTCTime
now :: Statement () UTCTime
now =
    [singletonStatement|
        SELECT now() :: timestamptz
    |]

existsDocument :: Statement DocumentID Bool
existsDocument :: Statement DocumentID Bool
existsDocument =
    (DocumentID -> Int64)
-> Statement Int64 Bool -> Statement DocumentID Bool
forall a b c. (a -> b) -> Statement b c -> Statement a c
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap
        DocumentID -> Int64
unDocumentID
        [singletonStatement|
            SELECT EXISTS (
                SELECT
                    1 :: bool
                FROM
                    docs
                WHERE
                    id = $1 :: int8
            ) :: bool
        |]

existsTreeRevision :: Statement TreeRevisionRef Bool
existsTreeRevision :: Statement TreeRevisionRef Bool
existsTreeRevision =
    (TreeRevisionRef -> (Int64, Maybe Int64, Maybe UTCTime))
-> Statement (Int64, Maybe Int64, Maybe UTCTime) Bool
-> Statement TreeRevisionRef Bool
forall a b c. (a -> b) -> Statement b c -> Statement a c
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap
        TreeRevisionRef -> (Int64, Maybe Int64, Maybe UTCTime)
uncurryTreeRevisionRef
        [singletonStatement|
            SELECT EXISTS (
                SELECT
                    1
                FROM
                    doc_tree_revisions
                WHERE
                    document = $1 :: int8
                    AND ($2 :: int8? IS NULL OR id = $2 :: int8?)
                    AND ($3 :: timestamptz? IS NULL OR creation_ts <= $3 :: timestamptz?)
            ) :: bool
        |]

existsTextElement :: Statement TextElementRef Bool
existsTextElement :: Statement TextElementRef Bool
existsTextElement =
    (TextElementRef -> (Int64, Int64))
-> Statement (Int64, Int64) Bool -> Statement TextElementRef Bool
forall a b c. (a -> b) -> Statement b c -> Statement a c
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap
        TextElementRef -> (Int64, Int64)
uncurryTextElementRef
        [singletonStatement|
            SELECT EXISTS (
                SELECT
                    1
                FROM
                    doc_text_elements
                WHERE
                    document = $1 :: int8
                    AND id = $2 :: int8
            ) :: bool
        |]

existsTextRevision :: Statement TextRevisionRef Bool
existsTextRevision :: Statement TextRevisionRef Bool
existsTextRevision =
    (TextRevisionRef -> (Int64, Int64, Maybe Int64, Maybe UTCTime))
-> Statement (Int64, Int64, Maybe Int64, Maybe UTCTime) Bool
-> Statement TextRevisionRef Bool
forall a b c. (a -> b) -> Statement b c -> Statement a c
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap
        TextRevisionRef -> (Int64, Int64, Maybe Int64, Maybe UTCTime)
uncurryTextRevisionRef
        [singletonStatement|
            SELECT EXISTS (
                SELECT
                    1
                FROM
                    doc_text_revisions tr
                    JOIN doc_text_elements te on tr.text_element = te.id
                WHERE
                    te.document = $1 :: int8
                    AND tr.text_element = $2 :: int8
                    AND ($3 :: int8? IS NULL OR tr.id = $3 :: int8?)
                    AND ($4 :: timestamptz? IS NULL OR tr.creation_ts <= $4 :: timestamptz?)
            ) :: bool
        |]

uncurryDocument
    :: ( Int64
       , Text
       , Int64
       , UTCTime
       , UUID
       , Text
       , UTCTime
       , UUID
       , Text
       )
    -> Document
uncurryDocument :: (Int64, Text, Int64, UTCTime, UUID, Text, UTCTime, UUID, Text)
-> Document
uncurryDocument
    ( Int64
id_
        , Text
name
        , Int64
groupID
        , UTCTime
created
        , UUID
createdByID
        , Text
createdByName
        , UTCTime
lastEdited
        , UUID
lastEditedByID
        , Text
lastEditedByName
        ) =
        Document
            { identifier :: DocumentID
Document.identifier = Int64 -> DocumentID
DocumentID Int64
id_
            , name :: Text
Document.name = Text
name
            , group :: Int64
Document.group = Int64
groupID
            , created :: UTCTime
Document.created = UTCTime
created
            , createdBy :: UserRef
Document.createdBy =
                UserRef
                    { identifier :: UUID
UserRef.identifier = UUID
createdByID
                    , name :: Text
UserRef.name = Text
createdByName
                    }
            , lastEdited :: UTCTime
Document.lastEdited = UTCTime
lastEdited
            , lastEditedBy :: UserRef
Document.lastEditedBy =
                UserRef
                    { identifier :: UUID
UserRef.identifier = UUID
lastEditedByID
                    , name :: Text
UserRef.name = Text
lastEditedByName
                    }
            }

createDocument :: Statement (Text, GroupID, UserID) Document
createDocument :: Statement (Text, Int64, UUID) Document
createDocument =
    ((Int64, Text, Int64, UTCTime, UUID, Text, UTCTime, UUID, Text)
 -> Document)
-> Statement
     (Text, Int64, UUID)
     (Int64, Text, Int64, UTCTime, UUID, Text, UTCTime, UUID, Text)
-> Statement (Text, Int64, UUID) Document
forall b c a. (b -> c) -> Statement a b -> Statement a c
forall (p :: * -> * -> *) b c a.
Profunctor p =>
(b -> c) -> p a b -> p a c
rmap
        (Int64, Text, Int64, UTCTime, UUID, Text, UTCTime, UUID, Text)
-> Document
uncurryDocument
        [singletonStatement|
            WITH inserted AS (
                insert into docs
                    (name, "group", created_by)
                values
                    ($1 :: text, $2 :: int8, $3 :: uuid)
                returning
                    id :: int8,
                    name :: text,
                    "group" :: int8,
                    creation_ts :: timestamptz?,
                    created_by :: uuid?
            )
            SELECT
                inserted.id :: int8,
                inserted.name :: text,
                inserted."group" :: int8,
                inserted.creation_ts :: timestamptz,
                inserted.created_by :: uuid,
                users.name :: text,
                inserted.creation_ts :: timestamptz,
                inserted.created_by :: uuid,
                users.name :: text
            FROM
                inserted
                LEFT JOIN users ON inserted.created_by = users.id
        |]

getDocument :: Statement DocumentID (Maybe Document)
getDocument :: Statement DocumentID (Maybe Document)
getDocument =
    (DocumentID -> Int64)
-> Statement Int64 (Maybe Document)
-> Statement DocumentID (Maybe Document)
forall a b c. (a -> b) -> Statement b c -> Statement a c
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap DocumentID -> Int64
unDocumentID (Statement Int64 (Maybe Document)
 -> Statement DocumentID (Maybe Document))
-> Statement Int64 (Maybe Document)
-> Statement DocumentID (Maybe Document)
forall a b. (a -> b) -> a -> b
$
        (Maybe
   (Int64, Text, Int64, UTCTime, UUID, Text, UTCTime, UUID, Text)
 -> Maybe Document)
-> Statement
     Int64
     (Maybe
        (Int64, Text, Int64, UTCTime, UUID, Text, UTCTime, UUID, Text))
-> Statement Int64 (Maybe Document)
forall b c a. (b -> c) -> Statement a b -> Statement a c
forall (p :: * -> * -> *) b c a.
Profunctor p =>
(b -> c) -> p a b -> p a c
rmap
            ((Int64, Text, Int64, UTCTime, UUID, Text, UTCTime, UUID, Text)
-> Document
uncurryDocument ((Int64, Text, Int64, UTCTime, UUID, Text, UTCTime, UUID, Text)
 -> Document)
-> Maybe
     (Int64, Text, Int64, UTCTime, UUID, Text, UTCTime, UUID, Text)
-> Maybe Document
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>)
            [maybeStatement|
                SELECT
                    d.id :: int8,
                    d.name :: text,
                    d."group" :: int8,
                    d.creation_ts :: timestamptz,
                    d.created_by :: uuid,
                    cu.name :: text,
                    COALESCE(r.creation_ts, d.creation_ts) :: timestamptz,
                    COALESCE(r.author_id, d.created_by) :: uuid,
                    COALESCE(r.author_name, cu.name) :: text
                FROM
                    docs d
                    LEFT JOIN LATERAL (
                        SELECT
                            dr.creation_ts,
                            dr.author AS author_id,
                            u.name AS author_name
                        FROM
                            doc_revisions dr
                            JOIN users u ON dr.author = u.id
                        WHERE
                            dr.document = d.id
                        ORDER BY
                            dr.creation_ts DESC
                        LIMIT 1
                    ) r ON TRUE
                    LEFT JOIN users cu ON d.created_by = cu.id
                WHERE
                    d.id = $1 :: int8
            |]

getDocuments :: Statement UserID (Vector Document)
getDocuments :: Statement UUID (Vector Document)
getDocuments =
    (Vector
   (Int64, Text, Int64, UTCTime, UUID, Text, UTCTime, UUID, Text)
 -> Vector Document)
-> Statement
     UUID
     (Vector
        (Int64, Text, Int64, UTCTime, UUID, Text, UTCTime, UUID, Text))
-> Statement UUID (Vector Document)
forall b c a. (b -> c) -> Statement a b -> Statement a c
forall (p :: * -> * -> *) b c a.
Profunctor p =>
(b -> c) -> p a b -> p a c
rmap
        ((Int64, Text, Int64, UTCTime, UUID, Text, UTCTime, UUID, Text)
-> Document
uncurryDocument ((Int64, Text, Int64, UTCTime, UUID, Text, UTCTime, UUID, Text)
 -> Document)
-> Vector
     (Int64, Text, Int64, UTCTime, UUID, Text, UTCTime, UUID, Text)
-> Vector Document
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>)
        [vectorStatement|
            SELECT DISTINCT
                d.id :: int8,
                d.name :: text,
                d."group" :: int8,
                d.creation_ts :: timestamptz,
                d.created_by :: uuid,
                cu.name :: text,
                COALESCE(dr.creation_ts, d.creation_ts) :: timestamptz AS last_edited,
                COALESCE(dr.author_id, d.created_by) :: uuid,
                COALESCE(dr.author_name, cu.name) :: text
            FROM
                docs d
                LEFT JOIN roles r ON r.group_id = d."group"
                LEFT JOIN external_document_rights edr ON d.id = edr.document_id
                LEFT JOIN LATERAL (
                    SELECT
                        dr.creation_ts,
                        dr.author AS author_id,
                        u.name AS author_name
                    FROM
                        doc_revisions dr
                        JOIN users u ON dr.author = u.id
                    WHERE
                        dr.document = d.id
                    ORDER BY
                        dr.creation_ts DESC
                    LIMIT 1
                ) dr ON TRUE
                LEFT JOIN users cu ON d.created_by = cu.id
            WHERE
                r.user_id = $1 :: uuid
                OR edr.user_id = $1 :: uuid
            ORDER BY
                last_edited DESC
        |]

getDocumentsBy :: Statement (Maybe UserID, Maybe GroupID) (Vector Document)
getDocumentsBy :: Statement (Maybe UUID, Maybe Int64) (Vector Document)
getDocumentsBy =
    (Vector
   (Int64, Text, Int64, UTCTime, UUID, Text, UTCTime, UUID, Text)
 -> Vector Document)
-> Statement
     (Maybe UUID, Maybe Int64)
     (Vector
        (Int64, Text, Int64, UTCTime, UUID, Text, UTCTime, UUID, Text))
-> Statement (Maybe UUID, Maybe Int64) (Vector Document)
forall b c a. (b -> c) -> Statement a b -> Statement a c
forall (p :: * -> * -> *) b c a.
Profunctor p =>
(b -> c) -> p a b -> p a c
rmap
        ((Int64, Text, Int64, UTCTime, UUID, Text, UTCTime, UUID, Text)
-> Document
uncurryDocument ((Int64, Text, Int64, UTCTime, UUID, Text, UTCTime, UUID, Text)
 -> Document)
-> Vector
     (Int64, Text, Int64, UTCTime, UUID, Text, UTCTime, UUID, Text)
-> Vector Document
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>)
        [vectorStatement|
            SELECT DISTINCT
                d.id :: int8,
                d.name :: text,
                d."group" :: int8,
                d.creation_ts :: timestamptz,
                d.created_by :: uuid,
                cu.name :: text,
                COALESCE(dr.creation_ts, d.creation_ts) :: timestamptz AS last_edited,
                COALESCE(dr.author_id, d.created_by) :: uuid,
                COALESCE(dr.author_name, cu.name) :: text
            FROM
                docs d
                LEFT JOIN roles r ON r.group_id = d."group"
                LEFT JOIN external_document_rights edr ON d.id = edr.document_id
                LEFT JOIN LATERAL (
                    SELECT
                        dr.creation_ts,
                        dr.author AS author_id,
                        u.name AS author_name
                    FROM
                        doc_revisions dr
                        JOIN users u ON dr.author = u.id
                    WHERE
                        dr.document = d.id
                    ORDER BY
                        dr.creation_ts DESC
                    LIMIT 1
                ) dr ON TRUE
                LEFT JOIN users cu ON d.created_by = cu.id
            WHERE
                r.user_id = $1 :: uuid?
                OR edr.user_id = $1 :: uuid?
                OR d."group" = $2 :: int8?
            ORDER BY
                last_edited DESC
        |]

uncurryTextElement :: (Int64, Text, Text) -> TextElement
uncurryTextElement :: (Int64, Text, Text) -> TextElement
uncurryTextElement (Int64
id_, Text
kind, Text
type_) =
    TextElement
        { identifier :: TextElementID
TextElement.identifier = Int64 -> TextElementID
TextElementID Int64
id_
        , textElementKind :: Text
TextElement.textElementKind = Text
kind
        , textElementType :: Text
TextElement.textElementType = Text
type_
        }

createTextElement :: Statement (DocumentID, Text, Text) TextElement
createTextElement :: Statement (DocumentID, Text, Text) TextElement
createTextElement =
    ((DocumentID, Text, Text) -> (Int64, Text, Text))
-> Statement (Int64, Text, Text) TextElement
-> Statement (DocumentID, Text, Text) TextElement
forall a b c. (a -> b) -> Statement b c -> Statement a c
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap (DocumentID, Text, Text) -> (Int64, Text, Text)
forall {b} {c}. (DocumentID, b, c) -> (Int64, b, c)
mapInput (Statement (Int64, Text, Text) TextElement
 -> Statement (DocumentID, Text, Text) TextElement)
-> Statement (Int64, Text, Text) TextElement
-> Statement (DocumentID, Text, Text) TextElement
forall a b. (a -> b) -> a -> b
$
        ((Int64, Text, Text) -> TextElement)
-> Statement (Int64, Text, Text) (Int64, Text, Text)
-> Statement (Int64, Text, Text) TextElement
forall b c a. (b -> c) -> Statement a b -> Statement a c
forall (p :: * -> * -> *) b c a.
Profunctor p =>
(b -> c) -> p a b -> p a c
rmap
            (Int64, Text, Text) -> TextElement
uncurryTextElement
            [singletonStatement|
            insert into doc_text_elements
                (document, kind, type)
            values
                ($1 :: int8, $2 :: text, $3 :: text)
            returning
                id :: int8,
                kind :: text,
                type :: text
        |]
  where
    mapInput :: (DocumentID, b, c) -> (Int64, b, c)
mapInput (DocumentID
docID, b
kind, c
type_) = (DocumentID -> Int64
unDocumentID DocumentID
docID, b
kind, c
type_)

getTextElement :: Statement TextElementID (Maybe TextElement)
getTextElement :: Statement TextElementID (Maybe TextElement)
getTextElement =
    (TextElementID -> Int64)
-> Statement Int64 (Maybe TextElement)
-> Statement TextElementID (Maybe TextElement)
forall a b c. (a -> b) -> Statement b c -> Statement a c
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap
        TextElementID -> Int64
unTextElementID
        (Statement Int64 (Maybe TextElement)
 -> Statement TextElementID (Maybe TextElement))
-> Statement Int64 (Maybe TextElement)
-> Statement TextElementID (Maybe TextElement)
forall a b. (a -> b) -> a -> b
$ (Maybe (Int64, Text, Text) -> Maybe TextElement)
-> Statement Int64 (Maybe (Int64, Text, Text))
-> Statement Int64 (Maybe TextElement)
forall b c a. (b -> c) -> Statement a b -> Statement a c
forall (p :: * -> * -> *) b c a.
Profunctor p =>
(b -> c) -> p a b -> p a c
rmap
            ((Int64, Text, Text) -> TextElement
uncurryTextElement ((Int64, Text, Text) -> TextElement)
-> Maybe (Int64, Text, Text) -> Maybe TextElement
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>)
            [maybeStatement|
                select
                    id :: int8,
                    kind :: text,
                    type :: text
                from
                    doc_text_elements
                where
                    id = $1 :: int8
            |]

uncurryTextRevisionHeader :: (Int64, UTCTime, UUID, Text) -> TextRevisionHeader
uncurryTextRevisionHeader :: (Int64, UTCTime, UUID, Text) -> TextRevisionHeader
uncurryTextRevisionHeader (Int64
id_, UTCTime
timestamp, UUID
authorID, Text
authorName) =
    TextRevisionHeader
        { identifier :: TextRevisionID
TextRevision.identifier = Int64 -> TextRevisionID
TextRevisionID Int64
id_
        , timestamp :: UTCTime
TextRevision.timestamp = UTCTime
timestamp
        , author :: UserRef
TextRevision.author =
            UserRef
                { identifier :: UUID
UserRef.identifier = UUID
authorID
                , name :: Text
UserRef.name = Text
authorName
                }
        }

uncurryTextRevision
    :: (Monad m)
    => (Int64, UTCTime, UUID, Text, Text)
    -> (TextRevisionID -> m (Vector CommentAnchor))
    -> m TextRevision
uncurryTextRevision :: forall (m :: * -> *).
Monad m =>
(Int64, UTCTime, UUID, Text, Text)
-> (TextRevisionID -> m (Vector CommentAnchor)) -> m TextRevision
uncurryTextRevision (Int64
id_, UTCTime
timestamp, UUID
authorID, Text
authorName, Text
content) TextRevisionID -> m (Vector CommentAnchor)
getAnchors =
    TextRevisionID -> m (Vector CommentAnchor)
getAnchors (Int64 -> TextRevisionID
TextRevisionID Int64
id_)
        m (Vector CommentAnchor)
-> (Vector CommentAnchor -> TextRevision) -> m TextRevision
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> TextRevisionHeader -> Text -> Vector CommentAnchor -> TextRevision
TextRevision
            ((Int64, UTCTime, UUID, Text) -> TextRevisionHeader
uncurryTextRevisionHeader (Int64
id_, UTCTime
timestamp, UUID
authorID, Text
authorName))
            Text
content

uncurryTextElementRevision
    :: (Monad m)
    => ( Int64
       , TextElementKind
       , TextElementType
       , Maybe Int64
       , Maybe UTCTime
       , Maybe UUID
       , Maybe Text
       , Maybe Text
       )
    -> (TextRevisionID -> m (Vector CommentAnchor))
    -> m TextElementRevision
uncurryTextElementRevision :: forall (m :: * -> *).
Monad m =>
(Int64, Text, Text, Maybe Int64, Maybe UTCTime, Maybe UUID,
 Maybe Text, Maybe Text)
-> (TextRevisionID -> m (Vector CommentAnchor))
-> m TextElementRevision
uncurryTextElementRevision
    (Int64
id_, Text
kind, Text
type_, Maybe Int64
revisionID, Maybe UTCTime
timestamp, Maybe UUID
authorID, Maybe Text
authorName, Maybe Text
content)
    TextRevisionID -> m (Vector CommentAnchor)
getAnchors = do
        Maybe (Vector CommentAnchor)
anchors <- (Int64 -> m (Vector CommentAnchor))
-> Maybe Int64 -> m (Maybe (Vector CommentAnchor))
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) -> Maybe a -> m (Maybe b)
mapM (TextRevisionID -> m (Vector CommentAnchor)
getAnchors (TextRevisionID -> m (Vector CommentAnchor))
-> (Int64 -> TextRevisionID) -> Int64 -> m (Vector CommentAnchor)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> TextRevisionID
TextRevisionID) Maybe Int64
revisionID
        TextElementRevision -> m TextElementRevision
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
            (TextElementRevision -> m TextElementRevision)
-> TextElementRevision -> m TextElementRevision
forall a b. (a -> b) -> a -> b
$ TextElement -> Maybe TextRevision -> TextElementRevision
TextElementRevision
                TextElement
                    { identifier :: TextElementID
TextElement.identifier = Int64 -> TextElementID
TextElementID Int64
id_
                    , textElementKind :: Text
TextElement.textElementKind = Text
kind
                    , textElementType :: Text
TextElement.textElementType = Text
type_
                    }
            (Maybe TextRevision -> TextElementRevision)
-> Maybe TextRevision -> TextElementRevision
forall a b. (a -> b) -> a -> b
$ do
                Int64
trRevisionID <- Maybe Int64
revisionID
                UTCTime
trTimestamp <- Maybe UTCTime
timestamp
                UUID
trAuthorID <- Maybe UUID
authorID
                Text
trAuthorName <- Maybe Text
authorName
                TextRevisionHeader -> Text -> Vector CommentAnchor -> TextRevision
TextRevision
                    TextRevisionHeader
                        { identifier :: TextRevisionID
TextRevision.identifier = Int64 -> TextRevisionID
TextRevisionID Int64
trRevisionID
                        , timestamp :: UTCTime
TextRevision.timestamp = UTCTime
trTimestamp
                        , author :: UserRef
TextRevision.author =
                            UserRef
                                { identifier :: UUID
UserRef.identifier = UUID
trAuthorID
                                , name :: Text
UserRef.name = Text
trAuthorName
                                }
                        }
                    (Text -> Vector CommentAnchor -> TextRevision)
-> Maybe Text -> Maybe (Vector CommentAnchor -> TextRevision)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
content
                    Maybe (Vector CommentAnchor -> TextRevision)
-> Maybe (Vector CommentAnchor) -> Maybe TextRevision
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe (Vector CommentAnchor)
anchors

updateTextRevision
    :: (Monad m)
    => Statement
        (TextRevisionID, Text)
        ( (TextRevisionID -> m (Vector CommentAnchor))
          -> m TextRevision
        )
updateTextRevision :: forall (m :: * -> *).
Monad m =>
Statement
  (TextRevisionID, Text)
  ((TextRevisionID -> m (Vector CommentAnchor)) -> m TextRevision)
updateTextRevision =
    ((TextRevisionID, Text) -> (Int64, Text))
-> Statement
     (Int64, Text)
     ((TextRevisionID -> m (Vector CommentAnchor)) -> m TextRevision)
-> Statement
     (TextRevisionID, Text)
     ((TextRevisionID -> m (Vector CommentAnchor)) -> m TextRevision)
forall a b c. (a -> b) -> Statement b c -> Statement a c
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap
        ((TextRevisionID -> Int64)
-> (TextRevisionID, Text) -> (Int64, Text)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first TextRevisionID -> Int64
unTextRevisionID)
        (Statement
   (Int64, Text)
   ((TextRevisionID -> m (Vector CommentAnchor)) -> m TextRevision)
 -> Statement
      (TextRevisionID, Text)
      ((TextRevisionID -> m (Vector CommentAnchor)) -> m TextRevision))
-> Statement
     (Int64, Text)
     ((TextRevisionID -> m (Vector CommentAnchor)) -> m TextRevision)
-> Statement
     (TextRevisionID, Text)
     ((TextRevisionID -> m (Vector CommentAnchor)) -> m TextRevision)
forall a b. (a -> b) -> a -> b
$ ((Int64, UTCTime, UUID, Text, Text)
 -> (TextRevisionID -> m (Vector CommentAnchor)) -> m TextRevision)
-> Statement (Int64, Text) (Int64, UTCTime, UUID, Text, Text)
-> Statement
     (Int64, Text)
     ((TextRevisionID -> m (Vector CommentAnchor)) -> m TextRevision)
forall b c a. (b -> c) -> Statement a b -> Statement a c
forall (p :: * -> * -> *) b c a.
Profunctor p =>
(b -> c) -> p a b -> p a c
rmap
            (Int64, UTCTime, UUID, Text, Text)
-> (TextRevisionID -> m (Vector CommentAnchor)) -> m TextRevision
forall (m :: * -> *).
Monad m =>
(Int64, UTCTime, UUID, Text, Text)
-> (TextRevisionID -> m (Vector CommentAnchor)) -> m TextRevision
uncurryTextRevision
            [singletonStatement|
                WITH updated AS (
                    UPDATE
                        doc_text_revisions
                    SET
                        id = nextval('doc_revision_seq'),
                        creation_ts = now(),
                        content = $2 :: text
                    WHERE
                        id = $1 :: int8
                    RETURNING
                        id :: int8,
                        creation_ts :: timestamptz,
                        author :: uuid,
                        content :: text
                ),
                updated_anchors AS (
                    UPDATE
                        doc_comment_anchors
                    SET
                        comment = updated.id
                    FROM
                        updated
                    WHERE
                        doc_comment_anchors.comment = $1 :: int8
                )
                SELECT
                    updated.id :: int8,
                    updated.creation_ts :: timestamptz,
                    updated.author :: uuid,
                    users.name :: text,
                    updated.content :: text
                FROM
                    updated
                    JOIN users on users.id = updated.author
            |]

createTextRevision
    :: (Monad m)
    => Statement
        (TextElementID, UUID, Text)
        ((TextRevisionID -> m (Vector CommentAnchor)) -> m TextRevision)
createTextRevision :: forall (m :: * -> *).
Monad m =>
Statement
  (TextElementID, UUID, Text)
  ((TextRevisionID -> m (Vector CommentAnchor)) -> m TextRevision)
createTextRevision =
    ((TextElementID, UUID, Text) -> (Int64, UUID, Text))
-> Statement
     (Int64, UUID, Text)
     ((TextRevisionID -> m (Vector CommentAnchor)) -> m TextRevision)
-> Statement
     (TextElementID, UUID, Text)
     ((TextRevisionID -> m (Vector CommentAnchor)) -> m TextRevision)
forall a b c. (a -> b) -> Statement b c -> Statement a c
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap
        (TextElementID, UUID, Text) -> (Int64, UUID, Text)
forall {b} {c}. (TextElementID, b, c) -> (Int64, b, c)
mapInput
        (Statement
   (Int64, UUID, Text)
   ((TextRevisionID -> m (Vector CommentAnchor)) -> m TextRevision)
 -> Statement
      (TextElementID, UUID, Text)
      ((TextRevisionID -> m (Vector CommentAnchor)) -> m TextRevision))
-> Statement
     (Int64, UUID, Text)
     ((TextRevisionID -> m (Vector CommentAnchor)) -> m TextRevision)
-> Statement
     (TextElementID, UUID, Text)
     ((TextRevisionID -> m (Vector CommentAnchor)) -> m TextRevision)
forall a b. (a -> b) -> a -> b
$ ((Int64, UTCTime, UUID, Text, Text)
 -> (TextRevisionID -> m (Vector CommentAnchor)) -> m TextRevision)
-> Statement (Int64, UUID, Text) (Int64, UTCTime, UUID, Text, Text)
-> Statement
     (Int64, UUID, Text)
     ((TextRevisionID -> m (Vector CommentAnchor)) -> m TextRevision)
forall b c a. (b -> c) -> Statement a b -> Statement a c
forall (p :: * -> * -> *) b c a.
Profunctor p =>
(b -> c) -> p a b -> p a c
rmap
            (Int64, UTCTime, UUID, Text, Text)
-> (TextRevisionID -> m (Vector CommentAnchor)) -> m TextRevision
forall (m :: * -> *).
Monad m =>
(Int64, UTCTime, UUID, Text, Text)
-> (TextRevisionID -> m (Vector CommentAnchor)) -> m TextRevision
uncurryTextRevision
            [singletonStatement|
                WITH inserted AS (
                    insert into doc_text_revisions
                        (text_element, author, content)
                    values
                        ($1 :: int8, $2 :: uuid, $3 :: text)
                    returning
                        id :: int8,
                        creation_ts :: timestamptz,
                        author :: uuid,
                        content :: text
                )
                SELECT
                    inserted.id :: int8,
                    inserted.creation_ts :: timestamptz,
                    inserted.author :: uuid,
                    users.name :: text,
                    inserted.content :: text
                FROM
                    inserted
                    JOIN users on users.id = inserted.author
            |]
  where
    mapInput :: (TextElementID, b, c) -> (Int64, b, c)
mapInput (TextElementID
elementID, b
author, c
content) =
        (TextElementID -> Int64
unTextElementID TextElementID
elementID, b
author, c
content)

getTextRevision
    :: (Monad m)
    => Statement
        (TextElementID, TextRevisionSelector)
        ((TextRevisionID -> m (Vector CommentAnchor)) -> m (Maybe TextRevision))
getTextRevision :: forall (m :: * -> *).
Monad m =>
Statement
  (TextElementID, TextRevisionSelector)
  ((TextRevisionID -> m (Vector CommentAnchor))
   -> m (Maybe TextRevision))
getTextRevision =
    ((TextElementID, TextRevisionSelector)
 -> (Int64, Maybe Int64, Maybe UTCTime))
-> Statement
     (Int64, Maybe Int64, Maybe UTCTime)
     ((TextRevisionID -> m (Vector CommentAnchor))
      -> m (Maybe TextRevision))
-> Statement
     (TextElementID, TextRevisionSelector)
     ((TextRevisionID -> m (Vector CommentAnchor))
      -> m (Maybe TextRevision))
forall a b c. (a -> b) -> Statement b c -> Statement a c
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap
        (TextElementID, TextRevisionSelector)
-> (Int64, Maybe Int64, Maybe UTCTime)
mapInput
        (Statement
   (Int64, Maybe Int64, Maybe UTCTime)
   ((TextRevisionID -> m (Vector CommentAnchor))
    -> m (Maybe TextRevision))
 -> Statement
      (TextElementID, TextRevisionSelector)
      ((TextRevisionID -> m (Vector CommentAnchor))
       -> m (Maybe TextRevision)))
-> Statement
     (Int64, Maybe Int64, Maybe UTCTime)
     ((TextRevisionID -> m (Vector CommentAnchor))
      -> m (Maybe TextRevision))
-> Statement
     (TextElementID, TextRevisionSelector)
     ((TextRevisionID -> m (Vector CommentAnchor))
      -> m (Maybe TextRevision))
forall a b. (a -> b) -> a -> b
$ (Maybe (Int64, UTCTime, UUID, Text, Text)
 -> (TextRevisionID -> m (Vector CommentAnchor))
 -> m (Maybe TextRevision))
-> Statement
     (Int64, Maybe Int64, Maybe UTCTime)
     (Maybe (Int64, UTCTime, UUID, Text, Text))
-> Statement
     (Int64, Maybe Int64, Maybe UTCTime)
     ((TextRevisionID -> m (Vector CommentAnchor))
      -> m (Maybe TextRevision))
forall b c a. (b -> c) -> Statement a b -> Statement a c
forall (p :: * -> * -> *) b c a.
Profunctor p =>
(b -> c) -> p a b -> p a c
rmap
            (\Maybe (Int64, UTCTime, UUID, Text, Text)
row TextRevisionID -> m (Vector CommentAnchor)
f -> ((Int64, UTCTime, UUID, Text, Text) -> m TextRevision)
-> Maybe (Int64, UTCTime, UUID, Text, Text)
-> m (Maybe TextRevision)
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) -> Maybe a -> m (Maybe b)
mapM ((Int64, UTCTime, UUID, Text, Text)
-> (TextRevisionID -> m (Vector CommentAnchor)) -> m TextRevision
forall (m :: * -> *).
Monad m =>
(Int64, UTCTime, UUID, Text, Text)
-> (TextRevisionID -> m (Vector CommentAnchor)) -> m TextRevision
`uncurryTextRevision` TextRevisionID -> m (Vector CommentAnchor)
f) Maybe (Int64, UTCTime, UUID, Text, Text)
row)
            [maybeStatement|
                select
                    tr.id :: int8,
                    tr.creation_ts :: timestamptz,
                    tr.author :: uuid,
                    u.name :: text,
                    tr.content :: text
                from
                    doc_text_revisions tr
                    join users u on tr.author = u.id
                where
                    tr.text_element = $1 :: int8
                    and ($2 :: int8? is null or tr.id = $2 :: int8?)
                    and ($3 :: timestamptz? is null or tr.creation_ts <= $3 :: timestamptz?)
                order by
                    tr.creation_ts desc
                limit 1
            |]
  where
    mapInput :: (TextElementID, TextRevisionSelector)
-> (Int64, Maybe Int64, Maybe UTCTime)
mapInput (TextElementID
textID, TextRevisionSelector
selector) =
        ( TextElementID -> Int64
unTextElementID TextElementID
textID
        , TextRevisionID -> Int64
unTextRevisionID (TextRevisionID -> Int64) -> Maybe TextRevisionID -> Maybe Int64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TextRevisionSelector -> Maybe TextRevisionID
specificTextRevision TextRevisionSelector
selector
        , TextRevisionSelector -> Maybe UTCTime
latestTextRevisionAsOf TextRevisionSelector
selector
        )

getTextRevisionHistory
    :: Statement
        (TextElementRef, Maybe UTCTime, Maybe UTCTime, Int64)
        (Vector TextRevisionHeader)
getTextRevisionHistory :: Statement
  (TextElementRef, Maybe UTCTime, Maybe UTCTime, Int64)
  (Vector TextRevisionHeader)
getTextRevisionHistory =
    ((TextElementRef, Maybe UTCTime, Maybe UTCTime, Int64)
 -> (Int64, Int64, Maybe UTCTime, Maybe UTCTime, Int64))
-> Statement
     (Int64, Int64, Maybe UTCTime, Maybe UTCTime, Int64)
     (Vector TextRevisionHeader)
-> Statement
     (TextElementRef, Maybe UTCTime, Maybe UTCTime, Int64)
     (Vector TextRevisionHeader)
forall a b c. (a -> b) -> Statement b c -> Statement a c
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap
        (TextElementRef, Maybe UTCTime, Maybe UTCTime, Int64)
-> (Int64, Int64, Maybe UTCTime, Maybe UTCTime, Int64)
forall {c} {d} {e}.
(TextElementRef, c, d, e) -> (Int64, Int64, c, d, e)
mapInput
        (Statement
   (Int64, Int64, Maybe UTCTime, Maybe UTCTime, Int64)
   (Vector TextRevisionHeader)
 -> Statement
      (TextElementRef, Maybe UTCTime, Maybe UTCTime, Int64)
      (Vector TextRevisionHeader))
-> Statement
     (Int64, Int64, Maybe UTCTime, Maybe UTCTime, Int64)
     (Vector TextRevisionHeader)
-> Statement
     (TextElementRef, Maybe UTCTime, Maybe UTCTime, Int64)
     (Vector TextRevisionHeader)
forall a b. (a -> b) -> a -> b
$ (Vector (Int64, UTCTime, UUID, Text) -> Vector TextRevisionHeader)
-> Statement
     (Int64, Int64, Maybe UTCTime, Maybe UTCTime, Int64)
     (Vector (Int64, UTCTime, UUID, Text))
-> Statement
     (Int64, Int64, Maybe UTCTime, Maybe UTCTime, Int64)
     (Vector TextRevisionHeader)
forall b c a. (b -> c) -> Statement a b -> Statement a c
forall (p :: * -> * -> *) b c a.
Profunctor p =>
(b -> c) -> p a b -> p a c
rmap
            ((Int64, UTCTime, UUID, Text) -> TextRevisionHeader
uncurryTextRevisionHeader ((Int64, UTCTime, UUID, Text) -> TextRevisionHeader)
-> Vector (Int64, UTCTime, UUID, Text) -> Vector TextRevisionHeader
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>)
            [vectorStatement|
                SELECT
                    tr.id :: int8,
                    tr.creation_ts :: TIMESTAMPTZ,
                    tr.author :: UUID,
                    u.name :: TEXT
                FROM
                    doc_text_revisions tr
                    JOIN doc_text_elements te ON tr.text_element = te.id
                    JOIN users u on tr.author = u.id
                WHERE
                    te.document = $1 :: int8
                    AND tr.text_element = $2 :: int8
                    AND tr.creation_ts > COALESCE($3 :: TIMESTAMPTZ?, '1900-01-01 00:00:00+00'::TIMESTAMPTZ)
                    AND tr.creation_ts < COALESCE($4 :: TIMESTAMPTZ?, NOW())
                ORDER BY
                    tr.creation_ts DESC
                LIMIT
                    $5 :: int8
            |]
  where
    mapInput :: (TextElementRef, c, d, e) -> (Int64, Int64, c, d, e)
mapInput (TextElementRef DocumentID
docID TextElementID
textID, c
maybeFrom, d
maybeTo, e
limit) =
        (DocumentID -> Int64
unDocumentID DocumentID
docID, TextElementID -> Int64
unTextElementID TextElementID
textID, c
maybeFrom, d
maybeTo, e
limit)

getLatestTextRevisionID :: Statement TextElementRef (Maybe TextRevisionID)
getLatestTextRevisionID :: Statement TextElementRef (Maybe TextRevisionID)
getLatestTextRevisionID =
    (TextElementRef -> (Int64, Int64))
-> Statement (Int64, Int64) (Maybe TextRevisionID)
-> Statement TextElementRef (Maybe TextRevisionID)
forall a b c. (a -> b) -> Statement b c -> Statement a c
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap
        TextElementRef -> (Int64, Int64)
uncurryTextElementRef
        (Statement (Int64, Int64) (Maybe TextRevisionID)
 -> Statement TextElementRef (Maybe TextRevisionID))
-> Statement (Int64, Int64) (Maybe TextRevisionID)
-> Statement TextElementRef (Maybe TextRevisionID)
forall a b. (a -> b) -> a -> b
$ (Maybe Int64 -> Maybe TextRevisionID)
-> Statement (Int64, Int64) (Maybe Int64)
-> Statement (Int64, Int64) (Maybe TextRevisionID)
forall b c a. (b -> c) -> Statement a b -> Statement a c
forall (p :: * -> * -> *) b c a.
Profunctor p =>
(b -> c) -> p a b -> p a c
rmap
            (Int64 -> TextRevisionID
TextRevisionID (Int64 -> TextRevisionID) -> Maybe Int64 -> Maybe TextRevisionID
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>)
            [maybeStatement|
                select
                    tr.id :: int8
                from
                    doc_text_revisions tr
                    join doc_text_elements te on tr.text_element = te.id
                where
                    te.document = $1 :: int8
                    and tr.text_element = $2 :: int8
                order by
                    tr.creation_ts desc
                limit 1
            |]

uncurryTextElementRef :: TextElementRef -> (Int64, Int64)
uncurryTextElementRef :: TextElementRef -> (Int64, Int64)
uncurryTextElementRef (TextElementRef DocumentID
docID TextElementID
textID) =
    (DocumentID -> Int64
unDocumentID DocumentID
docID, TextElementID -> Int64
unTextElementID TextElementID
textID)

getTextElementRevision
    :: (Monad m)
    => Statement
        TextRevisionRef
        ((TextRevisionID -> m (Vector CommentAnchor)) -> m (Maybe TextElementRevision))
getTextElementRevision :: forall (m :: * -> *).
Monad m =>
Statement
  TextRevisionRef
  ((TextRevisionID -> m (Vector CommentAnchor))
   -> m (Maybe TextElementRevision))
getTextElementRevision =
    (TextRevisionRef -> (Int64, Int64, Maybe Int64, Maybe UTCTime))
-> Statement
     (Int64, Int64, Maybe Int64, Maybe UTCTime)
     ((TextRevisionID -> m (Vector CommentAnchor))
      -> m (Maybe TextElementRevision))
-> Statement
     TextRevisionRef
     ((TextRevisionID -> m (Vector CommentAnchor))
      -> m (Maybe TextElementRevision))
forall a b c. (a -> b) -> Statement b c -> Statement a c
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap
        TextRevisionRef -> (Int64, Int64, Maybe Int64, Maybe UTCTime)
uncurryTextRevisionRef
        (Statement
   (Int64, Int64, Maybe Int64, Maybe UTCTime)
   ((TextRevisionID -> m (Vector CommentAnchor))
    -> m (Maybe TextElementRevision))
 -> Statement
      TextRevisionRef
      ((TextRevisionID -> m (Vector CommentAnchor))
       -> m (Maybe TextElementRevision)))
-> Statement
     (Int64, Int64, Maybe Int64, Maybe UTCTime)
     ((TextRevisionID -> m (Vector CommentAnchor))
      -> m (Maybe TextElementRevision))
-> Statement
     TextRevisionRef
     ((TextRevisionID -> m (Vector CommentAnchor))
      -> m (Maybe TextElementRevision))
forall a b. (a -> b) -> a -> b
$ (Maybe
   (Int64, Text, Text, Maybe Int64, Maybe UTCTime, Maybe UUID,
    Maybe Text, Maybe Text)
 -> (TextRevisionID -> m (Vector CommentAnchor))
 -> m (Maybe TextElementRevision))
-> Statement
     (Int64, Int64, Maybe Int64, Maybe UTCTime)
     (Maybe
        (Int64, Text, Text, Maybe Int64, Maybe UTCTime, Maybe UUID,
         Maybe Text, Maybe Text))
-> Statement
     (Int64, Int64, Maybe Int64, Maybe UTCTime)
     ((TextRevisionID -> m (Vector CommentAnchor))
      -> m (Maybe TextElementRevision))
forall b c a. (b -> c) -> Statement a b -> Statement a c
forall (p :: * -> * -> *) b c a.
Profunctor p =>
(b -> c) -> p a b -> p a c
rmap
            (\Maybe
  (Int64, Text, Text, Maybe Int64, Maybe UTCTime, Maybe UUID,
   Maybe Text, Maybe Text)
row TextRevisionID -> m (Vector CommentAnchor)
f -> ((Int64, Text, Text, Maybe Int64, Maybe UTCTime, Maybe UUID,
  Maybe Text, Maybe Text)
 -> m TextElementRevision)
-> Maybe
     (Int64, Text, Text, Maybe Int64, Maybe UTCTime, Maybe UUID,
      Maybe Text, Maybe Text)
-> m (Maybe 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) -> Maybe a -> m (Maybe b)
mapM ((Int64, Text, Text, Maybe Int64, Maybe UTCTime, Maybe UUID,
 Maybe Text, Maybe Text)
-> (TextRevisionID -> m (Vector CommentAnchor))
-> m TextElementRevision
forall (m :: * -> *).
Monad m =>
(Int64, Text, Text, Maybe Int64, Maybe UTCTime, Maybe UUID,
 Maybe Text, Maybe Text)
-> (TextRevisionID -> m (Vector CommentAnchor))
-> m TextElementRevision
`uncurryTextElementRevision` TextRevisionID -> m (Vector CommentAnchor)
f) Maybe
  (Int64, Text, Text, Maybe Int64, Maybe UTCTime, Maybe UUID,
   Maybe Text, Maybe Text)
row)
            [maybeStatement|
                select
                    te.id :: int8,
                    te.kind :: text,
                    te.type :: text,
                    tr.id :: int8?,
                    tr.creation_ts :: timestamptz?,
                    tr.author :: uuid?,
                    u.name :: text?,
                    tr.content :: text?
                from
                    doc_text_elements te
                    left join doc_text_revisions tr on te.id = tr.text_element
                    left join users u on tr.author = u.id
                where
                    te.document = $1 :: int8
                    and te.id = $2 :: int8
                    and ($3 :: int8? is null or tr.id = $3 :: int8?)
                    and ($4 :: timestamptz? is null or tr.creation_ts <= $4 :: timestamptz?)
                order by
                    tr.creation_ts desc
                limit 1
            |]

uncurryTextRevisionRef
    :: TextRevisionRef -> (Int64, Int64, Maybe Int64, Maybe UTCTime)
uncurryTextRevisionRef :: TextRevisionRef -> (Int64, Int64, Maybe Int64, Maybe UTCTime)
uncurryTextRevisionRef (TextRevisionRef (TextElementRef DocumentID
docID TextElementID
textID) TextRevisionSelector
revision) =
    ( DocumentID -> Int64
unDocumentID DocumentID
docID
    , TextElementID -> Int64
unTextElementID TextElementID
textID
    , TextRevisionID -> Int64
unTextRevisionID (TextRevisionID -> Int64) -> Maybe TextRevisionID -> Maybe Int64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TextRevisionSelector -> Maybe TextRevisionID
specificTextRevision TextRevisionSelector
revision
    , TextRevisionSelector -> Maybe UTCTime
latestTextRevisionAsOf TextRevisionSelector
revision
    )

getTreeNode :: Statement Hash NodeHeader
getTreeNode :: Statement Hash NodeHeader
getTreeNode =
    (Hash -> ByteString)
-> Statement ByteString NodeHeader -> Statement Hash NodeHeader
forall a b c. (a -> b) -> Statement b c -> Statement a c
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap
        Hash -> ByteString
unHash
        (Statement ByteString NodeHeader -> Statement Hash NodeHeader)
-> Statement ByteString NodeHeader -> Statement Hash NodeHeader
forall a b. (a -> b) -> a -> b
$ ((Text, Text, Maybe Text) -> NodeHeader)
-> Statement ByteString (Text, Text, Maybe Text)
-> Statement ByteString NodeHeader
forall b c a. (b -> c) -> Statement a b -> Statement a c
forall (p :: * -> * -> *) b c a.
Profunctor p =>
(b -> c) -> p a b -> p a c
rmap
            ((Text -> Text -> Maybe Text -> NodeHeader)
-> (Text, Text, Maybe Text) -> NodeHeader
forall a b. Curry a b => b -> a
uncurryN Text -> Text -> Maybe Text -> NodeHeader
NodeHeader)
            [singletonStatement|
            select
                kind :: text,
                type :: text,
                heading:: text?
            from
                doc_tree_nodes
            where
                hash = $1 :: bytea
        |]

putTreeNode :: Statement (Hash, NodeHeader) ()
putTreeNode :: Statement (Hash, NodeHeader) ()
putTreeNode =
    ((Hash, NodeHeader) -> (ByteString, Text, Text, Maybe Text))
-> Statement (ByteString, Text, Text, Maybe Text) ()
-> Statement (Hash, NodeHeader) ()
forall a b c. (a -> b) -> Statement b c -> Statement a c
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap
        ( \(Hash
hash, NodeHeader
header) ->
            ( Hash -> ByteString
unHash Hash
hash
            , NodeHeader -> Text
Tree.headerKind NodeHeader
header
            , NodeHeader -> Text
Tree.headerType NodeHeader
header
            , NodeHeader -> Maybe Text
Tree.heading NodeHeader
header
            )
        )
        [resultlessStatement|
            insert into doc_tree_nodes
                (hash, kind, type, heading)
            values
                ($1 :: bytea, $2 :: text, $3 :: text, $4 :: text?)
            on conflict do nothing
        |]

uncurryTreeEdge
    :: TreeEdge
    -> (ByteString, Int64, Maybe ByteString, Maybe Int64)
uncurryTreeEdge :: TreeEdge -> (ByteString, Int64, Maybe ByteString, Maybe Int64)
uncurryTreeEdge TreeEdge
edge =
    ( Hash -> ByteString
unHash (TreeEdge -> Hash
TreeEdge.parentHash TreeEdge
edge)
    , TreeEdge -> Int64
TreeEdge.position TreeEdge
edge
    , Maybe ByteString
childNode
    , Maybe Int64
childTextElement
    )
  where
    childNode :: Maybe ByteString
childNode = case TreeEdge -> TreeEdgeChildRef
TreeEdge.child TreeEdge
edge of
        (TreeEdgeRefToNode Hash
hash) -> ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ Hash -> ByteString
unHash Hash
hash
        (TreeEdgeRefToTextElement TextElementID
_) -> Maybe ByteString
forall a. Maybe a
Nothing
    childTextElement :: Maybe Int64
childTextElement = case TreeEdge -> TreeEdgeChildRef
TreeEdge.child TreeEdge
edge of
        (TreeEdgeRefToTextElement TextElementID
textID) -> Int64 -> Maybe Int64
forall a. a -> Maybe a
Just (Int64 -> Maybe Int64) -> Int64 -> Maybe Int64
forall a b. (a -> b) -> a -> b
$ TextElementID -> Int64
unTextElementID TextElementID
textID
        (TreeEdgeRefToNode Hash
_) -> Maybe Int64
forall a. Maybe a
Nothing

putTreeEdge :: Statement TreeEdge ()
putTreeEdge :: Statement TreeEdge ()
putTreeEdge =
    (TreeEdge -> (ByteString, Int64, Maybe ByteString, Maybe Int64))
-> Statement (ByteString, Int64, Maybe ByteString, Maybe Int64) ()
-> Statement TreeEdge ()
forall a b c. (a -> b) -> Statement b c -> Statement a c
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap
        TreeEdge -> (ByteString, Int64, Maybe ByteString, Maybe Int64)
uncurryTreeEdge
        [resultlessStatement|
            insert into doc_tree_edges
                ( parent
                , position
                , child_node
                , child_text_element
                )
            values
                ( $1 :: bytea
                , $2 :: int8
                , $3 :: bytea?
                , $4 :: int8?
                )
            on conflict (parent, position) do nothing
        |]

uncurryTreeEdgeChild
    :: ( Maybe ByteString
       , Maybe Text
       , Maybe Text
       , Maybe Text
       , Maybe Int64
       , Maybe Text
       , Maybe Text
       )
    -> Maybe TreeEdgeChild
uncurryTreeEdgeChild :: (Maybe ByteString, Maybe Text, Maybe Text, Maybe Text, Maybe Int64,
 Maybe Text, Maybe Text)
-> Maybe TreeEdgeChild
uncurryTreeEdgeChild (Maybe ByteString
nodeHash, Maybe Text
nodeKind, Maybe Text
nodeType, Maybe Text
nodeHeading, Maybe Int64
textID, Maybe Text
textKind, Maybe Text
textType) =
    Maybe TreeEdgeChild
maybeNode Maybe TreeEdgeChild -> Maybe TreeEdgeChild -> Maybe TreeEdgeChild
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe TreeEdgeChild
maybeText
  where
    maybeNode :: Maybe TreeEdgeChild
maybeNode = do
        ByteString
hash <- Maybe ByteString
nodeHash
        Text
kind <- Maybe Text
nodeKind
        Text
type_ <- Maybe Text
nodeType
        TreeEdgeChild -> Maybe TreeEdgeChild
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (TreeEdgeChild -> Maybe TreeEdgeChild)
-> TreeEdgeChild -> Maybe TreeEdgeChild
forall a b. (a -> b) -> a -> b
$
            Hash -> NodeHeader -> TreeEdgeChild
TreeEdgeToNode
                (ByteString -> Hash
Hash ByteString
hash)
                NodeHeader
                    { headerKind :: Text
Tree.headerKind = Text
kind
                    , headerType :: Text
Tree.headerType = Text
type_
                    , heading :: Maybe Text
Tree.heading = Maybe Text
nodeHeading
                    }
    maybeText :: Maybe TreeEdgeChild
maybeText = do
        Int64
id_ <- Maybe Int64
textID
        Text
kind <- Maybe Text
textKind
        Text
type_ <- Maybe Text
textType
        TreeEdgeChild -> Maybe TreeEdgeChild
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (TreeEdgeChild -> Maybe TreeEdgeChild)
-> TreeEdgeChild -> Maybe TreeEdgeChild
forall a b. (a -> b) -> a -> b
$
            TextElement -> TreeEdgeChild
TreeEdgeToTextElement
                TextElement
                    { identifier :: TextElementID
TextElement.identifier = Int64 -> TextElementID
TextElementID Int64
id_
                    , textElementKind :: Text
TextElement.textElementKind = Text
kind
                    , textElementType :: Text
TextElement.textElementType = Text
type_
                    }

getTreeEdgesByParent :: Statement Hash (Vector TreeEdgeChild)
getTreeEdgesByParent :: Statement Hash (Vector TreeEdgeChild)
getTreeEdgesByParent =
    (Hash -> ByteString)
-> Statement ByteString (Vector TreeEdgeChild)
-> Statement Hash (Vector TreeEdgeChild)
forall a b c. (a -> b) -> Statement b c -> Statement a c
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap
        Hash -> ByteString
unHash
        (Statement ByteString (Vector TreeEdgeChild)
 -> Statement Hash (Vector TreeEdgeChild))
-> Statement ByteString (Vector TreeEdgeChild)
-> Statement Hash (Vector TreeEdgeChild)
forall a b. (a -> b) -> a -> b
$ (Vector
   (Maybe ByteString, Maybe Text, Maybe Text, Maybe Text, Maybe Int64,
    Maybe Text, Maybe Text)
 -> Vector TreeEdgeChild)
-> Statement
     ByteString
     (Vector
        (Maybe ByteString, Maybe Text, Maybe Text, Maybe Text, Maybe Int64,
         Maybe Text, Maybe Text))
-> Statement ByteString (Vector TreeEdgeChild)
forall b c a. (b -> c) -> Statement a b -> Statement a c
forall (p :: * -> * -> *) b c a.
Profunctor p =>
(b -> c) -> p a b -> p a c
rmap
            (((Maybe ByteString, Maybe Text, Maybe Text, Maybe Text,
  Maybe Int64, Maybe Text, Maybe Text)
 -> Maybe TreeEdgeChild)
-> Vector
     (Maybe ByteString, Maybe Text, Maybe Text, Maybe Text, Maybe Int64,
      Maybe Text, Maybe Text)
-> Vector TreeEdgeChild
forall a b. (a -> Maybe b) -> Vector a -> Vector b
mapMaybe (Maybe ByteString, Maybe Text, Maybe Text, Maybe Text, Maybe Int64,
 Maybe Text, Maybe Text)
-> Maybe TreeEdgeChild
uncurryTreeEdgeChild)
            [vectorStatement|
                select
                    n.hash :: bytea?,
                    n.kind :: text?,
                    n.type :: text?,
                    n.heading :: text?,
                    t.id :: int8?,
                    t.kind :: text?,
                    t.type :: text?
                from
                    doc_tree_edges e
                    left join doc_tree_nodes n on e.child_node = n.hash
                    left join doc_text_elements t on e.child_text_element = t.id
                where
                    e.parent = $1 :: bytea
                order by
                    e.position ASC
            |]

uncurryTreeRevisionHeader
    :: (Int64, UTCTime, UserID, Text) -> TreeRevisionHeader
uncurryTreeRevisionHeader :: (Int64, UTCTime, UUID, Text) -> TreeRevisionHeader
uncurryTreeRevisionHeader (Int64
id_, UTCTime
timestamp, UUID
authorID, Text
authorName) =
    TreeRevisionHeader
        { identifier :: TreeRevisionID
TreeRevision.identifier = Int64 -> TreeRevisionID
TreeRevisionID Int64
id_
        , timestamp :: UTCTime
TreeRevision.timestamp = UTCTime
timestamp
        , author :: UserRef
TreeRevision.author =
            UserRef
                { identifier :: UUID
UserRef.identifier = UUID
authorID
                , name :: Text
UserRef.name = Text
authorName
                }
        }

uncurryTreeRevision
    :: (Int64, UTCTime, UserID, Text) -> Node a -> TreeRevision a
uncurryTreeRevision :: forall a. (Int64, UTCTime, UUID, Text) -> Node a -> TreeRevision a
uncurryTreeRevision = TreeRevisionHeader -> Node a -> TreeRevision a
forall a. TreeRevisionHeader -> Node a -> TreeRevision a
TreeRevision (TreeRevisionHeader -> Node a -> TreeRevision a)
-> ((Int64, UTCTime, UUID, Text) -> TreeRevisionHeader)
-> (Int64, UTCTime, UUID, Text)
-> Node a
-> TreeRevision a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int64, UTCTime, UUID, Text) -> TreeRevisionHeader
uncurryTreeRevisionHeader

uncurryTreeRevisionWithRoot
    :: (Int64, UTCTime, UserID, Text, ByteString)
    -> (Hash, Node a -> TreeRevision a)
uncurryTreeRevisionWithRoot :: forall a.
(Int64, UTCTime, UUID, Text, ByteString)
-> (Hash, Node a -> TreeRevision a)
uncurryTreeRevisionWithRoot (Int64
id_, UTCTime
ts, UUID
authorID, Text
authorName, ByteString
root) =
    (ByteString -> Hash
Hash ByteString
root, (Int64, UTCTime, UUID, Text) -> Node a -> TreeRevision a
forall a. (Int64, UTCTime, UUID, Text) -> Node a -> TreeRevision a
uncurryTreeRevision (Int64
id_, UTCTime
ts, UUID
authorID, Text
authorName))

putTreeRevision
    :: Statement (DocumentID, UserID, Hash) (Node a -> TreeRevision a)
putTreeRevision :: forall a.
Statement (DocumentID, UUID, Hash) (Node a -> TreeRevision a)
putTreeRevision =
    ((DocumentID, UUID, Hash) -> (Int64, UUID, ByteString))
-> Statement (Int64, UUID, ByteString) (Node a -> TreeRevision a)
-> Statement (DocumentID, UUID, Hash) (Node a -> TreeRevision a)
forall a b c. (a -> b) -> Statement b c -> Statement a c
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap
        (DocumentID, UUID, Hash) -> (Int64, UUID, ByteString)
forall {b}. (DocumentID, b, Hash) -> (Int64, b, ByteString)
mapInput
        (Statement (Int64, UUID, ByteString) (Node a -> TreeRevision a)
 -> Statement (DocumentID, UUID, Hash) (Node a -> TreeRevision a))
-> Statement (Int64, UUID, ByteString) (Node a -> TreeRevision a)
-> Statement (DocumentID, UUID, Hash) (Node a -> TreeRevision a)
forall a b. (a -> b) -> a -> b
$ ((Int64, UTCTime, UUID, Text) -> Node a -> TreeRevision a)
-> Statement (Int64, UUID, ByteString) (Int64, UTCTime, UUID, Text)
-> Statement (Int64, UUID, ByteString) (Node a -> TreeRevision a)
forall b c a. (b -> c) -> Statement a b -> Statement a c
forall (p :: * -> * -> *) b c a.
Profunctor p =>
(b -> c) -> p a b -> p a c
rmap
            (Int64, UTCTime, UUID, Text) -> Node a -> TreeRevision a
forall a. (Int64, UTCTime, UUID, Text) -> Node a -> TreeRevision a
uncurryTreeRevision
            [singletonStatement|
                WITH inserted AS (
                    insert into doc_tree_revisions
                        (document, author, root)
                    values
                        ($1 :: int8, $2 :: uuid, $3 :: bytea)
                    returning
                        id :: int8,
                        creation_ts :: timestamptz,
                        author :: uuid
                )
                SELECT
                    inserted.id :: int8,
                    inserted.creation_ts :: timestamptz,
                    inserted.author :: uuid,
                    users.name :: text
                FROM
                    inserted
                    JOIN users ON users.id = inserted.author
            |]
  where
    mapInput :: (DocumentID, b, Hash) -> (Int64, b, ByteString)
mapInput (DocumentID
docID, b
userID, Hash
rootHash) =
        (DocumentID -> Int64
unDocumentID DocumentID
docID, b
userID, Hash -> ByteString
unHash Hash
rootHash)

getTreeRevision
    :: Statement TreeRevisionRef (Maybe (Hash, Node a -> TreeRevision a))
getTreeRevision :: forall a.
Statement TreeRevisionRef (Maybe (Hash, Node a -> TreeRevision a))
getTreeRevision =
    (TreeRevisionRef -> (Int64, Maybe Int64, Maybe UTCTime))
-> Statement
     (Int64, Maybe Int64, Maybe UTCTime)
     (Maybe (Hash, Node a -> TreeRevision a))
-> Statement
     TreeRevisionRef (Maybe (Hash, Node a -> TreeRevision a))
forall a b c. (a -> b) -> Statement b c -> Statement a c
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap
        TreeRevisionRef -> (Int64, Maybe Int64, Maybe UTCTime)
uncurryTreeRevisionRef
        (Statement
   (Int64, Maybe Int64, Maybe UTCTime)
   (Maybe (Hash, Node a -> TreeRevision a))
 -> Statement
      TreeRevisionRef (Maybe (Hash, Node a -> TreeRevision a)))
-> Statement
     (Int64, Maybe Int64, Maybe UTCTime)
     (Maybe (Hash, Node a -> TreeRevision a))
-> Statement
     TreeRevisionRef (Maybe (Hash, Node a -> TreeRevision a))
forall a b. (a -> b) -> a -> b
$ (Maybe (Int64, UTCTime, UUID, Text, ByteString)
 -> Maybe (Hash, Node a -> TreeRevision a))
-> Statement
     (Int64, Maybe Int64, Maybe UTCTime)
     (Maybe (Int64, UTCTime, UUID, Text, ByteString))
-> Statement
     (Int64, Maybe Int64, Maybe UTCTime)
     (Maybe (Hash, Node a -> TreeRevision a))
forall b c a. (b -> c) -> Statement a b -> Statement a c
forall (p :: * -> * -> *) b c a.
Profunctor p =>
(b -> c) -> p a b -> p a c
rmap
            ((Int64, UTCTime, UUID, Text, ByteString)
-> (Hash, Node a -> TreeRevision a)
forall a.
(Int64, UTCTime, UUID, Text, ByteString)
-> (Hash, Node a -> TreeRevision a)
uncurryTreeRevisionWithRoot ((Int64, UTCTime, UUID, Text, ByteString)
 -> (Hash, Node a -> TreeRevision a))
-> Maybe (Int64, UTCTime, UUID, Text, ByteString)
-> Maybe (Hash, Node a -> TreeRevision a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>)
            [maybeStatement|
                select
                    tr.id :: int8,
                    tr.creation_ts :: timestamptz,
                    tr.author :: uuid,
                    u.name :: text,
                    tr.root :: bytea
                from
                    doc_tree_revisions tr
                    join users u on tr.author = u.id
                where
                    tr.document = $1 :: int8
                    and ($2 :: int8? is null or tr.id = $2 :: int8?)
                    and ($3 :: timestamptz? is null or tr.creation_ts <= $3 :: timestamptz?)
                order by
                    tr.creation_ts desc
                limit 1
            |]

uncurryTreeRevisionRef :: TreeRevisionRef -> (Int64, Maybe Int64, Maybe UTCTime)
uncurryTreeRevisionRef :: TreeRevisionRef -> (Int64, Maybe Int64, Maybe UTCTime)
uncurryTreeRevisionRef (TreeRevisionRef DocumentID
docID TreeRevisionSelector
selector) =
    ( DocumentID -> Int64
unDocumentID DocumentID
docID
    , TreeRevisionID -> Int64
unTreeRevisionID (TreeRevisionID -> Int64) -> Maybe TreeRevisionID -> Maybe Int64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TreeRevisionSelector -> Maybe TreeRevisionID
specificTreeRevision TreeRevisionSelector
selector
    , TreeRevisionSelector -> Maybe UTCTime
latestTreeRevisionAsOf TreeRevisionSelector
selector
    )

getTreeRevisionHistory
    :: Statement (DocumentID, Maybe UTCTime, Int64) (Vector TreeRevisionHeader)
getTreeRevisionHistory :: Statement
  (DocumentID, Maybe UTCTime, Int64) (Vector TreeRevisionHeader)
getTreeRevisionHistory =
    ((DocumentID, Maybe UTCTime, Int64)
 -> (Int64, Maybe UTCTime, Int64))
-> Statement
     (Int64, Maybe UTCTime, Int64) (Vector TreeRevisionHeader)
-> Statement
     (DocumentID, Maybe UTCTime, Int64) (Vector TreeRevisionHeader)
forall a b c. (a -> b) -> Statement b c -> Statement a c
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap
        (DocumentID, Maybe UTCTime, Int64) -> (Int64, Maybe UTCTime, Int64)
forall {b} {c}. (DocumentID, b, c) -> (Int64, b, c)
mapInput
        (Statement
   (Int64, Maybe UTCTime, Int64) (Vector TreeRevisionHeader)
 -> Statement
      (DocumentID, Maybe UTCTime, Int64) (Vector TreeRevisionHeader))
-> Statement
     (Int64, Maybe UTCTime, Int64) (Vector TreeRevisionHeader)
-> Statement
     (DocumentID, Maybe UTCTime, Int64) (Vector TreeRevisionHeader)
forall a b. (a -> b) -> a -> b
$ (Vector (Int64, UTCTime, UUID, Text) -> Vector TreeRevisionHeader)
-> Statement
     (Int64, Maybe UTCTime, Int64) (Vector (Int64, UTCTime, UUID, Text))
-> Statement
     (Int64, Maybe UTCTime, Int64) (Vector TreeRevisionHeader)
forall b c a. (b -> c) -> Statement a b -> Statement a c
forall (p :: * -> * -> *) b c a.
Profunctor p =>
(b -> c) -> p a b -> p a c
rmap
            ((Int64, UTCTime, UUID, Text) -> TreeRevisionHeader
uncurryTreeRevisionHeader ((Int64, UTCTime, UUID, Text) -> TreeRevisionHeader)
-> Vector (Int64, UTCTime, UUID, Text) -> Vector TreeRevisionHeader
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>)
            [vectorStatement|
                SELECT
                    tr.id :: int8,
                    tr.creation_ts :: TIMESTAMPTZ,
                    tr.author :: UUID,
                    u.name :: TEXT
                FROM
                    doc_tree_revisions tr
                    JOIN users u on tr.author = u.id
                WHERE
                    tr.document = $1 :: int8
                    AND tr.creation_ts < COALESCE($2 :: TIMESTAMPTZ?, NOW())
                ORDER BY
                    tr.creation_ts DESC
                LIMIT
                    $3 :: int8
            |]
  where
    mapInput :: (DocumentID, b, c) -> (Int64, b, c)
mapInput (DocumentID
docID, b
time, c
limit) = (DocumentID -> Int64
unDocumentID DocumentID
docID, b
time, c
limit)

getTextElementIDsForDocument :: Statement DocumentID (Vector TextElementID)
getTextElementIDsForDocument :: Statement DocumentID (Vector TextElementID)
getTextElementIDsForDocument =
    (DocumentID -> Int64)
-> Statement Int64 (Vector TextElementID)
-> Statement DocumentID (Vector TextElementID)
forall a b c. (a -> b) -> Statement b c -> Statement a c
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap DocumentID -> Int64
unDocumentID (Statement Int64 (Vector TextElementID)
 -> Statement DocumentID (Vector TextElementID))
-> Statement Int64 (Vector TextElementID)
-> Statement DocumentID (Vector TextElementID)
forall a b. (a -> b) -> a -> b
$
        (Vector Int64 -> Vector TextElementID)
-> Statement Int64 (Vector Int64)
-> Statement Int64 (Vector TextElementID)
forall b c a. (b -> c) -> Statement a b -> Statement a c
forall (p :: * -> * -> *) b c a.
Profunctor p =>
(b -> c) -> p a b -> p a c
rmap
            (Int64 -> TextElementID
TextElementID (Int64 -> TextElementID) -> Vector Int64 -> Vector TextElementID
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>)
            [vectorStatement|
                select
                    id :: int8
                from
                    doc_text_elements
                where
                    document = $1 :: int8
            |]

uncurryHistoryItem
    :: (Maybe Int64, Int64, UTCTime, UserID, Text) -> DocumentHistoryItem
uncurryHistoryItem :: (Maybe Int64, Int64, UTCTime, UUID, Text) -> DocumentHistoryItem
uncurryHistoryItem (Maybe Int64
textID, Int64
revID, UTCTime
ts, UUID
authorID, Text
authorName) =
    case Maybe Int64
textID of
        Just Int64
id_ ->
            TextElementID -> TextRevisionHeader -> DocumentHistoryItem
DocumentHistory.Text
                (Int64 -> TextElementID
TextElementID Int64
id_)
                TextRevisionHeader
                    { identifier :: TextRevisionID
TextRevision.identifier = Int64 -> TextRevisionID
TextRevisionID Int64
revID
                    , timestamp :: UTCTime
TextRevision.timestamp = UTCTime
ts
                    , author :: UserRef
TextRevision.author =
                        UserRef
                            { identifier :: UUID
UserRef.identifier = UUID
authorID
                            , name :: Text
UserRef.name = Text
authorName
                            }
                    }
        Maybe Int64
Nothing ->
            TreeRevisionHeader -> DocumentHistoryItem
DocumentHistory.Tree
                TreeRevisionHeader
                    { identifier :: TreeRevisionID
TreeRevision.identifier = Int64 -> TreeRevisionID
TreeRevisionID Int64
revID
                    , timestamp :: UTCTime
TreeRevision.timestamp = UTCTime
ts
                    , author :: UserRef
TreeRevision.author =
                        UserRef
                            { identifier :: UUID
UserRef.identifier = UUID
authorID
                            , name :: Text
UserRef.name = Text
authorName
                            }
                    }

getDocumentRevisionHistory
    :: Statement (DocumentID, Maybe UTCTime, Int64) (Vector DocumentHistoryItem)
getDocumentRevisionHistory :: Statement
  (DocumentID, Maybe UTCTime, Int64) (Vector DocumentHistoryItem)
getDocumentRevisionHistory =
    ((DocumentID, Maybe UTCTime, Int64)
 -> (Int64, Maybe UTCTime, Int64))
-> Statement
     (Int64, Maybe UTCTime, Int64) (Vector DocumentHistoryItem)
-> Statement
     (DocumentID, Maybe UTCTime, Int64) (Vector DocumentHistoryItem)
forall a b c. (a -> b) -> Statement b c -> Statement a c
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap
        (DocumentID, Maybe UTCTime, Int64) -> (Int64, Maybe UTCTime, Int64)
forall {b} {c}. (DocumentID, b, c) -> (Int64, b, c)
mapInput
        (Statement
   (Int64, Maybe UTCTime, Int64) (Vector DocumentHistoryItem)
 -> Statement
      (DocumentID, Maybe UTCTime, Int64) (Vector DocumentHistoryItem))
-> Statement
     (Int64, Maybe UTCTime, Int64) (Vector DocumentHistoryItem)
-> Statement
     (DocumentID, Maybe UTCTime, Int64) (Vector DocumentHistoryItem)
forall a b. (a -> b) -> a -> b
$ (Vector (Maybe Int64, Int64, UTCTime, UUID, Text)
 -> Vector DocumentHistoryItem)
-> Statement
     (Int64, Maybe UTCTime, Int64)
     (Vector (Maybe Int64, Int64, UTCTime, UUID, Text))
-> Statement
     (Int64, Maybe UTCTime, Int64) (Vector DocumentHistoryItem)
forall b c a. (b -> c) -> Statement a b -> Statement a c
forall (p :: * -> * -> *) b c a.
Profunctor p =>
(b -> c) -> p a b -> p a c
rmap
            ((Maybe Int64, Int64, UTCTime, UUID, Text) -> DocumentHistoryItem
uncurryHistoryItem ((Maybe Int64, Int64, UTCTime, UUID, Text) -> DocumentHistoryItem)
-> Vector (Maybe Int64, Int64, UTCTime, UUID, Text)
-> Vector DocumentHistoryItem
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>)
            [vectorStatement|
                SELECT
                    dr.text_element :: int8?,
                    dr.id :: int8,
                    dr.creation_ts :: TIMESTAMPTZ,
                    dr.author :: UUID,
                    u.name :: TEXT
                FROM
                    doc_revisions dr
                    JOIN users u ON dr.author = u.id
                WHERE
                    dr.document = $1 :: int8
                    AND dr.creation_ts < COALESCE($2 :: TIMESTAMPTZ?, NOW())
                ORDER BY
                    dr.creation_ts DESC
                LIMIT
                    $3 :: int8
            |]
  where
    mapInput :: (DocumentID, b, c) -> (Int64, b, c)
mapInput (DocumentID
docID, b
time, c
limit) = (DocumentID -> Int64
unDocumentID DocumentID
docID, b
time, c
limit)

uncurryRevisionKey :: (UTCTime, Int64, Maybe Int64, Int64) -> RevisionKey
uncurryRevisionKey :: (UTCTime, Int64, Maybe Int64, Int64) -> RevisionKey
uncurryRevisionKey (UTCTime
timestamp, Int64
docID, Maybe Int64
maybeTextID, Int64
revID) =
    RevisionKey
        { timestamp :: UTCTime
Revision.timestamp = UTCTime
timestamp
        , revision :: TextOrTree
Revision.revision = TextOrTree -> (Int64 -> TextOrTree) -> Maybe Int64 -> TextOrTree
forall b a. b -> (a -> b) -> Maybe a -> b
maybe TextOrTree
tree Int64 -> TextOrTree
text Maybe Int64
maybeTextID
        }
  where
    tree :: TextOrTree
tree =
        TreeRevisionRef -> TextOrTree
Revision.Tree (TreeRevisionRef -> TextOrTree) -> TreeRevisionRef -> TextOrTree
forall a b. (a -> b) -> a -> b
$
            DocumentID -> TreeRevisionSelector -> TreeRevisionRef
TreeRevisionRef (Int64 -> DocumentID
DocumentID Int64
docID) (TreeRevisionSelector -> TreeRevisionRef)
-> TreeRevisionSelector -> TreeRevisionRef
forall a b. (a -> b) -> a -> b
$
                TreeRevisionID -> TreeRevisionSelector
TreeRevision.Specific (TreeRevisionID -> TreeRevisionSelector)
-> TreeRevisionID -> TreeRevisionSelector
forall a b. (a -> b) -> a -> b
$
                    Int64 -> TreeRevisionID
TreeRevisionID Int64
revID
    text :: Int64 -> TextOrTree
text Int64
textID =
        TextRevisionRef -> TextOrTree
Revision.Text (TextRevisionRef -> TextOrTree) -> TextRevisionRef -> TextOrTree
forall a b. (a -> b) -> a -> b
$
            TextElementRef -> TextRevisionSelector -> TextRevisionRef
TextRevisionRef (DocumentID -> TextElementID -> TextElementRef
TextElementRef (Int64 -> DocumentID
DocumentID Int64
docID) (Int64 -> TextElementID
TextElementID Int64
textID)) (TextRevisionSelector -> TextRevisionRef)
-> TextRevisionSelector -> TextRevisionRef
forall a b. (a -> b) -> a -> b
$
                TextRevisionID -> TextRevisionSelector
TextRevision.Specific (TextRevisionID -> TextRevisionSelector)
-> TextRevisionID -> TextRevisionSelector
forall a b. (a -> b) -> a -> b
$
                    Int64 -> TextRevisionID
TextRevisionID Int64
revID

getRevisionKey
    :: Statement
        (DocumentID, RevisionSelector)
        (Maybe RevisionKey)
getRevisionKey :: Statement (DocumentID, RevisionSelector) (Maybe RevisionKey)
getRevisionKey =
    ((DocumentID, RevisionSelector)
 -> (Int64, Maybe Int64, Maybe UTCTime))
-> Statement
     (Int64, Maybe Int64, Maybe UTCTime) (Maybe RevisionKey)
-> Statement (DocumentID, RevisionSelector) (Maybe RevisionKey)
forall a b c. (a -> b) -> Statement b c -> Statement a c
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap (DocumentID, RevisionSelector)
-> (Int64, Maybe Int64, Maybe UTCTime)
mapInput (Statement (Int64, Maybe Int64, Maybe UTCTime) (Maybe RevisionKey)
 -> Statement (DocumentID, RevisionSelector) (Maybe RevisionKey))
-> Statement
     (Int64, Maybe Int64, Maybe UTCTime) (Maybe RevisionKey)
-> Statement (DocumentID, RevisionSelector) (Maybe RevisionKey)
forall a b. (a -> b) -> a -> b
$
        (Maybe (UTCTime, Int64, Maybe Int64, Int64) -> Maybe RevisionKey)
-> Statement
     (Int64, Maybe Int64, Maybe UTCTime)
     (Maybe (UTCTime, Int64, Maybe Int64, Int64))
-> Statement
     (Int64, Maybe Int64, Maybe UTCTime) (Maybe RevisionKey)
forall b c a. (b -> c) -> Statement a b -> Statement a c
forall (p :: * -> * -> *) b c a.
Profunctor p =>
(b -> c) -> p a b -> p a c
rmap
            ((UTCTime, Int64, Maybe Int64, Int64) -> RevisionKey
uncurryRevisionKey ((UTCTime, Int64, Maybe Int64, Int64) -> RevisionKey)
-> Maybe (UTCTime, Int64, Maybe Int64, Int64) -> Maybe RevisionKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>)
            [maybeStatement|
                SELECT
                    creation_ts :: TIMESTAMPTZ,
                    document :: int8,
                    text_element :: int8?,
                    id :: int8
                FROM
                    doc_revisions
                WHERE
                    document = $1 :: int8
                    AND ($2 :: int8? IS NULL OR id = $2 :: int8?)
                    AND ($3 :: timestamptz? IS NULL OR creation_ts <= $3 :: timestamptz?)
                ORDER BY
                    creation_ts DESC
                LIMIT 1
        |]
  where
    mapInput :: (DocumentID, RevisionSelector)
-> (Int64, Maybe Int64, Maybe UTCTime)
mapInput (DocumentID
docID, RevisionSelector
selector) =
        ( DocumentID -> Int64
unDocumentID DocumentID
docID
        , RevisionID -> Int64
unRevisionID (RevisionID -> Int64) -> Maybe RevisionID -> Maybe Int64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RevisionSelector -> Maybe RevisionID
specificRevision RevisionSelector
selector
        , RevisionSelector -> Maybe UTCTime
latestRevisionAsOf RevisionSelector
selector
        )

-- Natürlich schreibe ich dir einen Kommentar, der sagt, dass hier das UserManagement beginnt!

hasPermission :: Statement (UserID, DocumentID, Permission) Bool
hasPermission :: Statement (UUID, DocumentID, Permission) Bool
hasPermission =
    ((UUID, DocumentID, Permission) -> (UUID, Int64, Text))
-> Statement (UUID, Int64, Text) Bool
-> Statement (UUID, DocumentID, Permission) Bool
forall a b c. (a -> b) -> Statement b c -> Statement a c
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap
        (UUID, DocumentID, Permission) -> (UUID, Int64, Text)
mapInput
        [singletonStatement|
            select exists (
                SELECT
                    1
                FROM
                    roles r
                JOIN
                    docs d ON d."group" = r.group_id
                    LEFT JOIN external_document_rights e ON e.user_id = r.user_id
                WHERE
                    r.user_id = $1 :: uuid
                    AND (
                        d.id = $2 :: int8
                        OR (e.document_id = $2 :: int8 AND e.permission >= ($3 :: text :: permission))
                    )
            ) :: bool
        |]
  where
    mapInput :: (UserID, DocumentID, Permission) -> (UUID, Int64, Text)
    mapInput :: (UUID, DocumentID, Permission) -> (UUID, Int64, Text)
mapInput (UUID
userID, DocumentID
docID, Permission
perms) =
        (UUID
userID, DocumentID -> Int64
unDocumentID DocumentID
docID, String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Permission -> String
forall a. Show a => a -> String
show Permission
perms)

isGroupAdmin :: Statement (UserID, GroupID) Bool
isGroupAdmin :: Statement (UUID, Int64) Bool
isGroupAdmin =
    [singletonStatement|
        select exists (
            SELECT
                1
            FROM
                roles
            WHERE
                user_id = $1 :: uuid AND group_id = $2 :: int8 AND role = 'admin'
        ) :: bool
    |]

-- comments

uncurryMessage :: (UUID, Text, UTCTime, Text) -> Message
uncurryMessage :: (UUID, Text, UTCTime, Text) -> Message
uncurryMessage (UUID
authorID, Text
authorName, UTCTime
timestamp, Text
content) =
    Message
        { author :: UserRef
Comment.author =
            UserRef
                { identifier :: UUID
UserRef.identifier = UUID
authorID
                , name :: Text
UserRef.name = Text
authorName
                }
        , timestamp :: UTCTime
Comment.timestamp = UTCTime
timestamp
        , content :: Text
Comment.content = Text
content
        }

uncurryComment
    :: (Int64, UUID, Text, UTCTime, Maybe UTCTime, Text)
    -> Comment
uncurryComment :: (Int64, UUID, Text, UTCTime, Maybe UTCTime, Text) -> Comment
uncurryComment (Int64
id_, UUID
authorID, Text
authorName, UTCTime
timestamp, Maybe UTCTime
resolved, Text
content) =
    Comment
        { identifier :: CommentID
Comment.identifier = Int64 -> CommentID
CommentID Int64
id_
        , status :: Status
Comment.status = Status -> (UTCTime -> Status) -> Maybe UTCTime -> Status
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Status
Comment.Open UTCTime -> Status
Comment.Resolved Maybe UTCTime
resolved
        , message :: Message
Comment.message = (UUID, Text, UTCTime, Text) -> Message
uncurryMessage (UUID
authorID, Text
authorName, UTCTime
timestamp, Text
content)
        , replies :: Vector Message
Comment.replies = Vector Message
forall a. Vector a
Vector.empty
        }

createComment :: Statement (UserID, TextElementID, Text) Comment
createComment :: Statement (UUID, TextElementID, Text) Comment
createComment =
    ((UUID, TextElementID, Text) -> (UUID, Int64, Text))
-> Statement (UUID, Int64, Text) Comment
-> Statement (UUID, TextElementID, Text) Comment
forall a b c. (a -> b) -> Statement b c -> Statement a c
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap
        (UUID, TextElementID, Text) -> (UUID, Int64, Text)
forall {a} {c}. (a, TextElementID, c) -> (a, Int64, c)
mapInput
        (Statement (UUID, Int64, Text) Comment
 -> Statement (UUID, TextElementID, Text) Comment)
-> Statement (UUID, Int64, Text) Comment
-> Statement (UUID, TextElementID, Text) Comment
forall a b. (a -> b) -> a -> b
$ ((Int64, UUID, Text, UTCTime, Maybe UTCTime, Text) -> Comment)
-> Statement
     (UUID, Int64, Text)
     (Int64, UUID, Text, UTCTime, Maybe UTCTime, Text)
-> Statement (UUID, Int64, Text) Comment
forall b c a. (b -> c) -> Statement a b -> Statement a c
forall (p :: * -> * -> *) b c a.
Profunctor p =>
(b -> c) -> p a b -> p a c
rmap
            (Int64, UUID, Text, UTCTime, Maybe UTCTime, Text) -> Comment
uncurryComment
            [singletonStatement|
                WITH inserted AS (
                    INSERT INTO doc_comments
                        (author, text_element, content)
                    VALUES
                        ($1 :: UUID, $2 :: INT8, $3 :: TEXT)
                    RETURNING
                        id :: INT8,
                        author :: UUID,
                        creation_ts :: TIMESTAMPTZ,
                        resolved_ts :: TIMESTAMPTZ?,
                        content :: TEXT
                )
                SELECT
                    inserted.id :: INT8,
                    users.id :: UUID,
                    users.name :: TEXT,
                    inserted.creation_ts :: TIMESTAMPTZ,
                    inserted.resolved_ts :: TIMESTAMPTZ?,
                    inserted.content :: TEXT
                FROM
                    inserted
                    LEFT JOIN users ON inserted.author = users.id
            |]
  where
    mapInput :: (a, TextElementID, c) -> (a, Int64, c)
mapInput (a
userID, TextElementID
textID, c
text) = (a
userID, TextElementID -> Int64
unTextElementID TextElementID
textID, c
text)

getComments :: Statement (DocumentID, TextElementID) (Vector Comment)
getComments :: Statement (DocumentID, TextElementID) (Vector Comment)
getComments =
    ((DocumentID, TextElementID) -> (Int64, Int64))
-> Statement (Int64, Int64) (Vector Comment)
-> Statement (DocumentID, TextElementID) (Vector Comment)
forall a b c. (a -> b) -> Statement b c -> Statement a c
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap ((DocumentID -> Int64)
-> (TextElementID -> Int64)
-> (DocumentID, TextElementID)
-> (Int64, Int64)
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap DocumentID -> Int64
unDocumentID TextElementID -> Int64
unTextElementID) (Statement (Int64, Int64) (Vector Comment)
 -> Statement (DocumentID, TextElementID) (Vector Comment))
-> Statement (Int64, Int64) (Vector Comment)
-> Statement (DocumentID, TextElementID) (Vector Comment)
forall a b. (a -> b) -> a -> b
$
        (Vector (Int64, UUID, Text, UTCTime, Maybe UTCTime, Text)
 -> Vector Comment)
-> Statement
     (Int64, Int64)
     (Vector (Int64, UUID, Text, UTCTime, Maybe UTCTime, Text))
-> Statement (Int64, Int64) (Vector Comment)
forall b c a. (b -> c) -> Statement a b -> Statement a c
forall (p :: * -> * -> *) b c a.
Profunctor p =>
(b -> c) -> p a b -> p a c
rmap
            ((Int64, UUID, Text, UTCTime, Maybe UTCTime, Text) -> Comment
uncurryComment ((Int64, UUID, Text, UTCTime, Maybe UTCTime, Text) -> Comment)
-> Vector (Int64, UUID, Text, UTCTime, Maybe UTCTime, Text)
-> Vector Comment
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>)
            [vectorStatement|
                SELECT
                    comments.id :: INT8,
                    users.id :: UUID,
                    users.name :: TEXT,
                    comments.creation_ts :: TIMESTAMPTZ,
                    comments.resolved_ts :: TIMESTAMPTZ?,
                    comments.content :: TEXT
                FROM
                    doc_comments comments
                    LEFT JOIN users ON comments.author = users.id
                    LEFT JOIN doc_text_elements
                        ON comments.text_element = doc_text_elements.id
                WHERE
                    comments.text_element = $2 :: INT8
                    AND doc_text_elements.document = $1 :: INT8
            |]

createReply :: Statement (UserID, CommentID, Text) Message
createReply :: Statement (UUID, CommentID, Text) Message
createReply =
    ((UUID, CommentID, Text) -> (UUID, Int64, Text))
-> Statement (UUID, Int64, Text) Message
-> Statement (UUID, CommentID, Text) Message
forall a b c. (a -> b) -> Statement b c -> Statement a c
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap (UUID, CommentID, Text) -> (UUID, Int64, Text)
forall {a} {c}. (a, CommentID, c) -> (a, Int64, c)
mapInput (Statement (UUID, Int64, Text) Message
 -> Statement (UUID, CommentID, Text) Message)
-> Statement (UUID, Int64, Text) Message
-> Statement (UUID, CommentID, Text) Message
forall a b. (a -> b) -> a -> b
$
        ((UUID, Text, UTCTime, Text) -> Message)
-> Statement (UUID, Int64, Text) (UUID, Text, UTCTime, Text)
-> Statement (UUID, Int64, Text) Message
forall b c a. (b -> c) -> Statement a b -> Statement a c
forall (p :: * -> * -> *) b c a.
Profunctor p =>
(b -> c) -> p a b -> p a c
rmap
            (UUID, Text, UTCTime, Text) -> Message
uncurryMessage
            [singletonStatement|
                WITH inserted AS (
                    INSERT INTO doc_comment_replies
                        (author, comment, content)
                    VALUES
                        ($1 :: UUID, $2 :: INT8, $3 :: TEXT)
                    RETURNING
                        author :: UUID,
                        creation_ts :: TIMESTAMPTZ,
                        content :: TEXT
                )
                SELECT
                    users.id :: UUID,
                    users.name :: TEXT,
                    inserted.creation_ts :: TIMESTAMPTZ,
                    inserted.content :: TEXT
                FROM
                    inserted
                    LEFT JOIN users ON inserted.author = users.id
            |]
  where
    mapInput :: (a, CommentID, c) -> (a, Int64, c)
mapInput (a
userID, CommentID
commentID, c
content) =
        ( a
userID
        , CommentID -> Int64
unCommentID CommentID
commentID
        , c
content
        )

getReplies :: Statement CommentRef (Vector Message)
getReplies :: Statement CommentRef (Vector Message)
getReplies =
    (CommentRef -> (Int64, Int64, Int64))
-> Statement (Int64, Int64, Int64) (Vector Message)
-> Statement CommentRef (Vector Message)
forall a b c. (a -> b) -> Statement b c -> Statement a c
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap CommentRef -> (Int64, Int64, Int64)
curryCommentRef (Statement (Int64, Int64, Int64) (Vector Message)
 -> Statement CommentRef (Vector Message))
-> Statement (Int64, Int64, Int64) (Vector Message)
-> Statement CommentRef (Vector Message)
forall a b. (a -> b) -> a -> b
$
        (Vector (UUID, Text, UTCTime, Text) -> Vector Message)
-> Statement
     (Int64, Int64, Int64) (Vector (UUID, Text, UTCTime, Text))
-> Statement (Int64, Int64, Int64) (Vector Message)
forall b c a. (b -> c) -> Statement a b -> Statement a c
forall (p :: * -> * -> *) b c a.
Profunctor p =>
(b -> c) -> p a b -> p a c
rmap
            ((UUID, Text, UTCTime, Text) -> Message
uncurryMessage ((UUID, Text, UTCTime, Text) -> Message)
-> Vector (UUID, Text, UTCTime, Text) -> Vector Message
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>)
            [vectorStatement|
                SELECT
                    users.id :: UUID,
                    users.name :: TEXT,
                    replies.creation_ts :: TIMESTAMPTZ,
                    replies.content :: TEXT
                FROM
                    doc_comment_replies replies
                    LEFT JOIN users ON replies.author = users.id
                    LEFT JOIN doc_comments comments ON replies.comment = comments.id
                    LEFT JOIN doc_text_elements text_elements ON comments.text_element = text_elements.id
                WHERE
                    text_elements.document = $1 :: INT8
                    AND comments.text_element = $2 :: INT8
                    AND replies.comment = $3 :: INT8
            |]

curryCommentRef :: CommentRef -> (Int64, Int64, Int64)
curryCommentRef :: CommentRef -> (Int64, Int64, Int64)
curryCommentRef (CommentRef (TextElementRef DocumentID
docID TextElementID
textID) CommentID
commentID) =
    (DocumentID -> Int64
unDocumentID DocumentID
docID, TextElementID -> Int64
unTextElementID TextElementID
textID, CommentID -> Int64
unCommentID CommentID
commentID)

resolveComment :: Statement CommentID ()
resolveComment :: Statement CommentID ()
resolveComment =
    (CommentID -> Int64)
-> Statement Int64 () -> Statement CommentID ()
forall a b c. (a -> b) -> Statement b c -> Statement a c
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap
        CommentID -> Int64
unCommentID
        [resultlessStatement|
        UPDATE
            doc_comments
        SET
            resolved_ts = now()
        WHERE
            id = $1 :: INT8
    |]

existsComment :: Statement CommentRef Bool
existsComment :: Statement CommentRef Bool
existsComment =
    (CommentRef -> (Int64, Int64, Int64))
-> Statement (Int64, Int64, Int64) Bool
-> Statement CommentRef Bool
forall a b c. (a -> b) -> Statement b c -> Statement a c
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap
        CommentRef -> (Int64, Int64, Int64)
mapInput
        [singletonStatement|
            SELECT EXISTS (
                SELECT
                    1
                FROM
                    doc_comments c
                    JOIN doc_text_elements te ON c.text_element = te.id
                WHERE
                    te.document = $1 :: int8
                    AND c.text_element = $2 :: int8
                    AND c.id = $3 :: int8
            ) :: bool
        |]
  where
    mapInput :: CommentRef -> (Int64, Int64, Int64)
mapInput (CommentRef (TextElementRef DocumentID
docID TextElementID
textID) CommentID
commentID) =
        (DocumentID -> Int64
unDocumentID DocumentID
docID, TextElementID -> Int64
unTextElementID TextElementID
textID, CommentID -> Int64
unCommentID CommentID
commentID)

uncurryCommentAnchor :: (Int64, Int64, Int64, Int64, Int64) -> CommentAnchor
uncurryCommentAnchor :: (Int64, Int64, Int64, Int64, Int64) -> CommentAnchor
uncurryCommentAnchor (Int64
comment, Int64
start_col, Int64
start_row, Int64
end_col, Int64
end_row) =
    let start :: Anchor
start = Int64 -> Int64 -> Anchor
Anchor Int64
start_col Int64
start_row
        end :: Anchor
end = Int64 -> Int64 -> Anchor
Anchor Int64
end_col Int64
end_row
     in CommentAnchor
            { comment :: CommentID
Comment.comment = Int64 -> CommentID
CommentID Int64
comment
            , anchor :: Range
Comment.anchor = Anchor -> Anchor -> Range
Comment.range Anchor
start Anchor
end
            }

putCommentAnchor :: Statement (TextRevisionID, CommentAnchor) CommentAnchor
putCommentAnchor :: Statement (TextRevisionID, CommentAnchor) CommentAnchor
putCommentAnchor =
    ((TextRevisionID, CommentAnchor)
 -> (Int64, Int64, Int64, Int64, Int64, Int64))
-> Statement
     (Int64, Int64, Int64, Int64, Int64, Int64) CommentAnchor
-> Statement (TextRevisionID, CommentAnchor) CommentAnchor
forall a b c. (a -> b) -> Statement b c -> Statement a c
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap
        (TextRevisionID, CommentAnchor)
-> (Int64, Int64, Int64, Int64, Int64, Int64)
mapInput
        (Statement (Int64, Int64, Int64, Int64, Int64, Int64) CommentAnchor
 -> Statement (TextRevisionID, CommentAnchor) CommentAnchor)
-> Statement
     (Int64, Int64, Int64, Int64, Int64, Int64) CommentAnchor
-> Statement (TextRevisionID, CommentAnchor) CommentAnchor
forall a b. (a -> b) -> a -> b
$ ((Int64, Int64, Int64, Int64, Int64) -> CommentAnchor)
-> Statement
     (Int64, Int64, Int64, Int64, Int64, Int64)
     (Int64, Int64, Int64, Int64, Int64)
-> Statement
     (Int64, Int64, Int64, Int64, Int64, Int64) CommentAnchor
forall b c a. (b -> c) -> Statement a b -> Statement a c
forall (p :: * -> * -> *) b c a.
Profunctor p =>
(b -> c) -> p a b -> p a c
rmap
            (Int64, Int64, Int64, Int64, Int64) -> CommentAnchor
uncurryCommentAnchor
            [singletonStatement|
                INSERT INTO doc_comment_anchors
                    (revision, comment, start_col, start_row, end_col, end_row)
                VALUES
                    ($1 :: INT8, $2 :: INT8, $3 :: INT8, $4 :: INT8, $5 :: INT8, $6 :: INT8)
                ON CONFLICT (comment, revision)
                DO UPDATE SET
                    start_col = EXCLUDED.start_col,
                    start_row = EXCLUDED.start_row,
                    end_col = EXCLUDED.end_col,
                    end_row = EXCLUDED.end_row
                RETURNING
                    comment :: INT8,
                    start_col :: INT8,
                    start_row :: INT8,
                    end_col :: INT8,
                    end_row :: INT8
            |]
  where
    mapInput :: (TextRevisionID, CommentAnchor)
-> (Int64, Int64, Int64, Int64, Int64, Int64)
mapInput (TextRevisionID
revID, CommentAnchor
anchor) =
        let range :: Range
range = CommentAnchor -> Range
Comment.anchor CommentAnchor
anchor
            start :: Anchor
start = Range -> Anchor
Comment.start Range
range
            end :: Anchor
end = Range -> Anchor
Comment.end Range
range
         in ( TextRevisionID -> Int64
unTextRevisionID TextRevisionID
revID
            , CommentID -> Int64
unCommentID (CommentID -> Int64) -> CommentID -> Int64
forall a b. (a -> b) -> a -> b
$ CommentAnchor -> CommentID
Comment.comment CommentAnchor
anchor
            , Anchor -> Int64
Comment.col Anchor
start
            , Anchor -> Int64
Comment.row Anchor
start
            , Anchor -> Int64
Comment.col Anchor
end
            , Anchor -> Int64
Comment.row Anchor
end
            )

getCommentAnchors :: Statement TextRevisionID (Vector CommentAnchor)
getCommentAnchors :: Statement TextRevisionID (Vector CommentAnchor)
getCommentAnchors =
    (TextRevisionID -> Int64)
-> Statement Int64 (Vector CommentAnchor)
-> Statement TextRevisionID (Vector CommentAnchor)
forall a b c. (a -> b) -> Statement b c -> Statement a c
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap TextRevisionID -> Int64
unTextRevisionID (Statement Int64 (Vector CommentAnchor)
 -> Statement TextRevisionID (Vector CommentAnchor))
-> Statement Int64 (Vector CommentAnchor)
-> Statement TextRevisionID (Vector CommentAnchor)
forall a b. (a -> b) -> a -> b
$
        (Vector (Int64, Int64, Int64, Int64, Int64)
 -> Vector CommentAnchor)
-> Statement Int64 (Vector (Int64, Int64, Int64, Int64, Int64))
-> Statement Int64 (Vector CommentAnchor)
forall b c a. (b -> c) -> Statement a b -> Statement a c
forall (p :: * -> * -> *) b c a.
Profunctor p =>
(b -> c) -> p a b -> p a c
rmap
            ((Int64, Int64, Int64, Int64, Int64) -> CommentAnchor
uncurryCommentAnchor ((Int64, Int64, Int64, Int64, Int64) -> CommentAnchor)
-> Vector (Int64, Int64, Int64, Int64, Int64)
-> Vector CommentAnchor
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>)
            [vectorStatement|
                SELECT
                    comment :: INT8,
                    start_col :: INT8,
                    start_row :: INT8,
                    end_col :: INT8,
                    end_row :: INT8
                FROM
                    doc_comment_anchors
                WHERE
                    revision = $1 :: INT8
                ORDER BY
                    comment, start_col, end_col
            |]

deleteCommentAnchorsExcept :: Statement (TextRevisionID, Vector CommentID) ()
deleteCommentAnchorsExcept :: Statement (TextRevisionID, Vector CommentID) ()
deleteCommentAnchorsExcept =
    ((TextRevisionID, Vector CommentID) -> (Int64, Vector Int64))
-> Statement (Int64, Vector Int64) ()
-> Statement (TextRevisionID, Vector CommentID) ()
forall a b c. (a -> b) -> Statement b c -> Statement a c
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap
        ((TextRevisionID -> Int64)
-> (Vector CommentID -> Vector Int64)
-> (TextRevisionID, Vector CommentID)
-> (Int64, Vector Int64)
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap TextRevisionID -> Int64
unTextRevisionID (CommentID -> Int64
unCommentID (CommentID -> Int64) -> Vector CommentID -> Vector Int64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>))
        [resultlessStatement|
            DELETE FROM
                doc_comment_anchors
            WHERE
                revision = $1 :: INT8
                AND (cardinality($2 :: INT8[]) = 0 OR comment <> ALL($2 :: INT8[]))
        |]

uncurryLogMessage
    :: (UUID, Text, UTCTime, Maybe UUID, Maybe Text, Text, Aeson.Value)
    -> LogMessage
uncurryLogMessage :: (UUID, Text, UTCTime, Maybe UUID, Maybe Text, Text, Value)
-> LogMessage
uncurryLogMessage (UUID
identifier, Text
severity, UTCTime
timestamp, Maybe UUID
userID, Maybe Text
userName, Text
scope, Value
content) =
    LogMessage
        { identifier :: UUID
Logs.identifier = UUID
identifier
        , severity :: Severity
Logs.severity = case Text
severity of
            Text
"info" -> Severity
Info
            Text
"warning" -> Severity
Warning
            Text
"error" -> Severity
Error
            Text
_ -> Severity
forall a. HasCallStack => a
undefined -- should be unreachable
        , timestamp :: UTCTime
Logs.timestamp = UTCTime
timestamp
        , source :: Source
Logs.source = Source -> (UserRef -> Source) -> Maybe UserRef -> Source
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Source
System UserRef -> Source
User (Maybe UserRef -> Source) -> Maybe UserRef -> Source
forall a b. (a -> b) -> a -> b
$ do
            UUID
id_ <- Maybe UUID
userID
            Text
name <- Maybe Text
userName
            UserRef -> Maybe UserRef
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return
                UserRef
                    { identifier :: UUID
UserRef.identifier = UUID
id_
                    , name :: Text
UserRef.name = Text
name
                    }
        , scope :: Scope
Logs.scope = Text -> Scope
Scope Text
scope
        , content :: Value
Logs.content = Value
content
        }

getLogs :: Statement (Maybe UTCTime, Int64) (Vector LogMessage)
getLogs :: Statement (Maybe UTCTime, Int64) (Vector LogMessage)
getLogs =
    (Vector (UUID, Text, UTCTime, Maybe UUID, Maybe Text, Text, Value)
 -> Vector LogMessage)
-> Statement
     (Maybe UTCTime, Int64)
     (Vector (UUID, Text, UTCTime, Maybe UUID, Maybe Text, Text, Value))
-> Statement (Maybe UTCTime, Int64) (Vector LogMessage)
forall b c a. (b -> c) -> Statement a b -> Statement a c
forall (p :: * -> * -> *) b c a.
Profunctor p =>
(b -> c) -> p a b -> p a c
rmap
        ((UUID, Text, UTCTime, Maybe UUID, Maybe Text, Text, Value)
-> LogMessage
uncurryLogMessage ((UUID, Text, UTCTime, Maybe UUID, Maybe Text, Text, Value)
 -> LogMessage)
-> Vector
     (UUID, Text, UTCTime, Maybe UUID, Maybe Text, Text, Value)
-> Vector LogMessage
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>)
        [vectorStatement|
            SELECT
                logs.id :: UUID,
                logs.severity :: TEXT,
                logs."timestamp" :: TIMESTAMPTZ,
                users.id :: UUID?,
                users.name :: TEXT?,
                logs.scope :: Text,
                logs.content :: JSONB
            FROM
                logs
                LEFT JOIN users ON logs.user = users.id
            WHERE
                logs."timestamp" < COALESCE($1 :: TIMESTAMPTZ?, now())
            ORDER BY
                logs."timestamp" DESC
            LIMIT
                $2 :: INT8
        |]

logMessage
    :: (ToJSON v)
    => Statement (Severity, Maybe UserID, Scope, v) LogMessage
logMessage :: forall v.
ToJSON v =>
Statement (Severity, Maybe UUID, Scope, v) LogMessage
logMessage =
    ((Severity, Maybe UUID, Scope, v)
 -> (Text, Maybe UUID, Text, Value))
-> Statement (Text, Maybe UUID, Text, Value) LogMessage
-> Statement (Severity, Maybe UUID, Scope, v) LogMessage
forall a b c. (a -> b) -> Statement b c -> Statement a c
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap (Severity, Maybe UUID, Scope, v) -> (Text, Maybe UUID, Text, Value)
forall {a} {a} {b}.
(IsString a, ToJSON a) =>
(Severity, b, Scope, a) -> (a, b, Text, Value)
mapInput (Statement (Text, Maybe UUID, Text, Value) LogMessage
 -> Statement (Severity, Maybe UUID, Scope, v) LogMessage)
-> Statement (Text, Maybe UUID, Text, Value) LogMessage
-> Statement (Severity, Maybe UUID, Scope, v) LogMessage
forall a b. (a -> b) -> a -> b
$
        ((UUID, Text, UTCTime, Maybe UUID, Maybe Text, Text, Value)
 -> LogMessage)
-> Statement
     (Text, Maybe UUID, Text, Value)
     (UUID, Text, UTCTime, Maybe UUID, Maybe Text, Text, Value)
-> Statement (Text, Maybe UUID, Text, Value) LogMessage
forall b c a. (b -> c) -> Statement a b -> Statement a c
forall (p :: * -> * -> *) b c a.
Profunctor p =>
(b -> c) -> p a b -> p a c
rmap
            (UUID, Text, UTCTime, Maybe UUID, Maybe Text, Text, Value)
-> LogMessage
uncurryLogMessage
            [singletonStatement|
            WITH inserted AS (
                INSERT INTO logs
                    (severity, "user", scope, content)
                VALUES
                    ($1 :: TEXT :: severity, $2 :: UUID?, $3 :: TEXT, $4 :: JSONB)
                RETURNING
                    id :: UUID,
                    "severity" :: TEXT,
                    "timestamp" :: TIMESTAMPTZ,
                    "user" :: UUID?,
                    scope :: Text,
                    content :: JSONB
            )
            SELECT
                inserted.id :: UUID,
                inserted.severity :: TEXT,
                inserted."timestamp" :: TIMESTAMPTZ,
                users.id :: UUID?,
                users.name :: TEXT?,
                inserted.scope :: TEXT,
                inserted.content :: JSONB
            FROM
                inserted
                LEFT JOIN users ON inserted.user = users.id
        |]
  where
    mapInput :: (Severity, b, Scope, a) -> (a, b, Text, Value)
mapInput (Severity
severity, b
source, Scope
scope, a
content) =
        ( case Severity
severity of
            Severity
Info -> a
"info"
            Severity
Warning -> a
"warning"
            Severity
Error -> a
"error"
        , b
source
        , Scope -> Text
unScope Scope
scope
        , a -> Value
forall a. ToJSON a => a -> Value
toJSON a
content
        )

updateLatestTitle :: Statement (TextElementID, Text) ()
updateLatestTitle :: Statement (TextElementID, Text) ()
updateLatestTitle =
    ((TextElementID, Text) -> (Int64, Text))
-> Statement (Int64, Text) () -> Statement (TextElementID, Text) ()
forall a b c. (a -> b) -> Statement b c -> Statement a c
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap
        ((TextElementID -> Int64) -> (TextElementID, Text) -> (Int64, Text)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first TextElementID -> Int64
unTextElementID)
        [resultlessStatement|
            UPDATE
                doc_tree_edges d
            SET
                title = $2::text
            WHERE
                d.ctid = (
                    SELECT
                        ctid
                    FROM
                        doc_tree_edges
                    WHERE
                        child_text_element = $1::bigint
                    ORDER BY
                        creation_ts DESC
                    LIMIT 1
                )
        |]

-- | Helper to construct DraftRevisionHeader from database row
uncurryDraftRevisionHeader
    :: (Int64, Int64, UTCTime, UTCTime, UUID, Text) -> DraftRevisionHeader
uncurryDraftRevisionHeader :: (Int64, Int64, UTCTime, UTCTime, UUID, Text) -> DraftRevisionHeader
uncurryDraftRevisionHeader (Int64
draftId, Int64
basedOnId, UTCTime
creationTs, UTCTime
updatedTs, UUID
authorID, Text
authorName) =
    DraftRevisionHeader
        { draftIdentifier :: DraftRevisionID
TextRevision.draftIdentifier = Int64 -> DraftRevisionID
DraftRevisionID Int64
draftId
        , basedOnRevision :: TextRevisionID
TextRevision.basedOnRevision = Int64 -> TextRevisionID
TextRevisionID Int64
basedOnId
        , creationTimestamp :: UTCTime
TextRevision.creationTimestamp = UTCTime
creationTs
        , lastUpdatedTimestamp :: UTCTime
TextRevision.lastUpdatedTimestamp = UTCTime
updatedTs
        , draftAuthor :: UserRef
TextRevision.draftAuthor =
            UserRef
                { identifier :: UUID
UserRef.identifier = UUID
authorID
                , name :: Text
UserRef.name = Text
authorName
                }
        }

-- | Helper to construct DraftRevision from database row
uncurryDraftRevision
    :: (Monad m)
    => (Int64, Int64, UTCTime, UTCTime, UUID, Text, Text)
    -> (DraftRevisionID -> m (Vector CommentAnchor))
    -> m DraftRevision
uncurryDraftRevision :: forall (m :: * -> *).
Monad m =>
(Int64, Int64, UTCTime, UTCTime, UUID, Text, Text)
-> (DraftRevisionID -> m (Vector CommentAnchor)) -> m DraftRevision
uncurryDraftRevision (Int64
draftId, Int64
basedOnId, UTCTime
creationTs, UTCTime
updatedTs, UUID
authorID, Text
authorName, Text
content) DraftRevisionID -> m (Vector CommentAnchor)
getAnchors =
    DraftRevisionID -> m (Vector CommentAnchor)
getAnchors (Int64 -> DraftRevisionID
DraftRevisionID Int64
draftId)
        m (Vector CommentAnchor)
-> (Vector CommentAnchor -> DraftRevision) -> m DraftRevision
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> DraftRevisionHeader
-> Text -> Vector CommentAnchor -> DraftRevision
DraftRevision
            ( (Int64, Int64, UTCTime, UTCTime, UUID, Text) -> DraftRevisionHeader
uncurryDraftRevisionHeader
                (Int64
draftId, Int64
basedOnId, UTCTime
creationTs, UTCTime
updatedTs, UUID
authorID, Text
authorName)
            )
            Text
content

-- | Create a new draft text revision
createDraftTextRevision
    :: (Monad m)
    => Statement
        (TextElementID, TextRevisionID, UUID, Text)
        ((DraftRevisionID -> m (Vector CommentAnchor)) -> m DraftRevision)
createDraftTextRevision :: forall (m :: * -> *).
Monad m =>
Statement
  (TextElementID, TextRevisionID, UUID, Text)
  ((DraftRevisionID -> m (Vector CommentAnchor)) -> m DraftRevision)
createDraftTextRevision =
    ((TextElementID, TextRevisionID, UUID, Text)
 -> (Int64, Int64, UUID, Text))
-> Statement
     (Int64, Int64, UUID, Text)
     ((DraftRevisionID -> m (Vector CommentAnchor)) -> m DraftRevision)
-> Statement
     (TextElementID, TextRevisionID, UUID, Text)
     ((DraftRevisionID -> m (Vector CommentAnchor)) -> m DraftRevision)
forall a b c. (a -> b) -> Statement b c -> Statement a c
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap
        (TextElementID, TextRevisionID, UUID, Text)
-> (Int64, Int64, UUID, Text)
forall {c} {d}.
(TextElementID, TextRevisionID, c, d) -> (Int64, Int64, c, d)
mapInput
        (Statement
   (Int64, Int64, UUID, Text)
   ((DraftRevisionID -> m (Vector CommentAnchor)) -> m DraftRevision)
 -> Statement
      (TextElementID, TextRevisionID, UUID, Text)
      ((DraftRevisionID -> m (Vector CommentAnchor)) -> m DraftRevision))
-> Statement
     (Int64, Int64, UUID, Text)
     ((DraftRevisionID -> m (Vector CommentAnchor)) -> m DraftRevision)
-> Statement
     (TextElementID, TextRevisionID, UUID, Text)
     ((DraftRevisionID -> m (Vector CommentAnchor)) -> m DraftRevision)
forall a b. (a -> b) -> a -> b
$ ((Int64, Int64, UTCTime, UTCTime, UUID, Text, Text)
 -> (DraftRevisionID -> m (Vector CommentAnchor))
 -> m DraftRevision)
-> Statement
     (Int64, Int64, UUID, Text)
     (Int64, Int64, UTCTime, UTCTime, UUID, Text, Text)
-> Statement
     (Int64, Int64, UUID, Text)
     ((DraftRevisionID -> m (Vector CommentAnchor)) -> m DraftRevision)
forall b c a. (b -> c) -> Statement a b -> Statement a c
forall (p :: * -> * -> *) b c a.
Profunctor p =>
(b -> c) -> p a b -> p a c
rmap
            (Int64, Int64, UTCTime, UTCTime, UUID, Text, Text)
-> (DraftRevisionID -> m (Vector CommentAnchor)) -> m DraftRevision
forall (m :: * -> *).
Monad m =>
(Int64, Int64, UTCTime, UTCTime, UUID, Text, Text)
-> (DraftRevisionID -> m (Vector CommentAnchor)) -> m DraftRevision
uncurryDraftRevision
            [singletonStatement|
                WITH inserted AS (
                    INSERT INTO doc_draft_text_revisions
                        (text_element, based_on_revision, author, content)
                    VALUES
                        ($1 :: int8, $2 :: int8, $3 :: uuid, $4 :: text)
                    ON CONFLICT (text_element, author)
                    DO UPDATE SET
                        content = EXCLUDED.content,
                        last_updated_ts = NOW()
                    RETURNING
                        id :: int8,
                        based_on_revision :: int8,
                        creation_ts :: timestamptz,
                        last_updated_ts :: timestamptz,
                        author :: uuid,
                        content :: text
                )
                SELECT
                    inserted.id :: int8,
                    inserted.based_on_revision :: int8,
                    inserted.creation_ts :: timestamptz,
                    inserted.last_updated_ts :: timestamptz,
                    inserted.author :: uuid,
                    users.name :: text,
                    inserted.content :: text
                FROM
                    inserted
                    JOIN users ON users.id = inserted.author
            |]
  where
    mapInput :: (TextElementID, TextRevisionID, c, d) -> (Int64, Int64, c, d)
mapInput (TextElementID
elementID, TextRevisionID
revisionID, c
author, d
content) =
        (TextElementID -> Int64
unTextElementID TextElementID
elementID, TextRevisionID -> Int64
unTextRevisionID TextRevisionID
revisionID, c
author, d
content)

-- | Get draft revision for a text element by a specific user
getDraftTextRevision
    :: (Monad m)
    => Statement
        (TextElementID, UUID)
        ((DraftRevisionID -> m (Vector CommentAnchor)) -> m (Maybe DraftRevision))
getDraftTextRevision :: forall (m :: * -> *).
Monad m =>
Statement
  (TextElementID, UUID)
  ((DraftRevisionID -> m (Vector CommentAnchor))
   -> m (Maybe DraftRevision))
getDraftTextRevision =
    ((TextElementID, UUID) -> (Int64, UUID))
-> Statement
     (Int64, UUID)
     ((DraftRevisionID -> m (Vector CommentAnchor))
      -> m (Maybe DraftRevision))
-> Statement
     (TextElementID, UUID)
     ((DraftRevisionID -> m (Vector CommentAnchor))
      -> m (Maybe DraftRevision))
forall a b c. (a -> b) -> Statement b c -> Statement a c
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap
        ((TextElementID -> Int64) -> (TextElementID, UUID) -> (Int64, UUID)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first TextElementID -> Int64
unTextElementID)
        (Statement
   (Int64, UUID)
   ((DraftRevisionID -> m (Vector CommentAnchor))
    -> m (Maybe DraftRevision))
 -> Statement
      (TextElementID, UUID)
      ((DraftRevisionID -> m (Vector CommentAnchor))
       -> m (Maybe DraftRevision)))
-> Statement
     (Int64, UUID)
     ((DraftRevisionID -> m (Vector CommentAnchor))
      -> m (Maybe DraftRevision))
-> Statement
     (TextElementID, UUID)
     ((DraftRevisionID -> m (Vector CommentAnchor))
      -> m (Maybe DraftRevision))
forall a b. (a -> b) -> a -> b
$ (Maybe (Int64, Int64, UTCTime, UTCTime, UUID, Text, Text)
 -> (DraftRevisionID -> m (Vector CommentAnchor))
 -> m (Maybe DraftRevision))
-> Statement
     (Int64, UUID)
     (Maybe (Int64, Int64, UTCTime, UTCTime, UUID, Text, Text))
-> Statement
     (Int64, UUID)
     ((DraftRevisionID -> m (Vector CommentAnchor))
      -> m (Maybe DraftRevision))
forall b c a. (b -> c) -> Statement a b -> Statement a c
forall (p :: * -> * -> *) b c a.
Profunctor p =>
(b -> c) -> p a b -> p a c
rmap
            (\Maybe (Int64, Int64, UTCTime, UTCTime, UUID, Text, Text)
row DraftRevisionID -> m (Vector CommentAnchor)
f -> ((Int64, Int64, UTCTime, UTCTime, UUID, Text, Text)
 -> m DraftRevision)
-> Maybe (Int64, Int64, UTCTime, UTCTime, UUID, Text, Text)
-> m (Maybe DraftRevision)
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) -> Maybe a -> m (Maybe b)
mapM ((Int64, Int64, UTCTime, UTCTime, UUID, Text, Text)
-> (DraftRevisionID -> m (Vector CommentAnchor)) -> m DraftRevision
forall (m :: * -> *).
Monad m =>
(Int64, Int64, UTCTime, UTCTime, UUID, Text, Text)
-> (DraftRevisionID -> m (Vector CommentAnchor)) -> m DraftRevision
`uncurryDraftRevision` DraftRevisionID -> m (Vector CommentAnchor)
f) Maybe (Int64, Int64, UTCTime, UTCTime, UUID, Text, Text)
row)
            [maybeStatement|
                SELECT
                    drafts.id :: int8,
                    drafts.based_on_revision :: int8,
                    drafts.creation_ts :: timestamptz,
                    drafts.last_updated_ts :: timestamptz,
                    drafts.author :: uuid,
                    users.name :: text,
                    drafts.content :: text
                FROM
                    doc_draft_text_revisions drafts
                    JOIN users ON users.id = drafts.author
                WHERE
                    drafts.text_element = $1 :: int8
                    AND drafts.author = $2 :: uuid
            |]

-- | Delete draft revision
deleteDraftTextRevision :: Statement (TextElementID, UUID) ()
deleteDraftTextRevision :: Statement (TextElementID, UUID) ()
deleteDraftTextRevision =
    ((TextElementID, UUID) -> (Int64, UUID))
-> Statement (Int64, UUID) () -> Statement (TextElementID, UUID) ()
forall a b c. (a -> b) -> Statement b c -> Statement a c
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap
        ((TextElementID -> Int64) -> (TextElementID, UUID) -> (Int64, UUID)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first TextElementID -> Int64
unTextElementID)
        [resultlessStatement|
            DELETE FROM doc_draft_text_revisions
            WHERE
                text_element = $1 :: int8
                AND author = $2 :: uuid
        |]

-- | Get comment anchors for draft revision
getDraftCommentAnchors :: Statement DraftRevisionID (Vector CommentAnchor)
getDraftCommentAnchors :: Statement DraftRevisionID (Vector CommentAnchor)
getDraftCommentAnchors =
    (DraftRevisionID -> Int64)
-> Statement Int64 (Vector CommentAnchor)
-> Statement DraftRevisionID (Vector CommentAnchor)
forall a b c. (a -> b) -> Statement b c -> Statement a c
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap
        DraftRevisionID -> Int64
unDraftRevisionID
        (Statement Int64 (Vector CommentAnchor)
 -> Statement DraftRevisionID (Vector CommentAnchor))
-> Statement Int64 (Vector CommentAnchor)
-> Statement DraftRevisionID (Vector CommentAnchor)
forall a b. (a -> b) -> a -> b
$ (Maybe Value -> Vector CommentAnchor)
-> Statement Int64 (Maybe Value)
-> Statement Int64 (Vector CommentAnchor)
forall b c a. (b -> c) -> Statement a b -> Statement a c
forall (p :: * -> * -> *) b c a.
Profunctor p =>
(b -> c) -> p a b -> p a c
rmap
            (Vector CommentAnchor
-> Maybe (Vector CommentAnchor) -> Vector CommentAnchor
forall a. a -> Maybe a -> a
fromMaybe Vector CommentAnchor
forall a. Vector a
Vector.empty (Maybe (Vector CommentAnchor) -> Vector CommentAnchor)
-> (Maybe Value -> Maybe (Vector CommentAnchor))
-> Maybe Value
-> Vector CommentAnchor
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Value
-> (Value -> Maybe (Vector CommentAnchor))
-> Maybe (Vector CommentAnchor)
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Value -> Parser (Vector CommentAnchor))
-> Value -> Maybe (Vector CommentAnchor)
forall a b. (a -> Parser b) -> a -> Maybe b
parseMaybe Value -> Parser (Vector CommentAnchor)
forall a. FromJSON a => Value -> Parser a
parseJSON))
            [maybeStatement|
                SELECT
                    comment_anchors :: jsonb
                FROM doc_draft_text_revisions
                WHERE id = $1 :: int8
            |]

-- | Put comment anchors for draft revision (replace all)
putDraftCommentAnchors :: Statement (DraftRevisionID, Vector CommentAnchor) ()
putDraftCommentAnchors :: Statement (DraftRevisionID, Vector CommentAnchor) ()
putDraftCommentAnchors =
    ((DraftRevisionID, Vector CommentAnchor) -> (Int64, Value))
-> Statement (Int64, Value) ()
-> Statement (DraftRevisionID, Vector CommentAnchor) ()
forall a b c. (a -> b) -> Statement b c -> Statement a c
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap
        ((DraftRevisionID -> Int64)
-> (Vector CommentAnchor -> Value)
-> (DraftRevisionID, Vector CommentAnchor)
-> (Int64, Value)
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap DraftRevisionID -> Int64
unDraftRevisionID ([CommentAnchor] -> Value
forall a. ToJSON a => a -> Value
toJSON ([CommentAnchor] -> Value)
-> (Vector CommentAnchor -> [CommentAnchor])
-> Vector CommentAnchor
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector CommentAnchor -> [CommentAnchor]
forall a. Vector a -> [a]
Vector.toList))
        [resultlessStatement|
            UPDATE doc_draft_text_revisions
            SET comment_anchors = $2 :: jsonb
            WHERE id = $1 :: int8
        |]