{- 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.Role
    ( getRepoRolesR
    , postRepoRolesR
    , getRepoRoleNewR
    , getRepoRoleR
    , deleteRepoRoleR
    , postRepoRoleR
    , getRepoRoleOpsR
    , postRepoRoleOpsR
    , getRepoRoleOpNewR
    , getProjectRolesR
    , postProjectRolesR
    , getProjectRoleNewR
    , getProjectRoleR
    , deleteProjectRoleR
    , postProjectRoleR
    , getProjectRoleOpsR
    , postProjectRoleOpsR
    , getProjectRoleOpNewR
    )
where

import Prelude

import Database.Persist
import Text.Blaze.Html (Html)
import Yesod.Auth (requireAuthId)
import Yesod.Core (defaultLayout, setMessage)
import Yesod.Core.Handler (lookupPostParam, notFound, redirect)
import Yesod.Form.Functions (runFormPost)
import Yesod.Form.Types (FormResult (..))
import Yesod.Persist.Core (runDB, getBy404)

import Vervis.Form.Role
import Vervis.Foundation
import Vervis.Model
import Vervis.Model.Ident (ShrIdent, RlIdent, rl2text)
import Vervis.Role
import Vervis.Settings (widgetFile)
import Vervis.Widget.Role

getRepoRolesR :: ShrIdent -> Handler Html
getRepoRolesR shr = do
    --roles <- runDB $ do
    --    Entity sid _ <- getBy404 $ UniqueSharer shr
    --    selectList [RepoRoleSharer ==. sid] []
    graph <- runDB $ do
        Entity sid _s <- getBy404 $ UniqueSharer shr
        getRepoRoleGraph sid
    defaultLayout $(widgetFile "repo/role/graph")

postRepoRolesR :: ShrIdent -> Handler Html
postRepoRolesR shr = do
    sid <- fmap entityKey $ runDB $ getBy404 $ UniqueSharer shr
    ((result, widget), enctype) <- runFormPost $ newRepoRoleForm sid
    case result of
        FormSuccess nrr -> do
            runDB $ do
                let role = RepoRole
                        { repoRoleIdent  = nrrIdent nrr
                        , repoRoleSharer = sid
                        , repoRoleDesc   = nrrDesc nrr
                        }
                insert_ role
            redirect $ RepoRolesR shr
        FormMissing -> do
            setMessage "Field(s) missing"
            defaultLayout $(widgetFile "repo/role/new")
        FormFailure _l -> do
            setMessage "Invalid input, see errors below"
            defaultLayout $(widgetFile "repo/role/new")

getRepoRoleNewR :: ShrIdent -> Handler Html
getRepoRoleNewR shr = do
    sid <- fmap entityKey $ runDB $ getBy404 $ UniqueSharer shr
    ((_result, widget), enctype) <- runFormPost $ newRepoRoleForm sid
    defaultLayout $(widgetFile "repo/role/new")

getRepoRoleR :: ShrIdent -> RlIdent -> Handler Html
getRepoRoleR shr rl = do
    Entity _rid role <- runDB $ do
        Entity sid _ <- getBy404 $ UniqueSharer shr
        getBy404 $ UniqueRepoRole sid rl
    defaultLayout $(widgetFile "repo/role/one")

deleteRepoRoleR :: ShrIdent -> RlIdent -> Handler Html
deleteRepoRoleR shr rl = do
    runDB $ do
        Entity sid _s <- getBy404 $ UniqueSharer shr
        Entity rid _r <- getBy404 $ UniqueRepoRole sid rl
        delete rid
    setMessage "Role deleted."
    redirect $ RepoRolesR shr

postRepoRoleR :: ShrIdent -> RlIdent -> Handler Html
postRepoRoleR shr rl = do
    mmethod <- lookupPostParam "_method"
    case mmethod of
        Just "DELETE" -> deleteRepoRoleR shr rl
        _             -> notFound

getRepoRoleOpsR :: ShrIdent -> RlIdent -> Handler Html
getRepoRoleOpsR shr rl = do
    ops <- runDB $ do
        Entity sid _s <- getBy404 $ UniqueSharer shr
        Entity rid _r <- getBy404 $ UniqueRepoRole sid rl
        as <- selectList [RepoAccessRole ==. rid] []
        return $ map (repoAccessOp . entityVal) as
    defaultLayout $(widgetFile "repo/role/op/list")

postRepoRoleOpsR :: ShrIdent -> RlIdent -> Handler Html
postRepoRoleOpsR shr rl = do
    let getrid = do
            Entity sid _ <- getBy404 $ UniqueSharer shr
            fmap entityKey $ getBy404 $ UniqueRepoRole sid rl
    ((result, widget), enctype) <- runFormPost $ newRepoRoleOpForm getrid
    case result of
        FormSuccess op -> do
            runDB $ do
                rid <- getrid
                let access = RepoAccess
                        { repoAccessRole = rid
                        , repoAccessOp   = op
                        }
                insert_ access
            redirect $ RepoRoleOpsR shr rl
        FormMissing -> do
            setMessage "Field(s) missing"
            defaultLayout $(widgetFile "repo/role/op/new")
        FormFailure _l -> do
            setMessage "Invalid input, see errors below"
            defaultLayout $(widgetFile "repo/role/op/new")

getRepoRoleOpNewR :: ShrIdent -> RlIdent -> Handler Html
getRepoRoleOpNewR shr rl = do
    let getrid = do
            Entity sid _ <- getBy404 $ UniqueSharer shr
            fmap entityKey $ getBy404 $ UniqueRepoRole sid rl
    ((_result, widget), enctype) <- runFormPost $ newRepoRoleOpForm getrid
    defaultLayout $(widgetFile "repo/role/op/new")

getProjectRolesR :: ShrIdent -> Handler Html
getProjectRolesR shr = do
    --roles <- runDB $ do
    --    Entity sid _ <- getBy404 $ UniqueSharer shr
    --    selectList [ProjectRoleSharer ==. sid] []
    graph <- runDB $ do
        Entity sid _s <- getBy404 $ UniqueSharer shr
        getProjectRoleGraph sid
    defaultLayout $(widgetFile "project/role/graph")

postProjectRolesR :: ShrIdent -> Handler Html
postProjectRolesR shr = do
    sid <- fmap entityKey $ runDB $ getBy404 $ UniqueSharer shr
    ((result, widget), enctype) <- runFormPost $ newProjectRoleForm sid
    case result of
        FormSuccess npr -> do
            runDB $ do
                let role = ProjectRole
                        { projectRoleIdent  = nprIdent npr
                        , projectRoleSharer = sid
                        , projectRoleDesc   = nprDesc npr
                        }
                insert_ role
            redirect $ ProjectRolesR shr
        FormMissing -> do
            setMessage "Field(s) missing"
            defaultLayout $(widgetFile "project/role/new")
        FormFailure _l -> do
            setMessage "Invalid input, see errors below"
            defaultLayout $(widgetFile "project/role/new")

getProjectRoleNewR :: ShrIdent -> Handler Html
getProjectRoleNewR shr = do
    sid <- fmap entityKey $ runDB $ getBy404 $ UniqueSharer shr
    ((_result, widget), enctype) <- runFormPost $ newProjectRoleForm sid
    defaultLayout $(widgetFile "project/role/new")

getProjectRoleR :: ShrIdent -> RlIdent -> Handler Html
getProjectRoleR shr rl = do
    Entity _rid role <- runDB $ do
        Entity sid _ <- getBy404 $ UniqueSharer shr
        getBy404 $ UniqueProjectRole sid rl
    defaultLayout $(widgetFile "project/role/one")

deleteProjectRoleR :: ShrIdent -> RlIdent -> Handler Html
deleteProjectRoleR shr rl = do
    runDB $ do
        Entity sid _s <- getBy404 $ UniqueSharer shr
        Entity rid _r <- getBy404 $ UniqueProjectRole sid rl
        delete rid
    setMessage "Role deleted."
    redirect $ ProjectRolesR shr

postProjectRoleR :: ShrIdent -> RlIdent -> Handler Html
postProjectRoleR shr rl = do
    mmethod <- lookupPostParam "_method"
    case mmethod of
        Just "DELETE" -> deleteProjectRoleR shr rl
        _             -> notFound

getProjectRoleOpsR :: ShrIdent -> RlIdent -> Handler Html
getProjectRoleOpsR shr rl = do
    ops <- runDB $ do
        Entity sid _s <- getBy404 $ UniqueSharer shr
        Entity rid _r <- getBy404 $ UniqueProjectRole sid rl
        as <- selectList [ProjectAccessRole ==. rid] []
        return $ map (projectAccessOp . entityVal) as
    defaultLayout $(widgetFile "project/role/op/list")

postProjectRoleOpsR :: ShrIdent -> RlIdent -> Handler Html
postProjectRoleOpsR shr rl = do
    let getrid = do
            Entity sid _ <- getBy404 $ UniqueSharer shr
            fmap entityKey $ getBy404 $ UniqueProjectRole sid rl
    ((result, widget), enctype) <- runFormPost $ newProjectRoleOpForm getrid
    case result of
        FormSuccess op -> do
            runDB $ do
                rid <- getrid
                let access = ProjectAccess
                        { projectAccessRole = rid
                        , projectAccessOp   = op
                        }
                insert_ access
            redirect $ ProjectRoleOpsR shr rl
        FormMissing -> do
            setMessage "Field(s) missing"
            defaultLayout $(widgetFile "project/role/op/new")
        FormFailure _l -> do
            setMessage "Invalid input, see errors below"
            defaultLayout $(widgetFile "project/role/op/new")

getProjectRoleOpNewR :: ShrIdent -> RlIdent -> Handler Html
getProjectRoleOpNewR shr rl = do
    let getrid = do
            Entity sid _ <- getBy404 $ UniqueSharer shr
            fmap entityKey $ getBy404 $ UniqueProjectRole sid rl
    ((_result, widget), enctype) <- runFormPost $ newProjectRoleOpForm getrid
    defaultLayout $(widgetFile "project/role/op/new")