{- This file is part of Vervis.
 -
 - Written in 2016 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.Handler.Project
    ( getProjectsR
    , postProjectsR
    , getProjectNewR
    , getProjectR
    , putProjectR
    , postProjectR
    , getProjectEditR
    , getProjectDevsR
    , postProjectDevsR
    , getProjectDevNewR
    , getProjectDevR
    , deleteProjectDevR
    , postProjectDevR
    )
where

import Prelude

import Data.Maybe (fromMaybe)
import Data.Text (Text)
import Database.Persist
import Database.Esqueleto hiding (delete, (%), (==.))
import Text.Blaze.Html (Html)
import Yesod.Auth (requireAuthId)
import Yesod.Core (defaultLayout)
import Yesod.Core.Handler (redirect, setMessage, lookupPostParam, notFound)
import Yesod.Form.Functions (runFormPost)
import Yesod.Form.Types (FormResult (..))
import Yesod.Persist.Core (runDB, get404, getBy404)

import qualified Database.Esqueleto as E

import Vervis.Form.Project
import Vervis.Foundation
import Vervis.Model
import Vervis.Model.Ident
import Vervis.Model.Repo
import Vervis.Settings
import Vervis.Widget.Sharer
import Vervis.Widget.Workflow

getProjectsR :: ShrIdent -> Handler Html
getProjectsR ident = do
    projects <- runDB $ select $ from $ \ (sharer, project) -> do
        where_ $
            sharer ^. SharerIdent E.==. val ident                &&.
            sharer ^. SharerId    E.==. project ^. ProjectSharer
        orderBy [asc $ project ^. ProjectIdent]
        return $ project ^. ProjectIdent
    defaultLayout $(widgetFile "project/list")

postProjectsR :: ShrIdent -> Handler Html
postProjectsR shr = do
    Entity sid _ <- runDB $ getBy404 $ UniqueSharer shr
    ((result, widget), enctype) <- runFormPost $ newProjectForm sid
    case result of
        FormSuccess np -> do
            pid <- requireAuthId
            runDB $ do
                let project = Project
                        { projectIdent      = npIdent np
                        , projectSharer     = sid
                        , projectName       = npName np
                        , projectDesc       = npDesc np
                        , projectWorkflow   = npWflow np
                        , projectNextTicket = 1
                        , projectWiki       = Nothing
                        }
                jid <- insert project
                let collab = ProjectCollab
                        { projectCollabProject = jid
                        , projectCollabPerson  = pid
                        , projectCollabRole    = npRole np
                        }
                insert_ collab
            setMessage "Project added."
            redirect $ ProjectR shr (npIdent np)
        FormMissing -> do
            setMessage "Field(s) missing"
            defaultLayout $(widgetFile "project/new")
        FormFailure _l -> do
            setMessage "Project creation failed, see below"
            defaultLayout $(widgetFile "project/new")

getProjectNewR :: ShrIdent -> Handler Html
getProjectNewR shr = do
    Entity sid _ <- runDB $ getBy404 $ UniqueSharer shr
    ((_result, widget), enctype) <- runFormPost $ newProjectForm sid
    defaultLayout $(widgetFile "project/new")

getProjectR :: ShrIdent -> PrjIdent -> Handler Html
getProjectR shar proj = do
    (project, workflow, wsharer, repos) <- runDB $ do
        Entity sid s <- getBy404 $ UniqueSharer shar
        Entity pid p <- getBy404 $ UniqueProject proj sid
        w <- get404 $ projectWorkflow p
        sw <-
            if workflowSharer w == sid
                then return s
                else get404 $ workflowSharer w
        rs <- selectList [RepoProject ==. Just pid] [Asc RepoIdent]
        return (p, w, sw, rs)
    defaultLayout $(widgetFile "project/one")

putProjectR :: ShrIdent -> PrjIdent -> Handler Html
putProjectR shr prj = do
    ep@(Entity jid project) <- runDB $ do
        Entity sid _sharer <- getBy404 $ UniqueSharer shr
        getBy404 $ UniqueProject prj sid
    ((result, widget), enctype) <- runFormPost $ editProjectForm ep
    case result of
        FormSuccess project' -> do
            runDB $ replace jid project'
            setMessage "Project updated."
            redirect $ ProjectR shr prj
        FormMissing -> do
            setMessage "Field(s) missing."
            defaultLayout $(widgetFile "project/edit")
        FormFailure _l -> do
            setMessage "Project update failed, see errors below."
            defaultLayout $(widgetFile "project/edit")

postProjectR :: ShrIdent -> PrjIdent -> Handler Html
postProjectR shr prj = do
    mmethod <- lookupPostParam "_method"
    case mmethod of
        Just "PUT" -> putProjectR shr prj
        _          -> notFound

getProjectEditR :: ShrIdent -> PrjIdent -> Handler Html
getProjectEditR shr prj = do
    ep <- runDB $ do
        Entity sid _sharer <- getBy404 $ UniqueSharer shr
        getBy404 $ UniqueProject prj sid
    ((_result, widget), enctype) <- runFormPost $ editProjectForm ep
    defaultLayout $(widgetFile "project/edit")

getProjectDevsR :: ShrIdent -> PrjIdent -> Handler Html
getProjectDevsR shr rp = do
    devs <- runDB $ do
        rid <- do
            Entity s _ <- getBy404 $ UniqueSharer shr
            Entity r _ <- getBy404 $ UniqueProject rp s
            return r
        select $ from $ \ (collab, person, sharer, role) -> do
            where_ $
                collab ^. ProjectCollabProject E.==. val rid            &&.
                collab ^. ProjectCollabPerson  E.==. person ^. PersonId &&.
                person ^. PersonIdent          E.==. sharer ^. SharerId &&.
                collab ^. ProjectCollabRole    E.==. role ^. ProjectRoleId
            return (sharer, role ^. ProjectRoleIdent)
    defaultLayout $(widgetFile "project/collab/list")

postProjectDevsR :: ShrIdent -> PrjIdent -> Handler Html
postProjectDevsR shr rp = do
    (sid, jid) <- runDB $ do
        Entity s _ <- getBy404 $ UniqueSharer shr
        Entity j _ <- getBy404 $ UniqueProject rp s
        return (s, j)
    ((result, widget), enctype) <- runFormPost $ newProjectCollabForm sid jid
    case result of
        FormSuccess nc -> do
            runDB $ do
                let collab = ProjectCollab
                        { projectCollabProject = jid
                        , projectCollabPerson  = ncPerson nc
                        , projectCollabRole    = ncRole nc
                        }
                insert_ collab
            setMessage "Collaborator added."
            redirect $ ProjectDevsR shr rp
        FormMissing -> do
            setMessage "Field(s) missing"
            defaultLayout $(widgetFile "project/collab/new")
        FormFailure _l -> do
            setMessage "Operation failed, see errors below"
            defaultLayout $(widgetFile "project/collab/new")

getProjectDevNewR :: ShrIdent -> PrjIdent -> Handler Html
getProjectDevNewR shr rp = do
    (sid, jid) <- runDB $ do
        Entity s _ <- getBy404 $ UniqueSharer shr
        Entity j _ <- getBy404 $ UniqueProject rp s
        return (s, j)
    ((_result, widget), enctype) <- runFormPost $ newProjectCollabForm sid jid
    defaultLayout $(widgetFile "project/collab/new")

getProjectDevR :: ShrIdent -> PrjIdent -> ShrIdent -> Handler Html
getProjectDevR shr rp dev = do
    rl <- runDB $ do
        jid <- do
            Entity s _ <- getBy404 $ UniqueSharer shr
            Entity j _ <- getBy404 $ UniqueProject rp s
            return j
        pid <- do
            Entity s _ <- getBy404 $ UniqueSharer dev
            Entity p _ <- getBy404 $ UniquePersonIdent s
            return p
        Entity _cid collab <- getBy404 $ UniqueProjectCollab jid pid
        role <- getJust $ projectCollabRole collab
        return $ projectRoleIdent role
    defaultLayout $(widgetFile "project/collab/one")

deleteProjectDevR :: ShrIdent -> PrjIdent -> ShrIdent -> Handler Html
deleteProjectDevR shr rp dev = do
    runDB $ do
        jid <- do
            Entity s _ <- getBy404 $ UniqueSharer shr
            Entity j _ <- getBy404 $ UniqueProject rp s
            return j
        pid <- do
            Entity s _ <- getBy404 $ UniqueSharer dev
            Entity p _ <- getBy404 $ UniquePersonIdent s
            return p
        Entity cid _collab <- getBy404 $ UniqueProjectCollab jid pid
        delete cid
    setMessage "Collaborator removed."
    redirect $ ProjectDevsR shr rp

postProjectDevR :: ShrIdent -> PrjIdent -> ShrIdent -> Handler Html
postProjectDevR shr rp dev = do
    mmethod <- lookupPostParam "_method"
    case mmethod of
        Just "DELETE" -> deleteProjectDevR shr rp dev
        _             -> notFound