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

-- |
-- Module      : Docs
-- Description : Document Management and Version Control
-- License     : AGPL-3
-- Maintainer  : stu235271@mail.uni-kiel.de
--               stu236925@mail.uni-kiel.de
--
-- This module provides a high level api wrapper around "Docs.Database" to interact
-- with the document control and version management, e.g., to create, view, edit,
-- manage, discuss and version documents.
--
-- All @Docs@ api actions are abstracted over specific classes defined in
-- "Docs.Database". A specific implementation for PostgreSQL databases are
-- @HasqlSession@ and @HasqlTransaction@ in "Docs.Hasql.Database". These must be used
-- together, as some Database Operations require to be executed in a transactional
-- context. The PostgreSQL implementation can be used with the functions @run@ and
-- @runTransaction@ in "Docs.Hasql.Database".
module Docs
    ( Error (..)
    , Result
    , Limit
    , logMessage
    , newDefaultDocument
    , createDocument
    , getDocument
    , getDocuments
    , createTextElement
    , createTextRevision
    , getTextElementRevision
    , getTextRevisionPDF
    , getDocumentRevisionText
    , getTreeRevision
    , getDocumentRevisionTree
    , createTreeRevision
    , getFullTreeRevision
    , getTextHistory
    , getTreeHistory
    , getDocumentHistory
    , getDocumentRevision
    , getTreeRevisionPDF
    , getTreeRevisionHTML
    , getDocumentRevisionPDF
    , getDocumentRevisionHTML
    , createComment
    , getComments
    , resolveComment
    , createReply
    , getLogs
    , getDraftTextRevision
    , publishDraftTextRevision
    , discardDraftTextRevision
    ) where

import Control.Monad (join, unless)
import Control.Monad.Except (ExceptT (ExceptT), runExceptT, throwError)
import Control.Monad.Trans.Class (lift)
import Data.Foldable (find)
import Data.Functor ((<&>))
import Data.Text (Text)
import Data.Time (UTCTime, diffUTCTime)
import Data.Vector (Vector)

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

import qualified Language.Lsd.AST.Common as LSD
import qualified Language.Ltml.Common as LTML
import qualified Language.Ltml.Tree as LTML

import Control.Monad.IO.Class (MonadIO (liftIO))
import Data.Aeson (FromJSON, ToJSON)
import Data.Bifunctor (Bifunctor (bimap, first, second))
import qualified Data.ByteString.Lazy as BL
import Data.Maybe (fromMaybe)
import Data.OpenApi (ToSchema)
import qualified Data.Text as Text
import qualified Data.Text.Encoding as TE
import qualified Data.Vector as Vector
import Docs.Comment (Comment, CommentRef (CommentRef), Message)
import qualified Docs.Comment as Comment
import Docs.Database
    ( HasCheckPermission
    , HasCreateComment
    , HasCreateDocument
    , HasCreateTextElement
    , HasCreateTextRevision
    , HasCreateTreeRevision
    , HasExistsComment
    , HasExistsDocument
    , HasExistsTextElement
    , HasExistsTextRevision
    , HasExistsTreeRevision
    , HasGetComments
    , HasGetDocument
    , HasGetDocumentHistory
    , HasGetLogs
    , HasGetRevisionKey
    , HasGetTextElementRevision
    , HasGetTextHistory
    , HasGetTreeHistory
    , HasGetTreeRevision
    , HasIsGroupAdmin
    , HasIsSuperAdmin
    , HasLogMessage
    , HasRollback
    )
import qualified Docs.Database as DB
import Docs.Document (Document, DocumentID)
import qualified Docs.Document as Document
import Docs.DocumentHistory (DocumentHistory)
import Docs.FullDocument (FullDocument (FullDocument))
import qualified Docs.FullDocument as FullDocument
import Docs.LTML
    ( nodeToLtmlInputTreePred
    , treeRevisionToMeta
    )
import Docs.MetaTree (TreeRevisionWithMetaData (TreeRevisionWithMetaData))
import Docs.Renderable (directRenderable)
import qualified Docs.Renderable as Renderable
import Docs.Rendered
    ( HTMLBytes (HTMLBytes, unHTMLBytes)
    , PDFBytes (PDFBytes)
    , ZipBytes (ZipBytes)
    )
import Docs.Revision
    ( RevisionRef (RevisionRef)
    , textRevisionRefFor
    , treeRevisionRefFor
    )
import qualified Docs.Revision as Revision
import Docs.TextElement
    ( TextElement
    , TextElementID
    , TextElementKind
    , TextElementRef (..)
    , TextElementType
    )
import qualified Docs.TextElement as TextElement
import Docs.TextRevision
    ( ConflictStatus
    , DraftRevision
    , NewTextRevision (..)
    , Rendered (Rendered)
    , TextElementRevision (TextElementRevision)
    , TextRevisionHistory
    , TextRevisionRef (..)
    )
import qualified Docs.TextRevision as TextRevision
import Docs.Tree (Node)
import qualified Docs.Tree as Tree
import Docs.TreeRevision
    ( TreeRevision (TreeRevision)
    , TreeRevisionHistory
    , TreeRevisionRef (..)
    )
import qualified Docs.TreeRevision as TreeRevision
import qualified Docs.UserRef as UserRef
import GHC.Generics (Generic)
import GHC.Int (Int64)
import qualified Language.Ltml.AST.DocumentContainer as LTML
import qualified Language.Ltml.HTML as HTML
import qualified Language.Ltml.HTML.Export as HTML
import qualified Language.Ltml.ToLaTeX.PDFGenerator as PDF
import qualified Language.Ltml.Tree.ToLtml as LTML
import Logging.Logs (LogMessage, Severity (Warning))
import Logging.Scope (Scope)
import qualified Logging.Scope as Scope

-- | Represents an error of the docs api
data Error
    = NoPermission DocumentID Permission
    | NoPermissionForUser UserID
    | NoPermissionInGroup GroupID
    | SuperAdminOnly
    | DocumentNotFound DocumentID
    | RevisionNotFound RevisionRef
    | TextElementNotFound TextElementRef
    | TextRevisionNotFound TextRevisionRef
    | TreeRevisionNotFound TreeRevisionRef
    | CommentNotFound CommentRef
    | PDFError Text
    | ZipHTMLError
    | Custom Text
    deriving ((forall x. Error -> Rep Error x)
-> (forall x. Rep Error x -> Error) -> Generic Error
forall x. Rep Error x -> Error
forall x. Error -> Rep Error x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Error -> Rep Error x
from :: forall x. Error -> Rep Error x
$cto :: forall x. Rep Error x -> Error
to :: forall x. Rep Error x -> Error
Generic)

instance ToJSON Error

instance FromJSON Error

instance ToSchema Error

type Result a = Either Error a

type Limit = Int64

-- | Default restriction for how many revisions are returned by default from the
--   history functions
defaultHistoryLimit :: Limit
defaultHistoryLimit :: Limit
defaultHistoryLimit = Limit
200

-- | Subsequent revisions by the same authors are squashed within this time frame
squashRevisionsWithinMinutes :: Float
squashRevisionsWithinMinutes :: Float
squashRevisionsWithinMinutes = Float
15

-- | Wether subsequent revision by the same author should be squashed
enableSquashing :: Bool
enableSquashing :: Bool
enableSquashing = Bool
True

-- | Performs an transaction and performs an rollback on error
rollbackOnError :: (HasRollback m) => m (Result a) -> m (Result a)
rollbackOnError :: forall (m :: * -> *) a.
HasRollback m =>
m (Result a) -> m (Result a)
rollbackOnError m (Result a)
tx = do
    Result a
result <- m (Result a)
tx
    case Result a
result of
        Left Error
_ -> do
            m ()
forall (m :: * -> *). HasRollback m => m ()
DB.rollback
            Result a -> m (Result a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Result a
result
        Right a
_ -> Result a -> m (Result a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Result a
result

-- | Performs an action and logs the result on an error
logged :: (HasLogMessage m) => UserID -> Scope -> m (Result a) -> m (Result a)
logged :: forall (m :: * -> *) a.
HasLogMessage m =>
UserID -> Scope -> m (Result a) -> m (Result a)
logged UserID
userID Scope
scope m (Result a)
result = do
    Result a
value <- m (Result a)
result
    case Result a
value of
        Left Error
err -> do
            LogMessage
_ <- Severity -> Maybe UserID -> Scope -> Error -> m LogMessage
forall v.
ToJSON v =>
Severity -> Maybe UserID -> Scope -> v -> m LogMessage
forall (m :: * -> *) v.
(HasLogMessage m, ToJSON v) =>
Severity -> Maybe UserID -> Scope -> v -> m LogMessage
DB.logMessage Severity
Warning (UserID -> Maybe UserID
forall a. a -> Maybe a
Just UserID
userID) Scope
scope Error
err
            --                 ^~~~~~~ all of these errors are user errors
            Result a -> m (Result a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Result a -> m (Result a)) -> Result a -> m (Result a)
forall a b. (a -> b) -> a -> b
$ Error -> Result a
forall a b. a -> Either a b
Left Error
err
        Right a
val -> Result a -> m (Result a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Result a -> m (Result a)) -> Result a -> m (Result a)
forall a b. (a -> b) -> a -> b
$ a -> Result a
forall a b. b -> Either a b
Right a
val

-- | Logs a message
logMessage
    :: (HasLogMessage m, ToJSON v)
    => Severity
    -> Maybe UserID
    -> Scope
    -> v
    -> m LogMessage
logMessage :: forall (m :: * -> *) v.
(HasLogMessage m, ToJSON v) =>
Severity -> Maybe UserID -> Scope -> v -> m LogMessage
logMessage = Severity -> Maybe UserID -> Scope -> v -> m LogMessage
forall v.
ToJSON v =>
Severity -> Maybe UserID -> Scope -> v -> m LogMessage
forall (m :: * -> *) v.
(HasLogMessage m, ToJSON v) =>
Severity -> Maybe UserID -> Scope -> v -> m LogMessage
DB.logMessage

-- | Obtain log messages
getLogs
    :: (HasGetLogs m, HasLogMessage m)
    => UserID
    -> Maybe UTCTime
    -> Int64
    -> m (Result (Vector LogMessage))
getLogs :: forall (m :: * -> *).
(HasGetLogs m, HasLogMessage m) =>
UserID -> Maybe UTCTime -> Limit -> m (Result (Vector LogMessage))
getLogs UserID
userID Maybe UTCTime
offset Limit
limit = UserID
-> Scope
-> m (Result (Vector LogMessage))
-> m (Result (Vector LogMessage))
forall (m :: * -> *) a.
HasLogMessage m =>
UserID -> Scope -> m (Result a) -> m (Result a)
logged UserID
userID Scope
Scope.logging (m (Result (Vector LogMessage)) -> m (Result (Vector LogMessage)))
-> m (Result (Vector LogMessage)) -> m (Result (Vector LogMessage))
forall a b. (a -> b) -> a -> b
$ ExceptT Error m (Vector LogMessage)
-> m (Result (Vector LogMessage))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT Error m (Vector LogMessage)
 -> m (Result (Vector LogMessage)))
-> ExceptT Error m (Vector LogMessage)
-> m (Result (Vector LogMessage))
forall a b. (a -> b) -> a -> b
$ do
    UserID -> ExceptT Error m ()
forall (m :: * -> *).
HasIsSuperAdmin m =>
UserID -> ExceptT Error m ()
guardSuperAdmin UserID
userID
    m (Vector LogMessage) -> ExceptT Error m (Vector LogMessage)
forall (m :: * -> *) a. Monad m => m a -> ExceptT Error m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Vector LogMessage) -> ExceptT Error m (Vector LogMessage))
-> m (Vector LogMessage) -> ExceptT Error m (Vector LogMessage)
forall a b. (a -> b) -> a -> b
$ Maybe UTCTime -> Limit -> m (Vector LogMessage)
forall (m :: * -> *).
HasGetLogs m =>
Maybe UTCTime -> Limit -> m (Vector LogMessage)
DB.getLogs Maybe UTCTime
offset Limit
limit

-- | Create a new document
createDocument
    :: (HasCreateDocument m, HasLogMessage m)
    => UserID
    -> GroupID
    -> Text
    -> m (Result Document)
createDocument :: forall (m :: * -> *).
(HasCreateDocument m, HasLogMessage m) =>
UserID -> Limit -> Text -> m (Result Document)
createDocument UserID
userID Limit
groupID Text
title = UserID -> Scope -> m (Result Document) -> m (Result Document)
forall (m :: * -> *) a.
HasLogMessage m =>
UserID -> Scope -> m (Result a) -> m (Result a)
logged UserID
userID Scope
Scope.docs (m (Result Document) -> m (Result Document))
-> m (Result Document) -> m (Result Document)
forall a b. (a -> b) -> a -> b
$ ExceptT Error m Document -> m (Result Document)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT Error m Document -> m (Result Document))
-> ExceptT Error m Document -> m (Result Document)
forall a b. (a -> b) -> a -> b
$ do
    Limit -> UserID -> ExceptT Error m ()
forall (m :: * -> *).
HasIsGroupAdmin m =>
Limit -> UserID -> ExceptT Error m ()
guardGroupAdmin Limit
groupID UserID
userID
    m Document -> ExceptT Error m Document
forall (m :: * -> *) a. Monad m => m a -> ExceptT Error m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Document -> ExceptT Error m Document)
-> m Document -> ExceptT Error m Document
forall a b. (a -> b) -> a -> b
$ Text -> Limit -> UserID -> m Document
forall (m :: * -> *).
HasCreateDocument m =>
Text -> Limit -> UserID -> m Document
DB.createDocument Text
title Limit
groupID UserID
userID

-- | Get a document
getDocument
    :: (HasGetDocument m, HasLogMessage m)
    => UserID
    -> DocumentID
    -> m (Result Document)
getDocument :: forall (m :: * -> *).
(HasGetDocument m, HasLogMessage m) =>
UserID -> DocumentID -> m (Result Document)
getDocument UserID
userID DocumentID
docID = UserID -> Scope -> m (Result Document) -> m (Result Document)
forall (m :: * -> *) a.
HasLogMessage m =>
UserID -> Scope -> m (Result a) -> m (Result a)
logged UserID
userID Scope
Scope.docs (m (Result Document) -> m (Result Document))
-> m (Result Document) -> m (Result Document)
forall a b. (a -> b) -> a -> b
$ ExceptT Error m Document -> m (Result Document)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT Error m Document -> m (Result Document))
-> ExceptT Error m Document -> m (Result Document)
forall a b. (a -> b) -> a -> b
$ do
    Permission -> DocumentID -> UserID -> ExceptT Error m ()
forall (m :: * -> *).
HasCheckPermission m =>
Permission -> DocumentID -> UserID -> ExceptT Error m ()
guardPermission Permission
Read DocumentID
docID UserID
userID
    Maybe Document
document <- m (Maybe Document) -> ExceptT Error m (Maybe Document)
forall (m :: * -> *) a. Monad m => m a -> ExceptT Error m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Maybe Document) -> ExceptT Error m (Maybe Document))
-> m (Maybe Document) -> ExceptT Error m (Maybe Document)
forall a b. (a -> b) -> a -> b
$ DocumentID -> m (Maybe Document)
forall (m :: * -> *).
HasGetDocument m =>
DocumentID -> m (Maybe Document)
DB.getDocument DocumentID
docID
    ExceptT Error m Document
-> (Document -> ExceptT Error m Document)
-> Maybe Document
-> ExceptT Error m Document
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Error -> ExceptT Error m Document
forall a. Error -> ExceptT Error m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Error -> ExceptT Error m Document)
-> Error -> ExceptT Error m Document
forall a b. (a -> b) -> a -> b
$ DocumentID -> Error
DocumentNotFound DocumentID
docID) Document -> ExceptT Error m Document
forall a. a -> ExceptT Error m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Document
document

-- | Gets all documents visible by the user
--   OR all documents by the specified group and / or user
getDocuments
    :: (HasGetDocument m, HasLogMessage m)
    => UserID
    -> Maybe UserID
    -> Maybe GroupID
    -> m (Result (Vector Document))
getDocuments :: forall (m :: * -> *).
(HasGetDocument m, HasLogMessage m) =>
UserID
-> Maybe UserID -> Maybe Limit -> m (Result (Vector Document))
getDocuments UserID
userID Maybe UserID
byUserID Maybe Limit
byGroupID = UserID
-> Scope
-> m (Result (Vector Document))
-> m (Result (Vector Document))
forall (m :: * -> *) a.
HasLogMessage m =>
UserID -> Scope -> m (Result a) -> m (Result a)
logged UserID
userID Scope
Scope.docs (m (Result (Vector Document)) -> m (Result (Vector Document)))
-> m (Result (Vector Document)) -> m (Result (Vector Document))
forall a b. (a -> b) -> a -> b
$
    case (Maybe UserID
byUserID, Maybe Limit
byGroupID) of
        (Maybe UserID
Nothing, Maybe Limit
Nothing) -> Vector Document -> Result (Vector Document)
forall a b. b -> Either a b
Right (Vector Document -> Result (Vector Document))
-> m (Vector Document) -> m (Result (Vector Document))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UserID -> m (Vector Document)
forall (m :: * -> *).
HasGetDocument m =>
UserID -> m (Vector Document)
DB.getDocuments UserID
userID
        (Maybe UserID, Maybe Limit)
_ -> ExceptT Error m (Vector Document) -> m (Result (Vector Document))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT Error m (Vector Document) -> m (Result (Vector Document)))
-> ExceptT Error m (Vector Document)
-> m (Result (Vector Document))
forall a b. (a -> b) -> a -> b
$ do
            ExceptT Error m ()
-> (UserID -> ExceptT Error m ())
-> Maybe UserID
-> ExceptT Error m ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> ExceptT Error m ()
forall a. a -> ExceptT Error m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) (UserID -> UserID -> ExceptT Error m ()
forall (m :: * -> *).
HasIsSuperAdmin m =>
UserID -> UserID -> ExceptT Error m ()
guardUserRights UserID
userID) Maybe UserID
byUserID
            ExceptT Error m ()
-> (Limit -> ExceptT Error m ())
-> Maybe Limit
-> ExceptT Error m ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> ExceptT Error m ()
forall a. a -> ExceptT Error m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) (Limit -> UserID -> ExceptT Error m ()
forall (m :: * -> *).
HasIsGroupAdmin m =>
Limit -> UserID -> ExceptT Error m ()
`guardGroupAdmin` UserID
userID) Maybe Limit
byGroupID
            m (Vector Document) -> ExceptT Error m (Vector Document)
forall (m :: * -> *) a. Monad m => m a -> ExceptT Error m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Vector Document) -> ExceptT Error m (Vector Document))
-> m (Vector Document) -> ExceptT Error m (Vector Document)
forall a b. (a -> b) -> a -> b
$ Maybe UserID -> Maybe Limit -> m (Vector Document)
forall (m :: * -> *).
HasGetDocument m =>
Maybe UserID -> Maybe Limit -> m (Vector Document)
DB.getDocumentsBy Maybe UserID
byUserID Maybe Limit
byGroupID

-- | Create a new @TextElement@
createTextElement
    :: (HasCreateTextElement m, HasLogMessage m)
    => UserID
    -> DocumentID
    -> TextElementKind
    -> TextElementType
    -> m (Result TextElement)
createTextElement :: forall (m :: * -> *).
(HasCreateTextElement m, HasLogMessage m) =>
UserID -> DocumentID -> Text -> Text -> m (Result TextElement)
createTextElement UserID
userID DocumentID
docID Text
kind Text
type_ =
    UserID -> Scope -> m (Result TextElement) -> m (Result TextElement)
forall (m :: * -> *) a.
HasLogMessage m =>
UserID -> Scope -> m (Result a) -> m (Result a)
logged UserID
userID Scope
Scope.docsText (m (Result TextElement) -> m (Result TextElement))
-> m (Result TextElement) -> m (Result TextElement)
forall a b. (a -> b) -> a -> b
$
        ExceptT Error m TextElement -> m (Result TextElement)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT Error m TextElement -> m (Result TextElement))
-> ExceptT Error m TextElement -> m (Result TextElement)
forall a b. (a -> b) -> a -> b
$ do
            Permission -> DocumentID -> UserID -> ExceptT Error m ()
forall (m :: * -> *).
HasCheckPermission m =>
Permission -> DocumentID -> UserID -> ExceptT Error m ()
guardPermission Permission
Edit DocumentID
docID UserID
userID
            DocumentID -> ExceptT Error m ()
forall (m :: * -> *).
HasExistsDocument m =>
DocumentID -> ExceptT Error m ()
guardExistsDocument DocumentID
docID
            m TextElement -> ExceptT Error m TextElement
forall (m :: * -> *) a. Monad m => m a -> ExceptT Error m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m TextElement -> ExceptT Error m TextElement)
-> m TextElement -> ExceptT Error m TextElement
forall a b. (a -> b) -> a -> b
$ DocumentID -> Text -> Text -> m TextElement
forall (m :: * -> *).
HasCreateTextElement m =>
DocumentID -> Text -> Text -> m TextElement
DB.createTextElement DocumentID
docID Text
kind Text
type_

-- | Create a new 'TextRevision' in the Database.
--
--   Updates the latest revision instead of creating a new one, if
--      - the latest revision is created by the same author,
--      - the latest revision is no older than a set threshold.
--   In case of an update, the revision id is increased nevertheless to
--   prevent lost update scenarios.
createTextRevision
    :: ( HasCreateTextRevision m
       , HasGetTextElementRevision m
       , HasExistsComment m
       , HasLogMessage m
       , HasGetTreeRevision m
       , HasGetRevisionKey m
       , HasGetDocument m
       , DB.HasDraftTextRevision m
       )
    => UserID
    -> NewTextRevision
    -> m (Result (Rendered ConflictStatus))
createTextRevision :: forall (m :: * -> *).
(HasCreateTextRevision m, HasGetTextElementRevision m,
 HasExistsComment m, HasLogMessage m, HasGetTreeRevision m,
 HasGetRevisionKey m, HasGetDocument m, HasDraftTextRevision m) =>
UserID -> NewTextRevision -> m (Result (Rendered ConflictStatus))
createTextRevision UserID
userID NewTextRevision
revision = UserID
-> Scope
-> m (Result (Rendered ConflictStatus))
-> m (Result (Rendered ConflictStatus))
forall (m :: * -> *) a.
HasLogMessage m =>
UserID -> Scope -> m (Result a) -> m (Result a)
logged UserID
userID Scope
Scope.docsTextRevision (m (Result (Rendered ConflictStatus))
 -> m (Result (Rendered ConflictStatus)))
-> m (Result (Rendered ConflictStatus))
-> m (Result (Rendered ConflictStatus))
forall a b. (a -> b) -> a -> b
$
    ExceptT Error m (Rendered ConflictStatus)
-> m (Result (Rendered ConflictStatus))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT Error m (Rendered ConflictStatus)
 -> m (Result (Rendered ConflictStatus)))
-> ExceptT Error m (Rendered ConflictStatus)
-> m (Result (Rendered ConflictStatus))
forall a b. (a -> b) -> a -> b
$ do
        let ref :: TextElementRef
ref@(TextElementRef DocumentID
docID TextElementID
_) = NewTextRevision -> TextElementRef
newTextRevisionElement NewTextRevision
revision
        Permission -> DocumentID -> UserID -> ExceptT Error m ()
forall (m :: * -> *).
HasCheckPermission m =>
Permission -> DocumentID -> UserID -> ExceptT Error m ()
guardPermission Permission
Edit DocumentID
docID UserID
userID
        TextElementRef -> ExceptT Error m ()
forall (m :: * -> *).
HasExistsTextElement m =>
TextElementRef -> ExceptT Error m ()
guardExistsTextElement TextElementRef
ref
        (CommentRef -> ExceptT Error m ())
-> Vector CommentRef -> ExceptT Error m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_
            CommentRef -> ExceptT Error m ()
forall (m :: * -> *).
HasExistsComment m =>
CommentRef -> ExceptT Error m ()
guardExistsComment
            (TextElementRef -> CommentID -> CommentRef
CommentRef TextElementRef
ref (CommentID -> CommentRef)
-> (CommentAnchor -> CommentID) -> CommentAnchor -> CommentRef
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CommentAnchor -> CommentID
Comment.comment (CommentAnchor -> CommentRef)
-> Vector CommentAnchor -> Vector CommentRef
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NewTextRevision -> Vector CommentAnchor
newTextRevisionCommentAnchors NewTextRevision
revision)
        let latestRevisionRef :: TextRevisionRef
