{- This file is part of Vervis.
 -
 - Written in 2020, 2022 by fr33domlover <fr33domlover@riseup.net>.
 -
 - ♡ Copying is an act of love. Please copy, reuse and share.
 -
 - The author(s) have dedicated all copyright and related and neighboring
 - rights to this software to the public domain worldwide. This software is
 - distributed without any warranty.
 -
 - You should have received a copy of the CC0 Public Domain Dedication along
 - with this software. If not, see
 - <http://creativecommons.org/publicdomain/zero/1.0/>.
 -}

module Vervis.Cloth
    ( getCloth
    , getCloth404
    )
where

import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.Trans.Class
import Control.Monad.Trans.Maybe
import Control.Monad.Trans.Reader
import Data.Align
import Data.List.NonEmpty (NonEmpty, nonEmpty)
import Data.Maybe
import Data.These
import Data.Traversable
import Database.Persist
import Database.Persist.Sql
import Yesod.Core

import Yesod.Hashids

import Data.Either.Local
import Database.Persist.Local

import Vervis.Foundation
import Vervis.Model

getCloth
    :: MonadIO m
    => LoomId
    -> TicketLoomId
    -> ReaderT SqlBackend m
        ( Maybe
            ( Entity Loom
            , Entity TicketLoom
            , Entity Ticket
            , Either (Entity TicketAuthorLocal) (Entity TicketAuthorRemote)
            , Maybe
                ( Entity TicketResolve
                , Either
                    (Entity TicketResolveLocal)
                    (Entity TicketResolveRemote)
                )
            , These
                (NonEmpty BundleId)
                ( Either
                    (Entity MergeOriginLocal)
                    ( Entity MergeOriginRemote
                    , Maybe (Entity MergeOriginRemoteBranch)
                    )
                )
            )
        )
getCloth lid tlid = runMaybeT $ do
    l <- MaybeT $ get lid
    tl <- MaybeT $ get tlid
    guard $ ticketLoomLoom tl == lid

    let tid = ticketLoomTicket tl
    t <- lift $ getJust tid

    mergeRequest <- lift $ getMergeRequest tlid

    author <-
        lift $
            requireEitherAlt
                (getBy $ UniqueTicketAuthorLocal tid)
                (getBy $ UniqueTicketAuthorRemote tid)
                "MR doesn't have author"
                "MR has both local and remote author"

    mresolved <- lift $ getResolved tid

    return
        ( Entity lid l, Entity tlid tl, Entity tid t
        , author, mresolved, mergeRequest
        )

    where

    getMergeRequest
        :: MonadIO m
        => TicketLoomId
        -> ReaderT SqlBackend m
            (These
                (NonEmpty BundleId)
                ( Either
                    (Entity MergeOriginLocal)
                    ( Entity MergeOriginRemote
                    , Maybe (Entity MergeOriginRemoteBranch)
                    )
                )
            )
    getMergeRequest tlid = do
        maybeBundleIDs <-
            nonEmpty <$> selectKeysList [BundleTicket ==. tlid] [Desc BundleId]
        maybeOrigin <- do
            maybeOriginLocal <- getBy $ UniqueMergeOriginLocal tlid
            maybeOriginRemote <- do
                mmor <- getBy $ UniqueMergeOriginRemote tlid
                for mmor $ \ mor@(Entity originID _) ->
                    (mor,) <$> getBy (UniqueMergeOriginRemoteBranch originID)
            return $
                case (maybeOriginLocal, maybeOriginRemote) of
                    (Nothing, Nothing) -> Nothing
                    (Just l, Nothing) -> Just $ Left l
                    (Nothing, Just r) -> Just $ Right r
                    (Just _, Just _) ->
                        error "MR has both local and remote origin"
        case align maybeBundleIDs maybeOrigin of
            Just mr -> return mr
            Nothing -> error "MR with neither bundles nor origin"

    getResolved
        :: MonadIO m
        => TicketId
        -> ReaderT SqlBackend m
            (Maybe
                ( Entity TicketResolve
                , Either
                    (Entity TicketResolveLocal)
                    (Entity TicketResolveRemote)
                )
            )
    getResolved tid = do
        metr <- getBy $ UniqueTicketResolve tid
        for metr $ \ etr@(Entity trid _) ->
            (etr,) <$>
                requireEitherAlt
                    (getBy $ UniqueTicketResolveLocal trid)
                    (getBy $ UniqueTicketResolveRemote trid)
                    "No TRX"
                    "Both TRL and TRR"

getCloth404
    :: KeyHashid Loom
    -> KeyHashid TicketLoom
    -> AppDB
        ( Entity Loom
        , Entity TicketLoom
        , Entity Ticket
        , Either (Entity TicketAuthorLocal) (Entity TicketAuthorRemote)
        , Maybe
            ( Entity TicketResolve
            , Either
                (Entity TicketResolveLocal)
                (Entity TicketResolveRemote)
            )
        , These
            (NonEmpty BundleId)
            ( Either
                (Entity MergeOriginLocal)
                ( Entity MergeOriginRemote
                , Maybe (Entity MergeOriginRemoteBranch)
                )
            )
        )
getCloth404 lkhid tlkhid = do
    lid <- decodeKeyHashid404 lkhid
    tlid <- decodeKeyHashid404 tlkhid
    mcloth <- getCloth lid tlid
    case mcloth of
        Nothing -> notFound
        Just cloth -> return cloth