latestRevisionRef = TextElementRef -> TextRevisionSelector -> TextRevisionRef
TextRevisionRef TextElementRef
ref TextRevisionSelector
TextRevision.Latest
        Maybe TextElementRevision
latestElementRevision <-
            m (Maybe TextElementRevision)
-> ExceptT Error m (Maybe TextElementRevision)
forall (m :: * -> *) a. Monad m => m a -> ExceptT Error m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Maybe TextElementRevision)
 -> ExceptT Error m (Maybe TextElementRevision))
-> m (Maybe TextElementRevision)
-> ExceptT Error m (Maybe TextElementRevision)
forall a b. (a -> b) -> a -> b
$ TextRevisionRef -> m (Maybe TextElementRevision)
forall (m :: * -> *).
HasGetTextElementRevision m =>
TextRevisionRef -> m (Maybe TextElementRevision)
DB.getTextElementRevision TextRevisionRef
latestRevisionRef
        let latestRevision :: Maybe TextRevision
latestRevision = Maybe TextElementRevision
latestElementRevision Maybe TextElementRevision
-> (TextElementRevision -> Maybe TextRevision)
-> Maybe TextRevision
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= TextElementRevision -> Maybe TextRevision
TextRevision.revision
        let latestRevisionID :: Maybe TextRevisionID
latestRevisionID =
                Maybe TextRevision
latestRevision
                    Maybe TextRevision
-> (TextRevision -> TextRevisionID) -> Maybe TextRevisionID
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> TextRevisionHeader -> TextRevisionID
TextRevision.identifier (TextRevisionHeader -> TextRevisionID)
-> (TextRevision -> TextRevisionHeader)
-> TextRevision
-> TextRevisionID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextRevision -> TextRevisionHeader
TextRevision.header
        let parentRevisionID :: Maybe TextRevisionID
parentRevisionID = NewTextRevision -> Maybe TextRevisionID
newTextRevisionParent NewTextRevision
revision
        let createRevision :: ExceptT Error m TextRevision
createRevision =
                m TextRevision -> ExceptT Error m TextRevision
forall (m :: * -> *) a. Monad m => m a -> ExceptT Error m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m TextRevision -> ExceptT Error m TextRevision)
-> m TextRevision -> ExceptT Error m TextRevision
forall a b. (a -> b) -> a -> b
$
                    UserID
-> TextElementRef -> Text -> Vector CommentAnchor -> m TextRevision
forall (m :: * -> *).
HasCreateTextRevision m =>
UserID
-> TextElementRef -> Text -> Vector CommentAnchor -> m TextRevision
DB.createTextRevision
                        UserID
userID
                        TextElementRef
ref
                        (NewTextRevision -> Text
newTextRevisionContent NewTextRevision
revision)
                        (NewTextRevision -> Vector CommentAnchor
newTextRevisionCommentAnchors NewTextRevision
revision)
        do
            UTCTime
now <- m UTCTime -> ExceptT Error m UTCTime
forall (m :: * -> *) a. Monad m => m a -> ExceptT Error m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m UTCTime
forall (m :: * -> *). HasNow m => m UTCTime
DB.now
            let render :: a -> ExceptT Error m (Rendered a)
render =
                    UserID
-> TextRevisionRef -> Text -> a -> ExceptT Error m (Rendered a)
forall (m :: * -> *) a.
(HasGetTreeRevision m, HasLogMessage m,
 HasGetTextElementRevision m, HasGetRevisionKey m,
 HasGetDocument m) =>
UserID
-> TextRevisionRef -> Text -> a -> ExceptT Error m (Rendered a)
rendered'
                        UserID
userID
                        (TextElementRef -> TextRevisionSelector -> TextRevisionRef
TextRevisionRef TextElementRef
ref TextRevisionSelector
TextRevision.Latest)
                        (NewTextRevision -> Text
newTextRevisionContent NewTextRevision
revision)
            case Maybe TextRevision
latestRevision of
                -- first revision
                Maybe TextRevision
Nothing -> do
                    TextRevision
createdRevision <- ExceptT Error m TextRevision
createRevision
                    let result :: ConflictStatus
result = TextRevision -> ConflictStatus
TextRevision.NoConflict TextRevision
createdRevision
                    ConflictStatus -> ExceptT Error m (Rendered ConflictStatus)
forall {a}. a -> ExceptT Error m (Rendered a)
render ConflictStatus
result
                -- render . TextRevision.NoConflict <$> createRevision
                Just TextRevision
latest
                    -- content has not changed? -> return latest
                    | TextRevision -> NewTextRevision -> Bool
TextRevision.contentsNotChanged TextRevision
latest NewTextRevision
revision ->
                        ConflictStatus -> ExceptT Error m (Rendered ConflictStatus)
forall {a}. a -> ExceptT Error m (Rendered a)
render (ConflictStatus -> ExceptT Error m (Rendered ConflictStatus))
-> ConflictStatus -> ExceptT Error m (Rendered ConflictStatus)
forall a b. (a -> b) -> a -> b
$ TextRevision -> ConflictStatus
TextRevision.NoConflict TextRevision
latest
                    -- no conflict, and can update? -> update (squash)
                    | Maybe TextRevisionID
latestRevisionID Maybe TextRevisionID -> Maybe TextRevisionID -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe TextRevisionID
parentRevisionID Bool -> Bool -> Bool
&& UTCTime -> TextRevision -> Bool
shouldUpdate UTCTime
now TextRevision
latest -> do
                        TextRevision
newRevision <-
                            m TextRevision -> ExceptT Error m TextRevision
forall (m :: * -> *) a. Monad m => m a -> ExceptT Error m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m TextRevision -> ExceptT Error m TextRevision)
-> m TextRevision -> ExceptT Error m TextRevision
forall a b. (a -> b) -> a -> b
$
                                TextRevisionID -> Text -> Vector CommentAnchor -> m TextRevision
forall (m :: * -> *).
HasCreateTextRevision m =>
TextRevisionID -> Text -> Vector CommentAnchor -> m TextRevision
DB.updateTextRevision
                                    (TextRevision -> TextRevisionID
identifier TextRevision
latest)
                                    (NewTextRevision -> Text
newTextRevisionContent NewTextRevision
revision)
                                    (NewTextRevision -> Vector CommentAnchor
newTextRevisionCommentAnchors NewTextRevision
revision)
                        ConflictStatus -> ExceptT Error m (Rendered ConflictStatus)
forall {a}. a -> ExceptT Error m (Rendered a)
render (ConflictStatus -> ExceptT Error m (Rendered ConflictStatus))
-> ConflictStatus -> ExceptT Error m (Rendered ConflictStatus)
forall a b. (a -> b) -> a -> b
$ TextRevision -> ConflictStatus
TextRevision.NoConflict TextRevision
newRevision
                    -- no conflict, but can not update? -> create new
                    | Maybe TextRevisionID
latestRevisionID Maybe TextRevisionID -> Maybe TextRevisionID -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe TextRevisionID
parentRevisionID -> do
                        TextRevision
createdRevision <- ExceptT Error m TextRevision
createRevision
                        ConflictStatus -> ExceptT Error m (Rendered ConflictStatus)
forall {a}. a -> ExceptT Error m (Rendered a)
render (ConflictStatus -> ExceptT Error m (Rendered ConflictStatus))
-> ConflictStatus -> ExceptT Error m (Rendered ConflictStatus)
forall a b. (a -> b) -> a -> b
$ TextRevision -> ConflictStatus
TextRevision.NoConflict TextRevision
createdRevision
                    -- conflict
                    | Bool
otherwise ->
                        if NewTextRevision -> Bool
newTextRevisionIsAutoSave NewTextRevision
revision
                            then do
                                -- For autosave conflicts, create a draft revision
                                DraftRevision
draftRevision <-
                                    m DraftRevision -> ExceptT Error m DraftRevision
forall (m :: * -> *) a. Monad m => m a -> ExceptT Error m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m DraftRevision -> ExceptT Error m DraftRevision)
-> m DraftRevision -> ExceptT Error m DraftRevision
forall a b. (a -> b) -> a -> b
$
                                        UserID
-> TextElementRef
-> TextRevisionID
-> Text
-> Vector CommentAnchor
-> m DraftRevision
forall (m :: * -> *).
HasDraftTextRevision m =>
UserID
-> TextElementRef
-> TextRevisionID
-> Text
-> Vector CommentAnchor
-> m DraftRevision
DB.createDraftTextRevision
                                            UserID
userID
                                            TextElementRef
ref
                                            (TextRevision -> TextRevisionID
identifier TextRevision
latest)
                                            (NewTextRevision -> Text
newTextRevisionContent NewTextRevision
revision)
                                            (NewTextRevision -> Vector CommentAnchor
newTextRevisionCommentAnchors NewTextRevision
revision)
                                ConflictStatus -> ExceptT Error m (Rendered ConflictStatus)
forall {a}. a -> ExceptT Error m (Rendered a)
render (ConflictStatus -> ExceptT Error m (Rendered ConflictStatus))
-> ConflictStatus -> ExceptT Error m (Rendered ConflictStatus)
forall a b. (a -> b) -> a -> b
$
                                    DraftRevision -> TextRevisionID -> ConflictStatus
TextRevision.DraftCreated
                                        DraftRevision
draftRevision
                                        (TextRevision -> TextRevisionID
identifier TextRevision
latest)
                            else -- For manual save conflicts, return conflict
                                ConflictStatus -> ExceptT Error m (Rendered ConflictStatus)
forall {a}. a -> ExceptT Error m (Rendered a)
render (ConflictStatus -> ExceptT Error m (Rendered ConflictStatus))
-> ConflictStatus -> ExceptT Error m (Rendered ConflictStatus)
forall a b. (a -> b) -> a -> b
$
                                    TextRevisionID -> ConflictStatus
TextRevision.Conflict (TextRevisionID -> ConflictStatus)
-> TextRevisionID -> ConflictStatus
forall a b. (a -> b) -> a -> b
$
                                        TextRevision -> TextRevisionID
identifier TextRevision
latest
  where
    header :: TextRevision -> TextRevisionHeader
header = TextRevision -> TextRevisionHeader
TextRevision.header
    identifier :: TextRevision -> TextRevisionID
identifier = TextRevisionHeader -> TextRevisionID
TextRevision.identifier (TextRevisionHeader -> TextRevisionID)
-> (TextRevision -> TextRevisionHeader)
-> TextRevision
-> TextRevisionID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextRevision -> TextRevisionHeader
header
    timestamp :: TextRevision -> UTCTime
timestamp = TextRevisionHeader -> UTCTime
TextRevision.timestamp (TextRevisionHeader -> UTCTime)
-> (TextRevision -> TextRevisionHeader) -> TextRevision -> UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextRevision -> TextRevisionHeader
header
    author :: TextRevision -> UserRef
author = TextRevisionHeader -> UserRef
TextRevision.author (TextRevisionHeader -> UserRef)
-> (TextRevision -> TextRevisionHeader) -> TextRevision -> UserRef
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextRevision -> TextRevisionHeader
header
    authorID :: TextRevision -> UserID
authorID = UserRef -> UserID
UserRef.identifier (UserRef -> UserID)
-> (TextRevision -> UserRef) -> TextRevision -> UserID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextRevision -> UserRef
author
    shouldUpdate :: UTCTime -> TextRevision -> Bool
shouldUpdate UTCTime
tz TextRevision
latestRevision =
        Bool
enableSquashing
            Bool -> Bool -> Bool
&& UserID
userID UserID -> UserID -> Bool
forall a. Eq a => a -> a -> Bool
== TextRevision -> UserID
authorID TextRevision
latestRevision
            Bool -> Bool -> Bool
&& Float
diff Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
< Float
squashRevisionsWithinMinutes
      where
        diff :: Float
diff =
            ((Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
60) (Float -> Float)
-> (NominalDiffTime -> Float) -> NominalDiffTime -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NominalDiffTime -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac)
                (NominalDiffTime -> Float)
-> (UTCTime -> NominalDiffTime) -> UTCTime -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> UTCTime -> NominalDiffTime
diffUTCTime UTCTime
tz
                (UTCTime -> Float) -> UTCTime -> Float
forall a b. (a -> b) -> a -> b
$ TextRevision -> UTCTime
timestamp TextRevision
latestRevision

-- | Get a specific revision for a @TextElement@
getTextElementRevision
    :: ( HasGetTextElementRevision m
       , HasGetTreeRevision m
       , HasGetRevisionKey m
       , HasGetDocument m
       , HasLogMessage m
       )
    => UserID
    -> TextRevisionRef
    -> m (Result (Maybe (Rendered TextElementRevision)))
getTextElementRevision :: forall (m :: * -> *).
(HasGetTextElementRevision m, HasGetTreeRevision m,
 HasGetRevisionKey m, HasGetDocument m, HasLogMessage m) =>
UserID
-> TextRevisionRef
-> m (Result (Maybe (Rendered TextElementRevision)))
getTextElementRevision UserID
userID TextRevisionRef
ref = UserID
-> Scope
-> m (Result (Maybe (Rendered TextElementRevision)))
-> m (Result (Maybe (Rendered TextElementRevision)))
forall (m :: * -> *) a.
HasLogMessage m =>
UserID -> Scope -> m (Result a) -> m (Result a)
logged UserID
userID Scope
Scope.docsTextRevision (m (Result (Maybe (Rendered TextElementRevision)))
 -> m (Result (Maybe (Rendered TextElementRevision))))
-> m (Result (Maybe (Rendered TextElementRevision)))
-> m (Result (Maybe (Rendered TextElementRevision)))
forall a b. (a -> b) -> a -> b
$
    ExceptT Error m (Maybe (Rendered TextElementRevision))
-> m (Result (Maybe (Rendered TextElementRevision)))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT Error m (Maybe (Rendered TextElementRevision))
 -> m (Result (Maybe (Rendered TextElementRevision))))
-> ExceptT Error m (Maybe (Rendered TextElementRevision))
-> m (Result (Maybe (Rendered TextElementRevision)))
forall a b. (a -> b) -> a -> b
$ do
        let (TextRevisionRef (TextElementRef DocumentID
docID TextElementID
_) TextRevisionSelector
_) = TextRevisionRef
ref
        Permission -> DocumentID -> UserID -> ExceptT Error m ()
forall (m :: * -> *).
HasCheckPermission m =>
Permission -> DocumentID -> UserID -> ExceptT Error m ()
guardPermission Permission
Read DocumentID
docID UserID
userID
        Bool -> TextRevisionRef -> ExceptT Error m ()
forall (m :: * -> *).
HasExistsTextRevision m =>
Bool -> TextRevisionRef -> ExceptT Error m ()
guardExistsTextRevision Bool
True TextRevisionRef
ref
        Maybe TextElementRevision
revision <- m (Maybe TextElementRevision)
-> ExceptT Error m (Maybe TextElementRevision)
forall (m :: * -> *) a. Monad m => m a -> ExceptT Error m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Maybe TextElementRevision)
 -> ExceptT Error m (Maybe TextElementRevision))
-> m (Maybe TextElementRevision)
-> ExceptT Error m (Maybe TextElementRevision)
forall a b. (a -> b) -> a -> b
$ TextRevisionRef -> m (Maybe TextElementRevision)
forall (m :: * -> *).
HasGetTextElementRevision m =>
TextRevisionRef -> m (Maybe TextElementRevision)
DB.getTextElementRevision TextRevisionRef
ref
        (TextElementRevision
 -> ExceptT Error m (Rendered TextElementRevision))
-> Maybe TextElementRevision
-> ExceptT Error m (Maybe (Rendered 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 (UserID
-> TextRevisionRef
-> TextElementRevision
-> ExceptT Error m (Rendered TextElementRevision)
forall (m :: * -> *).
(HasGetTreeRevision m, HasLogMessage m,
 HasGetTextElementRevision m, HasGetRevisionKey m,
 HasGetDocument m) =>
UserID
-> TextRevisionRef
-> TextElementRevision
-> ExceptT Error m (Rendered TextElementRevision)
renderTextElementRevision UserID
userID TextRevisionRef
ref) Maybe TextElementRevision
revision

-- | Render HTML of a specific revision of a @TextElement@
renderTextElementRevision
    :: ( HasGetTreeRevision m
       , HasLogMessage m
       , HasGetTextElementRevision m
       , HasGetRevisionKey m
       , HasGetDocument m
       )
    => UserID
    -> TextRevisionRef
    -> TextElementRevision
    -> ExceptT Error m (Rendered TextElementRevision)
renderTextElementRevision :: forall (m :: * -> *).
(HasGetTreeRevision m, HasLogMessage m,
 HasGetTextElementRevision m, HasGetRevisionKey m,
 HasGetDocument m) =>
UserID
-> TextRevisionRef
-> TextElementRevision
-> ExceptT Error m (Rendered TextElementRevision)
renderTextElementRevision UserID
userID TextRevisionRef
ref TextElementRevision
rev = UserID
-> TextRevisionRef
-> Text
-> TextElementRevision
-> ExceptT Error m (Rendered TextElementRevision)
forall (m :: * -> *) a.
(HasGetTreeRevision m, HasLogMessage m,
 HasGetTextElementRevision m, HasGetRevisionKey m,
 HasGetDocument m) =>
UserID
-> TextRevisionRef -> Text -> a -> ExceptT Error m (Rendered a)
rendered' UserID
userID TextRevisionRef
ref Text
content TextElementRevision
rev
  where
    content :: Text
content = Text -> (TextRevision -> Text) -> Maybe TextRevision -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" TextRevision -> Text
TextRevision.content (Maybe TextRevision -> Text) -> Maybe TextRevision -> Text
forall a b. (a -> b) -> a -> b
$ TextElementRevision -> Maybe TextRevision
TextRevision.revision TextElementRevision
rev

rendered'
    :: ( HasGetTreeRevision m
       , HasLogMessage m
       , HasGetTextElementRevision m
       , HasGetRevisionKey m
       , HasGetDocument m
       )
    => UserID
    -> TextRevisionRef
    -> Text
    -> a
    -> ExceptT Error m (Rendered a)
rendered' :: forall (m :: * -> *) a.
(HasGetTreeRevision m, HasLogMessage m,
 HasGetTextElementRevision m, HasGetRevisionKey m,
 HasGetDocument m) =>
UserID
-> TextRevisionRef -> Text -> a -> ExceptT Error m (Rendered a)
rendered' UserID
userID TextRevisionRef
ref Text
content a
element = do
    HTMLBytes
html <- m (Either Error HTMLBytes) -> ExceptT Error m HTMLBytes
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (m (Either Error HTMLBytes) -> ExceptT Error m HTMLBytes)
-> m (Either Error HTMLBytes) -> ExceptT Error m HTMLBytes
forall a b. (a -> b) -> a -> b
$ UserID -> TextRevisionRef -> Text -> m (Either Error HTMLBytes)
forall (m :: * -> *).
(HasGetTreeRevision m, HasLogMessage m,
 HasGetTextElementRevision m, HasGetRevisionKey m,
 HasGetDocument m) =>
UserID -> TextRevisionRef -> Text -> m (Either Error HTMLBytes)
getTextRevisionHTMLForCustomText UserID
userID TextRevisionRef
ref Text
content
    let html' :: Maybe Text
html' =
            -- TODO: unHTMLBytes hier n bissl dumm, warum nicht den richtigen typen nuitzen????
            (UnicodeException -> Maybe Text)
-> (Text -> Maybe Text)
-> Either UnicodeException Text
-> Maybe Text
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe Text -> UnicodeException -> Maybe Text
forall a b. a -> b -> a
const Maybe Text
forall a. Maybe a
Nothing) Text -> Maybe Text
forall a. a -> Maybe a
Just (Either UnicodeException Text -> Maybe Text)
-> (HTMLBytes -> Either UnicodeException Text)
-> HTMLBytes
-> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either UnicodeException Text
TE.decodeUtf8' (ByteString -> Either UnicodeException Text)
-> (HTMLBytes -> ByteString)
-> HTMLBytes
-> Either UnicodeException Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LazyByteString -> ByteString
BL.toStrict (LazyByteString -> ByteString)
-> (HTMLBytes -> LazyByteString) -> HTMLBytes -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HTMLBytes -> LazyByteString
unHTMLBytes (HTMLBytes -> Maybe Text) -> HTMLBytes -> Maybe Text
forall a b. (a -> b) -> a -> b
$ HTMLBytes
html
    Rendered a -> ExceptT Error m (Rendered a)
forall a. a -> ExceptT Error m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Rendered a -> ExceptT Error m (Rendered a))
-> Rendered a -> ExceptT Error m (Rendered a)
forall a b. (a -> b) -> a -> b
$
        Rendered
            { element :: a
TextRevision.element = a
element
            , html :: Text
TextRevision.html = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" Maybe Text
html'
            }

getDocumentRevisionText
    :: (HasGetTextElementRevision m, HasGetRevisionKey m, HasLogMessage m)
    => UserID
    -> RevisionRef
    -> TextElementID
    -> m (Result (Maybe TextElementRevision))
getDocumentRevisionText :: forall (m :: * -> *).
(HasGetTextElementRevision m, HasGetRevisionKey m,
 HasLogMessage m) =>
UserID
-> RevisionRef
-> TextElementID
-> m (Result (Maybe TextElementRevision))
getDocumentRevisionText UserID
userID ref :: RevisionRef
ref@(RevisionRef DocumentID
docID RevisionSelector
_) TextElementID
textID =
    UserID
-> Scope
-> m (Result (Maybe TextElementRevision))
-> m (Result (Maybe TextElementRevision))
forall (m :: * -> *) a.
HasLogMessage m =>
UserID -> Scope -> m (Result a) -> m (Result a)
logged UserID
userID Scope
Scope.docsTextRevision (m (Result (Maybe TextElementRevision))
 -> m (Result (Maybe TextElementRevision)))
-> m (Result (Maybe TextElementRevision))
-> m (Result (Maybe TextElementRevision))
forall a b. (a -> b) -> a -> b
$ ExceptT Error m (Maybe TextElementRevision)
-> m (Result (Maybe TextElementRevision))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT Error m (Maybe TextElementRevision)
 -> m (Result (Maybe TextElementRevision)))
-> ExceptT Error m (Maybe TextElementRevision)
-> m (Result (Maybe TextElementRevision))
forall a b. (a -> b) -> a -> b
$ do
        Permission -> DocumentID -> UserID -> ExceptT Error m ()
forall (m :: * -> *).
HasCheckPermission m =>
Permission -> DocumentID -> UserID -> ExceptT Error m ()
guardPermission Permission
Read DocumentID
docID UserID
userID
        DocumentID -> ExceptT Error m ()
forall (m :: * -> *).
HasExistsDocument m =>
DocumentID -> ExceptT Error m ()
guardExistsDocument DocumentID
docID
        m (Maybe TextElementRevision)
-> ExceptT Error m (Maybe TextElementRevision)
forall (m :: * -> *) a. Monad m => m a -> ExceptT Error m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Maybe TextElementRevision)
 -> ExceptT Error m (Maybe TextElementRevision))
-> m (Maybe TextElementRevision)
-> ExceptT Error m (Maybe TextElementRevision)
forall a b. (a -> b) -> a -> b
$ do
            Maybe RevisionKey
key <- RevisionRef -> m (Maybe RevisionKey)
forall (m :: * -> *).
HasGetRevisionKey m =>
RevisionRef -> m (Maybe RevisionKey)
DB.getRevisionKey RevisionRef
ref
            let textRef :: TextElementRef
textRef = DocumentID -> TextElementID -> TextElementRef
TextElementRef DocumentID
docID TextElementID
textID
            Maybe (Maybe TextElementRevision)
result <-
                (RevisionKey -> m (Maybe TextElementRevision))
-> Maybe RevisionKey -> m (Maybe (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 (TextRevisionRef -> m (Maybe TextElementRevision)
forall (m :: * -> *).
HasGetTextElementRevision m =>
TextRevisionRef -> m (Maybe TextElementRevision)
DB.getTextElementRevision (TextRevisionRef -> m (Maybe TextElementRevision))
-> (RevisionKey -> TextRevisionRef)
-> RevisionKey
-> m (Maybe TextElementRevision)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextElementRef -> RevisionKey -> TextRevisionRef
textRevisionRefFor TextElementRef
textRef) Maybe RevisionKey
key
            Maybe TextElementRevision -> m (Maybe TextElementRevision)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe TextElementRevision -> m (Maybe TextElementRevision))
-> Maybe TextElementRevision -> m (Maybe TextElementRevision)
forall a b. (a -> b) -> a -> b
$ Maybe (Maybe TextElementRevision) -> Maybe TextElementRevision
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join Maybe (Maybe TextElementRevision)
result

createTreeRevision
    :: ( HasCreateTreeRevision m
       , HasLogMessage m
       , HasGetTextElementRevision m
       , HasGetTreeRevision m
       , HasRollback m
       )
    => UserID
    -> DocumentID
    -> Node TextElementID
    -> m (Result (TreeRevisionWithMetaData TextElementID))
createTreeRevision :: forall (m :: * -> *).
(HasCreateTreeRevision m, HasLogMessage m,
 HasGetTextElementRevision m, HasGetTreeRevision m,
 HasRollback m) =>
UserID
-> DocumentID
-> Node TextElementID
-> m (Result (TreeRevisionWithMetaData TextElementID))
createTreeRevision UserID
userID DocumentID
docID Node TextElementID
root = m (Result (TreeRevisionWithMetaData TextElementID))
-> m (Result (TreeRevisionWithMetaData TextElementID))
forall (m :: * -> *) a.
HasRollback m =>
m (Result a) -> m (Result a)
rollbackOnError (m (Result (TreeRevisionWithMetaData TextElementID))
 -> m (Result (TreeRevisionWithMetaData TextElementID)))
-> m (Result (TreeRevisionWithMetaData TextElementID))
-> m (Result (TreeRevisionWithMetaData TextElementID))
forall a b. (a -> b) -> a -> b
$
    UserID
-> Scope
-> m (Result (TreeRevisionWithMetaData TextElementID))
-> m (Result (TreeRevisionWithMetaData TextElementID))
forall (m :: * -> *) a.
HasLogMessage m =>
UserID -> Scope -> m (Result a) -> m (Result a)
logged UserID
userID Scope
Scope.docsTreeRevision (m (Result (TreeRevisionWithMetaData TextElementID))
 -> m (Result (TreeRevisionWithMetaData TextElementID)))
-> m (Result (TreeRevisionWithMetaData TextElementID))
-> m (Result (TreeRevisionWithMetaData TextElementID))
forall a b. (a -> b) -> a -> b
$
        ExceptT Error m (TreeRevisionWithMetaData TextElementID)
-> m (Result (TreeRevisionWithMetaData TextElementID))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT Error m (TreeRevisionWithMetaData TextElementID)
 -> m (Result (TreeRevisionWithMetaData TextElementID)))
-> ExceptT Error m (TreeRevisionWithMetaData TextElementID)
-> m (Result (TreeRevisionWithMetaData TextElementID))
forall a b. (a -> b) -> a -> b
$ do
            Permission -> DocumentID -> UserID -> ExceptT Error m ()
forall (m :: * -> *).
HasCheckPermission m =>
Permission -> DocumentID -> UserID -> ExceptT Error m ()
guardPermission Permission
Edit DocumentID
docID UserID
userID
            DocumentID -> ExceptT Error m ()
forall (m :: * -> *).
HasExistsDocument m =>
DocumentID -> ExceptT Error m ()
guardExistsDocument DocumentID
docID
            TextElementID -> Bool
existsTextElement <- m (TextElementID -> Bool)
-> ExceptT Error m (TextElementID -> Bool)
forall (m :: * -> *) a. Monad m => m a -> ExceptT Error m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (TextElementID -> Bool)
 -> ExceptT Error m (TextElementID -> Bool))
-> m (TextElementID -> Bool)
-> ExceptT Error m (TextElementID -> Bool)
forall a b. (a -> b) -> a -> b
$ DocumentID -> m (TextElementID -> Bool)
forall (m :: * -> *).
HasCreateTreeRevision m =>
DocumentID -> m (TextElementID -> Bool)
DB.existsTextElementInDocument DocumentID
docID
            (TreeRevision TreeRevisionHeader
header Node TextElementID
_) <- case (TextElementID -> Bool)
-> Node TextElementID -> Maybe TextElementID
forall {t :: * -> *} {a}.
Foldable t =>
(a -> Bool) -> t a -> Maybe a
firstFalse TextElementID -> Bool
existsTextElement Node TextElementID
root of
                Just TextElementID
textID -> Error -> ExceptT Error m (TreeRevision TextElementID)
forall a. Error -> ExceptT Error m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Error -> ExceptT Error m (TreeRevision TextElementID))
-> Error -> ExceptT Error m (TreeRevision TextElementID)
forall a b. (a -> b) -> a -> b
$ TextElementRef -> Error
TextElementNotFound (TextElementRef -> Error) -> TextElementRef -> Error
forall a b. (a -> b) -> a -> b
$ DocumentID -> TextElementID -> TextElementRef
TextElementRef DocumentID
docID TextElementID
textID
                Maybe TextElementID
Nothing -> m (TreeRevision TextElementID)
-> ExceptT Error m (TreeRevision TextElementID)
forall (m :: * -> *) a. Monad m => m a -> ExceptT Error m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (TreeRevision TextElementID)
 -> ExceptT Error m (TreeRevision TextElementID))
-> m (TreeRevision TextElementID)
-> ExceptT Error m (TreeRevision TextElementID)
forall a b. (a -> b) -> a -> b
$ UserID
-> DocumentID
-> Node TextElementID
-> m (TreeRevision TextElementID)
forall (m :: * -> *).
HasCreateTreeRevision m =>
UserID
-> DocumentID
-> Node TextElementID
-> m (TreeRevision TextElementID)
DB.createTreeRevision UserID
userID DocumentID
docID Node TextElementID
root
            Maybe (TreeRevisionWithMetaData TextElement)
newTree <-
                UserID
-> TreeRevisionRef
-> ExceptT Error m (Maybe (TreeRevisionWithMetaData TextElement))
forall (m :: * -> *).
(HasGetTreeRevision m, HasLogMessage m,
 HasGetTextElementRevision m) =>
UserID
-> TreeRevisionRef
-> ExceptT Error m (Maybe (TreeRevisionWithMetaData TextElement))
getTreeRevision' UserID
userID
                    (TreeRevisionRef
 -> ExceptT Error m (Maybe (TreeRevisionWithMetaData TextElement)))
-> TreeRevisionRef
-> ExceptT Error m (Maybe (TreeRevisionWithMetaData TextElement))
forall a b. (a -> b) -> a -> b
$ DocumentID -> TreeRevisionSelector -> TreeRevisionRef
TreeRevisionRef
                        DocumentID
docID
                    (TreeRevisionSelector -> TreeRevisionRef)
-> TreeRevisionSelector -> TreeRevisionRef
forall a b. (a -> b) -> a -> b
$ TreeRevisionID -> TreeRevisionSelector
TreeRevision.Specific
                        (TreeRevisionHeader -> TreeRevisionID
TreeRevision.identifier TreeRevisionHeader
header)
            TreeRevisionWithMetaData TextElement
newTree' <-
                m (Either Error (TreeRevisionWithMetaData TextElement))
-> ExceptT Error m (TreeRevisionWithMetaData TextElement)
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (m (Either Error (TreeRevisionWithMetaData TextElement))
 -> ExceptT Error m (TreeRevisionWithMetaData TextElement))
-> (Either Error (TreeRevisionWithMetaData TextElement)
    -> m (Either Error (TreeRevisionWithMetaData TextElement)))
-> Either Error (TreeRevisionWithMetaData TextElement)
-> ExceptT Error m (TreeRevisionWithMetaData TextElement)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either Error (TreeRevisionWithMetaData TextElement)
-> m (Either Error (TreeRevisionWithMetaData TextElement))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Error (TreeRevisionWithMetaData TextElement)
 -> ExceptT Error m (TreeRevisionWithMetaData TextElement))
-> Either Error (TreeRevisionWithMetaData TextElement)
-> ExceptT Error m (TreeRevisionWithMetaData TextElement)
forall a b. (a -> b) -> a -> b
$
                    Either Error (TreeRevisionWithMetaData TextElement)
-> (TreeRevisionWithMetaData TextElement
    -> Either Error (TreeRevisionWithMetaData TextElement))
-> Maybe (TreeRevisionWithMetaData TextElement)
-> Either Error (TreeRevisionWithMetaData TextElement)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
                        (Error -> Either Error (TreeRevisionWithMetaData TextElement)
forall a b. a -> Either a b
Left (Text -> Error
Custom Text
"The revision I just created is gone :((("))
                        TreeRevisionWithMetaData TextElement
-> Either Error (TreeRevisionWithMetaData TextElement)
forall a b. b -> Either a b
Right
                        Maybe (TreeRevisionWithMetaData TextElement)
newTree
            TreeRevisionWithMetaData TextElementID
-> ExceptT Error m (TreeRevisionWithMetaData TextElementID)
forall a. a -> ExceptT Error m a
forall (m :: * -> *) a. Monad m => a -> m a
return (TreeRevisionWithMetaData TextElementID
 -> ExceptT Error m (TreeRevisionWithMetaData TextElementID))
-> TreeRevisionWithMetaData TextElementID
-> ExceptT Error m (TreeRevisionWithMetaData TextElementID)
forall a b. (a -> b) -> a -> b
$ TextElement -> TextElementID
TextElement.identifier (TextElement -> TextElementID)
-> TreeRevisionWithMetaData TextElement
-> TreeRevisionWithMetaData TextElementID
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TreeRevisionWithMetaData TextElement
newTree'
  where
    firstFalse :: (a -> Bool) -> t a -> Maybe a
firstFalse a -> Bool
predicate = (a -> Bool) -> t a -> Maybe a
forall {t :: * -> *} {a}.
Foldable t =>
(a -> Bool) -> t a -> Maybe a
find (Bool -> Bool
not (Bool -> Bool) -> (a -> Bool) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Bool
predicate)

getFullTreeRevision
    :: (HasGetTreeRevision m, HasLogMessage m, HasGetTextElementRevision m)
    => UserID
    -> TreeRevisionRef
    -> m (Result (Maybe (TreeRevisionWithMetaData TextElementRevision)))
getFullTreeRevision :: forall (m :: * -> *).
(HasGetTreeRevision m, HasLogMessage m,
 HasGetTextElementRevision m) =>
UserID
-> TreeRevisionRef
-> m (Result
        (Maybe (TreeRevisionWithMetaData TextElementRevision)))
getFullTreeRevision UserID
userID =
    UserID
-> Scope
-> m (Result
        (Maybe (TreeRevisionWithMetaData TextElementRevision)))
-> m (Result
        (Maybe (TreeRevisionWithMetaData TextElementRevision)))
forall (m :: * -> *) a.
HasLogMessage m =>
UserID -> Scope -> m (Result a) -> m (Result a)
logged UserID
userID Scope
Scope.docsTreeRevision
        (m (Result (Maybe (TreeRevisionWithMetaData TextElementRevision)))
 -> m (Result
         (Maybe (TreeRevisionWithMetaData TextElementRevision))))
-> (TreeRevisionRef
    -> m (Result
            (Maybe (TreeRevisionWithMetaData TextElementRevision))))
-> TreeRevisionRef
-> m (Result
        (Maybe (TreeRevisionWithMetaData TextElementRevision)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExceptT
  Error m (Maybe (TreeRevisionWithMetaData TextElementRevision))
-> m (Result
        (Maybe (TreeRevisionWithMetaData TextElementRevision)))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT
        (ExceptT
   Error m (Maybe (TreeRevisionWithMetaData TextElementRevision))
 -> m (Result
         (Maybe (TreeRevisionWithMetaData TextElementRevision))))
-> (TreeRevisionRef
    -> ExceptT
         Error m (Maybe (TreeRevisionWithMetaData TextElementRevision)))
-> TreeRevisionRef
-> m (Result
        (Maybe (TreeRevisionWithMetaData TextElementRevision)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UserID
-> TreeRevisionRef
-> ExceptT
     Error m (Maybe (TreeRevisionWithMetaData TextElementRevision))
forall (m :: * -> *).
(HasGetTreeRevision m, HasLogMessage m,
 HasGetTextElementRevision m) =>
UserID
-> TreeRevisionRef
-> ExceptT
     Error m (Maybe (TreeRevisionWithMetaData TextElementRevision))
getFullTreeRevision' UserID
userID

getFullTreeRevision'
    :: (HasGetTreeRevision m, HasLogMessage m, HasGetTextElementRevision m)
    => UserID
    -> TreeRevisionRef
    -> ExceptT Error m (Maybe (TreeRevisionWithMetaData TextElementRevision))
getFullTreeRevision' :: forall (m :: * -> *).
(HasGetTreeRevision m, HasLogMessage m,
 HasGetTextElementRevision m) =>
UserID
-> TreeRevisionRef
-> ExceptT
     Error m (Maybe (TreeRevisionWithMetaData TextElementRevision))
getFullTreeRevision' UserID
userID TreeRevisionRef
ref = do
    Maybe (TreeRevision TextElementRevision)
fullTree <- UserID
-> TreeRevisionRef
-> ExceptT Error m (Maybe (TreeRevision TextElementRevision))
forall (m :: * -> *).
(HasGetTreeRevision m, HasGetTextElementRevision m,
 HasLogMessage m) =>
UserID
-> TreeRevisionRef
-> ExceptT Error m (Maybe (TreeRevision TextElementRevision))
getTreeWithLatestTexts UserID
userID TreeRevisionRef
ref
    m (Result (Maybe (TreeRevisionWithMetaData TextElementRevision)))
-> ExceptT
     Error m (Maybe (TreeRevisionWithMetaData TextElementRevision))
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (m (Result (Maybe (TreeRevisionWithMetaData TextElementRevision)))
 -> ExceptT
      Error m (Maybe (TreeRevisionWithMetaData TextElementRevision)))
-> (Result (Maybe (TreeRevisionWithMetaData TextElementRevision))
    -> m (Result
            (Maybe (TreeRevisionWithMetaData TextElementRevision))))
-> Result (Maybe (TreeRevisionWithMetaData TextElementRevision))
-> ExceptT
     Error m (Maybe (TreeRevisionWithMetaData TextElementRevision))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Result (Maybe (TreeRevisionWithMetaData TextElementRevision))
-> m (Result
        (Maybe (TreeRevisionWithMetaData TextElementRevision)))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Result (Maybe (TreeRevisionWithMetaData TextElementRevision))
 -> ExceptT
      Error m (Maybe (TreeRevisionWithMetaData TextElementRevision)))
-> Result (Maybe (TreeRevisionWithMetaData TextElementRevision))
-> ExceptT
     Error m (Maybe (TreeRevisionWithMetaData TextElementRevision))
forall a b. (a -> b) -> a -> b
$ case Maybe (TreeRevision TextElementRevision)
fullTree of
        Just TreeRevision TextElementRevision
tree -> (MetaError -> Error)
-> (TreeRevisionWithMetaData TextElementRevision
    -> Maybe (TreeRevisionWithMetaData TextElementRevision))
-> Either MetaError (TreeRevisionWithMetaData TextElementRevision)
-> Result (Maybe (TreeRevisionWithMetaData TextElementRevision))
forall a b c d. (a -> b) -> (c -> d) -> Either a c -> Either b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (Text -> Error
Custom (Text -> Error) -> (MetaError -> Text) -> MetaError -> Error
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack (String -> Text) -> (MetaError -> String) -> MetaError -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MetaError -> String
forall a. Show a => a -> String
show) TreeRevisionWithMetaData TextElementRevision
-> Maybe (TreeRevisionWithMetaData TextElementRevision)
forall a. a -> Maybe a
Just (TreeRevision TextElementRevision
-> Either MetaError (TreeRevisionWithMetaData TextElementRevision)
forall r.
Renderable r =>
TreeRevision r -> Either MetaError (TreeRevisionWithMetaData r)
treeRevisionToMeta TreeRevision TextElementRevision
tree)
        Maybe (TreeRevision TextElementRevision)
Nothing -> Maybe (TreeRevisionWithMetaData TextElementRevision)
-> Result (Maybe (TreeRevisionWithMetaData TextElementRevision))
forall a b. b -> Either a b
Right Maybe (TreeRevisionWithMetaData TextElementRevision)
forall a. Maybe a
Nothing

getTextRevisionPDF
    :: ( HasGetTreeRevision m
       , HasLogMessage m
       , HasGetTextElementRevision m
       , HasGetRevisionKey m
       , HasGetDocument m
       , MonadIO m
       )
    => UserID
    -> TextRevisionRef
    -> m (Result PDFBytes)
getTextRevisionPDF :: forall (m :: * -> *).
(HasGetTreeRevision m, HasLogMessage m,
 HasGetTextElementRevision m, HasGetRevisionKey m, HasGetDocument m,
 MonadIO m) =>
UserID -> TextRevisionRef -> m (Result PDFBytes)
getTextRevisionPDF UserID
userID ref :: TextRevisionRef
ref@(TextRevisionRef (TextElementRef DocumentID
_ TextElementID
textID) TextRevisionSelector
_) =
    UserID -> Scope -> m (Result PDFBytes) -> m (Result PDFBytes)
forall (m :: * -> *) a.
HasLogMessage m =>
UserID -> Scope -> m (Result a) -> m (Result a)
logged UserID
userID Scope
Scope.docsTreeRevision (m (Result PDFBytes) -> m (Result PDFBytes))
-> m (Result PDFBytes) -> m (Result PDFBytes)
forall a b. (a -> b) -> a -> b
$ ExceptT Error m PDFBytes -> m (Result PDFBytes)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT Error m PDFBytes -> m (Result PDFBytes))
-> ExceptT Error m PDFBytes -> m (Result PDFBytes)
forall a b. (a -> b) -> a -> b
$ do
        Bool -> TextRevisionRef -> ExceptT Error m ()
forall (m :: * -> *).
HasExistsTextRevision m =>
Bool -> TextRevisionRef -> ExceptT Error m ()
guardExistsTextRevision Bool
True TextRevisionRef
ref
        let ref' :: RevisionRef
ref' = TextRevisionRef -> RevisionRef
Revision.refFromTextRevision TextRevisionRef
ref
        Maybe (Flagged' DocumentContainer)
maybeDocumentContainer <-
            UserID
-> RevisionRef
-> TextElementID
-> ExceptT Error m (Maybe (Flagged' DocumentContainer))
forall (m :: * -> *).
(HasGetTreeRevision m, HasGetTextElementRevision m,
 HasGetRevisionKey m, HasGetDocument m, HasLogMessage m) =>
UserID
-> RevisionRef
-> TextElementID
-> ExceptT Error m (Maybe (Flagged' DocumentContainer))
getDocumentRevisionDocumentContainerForTextElement UserID
userID RevisionRef
ref' TextElementID
textID
        Flagged' DocumentContainer
documentContainer <-
            m (Either Error (Flagged' DocumentContainer))
-> ExceptT Error m (Flagged' DocumentContainer)
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (m (Either Error (Flagged' DocumentContainer))
 -> ExceptT Error m (Flagged' DocumentContainer))
-> (Either Error (Flagged' DocumentContainer)
    -> m (Either Error (Flagged' DocumentContainer)))
-> Either Error (Flagged' DocumentContainer)
-> ExceptT Error m (Flagged' DocumentContainer)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either Error (Flagged' DocumentContainer)
-> m (Either Error (Flagged' DocumentContainer))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Error (Flagged' DocumentContainer)
 -> ExceptT Error m (Flagged' DocumentContainer))
-> Either Error (Flagged' DocumentContainer)
-> ExceptT Error m (Flagged' DocumentContainer)
forall a b. (a -> b) -> a -> b
$
                Either Error (Flagged' DocumentContainer)
-> (Flagged' DocumentContainer
    -> Either Error (Flagged' DocumentContainer))
-> Maybe (Flagged' DocumentContainer)
-> Either Error (Flagged' DocumentContainer)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Error -> Either Error (Flagged' DocumentContainer)
forall a b. a -> Either a b
Left (Error -> Either Error (Flagged' DocumentContainer))
-> Error -> Either Error (Flagged' DocumentContainer)
forall a b. (a -> b) -> a -> b
$ RevisionRef -> Error
RevisionNotFound RevisionRef
ref') Flagged' DocumentContainer
-> Either Error (Flagged' DocumentContainer)
forall a b. b -> Either a b
Right Maybe (Flagged' DocumentContainer)
maybeDocumentContainer
        Flagged' DocumentContainer -> ExceptT Error m PDFBytes
forall (m :: * -> *).
MonadIO m =>
Flagged' DocumentContainer -> ExceptT Error m PDFBytes
toPDF Flagged' DocumentContainer
documentContainer

getTextRevisionHTMLForCustomText
    :: ( HasGetTreeRevision m
       , HasLogMessage m
       , HasGetTextElementRevision m
       , HasGetRevisionKey m
       , HasGetDocument m
       )
    => UserID
    -> TextRevisionRef
    -> Text
    -> m (Result HTMLBytes)
getTextRevisionHTMLForCustomText :: forall (m :: * -> *).
(HasGetTreeRevision m, HasLogMessage m,
 HasGetTextElementRevision m, HasGetRevisionKey m,
 HasGetDocument m) =>
UserID -> TextRevisionRef -> Text -> m (Either Error HTMLBytes)
getTextRevisionHTMLForCustomText UserID
userID ref :: TextRevisionRef
ref@(TextRevisionRef (TextElementRef DocumentID
_ TextElementID
textID) TextRevisionSelector
_) Text
text =
    UserID
-> Scope
-> m (Either Error HTMLBytes)
-> m (Either Error HTMLBytes)
forall (m :: * -> *) a.
HasLogMessage m =>
UserID -> Scope -> m (Result a) -> m (Result a)
logged UserID
userID Scope
Scope.docsTreeRevision (m (Either Error HTMLBytes) -> m (Either Error HTMLBytes))
-> m (Either Error HTMLBytes) -> m (Either Error HTMLBytes)
forall a b. (a -> b) -> a -> b
$ ExceptT Error m HTMLBytes -> m (Either Error HTMLBytes)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT Error m HTMLBytes -> m (Either Error HTMLBytes))
-> ExceptT Error m HTMLBytes -> m (Either Error HTMLBytes)
forall a b. (a -> b) -> a -> b
$ do
        Bool -> TextRevisionRef -> ExceptT Error m ()
forall (m :: * -> *).
HasExistsTextRevision m =>
Bool -> TextRevisionRef -> ExceptT Error m ()
guardExistsTextRevision Bool
True TextRevisionRef
ref
        let ref' :: RevisionRef
ref' = TextRevisionRef -> RevisionRef
Revision.refFromTextRevision TextRevisionRef
ref
        Maybe (Flagged' DocumentContainer)
maybeDocumentContainer <-
            UserID
-> RevisionRef
-> TextElementID
-> Text
-> ExceptT Error m (Maybe (Flagged' DocumentContainer))
forall (m :: * -> *).
(HasGetTreeRevision m, HasGetTextElementRevision m,
 HasGetRevisionKey m, HasGetDocument m, HasLogMessage m) =>
UserID
-> RevisionRef
-> TextElementID
-> Text
-> ExceptT Error m (Maybe (Flagged' DocumentContainer))
getDocumentRevisionDocumentContainerForCustomText UserID
userID RevisionRef
ref' TextElementID
textID Text
text
        HTMLBytes -> ExceptT Error m HTMLBytes
forall a. a -> ExceptT Error m a
forall (m :: * -> *) a. Monad m => a -> m a
return (HTMLBytes -> ExceptT Error m HTMLBytes)
-> HTMLBytes -> ExceptT Error m HTMLBytes
forall a b. (a -> b) -> a -> b
$
            LazyByteString -> HTMLBytes
HTMLBytes (LazyByteString -> HTMLBytes) -> LazyByteString -> HTMLBytes
forall a b. (a -> b) -> a -> b
$
                LazyByteString
-> (Flagged' DocumentContainer -> LazyByteString)
-> Maybe (Flagged' DocumentContainer)
-> LazyByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe LazyByteString
"" Flagged' DocumentContainer -> LazyByteString
HTML.renderHtmlCssBS Maybe (Flagged' DocumentContainer)
maybeDocumentContainer

getTreeRevisionPDF
    :: (HasGetTreeRevision m, HasLogMessage m, HasGetTextElementRevision m, MonadIO m)
    => UserID
    -> TreeRevisionRef
    -> m (Result PDFBytes)
getTreeRevisionPDF :: forall (m :: * -> *).
(HasGetTreeRevision m, HasLogMessage m,
 HasGetTextElementRevision m, MonadIO m) =>
UserID -> TreeRevisionRef -> m (Result PDFBytes)
getTreeRevisionPDF UserID
userID TreeRevisionRef
ref = UserID -> Scope -> m (Result PDFBytes) -> m (Result PDFBytes)
forall (m :: * -> *) a.
HasLogMessage m =>
UserID -> Scope -> m (Result a) -> m (Result a)
logged UserID
userID Scope
Scope.docsTreeRevision (m (Result PDFBytes) -> m (Result PDFBytes))
-> m (Result PDFBytes) -> m (Result PDFBytes)
forall a b. (a -> b) -> a -> b
$ ExceptT Error m PDFBytes -> m (Result PDFBytes)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT Error m PDFBytes -> m (Result PDFBytes))
-> ExceptT Error m PDFBytes -> m (Result PDFBytes)
forall a b. (a -> b) -> a -> b
$ do
    Maybe (Flagged' DocumentContainer)
maybeDocumentContainer <- UserID
-> TreeRevisionRef
-> ExceptT Error m (Maybe (Flagged' DocumentContainer))
forall (m :: * -> *).
(HasGetTreeRevision m, HasLogMessage m,
 HasGetTextElementRevision m) =>
UserID
-> TreeRevisionRef
-> ExceptT Error m (Maybe (Flagged' DocumentContainer))
getTreeRevisionDocumentContainer UserID
userID TreeRevisionRef
ref
    Flagged' DocumentContainer
documentContainer <-
        m (Either Error (Flagged' DocumentContainer))
-> ExceptT Error m (Flagged' DocumentContainer)
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (m (Either Error (Flagged' DocumentContainer))
 -> ExceptT Error m (Flagged' DocumentContainer))
-> (Either Error (Flagged' DocumentContainer)
    -> m (Either Error (Flagged' DocumentContainer)))
-> Either Error (Flagged' DocumentContainer)
-> ExceptT Error m (Flagged' DocumentContainer)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either Error (Flagged' DocumentContainer)
-> m (Either Error (Flagged' DocumentContainer))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Error (Flagged' DocumentContainer)
 -> ExceptT Error m (Flagged' DocumentContainer))
-> Either Error (Flagged' DocumentContainer)
-> ExceptT Error m (Flagged' DocumentContainer)
forall a b. (a -> b) -> a -> b
$
            Either Error (Flagged' DocumentContainer)
-> (Flagged' DocumentContainer
    -> Either Error (Flagged' DocumentContainer))
-> Maybe (Flagged' DocumentContainer)
-> Either Error (Flagged' DocumentContainer)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Error -> Either Error (Flagged' DocumentContainer)
forall a b. a -> Either a b
Left (Error -> Either Error (Flagged' DocumentContainer))
-> Error -> Either Error (Flagged' DocumentContainer)
forall a b. (a -> b) -> a -> b
$ TreeRevisionRef -> Error
TreeRevisionNotFound TreeRevisionRef
ref) Flagged' DocumentContainer
-> Either Error (Flagged' DocumentContainer)
forall a b. b -> Either a b
Right Maybe (Flagged' DocumentContainer)
maybeDocumentContainer
    Flagged' DocumentContainer -> ExceptT Error m PDFBytes
forall (m :: * -> *).
MonadIO m =>
Flagged' DocumentContainer -> ExceptT Error m PDFBytes
toPDF Flagged' DocumentContainer
documentContainer

getTreeRevisionHTML
    :: (HasGetTreeRevision m, HasLogMessage m, HasGetTextElementRevision m, MonadIO m)
    => UserID
    -> TreeRevisionRef
    -> m (Result ZipBytes)
getTreeRevisionHTML :: forall (m :: * -> *).
(HasGetTreeRevision m, HasLogMessage m,
 HasGetTextElementRevision m, MonadIO m) =>
UserID -> TreeRevisionRef -> m (Result ZipBytes)
getTreeRevisionHTML UserID
userID TreeRevisionRef
ref = UserID -> Scope -> m (Result ZipBytes) -> m (Result ZipBytes)
forall (m :: * -> *) a.
HasLogMessage m =>
UserID -> Scope -> m (Result a) -> m (Result a)
logged UserID
userID Scope
Scope.docsTreeRevision (m (Result ZipBytes) -> m (Result ZipBytes))
-> m (Result ZipBytes) -> m (Result ZipBytes)
forall a b. (a -> b) -> a -> b
$ ExceptT Error m ZipBytes -> m (Result ZipBytes)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT Error m ZipBytes -> m (Result ZipBytes))
-> ExceptT Error m ZipBytes -> m (Result ZipBytes)
forall a b. (a -> b) -> a -> b
$ do
    Maybe (Flagged' DocumentContainer)
maybeDocumentContainer <- UserID
-> TreeRevisionRef
-> ExceptT Error m (Maybe (Flagged' DocumentContainer))
forall (m :: * -> *).
(HasGetTreeRevision m, HasLogMessage m,
 HasGetTextElementRevision m) =>
UserID
-> TreeRevisionRef
-> ExceptT Error m (Maybe (Flagged' DocumentContainer))
getTreeRevisionDocumentContainer UserID
userID TreeRevisionRef
ref
    Flagged' DocumentContainer
documentContainer <-
        m (Either Error (Flagged' DocumentContainer))
-> ExceptT Error m (Flagged' DocumentContainer)
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (m (Either Error (Flagged' DocumentContainer))
 -> ExceptT Error m (Flagged' DocumentContainer))
-> (Either Error (Flagged' DocumentContainer)
    -> m (Either Error (Flagged' DocumentContainer)))
-> Either Error (Flagged' DocumentContainer)
-> ExceptT Error m (Flagged' DocumentContainer)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either Error (Flagged' DocumentContainer)
-> m (Either Error (Flagged' DocumentContainer))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Error (Flagged' DocumentContainer)
 -> ExceptT Error m (Flagged' DocumentContainer))
-> Either Error (Flagged' DocumentContainer)
-> ExceptT Error m (Flagged' DocumentContainer)
forall a b. (a -> b) -> a -> b
$
            Either Error (Flagged' DocumentContainer)
-> (Flagged' DocumentContainer
    -> Either Error (Flagged' DocumentContainer))
-> Maybe (Flagged' DocumentContainer)
-> Either Error (Flagged' DocumentContainer)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Error -> Either Error (Flagged' DocumentContainer)
forall a b. a -> Either a b
Left (Error -> Either Error (Flagged' DocumentContainer))
-> Error -> Either Error (Flagged' DocumentContainer)
forall a b. (a -> b) -> a -> b
$ TreeRevisionRef -> Error
TreeRevisionNotFound TreeRevisionRef
ref) Flagged' DocumentContainer
-> Either Error (Flagged' DocumentContainer)
forall a b. b -> Either a b
Right Maybe (Flagged' DocumentContainer)
maybeDocumentContainer
    Flagged' DocumentContainer -> ExceptT Error m ZipBytes
forall (m :: * -> *).
MonadIO m =>
Flagged' DocumentContainer -> ExceptT Error m ZipBytes
toHTML Flagged' DocumentContainer
documentContainer

toPDF
    :: (MonadIO m)
    => LTML.Flagged' LTML.DocumentContainer
    -> ExceptT Error m PDFBytes
toPDF :: forall (m :: * -> *).
MonadIO m =>
Flagged' DocumentContainer -> ExceptT Error m PDFBytes
toPDF Flagged' DocumentContainer
documentContainer = do
    Either String LazyByteString
pdf <- IO (Either String LazyByteString)
-> ExceptT Error m (Either String LazyByteString)
forall a. IO a -> ExceptT Error m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either String LazyByteString)
 -> ExceptT Error m (Either String LazyByteString))
-> IO (Either String LazyByteString)
-> ExceptT Error m (Either String LazyByteString)
forall a b. (a -> b) -> a -> b
$ Flagged' DocumentContainer -> IO (Either String LazyByteString)
forall a. ToPreLaTeXM a => a -> IO (Either String LazyByteString)
PDF.generatePDF Flagged' DocumentContainer
documentContainer
    m (Result PDFBytes) -> ExceptT Error m PDFBytes
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (m (Result PDFBytes) -> ExceptT Error m PDFBytes)
-> (Result PDFBytes -> m (Result PDFBytes))
-> Result PDFBytes
-> ExceptT Error m PDFBytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Result PDFBytes -> m (Result PDFBytes)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Result PDFBytes -> ExceptT Error m PDFBytes)
-> Result PDFBytes -> ExceptT Error m PDFBytes
forall a b. (a -> b) -> a -> b
$ (String -> Error)
-> (LazyByteString -> PDFBytes)
-> Either String LazyByteString
-> Result PDFBytes
forall a b c d. (a -> b) -> (c -> d) -> Either a c -> Either b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (Text -> Error
PDFError (Text -> Error) -> (String -> Text) -> String -> Error
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack) LazyByteString -> PDFBytes
PDFBytes Either String LazyByteString
pdf

toHTML
    :: (MonadIO m)
    => LTML.Flagged' LTML.DocumentContainer
    -> ExceptT Error m ZipBytes
toHTML :: forall (m :: * -> *).
MonadIO m =>
Flagged' DocumentContainer -> ExceptT Error m ZipBytes
toHTML Flagged' DocumentContainer
documentContainer = do
    Maybe LazyByteString
zipBytes <- IO (Maybe LazyByteString) -> ExceptT Error m (Maybe LazyByteString)
forall a. IO a -> ExceptT Error m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe LazyByteString)
 -> ExceptT Error m (Maybe LazyByteString))
-> IO (Maybe LazyByteString)
-> ExceptT Error m (Maybe LazyByteString)
forall a b. (a -> b) -> a -> b
$ Flagged' DocumentContainer -> IO (Maybe LazyByteString)
HTML.renderZip Flagged' DocumentContainer
documentContainer
    m (Result ZipBytes) -> ExceptT Error m ZipBytes
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (m (Result ZipBytes) -> ExceptT Error m ZipBytes)
-> (Result ZipBytes -> m (Result ZipBytes))
-> Result ZipBytes
-> ExceptT Error m ZipBytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Result ZipBytes -> m (Result ZipBytes)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Result ZipBytes -> ExceptT Error m ZipBytes)
-> Result ZipBytes -> ExceptT Error m ZipBytes
forall a b. (a -> b) -> a -> b
$ Result ZipBytes
-> (LazyByteString -> Result ZipBytes)
-> Maybe LazyByteString
-> Result ZipBytes
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Error -> Result ZipBytes
forall a b. a -> Either a b
Left Error
ZipHTMLError) (ZipBytes -> Result ZipBytes
forall a b. b -> Either a b
Right (ZipBytes -> Result ZipBytes)
-> (LazyByteString -> ZipBytes)
-> LazyByteString
-> Result ZipBytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LazyByteString -> ZipBytes
ZipBytes) Maybe LazyByteString
zipBytes

getTreeRevisionDocumentContainer
    :: (HasGetTreeRevision m, HasLogMessage m, HasGetTextElementRevision m)
    => UserID
    -> TreeRevisionRef
    -> ExceptT Error m (Maybe (LTML.Flagged' LTML.DocumentContainer))
getTreeRevisionDocumentContainer :: forall (m :: * -> *).
(HasGetTreeRevision m, HasLogMessage m,
 HasGetTextElementRevision m) =>
UserID
-> TreeRevisionRef
-> ExceptT Error m (Maybe (Flagged' DocumentContainer))
getTreeRevisionDocumentContainer UserID
userID TreeRevisionRef
ref = do
    Maybe (TreeRevision TextElementRevision)
fullRevision <- UserID
-> TreeRevisionRef
-> ExceptT Error m (Maybe (TreeRevision TextElementRevision))
forall (m :: * -> *).
(HasGetTreeRevision m, HasGetTextElementRevision m,
 HasLogMessage m) =>
UserID
-> TreeRevisionRef
-> ExceptT Error m (Maybe (TreeRevision TextElementRevision))
getTreeWithLatestTexts UserID
userID TreeRevisionRef
ref
    m (Either Error (Maybe (Flagged' DocumentContainer)))
-> ExceptT Error m (Maybe (Flagged' DocumentContainer))
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (m (Either Error (Maybe (Flagged' DocumentContainer)))
 -> ExceptT Error m (Maybe (Flagged' DocumentContainer)))
-> (Either Error (Maybe (Flagged' DocumentContainer))
    -> m (Either Error (Maybe (Flagged' DocumentContainer))))
-> Either Error (Maybe (Flagged' DocumentContainer))
-> ExceptT Error m (Maybe (Flagged' DocumentContainer))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either Error (Maybe (Flagged' DocumentContainer))
-> m (Either Error (Maybe (Flagged' DocumentContainer)))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Error (Maybe (Flagged' DocumentContainer))
 -> ExceptT Error m (Maybe (Flagged' DocumentContainer)))
-> Either Error (Maybe (Flagged' DocumentContainer))
-> ExceptT Error m (Maybe (Flagged' DocumentContainer))
forall a b. (a -> b) -> a -> b
$
        Either Error (Maybe (Flagged' DocumentContainer))
-> (TreeRevision TextElementRevision
    -> Either Error (Maybe (Flagged' DocumentContainer)))
-> Maybe (TreeRevision TextElementRevision)
-> Either Error (Maybe (Flagged' DocumentContainer))
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
            (Maybe (Flagged' DocumentContainer)
-> Either Error (Maybe (Flagged' DocumentContainer))
forall a b. b -> Either a b
Right Maybe (Flagged' DocumentContainer)
forall a. Maybe a
Nothing)
            ((Flagged' DocumentContainer -> Maybe (Flagged' DocumentContainer))
-> Either Error (Flagged' DocumentContainer)
-> Either Error (Maybe (Flagged' DocumentContainer))
forall b c a. (b -> c) -> Either a b -> Either a c
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second Flagged' DocumentContainer -> Maybe (Flagged' DocumentContainer)
forall a. a -> Maybe a
Just (Either Error (Flagged' DocumentContainer)
 -> Either Error (Maybe (Flagged' DocumentContainer)))
-> (TreeRevision TextElementRevision
    -> Either Error (Flagged' DocumentContainer))
-> TreeRevision TextElementRevision
-> Either Error (Maybe (Flagged' DocumentContainer))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TreeRevision TextElementRevision
-> Either Error (Flagged' DocumentContainer)
toDocumentContainer)
            Maybe (TreeRevision TextElementRevision)
fullRevision

toDocumentContainer
    :: TreeRevision TextElementRevision
    -> Result (LTML.Flagged' LTML.DocumentContainer)
toDocumentContainer :: TreeRevision TextElementRevision
-> Either Error (Flagged' DocumentContainer)
toDocumentContainer TreeRevision TextElementRevision
fullRevision =
    (TreeError -> Error)
-> Either TreeError (Flagged' DocumentContainer)
-> Either Error (Flagged' DocumentContainer)
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Text -> Error
Custom (Text -> Error) -> (TreeError -> Text) -> TreeError -> Error
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack (String -> Text) -> (TreeError -> String) -> TreeError -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TreeError -> String
forall a. Show a => a -> String
show) (Either TreeError (Flagged' DocumentContainer)
 -> Either Error (Flagged' DocumentContainer))
-> Either TreeError (Flagged' DocumentContainer)
-> Either Error (Flagged' DocumentContainer)
forall a b. (a -> b) -> a -> b
$
        FlaggedInputTree' -> Either TreeError (Flagged' DocumentContainer)
LTML.treeToLtml (FlaggedInputTree'
 -> Either TreeError (Flagged' DocumentContainer))
-> FlaggedInputTree'
-> Either TreeError (Flagged' DocumentContainer)
forall a b. (a -> b) -> a -> b
$
            TreeRevision TextElementRevision -> FlaggedInputTree'
forall {r}. Renderable r => TreeRevision r -> FlaggedInputTree'
toInputTree TreeRevision TextElementRevision
fullRevision
  where
    toInputTree :: TreeRevision r -> FlaggedInputTree'
toInputTree (TreeRevision TreeRevisionHeader
_ Node r
node) =
        (NodeHeader -> Bool) -> (r -> Bool) -> Node r -> FlaggedInputTree'
forall r.
Renderable r =>
(NodeHeader -> Bool) -> (r -> Bool) -> Node r -> FlaggedInputTree'
nodeToLtmlInputTreePred (Bool -> NodeHeader -> Bool
forall a b. a -> b -> a
const Bool
True) (Bool -> r -> Bool
forall a b. a -> b -> a
const Bool
True) Node r
node

toDocumentContainerForCustomText
    :: TextElementID
    -> Text
    -> TreeRevision TextElementRevision
    -> Result (LTML.Flagged' LTML.DocumentContainer)
toDocumentContainerForCustomText :: TextElementID
-> Text
-> TreeRevision TextElementRevision
-> Either Error (Flagged' DocumentContainer)
toDocumentContainerForCustomText TextElementID
textID Text
text TreeRevision TextElementRevision
fullRevision =
    let overridenRevision :: TreeRevision (DirectRenderable TextElementID)
overridenRevision = TextElementRevision -> DirectRenderable TextElementID
override (TextElementRevision -> DirectRenderable TextElementID)
-> TreeRevision TextElementRevision
-> TreeRevision (DirectRenderable TextElementID)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TreeRevision TextElementRevision
fullRevision
     in (TreeError -> Error)
-> Either TreeError (Flagged' DocumentContainer)
-> Either Error (Flagged' DocumentContainer)
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Text -> Error
Custom (Text -> Error) -> (TreeError -> Text) -> TreeError -> Error
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack (String -> Text) -> (TreeError -> String) -> TreeError -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TreeError -> String
forall a. Show a => a -> String
show) (Either TreeError (Flagged' DocumentContainer)
 -> Either Error (Flagged' DocumentContainer))
-> Either TreeError (Flagged' DocumentContainer)
-> Either Error (Flagged' DocumentContainer)
forall a b. (a -> b) -> a -> b
$
            FlaggedInputTree' -> Either TreeError (Flagged' DocumentContainer)
LTML.treeToLtml (FlaggedInputTree'
 -> Either TreeError (Flagged' DocumentContainer))
-> FlaggedInputTree'
-> Either TreeError (Flagged' DocumentContainer)
forall a b. (a -> b) -> a -> b
$
                TreeRevision (DirectRenderable TextElementID) -> FlaggedInputTree'
toInputTree TreeRevision (DirectRenderable TextElementID)
overridenRevision
  where
    toInputTree :: TreeRevision (DirectRenderable TextElementID) -> FlaggedInputTree'
toInputTree (TreeRevision TreeRevisionHeader
_ Node (DirectRenderable TextElementID)
node) =
        (NodeHeader -> Bool)
-> (DirectRenderable TextElementID -> Bool)
-> Node (DirectRenderable TextElementID)
-> FlaggedInputTree'
forall r.
Renderable r =>
(NodeHeader -> Bool) -> (r -> Bool) -> Node r -> FlaggedInputTree'
nodeToLtmlInputTreePred
            (Bool -> NodeHeader -> Bool
forall a b. a -> b -> a
const Bool
False)
            ((TextElementID
textID TextElementID -> TextElementID -> Bool
forall a. Eq a => a -> a -> Bool
==) (TextElementID -> Bool)
-> (DirectRenderable TextElementID -> TextElementID)
-> DirectRenderable TextElementID
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DirectRenderable TextElementID -> TextElementID
forall id. DirectRenderable id -> id
Renderable.identifier)
            Node (DirectRenderable TextElementID)
node
    override :: TextElementRevision -> DirectRenderable TextElementID
override rev :: TextElementRevision
rev@(TextElementRevision TextElement
textElement Maybe TextRevision
_) =
        let id_ :: TextElementID
id_ = TextElement -> TextElementID
TextElement.identifier TextElement
textElement
         in if TextElementID
id_ TextElementID -> TextElementID -> Bool
forall a. Eq a => a -> a -> Bool
== TextElementID
textID
                then
                    (TextElementRevision
-> TextElementID -> DirectRenderable TextElementID
forall r id. Renderable r => r -> id -> DirectRenderable id
directRenderable TextElementRevision
rev TextElementID
id_)
                        { Renderable.content = text
                        }
                else TextElementRevision
-> TextElementID -> DirectRenderable TextElementID
forall r id. Renderable r => r -> id -> DirectRenderable id
directRenderable TextElementRevision
rev TextElementID
id_

toDocumentContainerForTextElement
    :: TextElementID
    -> TreeRevision TextElementRevision
    -> Result (LTML.Flagged' LTML.DocumentContainer)
toDocumentContainerForTextElement :: TextElementID
-> TreeRevision TextElementRevision
-> Either Error (Flagged' DocumentContainer)
toDocumentContainerForTextElement TextElementID
teID TreeRevision TextElementRevision
fullRevision =
    (TreeError -> Error)
-> Either TreeError (Flagged' DocumentContainer)
-> Either Error (Flagged' DocumentContainer)
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Text -> Error
Custom (Text -> Error) -> (TreeError -> Text) -> TreeError -> Error
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack (String -> Text) -> (TreeError -> String) -> TreeError -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TreeError -> String
forall a. Show a => a -> String
show) (Either TreeError (Flagged' DocumentContainer)
 -> Either Error (Flagged' DocumentContainer))
-> Either TreeError (Flagged' DocumentContainer)
-> Either Error (Flagged' DocumentContainer)
forall a b. (a -> b) -> a -> b
$
        FlaggedInputTree' -> Either TreeError (Flagged' DocumentContainer)
LTML.treeToLtml (FlaggedInputTree'
 -> Either TreeError (Flagged' DocumentContainer))
-> FlaggedInputTree'
-> Either TreeError (Flagged' DocumentContainer)
forall a b. (a -> b) -> a -> b
$
            TreeRevision TextElementRevision -> FlaggedInputTree'
toInputTree TreeRevision TextElementRevision
fullRevision
  where
    toInputTree :: TreeRevision TextElementRevision -> FlaggedInputTree'
toInputTree (TreeRevision TreeRevisionHeader
_ Node TextElementRevision
node) =
        (NodeHeader -> Bool)
-> (TextElementRevision -> Bool)
-> Node TextElementRevision
-> FlaggedInputTree'
forall r.
Renderable r =>
(NodeHeader -> Bool) -> (r -> Bool) -> Node r -> FlaggedInputTree'
nodeToLtmlInputTreePred
            (Bool -> NodeHeader -> Bool
forall a b. a -> b -> a
const Bool
False)
            ((TextElementID
teID TextElementID -> TextElementID -> Bool
forall a. Eq a => a -> a -> Bool
==) (TextElementID -> Bool)
-> (TextElementRevision -> TextElementID)
-> TextElementRevision
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextElement -> TextElementID
TextElement.identifier (TextElement -> TextElementID)
-> (TextElementRevision -> TextElement)
-> TextElementRevision
-> TextElementID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextElementRevision -> TextElement
TextRevision.textElement)
            Node TextElementRevision
node

getDocumentRevisionDocumentContainerForTextElement
    :: ( HasGetTreeRevision m
       , HasGetTextElementRevision m
       , HasGetRevisionKey m
       , HasGetDocument m
       , HasLogMessage m
       )
    => UserID
    -> RevisionRef
    -> TextElementID
    -> ExceptT Error m (Maybe (LTML.Flagged' LTML.DocumentContainer))
getDocumentRevisionDocumentContainerForTextElement :: forall (m :: * -> *).
(HasGetTreeRevision m, HasGetTextElementRevision m,
 HasGetRevisionKey m, HasGetDocument m, HasLogMessage m) =>
UserID
-> RevisionRef
-> TextElementID
-> ExceptT Error m (Maybe (Flagged' DocumentContainer))
getDocumentRevisionDocumentContainerForTextElement UserID
userID RevisionRef
ref TextElementID
textID = do
    Maybe (TreeRevision TextElementRevision)
fullRevision <- UserID
-> RevisionRef
-> ExceptT Error m (FullDocument TextElementRevision)
forall (m :: * -> *).
(HasGetTreeRevision m, HasGetTextElementRevision m,
 HasGetRevisionKey m, HasGetDocument m, HasLogMessage m) =>
UserID
-> RevisionRef
-> ExceptT Error m (FullDocument TextElementRevision)
getDocumentRevision' UserID
userID RevisionRef
ref ExceptT Error m (FullDocument TextElementRevision)
-> (FullDocument TextElementRevision
    -> Maybe (TreeRevision TextElementRevision))
-> ExceptT Error m (Maybe (TreeRevision TextElementRevision))
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> FullDocument TextElementRevision
-> Maybe (TreeRevision TextElementRevision)
forall a. FullDocument a -> Maybe (TreeRevision a)
FullDocument.body
    m (Either Error (Maybe (Flagged' DocumentContainer)))
-> ExceptT Error m (Maybe (Flagged' DocumentContainer))
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (m (Either Error (Maybe (Flagged' DocumentContainer)))
 -> ExceptT Error m (Maybe (Flagged' DocumentContainer)))
-> (Either Error (Maybe (Flagged' DocumentContainer))
    -> m (Either Error (Maybe (Flagged' DocumentContainer))))
-> Either Error (Maybe (Flagged' DocumentContainer))
-> ExceptT Error m (Maybe (Flagged' DocumentContainer))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either Error (Maybe (Flagged' DocumentContainer))
-> m (Either Error (Maybe (Flagged' DocumentContainer)))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Error (Maybe (Flagged' DocumentContainer))
 -> ExceptT Error m (Maybe (Flagged' DocumentContainer)))
-> Either Error (Maybe (Flagged' DocumentContainer))
-> ExceptT Error m (Maybe (Flagged' DocumentContainer))
forall a b. (a -> b) -> a -> b
$
        Either Error (Maybe (Flagged' DocumentContainer))
-> (TreeRevision TextElementRevision
    -> Either Error (Maybe (Flagged' DocumentContainer)))
-> Maybe (TreeRevision TextElementRevision)
-> Either Error (Maybe (Flagged' DocumentContainer))
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
            (Maybe (Flagged' DocumentContainer)
-> Either Error (Maybe (Flagged' DocumentContainer))
forall a b. b -> Either a b
Right Maybe (Flagged' DocumentContainer)
forall a. Maybe a
Nothing)
            ((Flagged' DocumentContainer -> Maybe (Flagged' DocumentContainer))
-> Either Error (Flagged' DocumentContainer)
-> Either Error (Maybe (Flagged' DocumentContainer))
forall b c a. (b -> c) -> Either a b -> Either a c
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second Flagged' DocumentContainer -> Maybe (Flagged' DocumentContainer)
forall a. a -> Maybe a
Just (Either Error (Flagged' DocumentContainer)
 -> Either Error (Maybe (Flagged' DocumentContainer)))
-> (TreeRevision TextElementRevision
    -> Either Error (Flagged' DocumentContainer))
-> TreeRevision TextElementRevision
-> Either Error (Maybe (Flagged' DocumentContainer))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextElementID
-> TreeRevision TextElementRevision
-> Either Error (Flagged' DocumentContainer)
toDocumentContainerForTextElement TextElementID
textID)
            Maybe (TreeRevision TextElementRevision)
fullRevision

getDocumentRevisionDocumentContainerForCustomText
    :: ( HasGetTreeRevision m
       , HasGetTextElementRevision m
       , HasGetRevisionKey m
       , HasGetDocument m
       , HasLogMessage m
       )
    => UserID
    -> RevisionRef
    -> TextElementID
    -> Text
    -> ExceptT Error m (Maybe (LTML.Flagged' LTML.DocumentContainer))
getDocumentRevisionDocumentContainerForCustomText :: forall (m :: * -> *).
(HasGetTreeRevision m, HasGetTextElementRevision m,
 HasGetRevisionKey m, HasGetDocument m, HasLogMessage m) =>
UserID
-> RevisionRef
-> TextElementID
-> Text
-> ExceptT Error m (Maybe (Flagged' DocumentContainer))
getDocumentRevisionDocumentContainerForCustomText UserID
userID RevisionRef
ref TextElementID
textID Text
text = do
    Maybe (TreeRevision TextElementRevision)
fullRevision <- UserID
-> RevisionRef
-> ExceptT Error m (FullDocument TextElementRevision)
forall (m :: * -> *).
(HasGetTreeRevision m, HasGetTextElementRevision m,
 HasGetRevisionKey m, HasGetDocument m, HasLogMessage m) =>
UserID
-> RevisionRef
-> ExceptT Error m (FullDocument TextElementRevision)
getDocumentRevision' UserID
userID RevisionRef
ref ExceptT Error m (FullDocument TextElementRevision)
-> (FullDocument TextElementRevision
    -> Maybe (TreeRevision TextElementRevision))
-> ExceptT Error m (Maybe (TreeRevision TextElementRevision))
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> FullDocument TextElementRevision
-> Maybe (TreeRevision TextElementRevision)
forall a. FullDocument a -> Maybe (TreeRevision a)
FullDocument.body
    m (Either Error (Maybe (Flagged' DocumentContainer)))
-> ExceptT Error m (Maybe (Flagged' DocumentContainer))
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (m (Either Error (Maybe (Flagged' DocumentContainer)))
 -> ExceptT Error m (Maybe (Flagged' DocumentContainer)))
-> (Either Error (Maybe (Flagged' DocumentContainer))
    -> m (Either Error (Maybe (Flagged' DocumentContainer))))
-> Either Error (Maybe (Flagged' DocumentContainer))
-> ExceptT Error m (Maybe (Flagged' DocumentContainer))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either Error (Maybe (Flagged' DocumentContainer))
-> m (Either Error (Maybe (Flagged' DocumentContainer)))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Error (Maybe (Flagged' DocumentContainer))
 -> ExceptT Error m (Maybe (Flagged' DocumentContainer)))
-> Either Error (Maybe (Flagged' DocumentContainer))
-> ExceptT Error m (Maybe (Flagged' DocumentContainer))
forall a b. (a -> b) -> a -> b
$
        Either Error (Maybe (Flagged' DocumentContainer))
-> (TreeRevision TextElementRevision
    -> Either Error (Maybe (Flagged' DocumentContainer)))
-> Maybe (TreeRevision TextElementRevision)
-> Either Error (Maybe (Flagged' DocumentContainer))
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
            (Maybe (Flagged' DocumentContainer)
-> Either Error (Maybe (Flagged' DocumentContainer))
forall a b. b -> Either a b
Right Maybe (Flagged' DocumentContainer)
forall a. Maybe a
Nothing)
            ((Flagged' DocumentContainer -> Maybe (Flagged' DocumentContainer))
-> Either Error (Flagged' DocumentContainer)
-> Either Error (Maybe (Flagged' DocumentContainer))
forall b c a. (b -> c) -> Either a b -> Either a c
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second Flagged' DocumentContainer -> Maybe (Flagged' DocumentContainer)
forall a. a -> Maybe a
Just (Either Error (Flagged' DocumentContainer)
 -> Either Error (Maybe (Flagged' DocumentContainer)))
-> (TreeRevision TextElementRevision
    -> Either Error (Flagged' DocumentContainer))
-> TreeRevision TextElementRevision
-> Either Error (Maybe (Flagged' DocumentContainer))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextElementID
-> Text
-> TreeRevision TextElementRevision
-> Either Error (Flagged' DocumentContainer)
toDocumentContainerForCustomText TextElementID
textID Text
text)
            Maybe (TreeRevision TextElementRevision)
fullRevision

getTreeRevision
    :: (HasGetTreeRevision m, HasLogMessage m, HasGetTextElementRevision m)
    => UserID
    -> TreeRevisionRef
    -> m (Result (Maybe (TreeRevisionWithMetaData TextElement)))
getTreeRevision :: forall (m :: * -> *).
(HasGetTreeRevision m, HasLogMessage m,
 HasGetTextElementRevision m) =>
UserID
-> TreeRevisionRef
-> m (Result (Maybe (TreeRevisionWithMetaData TextElement)))
getTreeRevision UserID
userID =
    UserID
-> Scope
-> m (Result (Maybe (TreeRevisionWithMetaData TextElement)))
-> m (Result (Maybe (TreeRevisionWithMetaData TextElement)))
forall (m :: * -> *) a.
HasLogMessage m =>
UserID -> Scope -> m (Result a) -> m (Result a)
logged UserID
userID Scope
Scope.docsTreeRevision
        (m (Result (Maybe (TreeRevisionWithMetaData TextElement)))
 -> m (Result (Maybe (TreeRevisionWithMetaData TextElement))))
-> (TreeRevisionRef
    -> m (Result (Maybe (TreeRevisionWithMetaData TextElement))))
-> TreeRevisionRef
-> m (Result (Maybe (TreeRevisionWithMetaData TextElement)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExceptT Error m (Maybe (TreeRevisionWithMetaData TextElement))
-> m (Result (Maybe (TreeRevisionWithMetaData TextElement)))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT
        (ExceptT Error m (Maybe (TreeRevisionWithMetaData TextElement))
 -> m (Result (Maybe (TreeRevisionWithMetaData TextElement))))
-> (TreeRevisionRef
    -> ExceptT Error m (Maybe (TreeRevisionWithMetaData TextElement)))
-> TreeRevisionRef
-> m (Result (Maybe (TreeRevisionWithMetaData TextElement)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UserID
-> TreeRevisionRef
-> ExceptT Error m (Maybe (TreeRevisionWithMetaData TextElement))
forall (m :: * -> *).
(HasGetTreeRevision m, HasLogMessage m,
 HasGetTextElementRevision m) =>
UserID
-> TreeRevisionRef
-> ExceptT Error m (Maybe (TreeRevisionWithMetaData TextElement))
getTreeRevision' UserID
userID

getTreeRevision'
    :: (HasGetTreeRevision m, HasLogMessage m, HasGetTextElementRevision m)
    => UserID
    -> TreeRevisionRef
    -> ExceptT Error m (Maybe (TreeRevisionWithMetaData TextElement))
getTreeRevision' :: forall (m :: * -> *).
(HasGetTreeRevision m, HasLogMessage m,
 HasGetTextElementRevision m) =>
UserID
-> TreeRevisionRef
-> ExceptT Error m (Maybe (TreeRevisionWithMetaData TextElement))
getTreeRevision' UserID
userID TreeRevisionRef
ref =
    -- ich möchte nicht drüber reden.
    ((TextElementRevision -> TextElement
TextRevision.textElement (TextElementRevision -> TextElement)
-> TreeRevisionWithMetaData TextElementRevision
-> TreeRevisionWithMetaData TextElement
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (TreeRevisionWithMetaData TextElementRevision
 -> TreeRevisionWithMetaData TextElement)
-> Maybe (TreeRevisionWithMetaData TextElementRevision)
-> Maybe (TreeRevisionWithMetaData TextElement)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (Maybe (TreeRevisionWithMetaData TextElementRevision)
 -> Maybe (TreeRevisionWithMetaData TextElement))
-> ExceptT
     Error m (Maybe (TreeRevisionWithMetaData TextElementRevision))
-> ExceptT Error m (Maybe (TreeRevisionWithMetaData TextElement))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UserID
-> TreeRevisionRef
-> ExceptT
     Error m (Maybe (TreeRevisionWithMetaData TextElementRevision))
forall (m :: * -> *).
(HasGetTreeRevision m, HasLogMessage m,
 HasGetTextElementRevision m) =>
UserID
-> TreeRevisionRef
-> ExceptT
     Error m (Maybe (TreeRevisionWithMetaData TextElementRevision))
getFullTreeRevision' UserID
userID TreeRevisionRef
ref

getDocumentRevisionTree
    :: (HasGetTreeRevision m, HasGetRevisionKey m, HasLogMessage m)
    => UserID
    -> RevisionRef
    -> m (Result (Maybe (TreeRevision TextElement)))
getDocumentRevisionTree :: forall (m :: * -> *).
(HasGetTreeRevision m, HasGetRevisionKey m, HasLogMessage m) =>
UserID
-> RevisionRef -> m (Result (Maybe (TreeRevision TextElement)))
getDocumentRevisionTree UserID
userID ref :: RevisionRef
ref@(RevisionRef DocumentID
docID RevisionSelector
_) =
    UserID
-> Scope
-> m (Result (Maybe (TreeRevision TextElement)))
-> m (Result (Maybe (TreeRevision TextElement)))
forall (m :: * -> *) a.
HasLogMessage m =>
UserID -> Scope -> m (Result a) -> m (Result a)
logged UserID
userID Scope
Scope.docsTreeRevision (m (Result (Maybe (TreeRevision TextElement)))
 -> m (Result (Maybe (TreeRevision TextElement))))
-> m (Result (Maybe (TreeRevision TextElement)))
-> m (Result (Maybe (TreeRevision TextElement)))
forall a b. (a -> b) -> a -> b
$
        ExceptT Error m (Maybe (TreeRevision TextElement))
-> m (Result (Maybe (TreeRevision TextElement)))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT Error m (Maybe (TreeRevision TextElement))
 -> m (Result (Maybe (TreeRevision TextElement))))
-> ExceptT Error m (Maybe (TreeRevision TextElement))
-> m (Result (Maybe (TreeRevision TextElement)))
forall a b. (a -> b) -> a -> b
$ do
            Permission -> DocumentID -> UserID -> ExceptT Error m ()
forall (m :: * -> *).
HasCheckPermission m =>
Permission -> DocumentID -> UserID -> ExceptT Error m ()
guardPermission Permission
Read DocumentID
docID UserID
userID
            DocumentID -> ExceptT Error m ()
forall (m :: * -> *).
HasExistsDocument m =>
DocumentID -> ExceptT Error m ()
guardExistsDocument DocumentID
docID
            m (Maybe (TreeRevision TextElement))
-> ExceptT Error m (Maybe (TreeRevision TextElement))
forall (m :: * -> *) a. Monad m => m a -> ExceptT Error m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Maybe (TreeRevision TextElement))
 -> ExceptT Error m (Maybe (TreeRevision TextElement)))
-> m (Maybe (TreeRevision TextElement))
-> ExceptT Error m (Maybe (TreeRevision TextElement))
forall a b. (a -> b) -> a -> b
$ do
                Maybe RevisionKey
key <- RevisionRef -> m (Maybe RevisionKey)
forall (m :: * -> *).
HasGetRevisionKey m =>
RevisionRef -> m (Maybe RevisionKey)
DB.getRevisionKey RevisionRef
ref
                Maybe (Maybe (TreeRevision TextElement))
result <- (RevisionKey -> m (Maybe (TreeRevision TextElement)))
-> Maybe RevisionKey
-> m (Maybe (Maybe (TreeRevision TextElement)))
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 (TreeRevisionRef -> m (Maybe (TreeRevision TextElement))
forall (m :: * -> *).
HasGetTreeRevision m =>
TreeRevisionRef -> m (Maybe (TreeRevision TextElement))
DB.getTreeRevision (TreeRevisionRef -> m (Maybe (TreeRevision TextElement)))
-> (RevisionKey -> TreeRevisionRef)
-> RevisionKey
-> m (Maybe (TreeRevision TextElement))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DocumentID -> RevisionKey -> TreeRevisionRef
treeRevisionRefFor DocumentID
docID) Maybe RevisionKey
key
                Maybe (TreeRevision TextElement)
-> m (Maybe (TreeRevision TextElement))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (TreeRevision TextElement)
 -> m (Maybe (TreeRevision TextElement)))
-> Maybe (TreeRevision TextElement)
-> m (Maybe (TreeRevision TextElement))
forall a b. (a -> b) -> a -> b
$ Maybe (Maybe (TreeRevision TextElement))
-> Maybe (TreeRevision TextElement)
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join Maybe (Maybe (TreeRevision TextElement))
result

getTextHistory
    :: (HasGetTextHistory m, HasLogMessage m)
    => UserID
    -> TextElementRef
    -> Maybe UTCTime
    -> Maybe UTCTime
    -> Maybe Limit
    -> m (Result TextRevisionHistory)
getTextHistory :: forall (m :: * -> *).
(HasGetTextHistory m, HasLogMessage m) =>
UserID
-> TextElementRef
-> Maybe UTCTime
-> Maybe UTCTime
-> Maybe Limit
-> m (Result TextRevisionHistory)
getTextHistory UserID
userID ref :: TextElementRef
ref@(TextElementRef DocumentID
docID TextElementID
_) Maybe UTCTime
from Maybe UTCTime
to Maybe Limit
limit = UserID
-> Scope
-> m (Result TextRevisionHistory)
-> m (Result TextRevisionHistory)
forall (m :: * -> *) a.
HasLogMessage m =>
UserID -> Scope -> m (Result a) -> m (Result a)
logged UserID
userID Scope
Scope.docsText (m (Result TextRevisionHistory) -> m (Result TextRevisionHistory))
-> m (Result TextRevisionHistory) -> m (Result TextRevisionHistory)
forall a b. (a -> b) -> a -> b
$
    ExceptT Error m TextRevisionHistory
-> m (Result TextRevisionHistory)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT Error m TextRevisionHistory
 -> m (Result TextRevisionHistory))
-> ExceptT Error m TextRevisionHistory
-> m (Result TextRevisionHistory)
forall a b. (a -> b) -> a -> b
$ do
        Permission -> DocumentID -> UserID -> ExceptT Error m ()
forall (m :: * -> *).
HasCheckPermission m =>
Permission -> DocumentID -> UserID -> ExceptT Error m ()
guardPermission Permission
Read DocumentID
docID UserID
userID
        TextElementRef -> ExceptT Error m ()
forall (m :: * -> *).
HasExistsTextElement m =>
TextElementRef -> ExceptT Error m ()
guardExistsTextElement TextElementRef
ref
        m TextRevisionHistory -> ExceptT Error m TextRevisionHistory
forall (m :: * -> *) a. Monad m => m a -> ExceptT Error m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m TextRevisionHistory -> ExceptT Error m TextRevisionHistory)
-> m TextRevisionHistory -> ExceptT Error m TextRevisionHistory
forall a b. (a -> b) -> a -> b
$ TextElementRef
-> Maybe UTCTime -> Maybe UTCTime -> Limit -> m TextRevisionHistory
forall (m :: * -> *).
HasGetTextHistory m =>
TextElementRef
-> Maybe UTCTime -> Maybe UTCTime -> Limit -> m TextRevisionHistory
DB.getTextHistory TextElementRef
ref Maybe UTCTime
from Maybe UTCTime
to (Limit -> m TextRevisionHistory) -> Limit -> m TextRevisionHistory
forall a b. (a -> b) -> a -> b
$ Limit -> Maybe Limit -> Limit
forall a. a -> Maybe a -> a
fromMaybe Limit
defaultHistoryLimit Maybe Limit
limit

getTreeHistory
    :: (HasGetTreeHistory m, HasLogMessage m)
    => UserID
    -> DocumentID
    -> Maybe UTCTime
    -> Maybe Limit
    -> m (Result TreeRevisionHistory)
getTreeHistory :: forall (m :: * -> *).
(HasGetTreeHistory m, HasLogMessage m) =>
UserID
-> DocumentID
-> Maybe UTCTime
-> Maybe Limit
-> m (Result TreeRevisionHistory)
getTreeHistory UserID
userID DocumentID
docID Maybe UTCTime
time Maybe Limit
limit = UserID
-> Scope
-> m (Result TreeRevisionHistory)
-> m (Result TreeRevisionHistory)
forall (m :: * -> *) a.
HasLogMessage m =>
UserID -> Scope -> m (Result a) -> m (Result a)
logged UserID
userID Scope
Scope.docsTree (m (Result TreeRevisionHistory) -> m (Result TreeRevisionHistory))
-> m (Result TreeRevisionHistory) -> m (Result TreeRevisionHistory)
forall a b. (a -> b) -> a -> b
$
    ExceptT Error m TreeRevisionHistory
-> m (Result TreeRevisionHistory)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT Error m TreeRevisionHistory
 -> m (Result TreeRevisionHistory))
-> ExceptT Error m TreeRevisionHistory
-> m (Result TreeRevisionHistory)
forall a b. (a -> b) -> a -> b
$ do
        Permission -> DocumentID -> UserID -> ExceptT Error m ()
forall (m :: * -> *).
HasCheckPermission m =>
Permission -> DocumentID -> UserID -> ExceptT Error m ()
guardPermission Permission
Read DocumentID
docID UserID
userID
        DocumentID -> ExceptT Error m ()
forall (m :: * -> *).
HasExistsDocument m =>
DocumentID -> ExceptT Error m ()
guardExistsDocument DocumentID
docID
        m TreeRevisionHistory -> ExceptT Error m TreeRevisionHistory
forall (m :: * -> *) a. Monad m => m a -> ExceptT Error m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m TreeRevisionHistory -> ExceptT Error m TreeRevisionHistory)
-> m TreeRevisionHistory -> ExceptT Error m TreeRevisionHistory
forall a b. (a -> b) -> a -> b
$ DocumentID -> Maybe UTCTime -> Limit -> m TreeRevisionHistory
forall (m :: * -> *).
HasGetTreeHistory m =>
DocumentID -> Maybe UTCTime -> Limit -> m TreeRevisionHistory
DB.getTreeHistory DocumentID
docID Maybe UTCTime
time (Limit -> m TreeRevisionHistory) -> Limit -> m TreeRevisionHistory
forall a b. (a -> b) -> a -> b
$ Limit -> Maybe Limit -> Limit
forall a. a -> Maybe a -> a
fromMaybe Limit
defaultHistoryLimit Maybe Limit
limit

getDocumentHistory
    :: (HasGetDocumentHistory m, HasLogMessage m)
    => UserID
    -> DocumentID
    -> Maybe UTCTime
    -> Maybe Limit
    -> m (Result DocumentHistory)
getDocumentHistory :: forall (m :: * -> *).
(HasGetDocumentHistory m, HasLogMessage m) =>
UserID
-> DocumentID
-> Maybe UTCTime
-> Maybe Limit
-> m (Result DocumentHistory)
getDocumentHistory UserID
userID DocumentID
docID Maybe UTCTime
time Maybe Limit
limit = UserID
-> Scope
-> m (Result DocumentHistory)
-> m (Result DocumentHistory)
forall (m :: * -> *) a.
HasLogMessage m =>
UserID -> Scope -> m (Result a) -> m (Result a)
logged UserID
userID Scope
Scope.docs (m (Result DocumentHistory) -> m (Result DocumentHistory))
-> m (Result DocumentHistory) -> m (Result DocumentHistory)
forall a b. (a -> b) -> a -> b
$
    ExceptT Error m DocumentHistory -> m (Result DocumentHistory)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT Error m DocumentHistory -> m (Result DocumentHistory))
-> ExceptT Error m DocumentHistory -> m (Result DocumentHistory)
forall a b. (a -> b) -> a -> b
$ do
        Permission -> DocumentID -> UserID -> ExceptT Error m ()
forall (m :: * -> *).
HasCheckPermission m =>
Permission -> DocumentID -> UserID -> ExceptT Error m ()
guardPermission Permission
Read DocumentID
docID UserID
userID
        DocumentID -> ExceptT Error m ()
forall (m :: * -> *).
HasExistsDocument m =>
DocumentID -> ExceptT Error m ()
guardExistsDocument DocumentID
docID
        m DocumentHistory -> ExceptT Error m DocumentHistory
forall (m :: * -> *) a. Monad m => m a -> ExceptT Error m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m DocumentHistory -> ExceptT Error m DocumentHistory)
-> m DocumentHistory -> ExceptT Error m DocumentHistory
forall a b. (a -> b) -> a -> b
$ DocumentID -> Maybe UTCTime -> Limit -> m DocumentHistory
forall (m :: * -> *).
HasGetDocumentHistory m =>
DocumentID -> Maybe UTCTime -> Limit -> m DocumentHistory
DB.getDocumentHistory DocumentID
docID Maybe UTCTime
time (Limit -> m DocumentHistory) -> Limit -> m DocumentHistory
forall a b. (a -> b) -> a -> b
$ Limit -> Maybe Limit -> Limit
forall a. a -> Maybe a -> a
fromMaybe Limit
defaultHistoryLimit Maybe Limit
limit

getTreeWithLatestTexts
    :: (HasGetTreeRevision m, HasGetTextElementRevision m, HasLogMessage m)
    => UserID
    -> TreeRevisionRef
    -> ExceptT Error m (Maybe (TreeRevision TextElementRevision))
getTreeWithLatestTexts :: forall (m :: * -> *).
(HasGetTreeRevision m, HasGetTextElementRevision m,
 HasLogMessage m) =>
UserID
-> TreeRevisionRef
-> ExceptT Error m (Maybe (TreeRevision TextElementRevision))
getTreeWithLatestTexts UserID
userID TreeRevisionRef
revision = do
    Permission -> DocumentID -> UserID -> ExceptT Error m ()
forall (m :: * -> *).
HasCheckPermission m =>
Permission -> DocumentID -> UserID -> ExceptT Error m ()
guardPermission Permission
Read DocumentID
docID UserID
userID
    DocumentID -> ExceptT Error m ()
forall (m :: * -> *).
HasExistsDocument m =>
DocumentID -> ExceptT Error m ()
guardExistsDocument DocumentID
docID
    Bool -> TreeRevisionRef -> ExceptT Error m ()
forall (m :: * -> *).
HasExistsTreeRevision m =>
Bool -> TreeRevisionRef -> ExceptT Error m ()
guardExistsTreeRevision Bool
True TreeRevisionRef
revision
    m (Maybe (TreeRevision TextElementRevision))
-> ExceptT Error m (Maybe (TreeRevision TextElementRevision))
forall (m :: * -> *) a. Monad m => m a -> ExceptT Error m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Maybe (TreeRevision TextElementRevision))
 -> ExceptT Error m (Maybe (TreeRevision TextElementRevision)))
-> m (Maybe (TreeRevision TextElementRevision))
-> ExceptT Error m (Maybe (TreeRevision TextElementRevision))
forall a b. (a -> b) -> a -> b
$ do
        Maybe (TreeRevision TextElement)
treeRevision <- TreeRevisionRef -> m (Maybe (TreeRevision TextElement))
forall (m :: * -> *).
HasGetTreeRevision m =>
TreeRevisionRef -> m (Maybe (TreeRevision TextElement))
DB.getTreeRevision TreeRevisionRef
revision
        (TreeRevision TextElement -> m (TreeRevision TextElementRevision))
-> Maybe (TreeRevision TextElement)
-> m (Maybe (TreeRevision 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 ((TextElementID -> m (Maybe TextRevision))
-> TreeRevision TextElement -> m (TreeRevision TextElementRevision)
forall (m :: * -> *).
Monad m =>
(TextElementID -> m (Maybe TextRevision))
-> TreeRevision TextElement -> m (TreeRevision TextElementRevision)
TreeRevision.withTextRevisions TextElementID -> m (Maybe TextRevision)
getter') Maybe (TreeRevision TextElement)
treeRevision
  where
    (TreeRevisionRef DocumentID
docID TreeRevisionSelector
_) = TreeRevisionRef
revision
    getter :: TextElementID -> m (Maybe TextElementRevision)
getter =
        TextRevisionRef -> m (Maybe TextElementRevision)
forall (m :: * -> *).
HasGetTextElementRevision m =>
TextRevisionRef -> m (Maybe TextElementRevision)
DB.getTextElementRevision
            (TextRevisionRef -> m (Maybe TextElementRevision))
-> (TextElementID -> TextRevisionRef)
-> TextElementID
-> m (Maybe TextElementRevision)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TextElementRef -> TextRevisionSelector -> TextRevisionRef
`TextRevisionRef` TextRevisionSelector
TextRevision.Latest)
            (TextElementRef -> TextRevisionRef)
-> (TextElementID -> TextElementRef)
-> TextElementID
-> TextRevisionRef
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DocumentID -> TextElementID -> TextElementRef
TextElementRef DocumentID
docID
    getter' :: TextElementID -> m (Maybe TextRevision)
getter' = (m (Maybe TextElementRevision)
-> (Maybe TextElementRevision -> Maybe TextRevision)
-> m (Maybe TextRevision)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Maybe TextElementRevision
-> (TextElementRevision -> Maybe TextRevision)
-> Maybe TextRevision
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= TextElementRevision -> Maybe TextRevision
elementRevisionToRevision)) (m (Maybe TextElementRevision) -> m (Maybe TextRevision))
-> (TextElementID -> m (Maybe TextElementRevision))
-> TextElementID
-> m (Maybe TextRevision)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextElementID -> m (Maybe TextElementRevision)
getter
    elementRevisionToRevision :: TextElementRevision -> Maybe TextRevision
elementRevisionToRevision (TextElementRevision TextElement
_ Maybe TextRevision
rev) = Maybe TextRevision
rev

getDocumentRevisionPDF
    :: ( HasGetTreeRevision m
       , HasGetTextElementRevision m
       , HasGetRevisionKey m
       , HasGetDocument m
       , HasLogMessage m
       , MonadIO m
       )
    => UserID
    -> RevisionRef
    -> m (Result PDFBytes)
getDocumentRevisionPDF :: forall (m :: * -> *).
(HasGetTreeRevision m, HasGetTextElementRevision m,
 HasGetRevisionKey m, HasGetDocument m, HasLogMessage m,
 MonadIO m) =>
UserID -> RevisionRef -> m (Result PDFBytes)
getDocumentRevisionPDF UserID
userID RevisionRef
ref =
    UserID -> Scope -> m (Result PDFBytes) -> m (Result PDFBytes)
forall (m :: * -> *) a.
HasLogMessage m =>
UserID -> Scope -> m (Result a) -> m (Result a)
logged UserID
userID Scope
Scope.docsTreeRevision (m (Result PDFBytes) -> m (Result PDFBytes))
-> m (Result PDFBytes) -> m (Result PDFBytes)
forall a b. (a -> b) -> a -> b
$ ExceptT Error m PDFBytes -> m (Result PDFBytes)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT Error m PDFBytes -> m (Result PDFBytes))
-> ExceptT Error m PDFBytes -> m (Result PDFBytes)
forall a b. (a -> b) -> a -> b
$ do
        Maybe (Flagged' DocumentContainer)
maybeDocumentContainer <- UserID
-> RevisionRef
-> ExceptT Error m (Maybe (Flagged' DocumentContainer))
forall (m :: * -> *).
(HasGetTreeRevision m, HasGetTextElementRevision m,
 HasGetRevisionKey m, HasGetDocument m, HasLogMessage m) =>
UserID
-> RevisionRef
-> ExceptT Error m (Maybe (Flagged' DocumentContainer))
getDocumentRevisionDocumentContainer UserID
userID RevisionRef
ref
        Flagged' DocumentContainer
documentContainer <-
            m (Either Error (Flagged' DocumentContainer))
-> ExceptT Error m (Flagged' DocumentContainer)
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (m (Either Error (Flagged' DocumentContainer))
 -> ExceptT Error m (Flagged' DocumentContainer))
-> (Either Error (Flagged' DocumentContainer)
    -> m (Either Error (Flagged' DocumentContainer)))
-> Either Error (Flagged' DocumentContainer)
-> ExceptT Error m (Flagged' DocumentContainer)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either Error (Flagged' DocumentContainer)
-> m (Either Error (Flagged' DocumentContainer))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Error (Flagged' DocumentContainer)
 -> ExceptT Error m (Flagged' DocumentContainer))
-> Either Error (Flagged' DocumentContainer)
-> ExceptT Error m (Flagged' DocumentContainer)
forall a b. (a -> b) -> a -> b
$
                Either Error (Flagged' DocumentContainer)
-> (Flagged' DocumentContainer
    -> Either Error (Flagged' DocumentContainer))
-> Maybe (Flagged' DocumentContainer)
-> Either Error (Flagged' DocumentContainer)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
                    (Error -> Either Error (Flagged' DocumentContainer)
forall a b. a -> Either a b
Left (Error -> Either Error (Flagged' DocumentContainer))
-> Error -> Either Error (Flagged' DocumentContainer)
forall a b. (a -> b) -> a -> b
$ RevisionRef -> Error
RevisionNotFound RevisionRef
ref)
                    Flagged' DocumentContainer
-> Either Error (Flagged' DocumentContainer)
forall a b. b -> Either a b
Right
                    Maybe (Flagged' DocumentContainer)
maybeDocumentContainer
        Flagged' DocumentContainer -> ExceptT Error m PDFBytes
forall (m :: * -> *).
MonadIO m =>
Flagged' DocumentContainer -> ExceptT Error m PDFBytes
toPDF Flagged' DocumentContainer
documentContainer

getDocumentRevisionHTML
    :: ( HasGetTreeRevision m
       , HasGetTextElementRevision m
       , HasGetRevisionKey m
       , HasGetDocument m
       , HasLogMessage m
       , MonadIO m
       )
    => UserID
    -> RevisionRef
    -> m (Result ZipBytes)
getDocumentRevisionHTML :: forall (m :: * -> *).
(HasGetTreeRevision m, HasGetTextElementRevision m,
 HasGetRevisionKey m, HasGetDocument m, HasLogMessage m,
 MonadIO m) =>
UserID -> RevisionRef -> m (Result ZipBytes)
getDocumentRevisionHTML UserID
userID RevisionRef
ref =
    UserID -> Scope -> m (Result ZipBytes) -> m (Result ZipBytes)
forall (m :: * -> *) a.
HasLogMessage m =>
UserID -> Scope -> m (Result a) -> m (Result a)
logged UserID
userID Scope
Scope.docsTreeRevision (m (Result ZipBytes) -> m (Result ZipBytes))
-> m (Result ZipBytes) -> m (Result ZipBytes)
forall a b. (a -> b) -> a -> b
$ ExceptT Error m ZipBytes -> m (Result ZipBytes)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT Error m ZipBytes -> m (Result ZipBytes))
-> ExceptT Error m ZipBytes -> m (Result ZipBytes)
forall a b. (a -> b) -> a -> b
$ do
        Maybe (Flagged' DocumentContainer)
maybeDocumentContainer <- UserID
-> RevisionRef
-> ExceptT Error m (Maybe (Flagged' DocumentContainer))
forall (m :: * -> *).
(HasGetTreeRevision m, HasGetTextElementRevision m,
 HasGetRevisionKey m, HasGetDocument m, HasLogMessage m) =>
UserID
-> RevisionRef
-> ExceptT Error m (Maybe (Flagged' DocumentContainer))
getDocumentRevisionDocumentContainer UserID
userID RevisionRef
ref
        Flagged' DocumentContainer
documentContainer <-
            m (Either Error (Flagged' DocumentContainer))
-> ExceptT Error m (Flagged' DocumentContainer)
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (m (Either Error (Flagged' DocumentContainer))
 -> ExceptT Error m (Flagged' DocumentContainer))
-> (Either Error (Flagged' DocumentContainer)
    -> m (Either Error (Flagged' DocumentContainer)))
-> Either Error (Flagged' DocumentContainer)
-> ExceptT Error m (Flagged' DocumentContainer)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either Error (Flagged' DocumentContainer)
-> m (Either Error (Flagged' DocumentContainer))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Error (Flagged' DocumentContainer)
 -> ExceptT Error m (Flagged' DocumentContainer))
-> Either Error (Flagged' DocumentContainer)
-> ExceptT Error m (Flagged' DocumentContainer)
forall a b. (a -> b) -> a -> b
$
                Either Error (Flagged' DocumentContainer)
-> (Flagged' DocumentContainer
    -> Either Error (Flagged' DocumentContainer))
-> Maybe (Flagged' DocumentContainer)
-> Either Error (Flagged' DocumentContainer)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
                    (Error -> Either Error (Flagged' DocumentContainer)
forall a b. a -> Either a b
Left (Error -> Either Error (Flagged' DocumentContainer))
-> Error -> Either Error (Flagged' DocumentContainer)
forall a b. (a -> b) -> a -> b
$ RevisionRef -> Error
RevisionNotFound RevisionRef
ref)
                    Flagged' DocumentContainer
-> Either Error (Flagged' DocumentContainer)
forall a b. b -> Either a b
Right
                    Maybe (Flagged' DocumentContainer)
maybeDocumentContainer
        Flagged' DocumentContainer -> ExceptT Error m ZipBytes
forall (m :: * -> *).
MonadIO m =>
Flagged' DocumentContainer -> ExceptT Error m ZipBytes
toHTML Flagged' DocumentContainer
documentContainer

getDocumentRevisionDocumentContainer
    :: ( HasGetTreeRevision m
       , HasGetTextElementRevision m
       , HasGetRevisionKey m
       , HasGetDocument m
       , HasLogMessage m
       )
    => UserID
    -> RevisionRef
    -> ExceptT Error m (Maybe (LTML.Flagged' LTML.DocumentContainer))
getDocumentRevisionDocumentContainer :: forall (m :: * -> *).
(HasGetTreeRevision m, HasGetTextElementRevision m,
 HasGetRevisionKey m, HasGetDocument m, HasLogMessage m) =>
UserID
-> RevisionRef
-> ExceptT Error m (Maybe (Flagged' DocumentContainer))
getDocumentRevisionDocumentContainer UserID
userID RevisionRef
ref = do
    Maybe (TreeRevision TextElementRevision)
fullRevision <- UserID
-> RevisionRef
-> ExceptT Error m (FullDocument TextElementRevision)
forall (m :: * -> *).
(HasGetTreeRevision m, HasGetTextElementRevision m,
 HasGetRevisionKey m, HasGetDocument m, HasLogMessage m) =>
UserID
-> RevisionRef
-> ExceptT Error m (FullDocument TextElementRevision)
getDocumentRevision' UserID
userID RevisionRef
ref ExceptT Error m (FullDocument TextElementRevision)
-> (FullDocument TextElementRevision
    -> Maybe (TreeRevision TextElementRevision))
-> ExceptT Error m (Maybe (TreeRevision TextElementRevision))
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> FullDocument TextElementRevision
-> Maybe (TreeRevision TextElementRevision)
forall a. FullDocument a -> Maybe (TreeRevision a)
FullDocument.body
    m (Either Error (Maybe (Flagged' DocumentContainer)))
-> ExceptT Error m (Maybe (Flagged' DocumentContainer))
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (m (Either Error (Maybe (Flagged' DocumentContainer)))
 -> ExceptT Error m (Maybe (Flagged' DocumentContainer)))
-> (Either Error (Maybe (Flagged' DocumentContainer))
    -> m (Either Error (Maybe (Flagged' DocumentContainer))))
-> Either Error (Maybe (Flagged' DocumentContainer))
-> ExceptT Error m (Maybe (Flagged' DocumentContainer))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either Error (Maybe (Flagged' DocumentContainer))
-> m (Either Error (Maybe (Flagged' DocumentContainer)))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Error (Maybe (Flagged' DocumentContainer))
 -> ExceptT Error m (Maybe (Flagged' DocumentContainer)))
-> Either Error (Maybe (Flagged' DocumentContainer))
-> ExceptT Error m (Maybe (Flagged' DocumentContainer))
forall a b. (a -> b) -> a -> b
$
        Either Error (Maybe (Flagged' DocumentContainer))
-> (TreeRevision TextElementRevision
    -> Either Error (Maybe (Flagged' DocumentContainer)))
-> Maybe (TreeRevision TextElementRevision)
-> Either Error (Maybe (Flagged' DocumentContainer))
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
            (Maybe (Flagged' DocumentContainer)
-> Either Error (Maybe (Flagged' DocumentContainer))
forall a b. b -> Either a b
Right Maybe (Flagged' DocumentContainer)
forall a. Maybe a
Nothing)
            ((Flagged' DocumentContainer -> Maybe (Flagged' DocumentContainer))
-> Either Error (Flagged' DocumentContainer)
-> Either Error (Maybe (Flagged' DocumentContainer))
forall b c a. (b -> c) -> Either a b -> Either a c
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second Flagged' DocumentContainer -> Maybe (Flagged' DocumentContainer)
forall a. a -> Maybe a
Just (Either Error (Flagged' DocumentContainer)
 -> Either Error (Maybe (Flagged' DocumentContainer)))
-> (TreeRevision TextElementRevision
    -> Either Error (Flagged' DocumentContainer))
-> TreeRevision TextElementRevision
-> Either Error (Maybe (Flagged' DocumentContainer))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TreeRevision TextElementRevision
-> Either Error (Flagged' DocumentContainer)
toDocumentContainer)
            Maybe (TreeRevision TextElementRevision)
fullRevision

getDocumentRevision
    :: ( HasGetTreeRevision m
       , HasGetTextElementRevision m
       , HasGetRevisionKey m
       , HasGetDocument m
       , HasLogMessage m
       )
    => UserID
    -> RevisionRef
    -> m (Result (FullDocument TextElementRevision))
getDocumentRevision :: forall (m :: * -> *).
(HasGetTreeRevision m, HasGetTextElementRevision m,
 HasGetRevisionKey m, HasGetDocument m, HasLogMessage m) =>
UserID
-> RevisionRef -> m (Result (FullDocument TextElementRevision))
getDocumentRevision UserID
userID =
    UserID
-> Scope
-> m (Result (FullDocument TextElementRevision))
-> m (Result (FullDocument TextElementRevision))
forall (m :: * -> *) a.
HasLogMessage m =>
UserID -> Scope -> m (Result a) -> m (Result a)
logged UserID
userID Scope
Scope.docs (m (Result (FullDocument TextElementRevision))
 -> m (Result (FullDocument TextElementRevision)))
-> (RevisionRef -> m (Result (FullDocument TextElementRevision)))
-> RevisionRef
-> m (Result (FullDocument TextElementRevision))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExceptT Error m (FullDocument TextElementRevision)
-> m (Result (FullDocument TextElementRevision))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT Error m (FullDocument TextElementRevision)
 -> m (Result (FullDocument TextElementRevision)))
-> (RevisionRef
    -> ExceptT Error m (FullDocument TextElementRevision))
-> RevisionRef
-> m (Result (FullDocument TextElementRevision))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UserID
-> RevisionRef
-> ExceptT Error m (FullDocument TextElementRevision)
forall (m :: * -> *).
(HasGetTreeRevision m, HasGetTextElementRevision m,
 HasGetRevisionKey m, HasGetDocument m, HasLogMessage m) =>
UserID
-> RevisionRef
-> ExceptT Error m (FullDocument TextElementRevision)
getDocumentRevision' UserID
userID

getDocumentRevision'
    :: ( HasGetTreeRevision m
       , HasGetTextElementRevision m
       , HasGetRevisionKey m
       , HasGetDocument m
       , HasLogMessage m
       )
    => UserID
    -> RevisionRef
    -> ExceptT Error m (FullDocument TextElementRevision)
getDocumentRevision' :: forall (m :: * -> *).
(HasGetTreeRevision m, HasGetTextElementRevision m,
 HasGetRevisionKey m, HasGetDocument m, HasLogMessage m) =>
UserID
-> RevisionRef
-> ExceptT Error m (FullDocument TextElementRevision)
getDocumentRevision' UserID
userID ref :: RevisionRef
ref@(RevisionRef DocumentID
docID RevisionSelector
_) = do
    Permission -> DocumentID -> UserID -> ExceptT Error m ()
forall (m :: * -> *).
HasCheckPermission m =>
Permission -> DocumentID -> UserID -> ExceptT Error m ()
guardPermission Permission
Read DocumentID
docID UserID
userID
    DocumentID -> ExceptT Error m ()
forall (m :: * -> *).
HasExistsDocument m =>
DocumentID -> ExceptT Error m ()
guardExistsDocument DocumentID
docID
    Maybe Document
maybeDocument <- m (Maybe Document) -> ExceptT Error m (Maybe Document)
forall (m :: * -> *) a. Monad m => m a -> ExceptT Error m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Maybe Document) -> ExceptT Error m (Maybe Document))
-> m (Maybe Document) -> ExceptT Error m (Maybe Document)
forall a b. (a -> b) -> a -> b
$ DocumentID -> m (Maybe Document)
forall (m :: * -> *).
HasGetDocument m =>
DocumentID -> m (Maybe Document)
DB.getDocument DocumentID
docID
    Document
document <- ExceptT Error m Document
-> (Document -> ExceptT Error m Document)
-> Maybe Document
-> ExceptT Error m Document
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Error -> ExceptT Error m Document
forall a. Error -> ExceptT Error m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Error -> ExceptT Error m Document)
-> Error -> ExceptT Error m Document
forall a b. (a -> b) -> a -> b
$ DocumentID -> Error
DocumentNotFound DocumentID
docID) Document -> ExceptT Error m Document
forall a. a -> ExceptT Error m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Document
maybeDocument
    m (FullDocument TextElementRevision)
-> ExceptT Error m (FullDocument TextElementRevision)
forall (m :: * -> *) a. Monad m => m a -> ExceptT Error m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (FullDocument TextElementRevision)
 -> ExceptT Error m (FullDocument TextElementRevision))
-> m (FullDocument TextElementRevision)
-> ExceptT Error m (FullDocument TextElementRevision)
forall a b. (a -> b) -> a -> b
$ do
        Maybe RevisionKey
key <- RevisionRef -> m (Maybe RevisionKey)
forall (m :: * -> *).
HasGetRevisionKey m =>
RevisionRef -> m (Maybe RevisionKey)
DB.getRevisionKey RevisionRef
ref
        Maybe (Maybe (TreeRevision TextElement))
result <- (RevisionKey -> m (Maybe (TreeRevision TextElement)))
-> Maybe RevisionKey
-> m (Maybe (Maybe (TreeRevision TextElement)))
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 (TreeRevisionRef -> m (Maybe (TreeRevision TextElement))
forall (m :: * -> *).
HasGetTreeRevision m =>
TreeRevisionRef -> m (Maybe (TreeRevision TextElement))
DB.getTreeRevision (TreeRevisionRef -> m (Maybe (TreeRevision TextElement)))
-> (RevisionKey -> TreeRevisionRef)
-> RevisionKey
-> m (Maybe (TreeRevision TextElement))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DocumentID -> RevisionKey -> TreeRevisionRef
treeRevisionRefFor DocumentID
docID) Maybe RevisionKey
key
        let tree :: Maybe (TreeRevision TextElement)
tree = Maybe (Maybe (TreeRevision TextElement))
-> Maybe (TreeRevision TextElement)
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join Maybe (Maybe (TreeRevision TextElement))
result
        Maybe (TreeRevision TextElementRevision)
body <- (TreeRevision TextElement -> m (TreeRevision TextElementRevision))
-> Maybe (TreeRevision TextElement)
-> m (Maybe (TreeRevision 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 ((TextElementID -> m (Maybe TextRevision))
-> TreeRevision TextElement -> m (TreeRevision TextElementRevision)
forall (m :: * -> *).
Monad m =>
(TextElementID -> m (Maybe TextRevision))
-> TreeRevision TextElement -> m (TreeRevision TextElementRevision)
TreeRevision.withTextRevisions TextElementID -> m (Maybe TextRevision)
getter') Maybe (TreeRevision TextElement)
tree
        FullDocument TextElementRevision
-> m (FullDocument TextElementRevision)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
            FullDocument
                { header :: Document
FullDocument.header = Document
document
                , body :: Maybe (TreeRevision TextElementRevision)
FullDocument.body = Maybe (TreeRevision TextElementRevision)
body
                }
  where
    getter :: TextElementID -> m (Maybe TextElementRevision)
getter TextElementID
textID = do
        Maybe RevisionKey
key <- RevisionRef -> m (Maybe RevisionKey)
forall (m :: * -> *).
HasGetRevisionKey m =>
RevisionRef -> m (Maybe RevisionKey)
DB.getRevisionKey RevisionRef
ref
        Maybe (Maybe TextElementRevision)
result <-
            (RevisionKey -> m (Maybe TextElementRevision))
-> Maybe RevisionKey -> m (Maybe (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
                ( TextRevisionRef -> m (Maybe TextElementRevision)
forall (m :: * -> *).
HasGetTextElementRevision m =>
TextRevisionRef -> m (Maybe TextElementRevision)
DB.getTextElementRevision
                    (TextRevisionRef -> m (Maybe TextElementRevision))
-> (RevisionKey -> TextRevisionRef)
-> RevisionKey
-> m (Maybe TextElementRevision)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextElementRef -> RevisionKey -> TextRevisionRef
textRevisionRefFor
                        (DocumentID -> TextElementID -> TextElementRef
TextElementRef DocumentID
docID TextElementID
textID)
                )
                Maybe RevisionKey
key
        Maybe TextElementRevision -> m (Maybe TextElementRevision)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe TextElementRevision -> m (Maybe TextElementRevision))
-> Maybe TextElementRevision -> m (Maybe TextElementRevision)
forall a b. (a -> b) -> a -> b
$ Maybe (Maybe TextElementRevision) -> Maybe TextElementRevision
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join Maybe (Maybe TextElementRevision)
result
    getter' :: TextElementID -> m (Maybe TextRevision)
getter' = (m (Maybe TextElementRevision)
-> (Maybe TextElementRevision -> Maybe TextRevision)
-> m (Maybe TextRevision)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Maybe TextElementRevision
-> (TextElementRevision -> Maybe TextRevision)
-> Maybe TextRevision
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= TextElementRevision -> Maybe TextRevision
elementRevisionToRevision)) (m (Maybe TextElementRevision) -> m (Maybe TextRevision))
-> (TextElementID -> m (Maybe TextElementRevision))
-> TextElementID
-> m (Maybe TextRevision)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextElementID -> m (Maybe TextElementRevision)
forall {m :: * -> *}.
(HasGetRevisionKey m, HasGetTextElementRevision m) =>
TextElementID -> m (Maybe TextElementRevision)
getter
    elementRevisionToRevision :: TextElementRevision -> Maybe TextRevision
elementRevisionToRevision (TextElementRevision TextElement
_ Maybe TextRevision
rev) = Maybe TextRevision
rev

createComment
    :: (HasCreateComment m, HasLogMessage m)
    => UserID
    -> TextElementRef
    -> Text
    -> m (Result Comment)
createComment :: forall (m :: * -> *).
(HasCreateComment m, HasLogMessage m) =>
UserID -> TextElementRef -> Text -> m (Result Comment)
createComment UserID
userID ref :: TextElementRef
ref@(TextElementRef DocumentID
docID TextElementID
textID) Text
text =
    UserID -> Scope -> m (Result Comment) -> m (Result Comment)
forall (m :: * -> *) a.
HasLogMessage m =>
UserID -> Scope -> m (Result a) -> m (Result a)
logged UserID
userID Scope
Scope.docsComment (m (Result Comment) -> m (Result Comment))
-> m (Result Comment) -> m (Result Comment)
forall a b. (a -> b) -> a -> b
$ ExceptT Error m Comment -> m (Result Comment)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT Error m Comment -> m (Result Comment))
-> ExceptT Error m Comment -> m (Result Comment)
forall a b. (a -> b) -> a -> b
$ do
        Permission -> DocumentID -> UserID -> ExceptT Error m ()
forall (m :: * -> *).
HasCheckPermission m =>
Permission -> DocumentID -> UserID -> ExceptT Error m ()
guardPermission Permission
Comment DocumentID
docID UserID
userID
        TextElementRef -> ExceptT Error m ()
forall (m :: * -> *).
HasExistsTextElement m =>
TextElementRef -> ExceptT Error m ()
guardExistsTextElement TextElementRef
ref
        m Comment -> ExceptT Error m Comment
forall (m :: * -> *) a. Monad m => m a -> ExceptT Error m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Comment -> ExceptT Error m Comment)
-> m Comment -> ExceptT Error m Comment
forall a b. (a -> b) -> a -> b
$ UserID -> TextElementID -> Text -> m Comment
forall (m :: * -> *).
HasCreateComment m =>
UserID -> TextElementID -> Text -> m Comment
DB.createComment UserID
userID TextElementID
textID Text
text

getComments
    :: (HasGetComments m, HasLogMessage m)
    => UserID
    -> TextElementRef
    -> m (Result (Vector Comment))
getComments :: forall (m :: * -> *).
(HasGetComments m, HasLogMessage m) =>
UserID -> TextElementRef -> m (Result (Vector Comment))
getComments UserID
userID ref :: TextElementRef
ref@(TextElementRef DocumentID
docID TextElementID
_) = UserID
-> Scope
-> m (Result (Vector Comment))
-> m (Result (Vector Comment))
forall (m :: * -> *) a.
HasLogMessage m =>
UserID -> Scope -> m (Result a) -> m (Result a)
logged UserID
userID Scope
Scope.docsComment (m (Result (Vector Comment)) -> m (Result (Vector Comment)))
-> m (Result (Vector Comment)) -> m (Result (Vector Comment))
forall a b. (a -> b) -> a -> b
$
    ExceptT Error m (Vector Comment) -> m (Result (Vector Comment))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT Error m (Vector Comment) -> m (Result (Vector Comment)))
-> ExceptT Error m (Vector Comment) -> m (Result (Vector Comment))
forall a b. (a -> b) -> a -> b
$ do
        Permission -> DocumentID -> UserID -> ExceptT Error m ()
forall (m :: * -> *).
HasCheckPermission m =>
Permission -> DocumentID -> UserID -> ExceptT Error m ()
guardPermission Permission
Read DocumentID
docID UserID
userID
        TextElementRef -> ExceptT Error m ()
forall (m :: * -> *).
HasExistsTextElement m =>
TextElementRef -> ExceptT Error m ()
guardExistsTextElement TextElementRef
ref
        m (Vector Comment) -> ExceptT Error m (Vector Comment)
forall (m :: * -> *) a. Monad m => m a -> ExceptT Error m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Vector Comment) -> ExceptT Error m (Vector Comment))
-> m (Vector Comment) -> ExceptT Error m (Vector Comment)
forall a b. (a -> b) -> a -> b
$ TextElementRef -> m (Vector Comment)
forall (m :: * -> *).
HasGetComments m =>
TextElementRef -> m (Vector Comment)
DB.getComments TextElementRef
ref

resolveComment
    :: (HasCreateComment m, HasLogMessage m)
    => UserID
    -> CommentRef
    -> m (Result ())
resolveComment :: forall (m :: * -> *).
(HasCreateComment m, HasLogMessage m) =>
UserID -> CommentRef -> m (Result ())
resolveComment UserID
userID ref :: CommentRef
ref@(CommentRef (TextElementRef DocumentID
docID TextElementID
_) CommentID
commentID) =
    UserID -> Scope -> m (Result ()) -> m (Result ())
forall (m :: * -> *) a.
HasLogMessage m =>
UserID -> Scope -> m (Result a) -> m (Result a)
logged UserID
userID Scope
Scope.docsComment (m (Result ()) -> m (Result ())) -> m (Result ()) -> m (Result ())
forall a b. (a -> b) -> a -> b
$ ExceptT Error m () -> m (Result ())
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT Error m () -> m (Result ()))
-> ExceptT Error m () -> m (Result ())
forall a b. (a -> b) -> a -> b
$ do
        Permission -> DocumentID -> UserID -> ExceptT Error m ()
forall (m :: * -> *).
HasCheckPermission m =>
Permission -> DocumentID -> UserID -> ExceptT Error m ()
guardPermission Permission
Comment DocumentID
docID UserID
userID
        CommentRef -> ExceptT Error m ()
forall (m :: * -> *).
HasExistsComment m =>
CommentRef -> ExceptT Error m ()
guardExistsComment CommentRef
ref
        m () -> ExceptT Error m ()
forall (m :: * -> *) a. Monad m => m a -> ExceptT Error m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ExceptT Error m ()) -> m () -> ExceptT Error m ()
forall a b. (a -> b) -> a -> b
$ CommentID -> m ()
forall (m :: * -> *). HasCreateComment m => CommentID -> m ()
DB.resolveComment CommentID
commentID

createReply
    :: (HasCreateComment m, HasLogMessage m)
    => UserID
    -> CommentRef
    -> Text
    -> m (Result Message)
createReply :: forall (m :: * -> *).
(HasCreateComment m, HasLogMessage m) =>
UserID -> CommentRef -> Text -> m (Result Message)
createReply UserID
userID ref :: CommentRef
ref@(CommentRef (TextElementRef DocumentID
docID TextElementID
_) CommentID
commentID) Text
content =
    UserID -> Scope -> m (Result Message) -> m (Result Message)
forall (m :: * -> *) a.
HasLogMessage m =>
UserID -> Scope -> m (Result a) -> m (Result a)
logged UserID
userID Scope
Scope.docsComment (m (Result Message) -> m (Result Message))
-> m (Result Message) -> m (Result Message)
forall a b. (a -> b) -> a -> b
$ ExceptT Error m Message -> m (Result Message)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT Error m Message -> m (Result Message))
-> ExceptT Error m Message -> m (Result Message)
forall a b. (a -> b) -> a -> b
$ do
        Permission -> DocumentID -> UserID -> ExceptT Error m ()
forall (m :: * -> *).
HasCheckPermission m =>
Permission -> DocumentID -> UserID -> ExceptT Error m ()
guardPermission Permission
Comment DocumentID
docID UserID
userID
        CommentRef -> ExceptT Error m ()
forall (m :: * -> *).
HasExistsComment m =>
CommentRef -> ExceptT Error m ()
guardExistsComment CommentRef
ref
        m Message -> ExceptT Error m Message
forall (m :: * -> *) a. Monad m => m a -> ExceptT Error m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Message -> ExceptT Error m Message)
-> m Message -> ExceptT Error m Message
forall a b. (a -> b) -> a -> b
$ UserID -> CommentID -> Text -> m Message
forall (m :: * -> *).
HasCreateComment m =>
UserID -> CommentID -> Text -> m Message
DB.createReply UserID
userID CommentID
commentID Text
content

newDefaultDocument
    :: ( HasCreateDocument m
       , HasLogMessage m
       , HasCreateTextElement m
       , HasCreateTextRevision m
       , HasGetTextElementRevision m
       , HasExistsComment m
       , HasCreateTreeRevision m
       , HasGetTreeRevision m
       , HasGetRevisionKey m
       , HasGetDocument m
       , HasRollback m
       , DB.HasDraftTextRevision m
       )
    => UserID
    -> GroupID
    -> Text
    -> LTML.FlaggedInputTree'
    -> m (Result (FullDocument (Rendered TextElementRevision)))
newDefaultDocument :: forall (m :: * -> *).
(HasCreateDocument m, HasLogMessage m, HasCreateTextElement m,
 HasCreateTextRevision m, HasGetTextElementRevision m,
 HasExistsComment m, HasCreateTreeRevision m, HasGetTreeRevision m,
 HasGetRevisionKey m, HasGetDocument m, HasRollback m,
 HasDraftTextRevision m) =>
UserID
-> Limit
-> Text
-> FlaggedInputTree'
-> m (Result (FullDocument (Rendered TextElementRevision)))
newDefaultDocument UserID
userID Limit
groupID Text
title FlaggedInputTree'
tree = ExceptT Error m (FullDocument (Rendered TextElementRevision))
-> m (Result (FullDocument (Rendered TextElementRevision)))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT Error m (FullDocument (Rendered TextElementRevision))
 -> m (Result (FullDocument (Rendered TextElementRevision))))
-> ExceptT Error m (FullDocument (Rendered TextElementRevision))
-> m (Result (FullDocument (Rendered TextElementRevision)))
forall a b. (a -> b) -> a -> b
$ do
    Document
doc <- m (Result Document) -> ExceptT Error m Document
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (m (Result Document) -> ExceptT Error m Document)
-> m (Result Document) -> ExceptT Error m Document
forall a b. (a -> b) -> a -> b
$ UserID -> Limit -> Text -> m (Result Document)
forall (m :: * -> *).
(HasCreateDocument m, HasLogMessage m) =>
UserID -> Limit -> Text -> m (Result Document)
createDocument UserID
userID Limit
groupID Text
title
    let docID :: DocumentID
docID = Document -> DocumentID
Document.identifier Document
doc
    let emplaceTexts :: FlaggedTree flag (Maybe Text) Text
-> ExceptT Error m (Tree (Rendered TextElementRevision))
emplaceTexts (LTML.Flagged flag
_ (LTML.TypedTree (LSD.KindName String
kind) (LSD.TypeName String
type_) Tree flag (Maybe Text) Text
content)) =
            case Tree flag (Maybe Text) Text
content of
                (LTML.Tree Maybe Text
heading [FlaggedTree flag (Maybe Text) Text]
children) -> do
                    [Tree (Rendered TextElementRevision)]
emplacedChildren <- (FlaggedTree flag (Maybe Text) Text
 -> ExceptT Error m (Tree (Rendered TextElementRevision)))
-> [FlaggedTree flag (Maybe Text) Text]
-> ExceptT Error m [Tree (Rendered TextElementRevision)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM FlaggedTree flag (Maybe Text) Text
-> ExceptT Error m (Tree (Rendered TextElementRevision))
emplaceTexts [FlaggedTree flag (Maybe Text) Text]
children
                    Tree (Rendered TextElementRevision)
-> ExceptT Error m (Tree (Rendered TextElementRevision))
forall a. a -> ExceptT Error m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Tree (Rendered TextElementRevision)
 -> ExceptT Error m (Tree (Rendered TextElementRevision)))
-> Tree (Rendered TextElementRevision)
-> ExceptT Error m (Tree (Rendered TextElementRevision))
forall a b. (a -> b) -> a -> b
$
                        Node (Rendered TextElementRevision)
-> Tree (Rendered TextElementRevision)
forall a. Node a -> Tree a
Tree.Tree (Node (Rendered TextElementRevision)
 -> Tree (Rendered TextElementRevision))
-> Node (Rendered TextElementRevision)
-> Tree (Rendered TextElementRevision)
forall a b. (a -> b) -> a -> b
$
                            NodeHeader
-> [Tree (Rendered TextElementRevision)]
-> Node (Rendered TextElementRevision)
forall a. NodeHeader -> [Tree a] -> Node a
Tree.Node
                                (Text -> Text -> Maybe Text -> NodeHeader
Tree.NodeHeader (String -> Text
Text.pack String
kind) (String -> Text
Text.pack String
type_) Maybe Text
heading)
                                [Tree (Rendered TextElementRevision)]
emplacedChildren
                (LTML.Leaf Text
text) -> do
                    TextElement
textElement <-
                        m (Result TextElement) -> ExceptT Error m TextElement
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (m (Result TextElement) -> ExceptT Error m TextElement)
-> m (Result TextElement) -> ExceptT Error m TextElement
forall a b. (a -> b) -> a -> b
$
                            UserID -> DocumentID -> Text -> Text -> m (Result TextElement)
forall (m :: * -> *).
(HasCreateTextElement m, HasLogMessage m) =>
UserID -> DocumentID -> Text -> Text -> m (Result TextElement)
createTextElement
                                UserID
userID
                                DocumentID
docID
                                (String -> Text
Text.pack String
kind)
                                (String -> Text
Text.pack String
type_)
                    let textID :: TextElementID
textID = TextElement -> TextElementID
TextElement.identifier TextElement
textElement
                    let textRev :: TextElementRef
textRev = DocumentID -> TextElementID -> TextElementRef
TextElementRef DocumentID
docID TextElementID
textID
                    Rendered ConflictStatus
textRevision <-
                        m (Result (Rendered ConflictStatus))
-> ExceptT Error m (Rendered ConflictStatus)
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (m (Result (Rendered ConflictStatus))
 -> ExceptT Error m (Rendered ConflictStatus))
-> m (Result (Rendered ConflictStatus))
-> ExceptT Error m (Rendered ConflictStatus)
forall a b. (a -> b) -> a -> b
$
                            UserID -> NewTextRevision -> m (Result (Rendered ConflictStatus))
forall (m :: * -> *).
(HasCreateTextRevision m, HasGetTextElementRevision m,
 HasExistsComment m, HasLogMessage m, HasGetTreeRevision m,
 HasGetRevisionKey m, HasGetDocument m, HasDraftTextRevision m) =>
UserID -> NewTextRevision -> m (Result (Rendered ConflictStatus))
createTextRevision UserID
userID (NewTextRevision -> m (Result (Rendered ConflictStatus)))
-> NewTextRevision -> m (Result (Rendered ConflictStatus))
forall a b. (a -> b) -> a -> b
$
                                NewTextRevision
                                    { newTextRevisionParent :: Maybe TextRevisionID
newTextRevisionParent = Maybe TextRevisionID
forall a. Maybe a
Nothing
                                    , newTextRevisionElement :: TextElementRef
newTextRevisionElement = TextElementRef
textRev
                                    , newTextRevisionContent :: Text
newTextRevisionContent = Text
text
                                    , newTextRevisionCommentAnchors :: Vector CommentAnchor
newTextRevisionCommentAnchors = Vector CommentAnchor
forall a. Vector a
Vector.empty
                                    , newTextRevisionIsAutoSave :: Bool
newTextRevisionIsAutoSave = Bool
False -- Document creation is not autosave
                                    }
                    case Rendered ConflictStatus -> ConflictStatus
forall a. Rendered a -> a
TextRevision.element Rendered ConflictStatus
textRevision of
                        TextRevision.NoConflict TextRevision
revision ->
                            Tree (Rendered TextElementRevision)
-> ExceptT Error m (Tree (Rendered TextElementRevision))
forall a. a -> ExceptT Error m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Tree (Rendered TextElementRevision)
 -> ExceptT Error m (Tree (Rendered TextElementRevision)))
-> Tree (Rendered TextElementRevision)
-> ExceptT Error m (Tree (Rendered TextElementRevision))
forall a b. (a -> b) -> a -> b
$
                                Rendered TextElementRevision -> Tree (Rendered TextElementRevision)
forall a. a -> Tree a
Tree.Leaf (Rendered TextElementRevision
 -> Tree (Rendered TextElementRevision))
-> Rendered TextElementRevision
-> Tree (Rendered TextElementRevision)
forall a b. (a -> b) -> a -> b
$
                                    TextElementRevision -> Text -> Rendered TextElementRevision
forall a. a -> Text -> Rendered a
Rendered
                                        (TextElement -> Maybe TextRevision -> TextElementRevision
TextElementRevision TextElement
textElement (Maybe TextRevision -> TextElementRevision)
-> Maybe TextRevision -> TextElementRevision
forall a b. (a -> b) -> a -> b
$ TextRevision -> Maybe TextRevision
forall a. a -> Maybe a
Just TextRevision
revision)
                                        (Rendered ConflictStatus -> Text
forall a. Rendered a -> Text
TextRevision.html Rendered ConflictStatus
textRevision)
                        ConflictStatus
_ ->
                            Error -> ExceptT Error m (Tree (Rendered TextElementRevision))
forall a. Error -> ExceptT Error m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Error -> ExceptT Error m (Tree (Rendered TextElementRevision)))
-> Error -> ExceptT Error m (Tree (Rendered TextElementRevision))
forall a b. (a -> b) -> a -> b
$ Text -> Error
Custom Text
"Text Revision Conflict During Initial Document Creation."
    Tree (Rendered TextElementRevision)
root <- FlaggedInputTree'
-> ExceptT Error m (Tree (Rendered TextElementRevision))
forall {m :: * -> *} {flag}.
(HasCreateTextElement m, HasLogMessage m, HasCreateTextRevision m,
 HasGetTextElementRevision m, HasExistsComment m,
 HasGetTreeRevision m, HasGetRevisionKey m, HasGetDocument m,
 HasDraftTextRevision m) =>
FlaggedTree flag (Maybe Text) Text
-> ExceptT Error m (Tree (Rendered TextElementRevision))
emplaceTexts FlaggedInputTree'
tree
    case Tree (Rendered TextElementRevision)
root of
        Tree.Tree Node (Rendered TextElementRevision)
node -> do
            TreeRevisionWithMetaData TreeRevisionHeader
header TreeWithMetaData TextElementID
_ <-
                m (Result (TreeRevisionWithMetaData TextElementID))
-> ExceptT Error m (TreeRevisionWithMetaData TextElementID)
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (m (Result (TreeRevisionWithMetaData TextElementID))
 -> ExceptT Error m (TreeRevisionWithMetaData TextElementID))
-> m (Result (TreeRevisionWithMetaData TextElementID))
-> ExceptT Error m (TreeRevisionWithMetaData TextElementID)
forall a b. (a -> b) -> a -> b
$
                    UserID
-> DocumentID
-> Node TextElementID
-> m (Result (TreeRevisionWithMetaData TextElementID))
forall (m :: * -> *).
(HasCreateTreeRevision m, HasLogMessage m,
 HasGetTextElementRevision m, HasGetTreeRevision m,
 HasRollback m) =>
UserID
-> DocumentID
-> Node TextElementID
-> m (Result (TreeRevisionWithMetaData TextElementID))
createTreeRevision
                        UserID
userID
                        DocumentID
docID
                        ( (TextElement -> TextElementID
TextElement.identifier (TextElement -> TextElementID)
-> (TextElementRevision -> TextElement)
-> TextElementRevision
-> TextElementID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextElementRevision -> TextElement
TextRevision.textElement) (TextElementRevision -> TextElementID)
-> (Rendered TextElementRevision -> TextElementRevision)
-> Rendered TextElementRevision
-> TextElementID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rendered TextElementRevision -> TextElementRevision
forall a. Rendered a -> a
TextRevision.element
                            (Rendered TextElementRevision -> TextElementID)
-> Node (Rendered TextElementRevision) -> Node TextElementID
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Node (Rendered TextElementRevision)
node
                        )
            FullDocument (Rendered TextElementRevision)
-> ExceptT Error m (FullDocument (Rendered TextElementRevision))
forall a. a -> ExceptT Error m a
forall (m :: * -> *) a. Monad m => a -> m a
return (FullDocument (Rendered TextElementRevision)
 -> ExceptT Error m (FullDocument (Rendered TextElementRevision)))
-> FullDocument (Rendered TextElementRevision)
-> ExceptT Error m (FullDocument (Rendered TextElementRevision))
forall a b. (a -> b) -> a -> b
$ Document
-> Maybe (TreeRevision (Rendered TextElementRevision))
-> FullDocument (Rendered TextElementRevision)
forall a. Document -> Maybe (TreeRevision a) -> FullDocument a
FullDocument Document
doc (Maybe (TreeRevision (Rendered TextElementRevision))
 -> FullDocument (Rendered TextElementRevision))
-> Maybe (TreeRevision (Rendered TextElementRevision))
-> FullDocument (Rendered TextElementRevision)
forall a b. (a -> b) -> a -> b
$ TreeRevision (Rendered TextElementRevision)
-> Maybe (TreeRevision (Rendered TextElementRevision))
forall a. a -> Maybe a
Just (TreeRevision (Rendered TextElementRevision)
 -> Maybe (TreeRevision (Rendered TextElementRevision)))
-> TreeRevision (Rendered TextElementRevision)
-> Maybe (TreeRevision (Rendered TextElementRevision))
forall a b. (a -> b) -> a -> b
$ TreeRevisionHeader
-> Node (Rendered TextElementRevision)
-> TreeRevision (Rendered TextElementRevision)
forall a. TreeRevisionHeader -> Node a -> TreeRevision a
TreeRevision.TreeRevision TreeRevisionHeader
header Node (Rendered TextElementRevision)
node
        Tree.Leaf Rendered TextElementRevision
_ -> Error
-> ExceptT Error m (FullDocument (Rendered TextElementRevision))
forall a. Error -> ExceptT Error m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Error
 -> ExceptT Error m (FullDocument (Rendered TextElementRevision)))
-> Error
-> ExceptT Error m (FullDocument (Rendered TextElementRevision))
forall a b. (a -> b) -> a -> b
$ Text -> Error
Custom Text
"Root is leaf :/"

-- guards

guardPermission
    :: (HasCheckPermission m)
    => Permission
    -> DocumentID
    -> UserID
    -> ExceptT Error m ()
guardPermission :: forall (m :: * -> *).
HasCheckPermission m =>
Permission -> DocumentID -> UserID -> ExceptT Error m ()
guardPermission Permission
perms DocumentID
docID UserID
userID = do
    Bool
hasPermission <- m Bool -> ExceptT Error m Bool
forall (m :: * -> *) a. Monad m => m a -> ExceptT Error m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Bool -> ExceptT Error m Bool) -> m Bool -> ExceptT Error m Bool
forall a b. (a -> b) -> a -> b
$ UserID -> DocumentID -> Permission -> m Bool
forall (m :: * -> *).
HasCheckPermission m =>
UserID -> DocumentID -> Permission -> m Bool
DB.checkDocumentPermission UserID
userID DocumentID
docID Permission
perms
    Bool
superAdmin <- m Bool -> ExceptT Error m Bool
forall (m :: * -> *) a. Monad m => m a -> ExceptT Error m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Bool -> ExceptT Error m Bool) -> m Bool -> ExceptT Error m Bool
forall a b. (a -> b) -> a -> b
$ UserID -> m Bool
forall (m :: * -> *). HasIsSuperAdmin m => UserID -> m Bool
DB.isSuperAdmin UserID
userID
    Bool -> ExceptT Error m () -> ExceptT Error m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Bool
hasPermission Bool -> Bool -> Bool
|| Bool
superAdmin) (ExceptT Error m () -> ExceptT Error m ())
-> ExceptT Error m () -> ExceptT Error m ()
forall a b. (a -> b) -> a -> b
$
        Error -> ExceptT Error m ()
forall a. Error -> ExceptT Error m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (DocumentID -> Permission -> Error
NoPermission DocumentID
docID Permission
perms)

guardGroupAdmin
    :: (HasIsGroupAdmin m)
    => GroupID
    -> UserID
    -> ExceptT Error m ()
guardGroupAdmin :: forall (m :: * -> *).
HasIsGroupAdmin m =>
Limit -> UserID -> ExceptT Error m ()
guardGroupAdmin Limit
groupID UserID
userID = do
    Bool
hasPermission <- m Bool -> ExceptT Error m Bool
forall (m :: * -> *) a. Monad m => m a -> ExceptT Error m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Bool -> ExceptT Error m Bool) -> m Bool -> ExceptT Error m Bool
forall a b. (a -> b) -> a -> b
$ UserID -> Limit -> m Bool
forall (m :: * -> *).
HasIsGroupAdmin m =>
UserID -> Limit -> m Bool
DB.isGroupAdmin UserID
userID Limit
groupID
    Bool
superAdmin <- m Bool -> ExceptT Error m Bool
forall (m :: * -> *) a. Monad m => m a -> ExceptT Error m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Bool -> ExceptT Error m Bool) -> m Bool -> ExceptT Error m Bool
forall a b. (a -> b) -> a -> b
$ UserID -> m Bool
forall (m :: * -> *). HasIsSuperAdmin m => UserID -> m Bool
DB.isSuperAdmin UserID
userID
    Bool -> ExceptT Error m () -> ExceptT Error m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Bool
hasPermission Bool -> Bool -> Bool
|| Bool
superAdmin) (ExceptT Error m () -> ExceptT Error m ())
-> ExceptT Error m () -> ExceptT Error m ()
forall a b. (a -> b) -> a -> b
$
        Error -> ExceptT Error m ()
forall a. Error -> ExceptT Error m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Limit -> Error
NoPermissionInGroup Limit
groupID)

guardUserRights
    :: (HasIsSuperAdmin m)
    => UserID
    -> UserID
    -> ExceptT Error m ()
guardUserRights :: forall (m :: * -> *).
HasIsSuperAdmin m =>
UserID -> UserID -> ExceptT Error m ()
guardUserRights UserID
userID UserID
forUserID = do
    Bool
superAdmin <- m Bool -> ExceptT Error m Bool
forall (m :: * -> *) a. Monad m => m a -> ExceptT Error m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Bool -> ExceptT Error m Bool) -> m Bool -> ExceptT Error m Bool
forall a b. (a -> b) -> a -> b
$ UserID -> m Bool
forall (m :: * -> *). HasIsSuperAdmin m => UserID -> m Bool
DB.isSuperAdmin UserID
userID
    Bool -> ExceptT Error m () -> ExceptT Error m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (UserID
userID UserID -> UserID -> Bool
forall a. Eq a => a -> a -> Bool
== UserID
forUserID Bool -> Bool -> Bool
|| Bool
superAdmin) (ExceptT Error m () -> ExceptT Error m ())
-> ExceptT Error m () -> ExceptT Error m ()
forall a b. (a -> b) -> a -> b
$
        Error -> ExceptT Error m ()
forall a. Error -> ExceptT Error m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (UserID -> Error
NoPermissionForUser UserID
forUserID)

guardSuperAdmin
    :: (HasIsSuperAdmin m)
    => UserID
    -> ExceptT Error m ()
guardSuperAdmin :: forall (m :: * -> *).
HasIsSuperAdmin m =>
UserID -> ExceptT Error m ()
guardSuperAdmin UserID
userID = do
    Bool
isSuperAdmin <- m Bool -> ExceptT Error m Bool
forall (m :: * -> *) a. Monad m => m a -> ExceptT Error m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Bool -> ExceptT Error m Bool) -> m Bool -> ExceptT Error m Bool
forall a b. (a -> b) -> a -> b
$ UserID -> m Bool
forall (m :: * -> *). HasIsSuperAdmin m => UserID -> m Bool
DB.isSuperAdmin UserID
userID
    Bool -> ExceptT Error m () -> ExceptT Error m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
isSuperAdmin (ExceptT Error m () -> ExceptT Error m ())
-> ExceptT Error m () -> ExceptT Error m ()
forall a b. (a -> b) -> a -> b
$
        Error -> ExceptT Error m ()
forall a. Error -> ExceptT Error m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError Error
SuperAdminOnly

guardExistsDocument
    :: (HasExistsDocument m)
    => DocumentID
    -> ExceptT Error m ()
guardExistsDocument :: forall (m :: * -> *).
HasExistsDocument m =>
DocumentID -> ExceptT Error m ()
guardExistsDocument DocumentID
docID = do
    Bool
existsDocument <- m Bool -> ExceptT Error m Bool
forall (m :: * -> *) a. Monad m => m a -> ExceptT Error m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Bool -> ExceptT Error m Bool) -> m Bool -> ExceptT Error m Bool
forall a b. (a -> b) -> a -> b
$ DocumentID -> m Bool
forall (m :: * -> *). HasExistsDocument m => DocumentID -> m Bool
DB.existsDocument DocumentID
docID
    Bool -> ExceptT Error m () -> ExceptT Error m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
existsDocument (ExceptT Error m () -> ExceptT Error m ())
-> ExceptT Error m () -> ExceptT Error m ()
forall a b. (a -> b) -> a -> b
$
        Error -> ExceptT Error m ()
forall a. Error -> ExceptT Error m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (DocumentID -> Error
DocumentNotFound DocumentID
docID)

guardExistsTreeRevision
    :: (HasExistsTreeRevision m)
    => Bool
    -- ^ wether or not to consider `Latest` to exist if no revision exists.
    -> TreeRevisionRef
    -- ^ reference to the revision
    -> ExceptT Error m ()
guardExistsTreeRevision :: forall (m :: * -> *).
HasExistsTreeRevision m =>
Bool -> TreeRevisionRef -> ExceptT Error m ()
guardExistsTreeRevision Bool
allowLatestNothing ref :: TreeRevisionRef
ref@(TreeRevisionRef DocumentID
docID TreeRevisionSelector
selector) = do
    DocumentID -> ExceptT Error m ()
forall (m :: * -> *).
HasExistsDocument m =>
DocumentID -> ExceptT Error m ()
guardExistsDocument DocumentID
docID
    Bool
existsTreeRevision <- m Bool -> ExceptT Error m Bool
forall (m :: * -> *) a. Monad m => m a -> ExceptT Error m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Bool -> ExceptT Error m Bool) -> m Bool -> ExceptT Error m Bool
forall a b. (a -> b) -> a -> b
$ TreeRevisionRef -> m Bool
forall (m :: * -> *).
HasExistsTreeRevision m =>
TreeRevisionRef -> m Bool
DB.existsTreeRevision TreeRevisionRef
ref
    let considerExistant :: Bool
considerExistant = case TreeRevisionSelector
selector of
            TreeRevision.Specific TreeRevisionID
_ -> Bool
existsTreeRevision
            TreeRevisionSelector
_ -> Bool
existsTreeRevision Bool -> Bool -> Bool
|| Bool
allowLatestNothing
    Bool -> ExceptT Error m () -> ExceptT Error m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
considerExistant (ExceptT Error m () -> ExceptT Error m ())
-> ExceptT Error m () -> ExceptT Error m ()
forall a b. (a -> b) -> a -> b
$
        Error -> ExceptT Error m ()
forall a. Error -> ExceptT Error m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (TreeRevisionRef -> Error
TreeRevisionNotFound TreeRevisionRef
ref)

guardExistsTextElement
    :: (HasExistsTextElement m)
    => TextElementRef
    -> ExceptT Error m ()
guardExistsTextElement :: forall (m :: * -> *).
HasExistsTextElement m =>
TextElementRef -> ExceptT Error m ()
guardExistsTextElement ref :: TextElementRef
ref@(TextElementRef DocumentID
docID TextElementID
_) = do
    DocumentID -> ExceptT Error m ()
forall (m :: * -> *).
HasExistsDocument m =>
DocumentID -> ExceptT Error m ()
guardExistsDocument DocumentID
docID
    Bool
existsTextElement <- m Bool -> ExceptT Error m Bool
forall (m :: * -> *) a. Monad m => m a -> ExceptT Error m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Bool -> ExceptT Error m Bool) -> m Bool -> ExceptT Error m Bool
forall a b. (a -> b) -> a -> b
$ TextElementRef -> m Bool
forall (m :: * -> *).
HasExistsTextElement m =>
TextElementRef -> m Bool
DB.existsTextElement TextElementRef
ref
    Bool -> ExceptT Error m () -> ExceptT Error m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
existsTextElement (ExceptT Error m () -> ExceptT Error m ())
-> ExceptT Error m () -> ExceptT Error m ()
forall a b. (a -> b) -> a -> b
$
        Error -> ExceptT Error m ()
forall a. Error -> ExceptT Error m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (TextElementRef -> Error
TextElementNotFound TextElementRef
ref)

guardExistsTextRevision
    :: (HasExistsTextRevision m)
    => Bool
    -- ^ wether or not to consider `Latest` to exist if no revision exists.
    -> TextRevisionRef
    -- ^ reference to the revision
    -> ExceptT Error m ()
guardExistsTextRevision :: forall (m :: * -> *).
HasExistsTextRevision m =>
Bool -> TextRevisionRef -> ExceptT Error m ()
guardExistsTextRevision Bool
allowLatestNothing ref :: TextRevisionRef
ref@(TextRevisionRef TextElementRef
elementRef TextRevisionSelector
selector) = do
    TextElementRef -> ExceptT Error m ()
forall (m :: * -> *).
HasExistsTextElement m =>
TextElementRef -> ExceptT Error m ()
guardExistsTextElement TextElementRef
elementRef
    Bool
existsTextRevision <- m Bool -> ExceptT Error m Bool
forall (m :: * -> *) a. Monad m => m a -> ExceptT Error m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Bool -> ExceptT Error m Bool) -> m Bool -> ExceptT Error m Bool
forall a b. (a -> b) -> a -> b
$ TextRevisionRef -> m Bool
forall (m :: * -> *).
HasExistsTextRevision m =>
TextRevisionRef -> m Bool
DB.existsTextRevision TextRevisionRef
ref
    let considerExistant :: Bool
considerExistant = case TextRevisionSelector
selector of
            TextRevision.Specific TextRevisionID
_ -> Bool
existsTextRevision
            TextRevisionSelector
_ -> Bool
existsTextRevision Bool -> Bool -> Bool
|| Bool
allowLatestNothing
    Bool -> ExceptT Error m () -> ExceptT Error m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
considerExistant (ExceptT Error m () -> ExceptT Error m ())
-> ExceptT Error m () -> ExceptT Error m ()
forall a b. (a -> b) -> a -> b
$
        Error -> ExceptT Error m ()
forall a. Error -> ExceptT Error m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (TextRevisionRef -> Error
TextRevisionNotFound TextRevisionRef
ref)

guardExistsComment
    :: (HasExistsComment m)
    => CommentRef
    -> ExceptT Error m ()
guardExistsComment :: forall (m :: * -> *).
HasExistsComment m =>
CommentRef -> ExceptT Error m ()
guardExistsComment ref :: CommentRef
ref@(CommentRef TextElementRef
textRef CommentID
_) = do
    TextElementRef -> ExceptT Error m ()
forall (m :: * -> *).
HasExistsTextElement m =>
TextElementRef -> ExceptT Error m ()
guardExistsTextElement TextElementRef
textRef
    Bool
existsComment <- m Bool -> ExceptT Error m Bool
forall (m :: * -> *) a. Monad m => m a -> ExceptT Error m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Bool -> ExceptT Error m Bool) -> m Bool -> ExceptT Error m Bool
forall a b. (a -> b) -> a -> b
$ CommentRef -> m Bool
forall (m :: * -> *). HasExistsComment m => CommentRef -> m Bool
DB.existsComment CommentRef
ref
    Bool -> ExceptT Error m () -> ExceptT Error m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
existsComment (ExceptT Error m () -> ExceptT Error m ())
-> ExceptT Error m () -> ExceptT Error m ()
forall a b. (a -> b) -> a -> b
$
        Error -> ExceptT Error m ()
forall a. Error -> ExceptT Error m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (CommentRef -> Error
CommentNotFound CommentRef
ref)

-- | Get draft text revision for a user and text element.
-- Returns Nothing if no draft exists for this user/element combination.
-- Drafts are user-specific and element-specific (one draft per user per text element).
getDraftTextRevision
    :: ( DB.HasDraftTextRevision m
       , HasLogMessage m
       , HasGetTreeRevision m
       , HasGetTextElementRevision m
       , HasGetRevisionKey m
       , HasGetDocument m
       )
    => UserID
    -> TextElementRef
    -> m (Result (Maybe (Rendered DraftRevision)))
getDraftTextRevision :: forall (m :: * -> *).
(HasDraftTextRevision m, HasLogMessage m, HasGetTreeRevision m,
 HasGetTextElementRevision m, HasGetRevisionKey m,
 HasGetDocument m) =>
UserID
-> TextElementRef -> m (Result (Maybe (Rendered DraftRevision)))
getDraftTextRevision UserID
userID ref :: TextElementRef
ref@(TextElementRef DocumentID
docID TextElementID
_) = UserID
-> Scope
-> m (Result (Maybe (Rendered DraftRevision)))
-> m (Result (Maybe (Rendered DraftRevision)))
forall (m :: * -> *) a.
HasLogMessage m =>
UserID -> Scope -> m (Result a) -> m (Result a)
logged UserID
userID Scope
Scope.docsTextRevision (m (Result (Maybe (Rendered DraftRevision)))
 -> m (Result (Maybe (Rendered DraftRevision))))
-> m (Result (Maybe (Rendered DraftRevision)))
-> m (Result (Maybe (Rendered DraftRevision)))
forall a b. (a -> b) -> a -> b
$ ExceptT Error m (Maybe (Rendered DraftRevision))
-> m (Result (Maybe (Rendered DraftRevision)))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT Error m (Maybe (Rendered DraftRevision))
 -> m (Result (Maybe (Rendered DraftRevision))))
-> ExceptT Error m (Maybe (Rendered DraftRevision))
-> m (Result (Maybe (Rendered DraftRevision)))
forall a b. (a -> b) -> a -> b
$ do
    -- let render =
    --         rendered'
    --             userID
    --             (TextRevisionRef ref TextRevision.Latest)
    --             (newTextRevisionContent revision)
    Permission -> DocumentID -> UserID -> ExceptT Error m ()
forall (m :: * -> *).
HasCheckPermission m =>
Permission -> DocumentID -> UserID -> ExceptT Error m ()
guardPermission Permission
Read DocumentID
docID UserID
userID
    TextElementRef -> ExceptT Error m ()
forall (m :: * -> *).
HasExistsTextElement m =>
TextElementRef -> ExceptT Error m ()
guardExistsTextElement TextElementRef
ref
    Maybe DraftRevision
revision <- m (Maybe DraftRevision) -> ExceptT Error m (Maybe DraftRevision)
forall (m :: * -> *) a. Monad m => m a -> ExceptT Error m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Maybe DraftRevision) -> ExceptT Error m (Maybe DraftRevision))
-> m (Maybe DraftRevision) -> ExceptT Error m (Maybe DraftRevision)
forall a b. (a -> b) -> a -> b
$ UserID -> TextElementRef -> m (Maybe DraftRevision)
forall (m :: * -> *).
HasDraftTextRevision m =>
UserID -> TextElementRef -> m (Maybe DraftRevision)
DB.getDraftTextRevision UserID
userID TextElementRef
ref
    (DraftRevision -> ExceptT Error m (Rendered DraftRevision))
-> Maybe DraftRevision
-> ExceptT Error m (Maybe (Rendered 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
        ( \DraftRevision
rev ->
            UserID
-> TextRevisionRef
-> Text
-> DraftRevision
-> ExceptT Error m (Rendered DraftRevision)
forall (m :: * -> *) a.
(HasGetTreeRevision m, HasLogMessage m,
 HasGetTextElementRevision m, HasGetRevisionKey m,
 HasGetDocument m) =>
UserID
-> TextRevisionRef -> Text -> a -> ExceptT Error m (Rendered a)
rendered'
                UserID
userID
                (TextElementRef -> TextRevisionSelector -> TextRevisionRef
TextRevisionRef TextElementRef
ref TextRevisionSelector
TextRevision.Latest)
                (DraftRevision -> Text
TextRevision.draftContent DraftRevision
rev)
                DraftRevision
rev
        )
        Maybe DraftRevision
revision

-- | Publish a draft text revision to the main revision tree.
-- This attempts to create a regular text revision from the draft content.
-- If conflicts occur, they are handled as errors (since publishing is explicit, not auto-save).
-- On successful publish, the draft is automatically discarded.
publishDraftTextRevision
    :: ( DB.HasDraftTextRevision m
       , HasCreateTextRevision m
       , HasGetTextElementRevision m
       , HasExistsComment m
       , HasGetRevisionKey m
       , HasGetDocument m
       , HasGetTreeRevision m
       , HasLogMessage m
       )
    => UserID
    -> TextElementRef
    -> m (Result (Rendered ConflictStatus))
publishDraftTextRevision :: forall (m :: * -> *).
(HasDraftTextRevision m, HasCreateTextRevision m,
 HasGetTextElementRevision m, HasExistsComment m,
 HasGetRevisionKey m, HasGetDocument m, HasGetTreeRevision m,
 HasLogMessage m) =>
UserID -> TextElementRef -> m (Result (Rendered ConflictStatus))
publishDraftTextRevision UserID
userID ref :: TextElementRef
ref@(TextElementRef DocumentID
docID TextElementID
_) = UserID
-> Scope
-> m (Result (Rendered ConflictStatus))
-> m (Result (Rendered ConflictStatus))
forall (m :: * -> *) a.
HasLogMessage m =>
UserID -> Scope -> m (Result a) -> m (Result a)
logged UserID
userID Scope
Scope.docsTextRevision (m (Result (Rendered ConflictStatus))
 -> m (Result (Rendered ConflictStatus)))
-> m (Result (Rendered ConflictStatus))
-> m (Result (Rendered ConflictStatus))
forall a b. (a -> b) -> a -> b
$ ExceptT Error m (Rendered ConflictStatus)
-> m (Result (Rendered ConflictStatus))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT Error m (Rendered ConflictStatus)
 -> m (Result (Rendered ConflictStatus)))
-> ExceptT Error m (Rendered ConflictStatus)
-> m (Result (Rendered ConflictStatus))
forall a b. (a -> b) -> a -> b
$ do
    Permission -> DocumentID -> UserID -> ExceptT Error m ()
forall (m :: * -> *).
HasCheckPermission m =>
Permission -> DocumentID -> UserID -> ExceptT Error m ()
guardPermission Permission
Edit DocumentID
docID UserID
userID
    TextElementRef -> ExceptT Error m ()
forall (m :: * -> *).
HasExistsTextElement m =>
TextElementRef -> ExceptT Error m ()
guardExistsTextElement TextElementRef
ref

    -- Get the current draft
    Maybe DraftRevision
maybeDraft <- m (Maybe DraftRevision) -> ExceptT Error m (Maybe DraftRevision)
forall (m :: * -> *) a. Monad m => m a -> ExceptT Error m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Maybe DraftRevision) -> ExceptT Error m (Maybe DraftRevision))
-> m (Maybe DraftRevision) -> ExceptT Error m (Maybe DraftRevision)
forall a b. (a -> b) -> a -> b
$ UserID -> TextElementRef -> m (Maybe DraftRevision)
forall (m :: * -> *).
HasDraftTextRevision m =>
UserID -> TextElementRef -> m (Maybe DraftRevision)
DB.getDraftTextRevision UserID
userID TextElementRef
ref
    case Maybe DraftRevision
maybeDraft of
        Maybe DraftRevision
Nothing -> Error -> ExceptT Error m (Rendered ConflictStatus)
forall a. Error -> ExceptT Error m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Error -> ExceptT Error m (Rendered ConflictStatus))
-> Error -> ExceptT Error m (Rendered ConflictStatus)
forall a b. (a -> b) -> a -> b
$ Text -> Error
Custom Text
"No draft found for this text element"
        Just DraftRevision
draft -> do
            -- Create a new regular revision from the draft
            let draftHeader :: DraftRevisionHeader
draftHeader = DraftRevision -> DraftRevisionHeader
TextRevision.draftHeader DraftRevision
draft
            let basedOnRevisionID :: TextRevisionID
basedOnRevisionID = DraftRevisionHeader -> TextRevisionID
TextRevision.basedOnRevision DraftRevisionHeader
draftHeader
            let newRevision :: NewTextRevision
newRevision =
                    NewTextRevision
                        { newTextRevisionElement :: TextElementRef
newTextRevisionElement = TextElementRef
ref
                        , newTextRevisionParent :: Maybe TextRevisionID
newTextRevisionParent = TextRevisionID -> Maybe TextRevisionID
forall a. a -> Maybe a
Just TextRevisionID
basedOnRevisionID
                        , newTextRevisionContent :: Text
newTextRevisionContent = DraftRevision -> Text
TextRevision.draftContent DraftRevision
draft
                        , newTextRevisionCommentAnchors :: Vector CommentAnchor
newTextRevisionCommentAnchors = DraftRevision -> Vector CommentAnchor
TextRevision.draftCommentAnchors DraftRevision
draft
                        , newTextRevisionIsAutoSave :: Bool
newTextRevisionIsAutoSave = Bool
False -- Publishing is explicit, not auto
                        }

            -- Create the revision (may conflict with newer changes)
            Rendered ConflictStatus
result <- m (Result (Rendered ConflictStatus))
-> ExceptT Error m (Rendered ConflictStatus)
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (m (Result (Rendered ConflictStatus))
 -> ExceptT Error m (Rendered ConflictStatus))
-> m (Result (Rendered ConflictStatus))
-> ExceptT Error m (Rendered ConflictStatus)
forall a b. (a -> b) -> a -> b
$ UserID -> NewTextRevision -> m (Result (Rendered ConflictStatus))
forall (m :: * -> *).
(HasCreateTextRevision m, HasGetTextElementRevision m,
 HasExistsComment m, HasLogMessage m, HasGetTreeRevision m,
 HasGetRevisionKey m, HasGetDocument m, HasDraftTextRevision m) =>
UserID -> NewTextRevision -> m (Result (Rendered ConflictStatus))
createTextRevision UserID
userID NewTextRevision
newRevision

            -- If successful, delete the draft
            case Rendered ConflictStatus -> ConflictStatus
forall a. Rendered a -> a
TextRevision.element Rendered ConflictStatus
result of
                TextRevision.NoConflict TextRevision
_ -> do
                    m () -> ExceptT Error m ()
forall (m :: * -> *) a. Monad m => m a -> ExceptT Error m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ExceptT Error m ()) -> m () -> ExceptT Error m ()
forall a b. (a -> b) -> a -> b
$ UserID -> TextElementRef -> m ()
forall (m :: * -> *).
HasDraftTextRevision m =>
UserID -> TextElementRef -> m ()
DB.deleteDraftTextRevision UserID
userID TextElementRef
ref
                    Rendered ConflictStatus
-> ExceptT Error m (Rendered ConflictStatus)
forall a. a -> ExceptT Error m a
forall (m :: * -> *) a. Monad m => a -> m a
return Rendered ConflictStatus
result
                ConflictStatus
_ -> Rendered ConflictStatus
-> ExceptT Error m (Rendered ConflictStatus)
forall a. a -> ExceptT Error m a
forall (m :: * -> *) a. Monad m => a -> m a
return Rendered ConflictStatus
result -- Keep draft on conflict

-- | Discard a draft text revision, permanently deleting all unsaved changes.
-- This operation cannot be undone. The draft is completely removed from storage.
discardDraftTextRevision
    :: (DB.HasDraftTextRevision m, HasLogMessage m)
    => UserID
    -> TextElementRef
    -> m (Result ())
discardDraftTextRevision :: forall (m :: * -> *).
(HasDraftTextRevision m, HasLogMessage m) =>
UserID -> TextElementRef -> m (Result ())
discardDraftTextRevision UserID
userID ref :: TextElementRef
ref@(TextElementRef DocumentID
docID TextElementID
_) = UserID -> Scope -> m (Result ()) -> m (Result ())
forall (m :: * -> *) a.
HasLogMessage m =>
UserID -> Scope -> m (Result a) -> m (Result a)
logged UserID
userID Scope
Scope.docsTextRevision (m (Result ()) -> m (Result ())) -> m (Result ()) -> m (Result ())
forall a b. (a -> b) -> a -> b
$ ExceptT Error m () -> m (Result ())
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT Error m () -> m (Result ()))
-> ExceptT Error m () -> m (Result ())
forall a b. (a -> b) -> a -> b
$ do
    Permission -> DocumentID -> UserID -> ExceptT Error m ()
forall (m :: * -> *).
HasCheckPermission m =>
Permission -> DocumentID -> UserID -> ExceptT Error m ()
guardPermission Permission
Edit DocumentID
docID UserID
userID
    TextElementRef -> ExceptT Error m ()
forall (m :: * -> *).
HasExistsTextElement m =>
TextElementRef -> ExceptT Error m ()
guardExistsTextElement TextElementRef
ref
    m () -> ExceptT Error m ()
forall (m :: * -> *) a. Monad m => m a -> ExceptT Error m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ExceptT Error m ()) -> m () -> ExceptT Error m ()
forall a b. (a -> b) -> a -> b
$ UserID -> TextElementRef -> m ()
forall (m :: * -> *).
HasDraftTextRevision m =>
UserID -> TextElementRef -> m ()
DB.deleteDraftTextRevision UserID
userID TextElementRef
ref