{- This file is part of Vervis. - - Written in 2016 by fr33domlover . - - ♡ 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 - . -} module Vervis.Handler.Workflow ( getWorkflowsR , postWorkflowsR , getWorkflowNewR , getWorkflowR , deleteWorkflowR , postWorkflowR ) where import Prelude import Data.Maybe (fromMaybe) import Data.Text (Text) import Database.Persist 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, getBy404) import Vervis.Form.Workflow import Vervis.Foundation import Vervis.Model import Vervis.Model.Ident import Vervis.Settings import Vervis.Widget.Sharer getWorkflowsR :: ShrIdent -> Handler Html getWorkflowsR shr = do ws <- runDB $ do Entity sid _ <- getBy404 $ UniqueSharer shr selectList [WorkflowSharer ==. sid] [] defaultLayout $(widgetFile "workflow/list") postWorkflowsR :: ShrIdent -> Handler Html postWorkflowsR shr = do Entity sid _ <- runDB $ getBy404 $ UniqueSharer shr ((result, widget), enctype) <- runFormPost $ newWorkflowForm sid case result of FormSuccess nw -> do let workflow = Workflow { workflowSharer = sid , workflowIdent = nwIdent nw , workflowName = nwName nw , workflowDesc = nwDesc nw } runDB $ insert_ workflow setMessage "Workflow added." redirect $ WorkflowR shr (nwIdent nw) FormMissing -> do setMessage "Field(s) missing" defaultLayout $(widgetFile "workflow/new") FormFailure _l -> do setMessage "Workflow creation failed, see below" defaultLayout $(widgetFile "workflow/new") getWorkflowNewR :: ShrIdent -> Handler Html getWorkflowNewR shr = do Entity sid _ <- runDB $ getBy404 $ UniqueSharer shr ((_result, widget), enctype) <- runFormPost $ newWorkflowForm sid defaultLayout $(widgetFile "workflow/new") getWorkflowR :: ShrIdent -> WflIdent -> Handler Html getWorkflowR shr wfl = do w <- runDB $ do Entity sid _s <- getBy404 $ UniqueSharer shr Entity _wid w <- getBy404 $ UniqueWorkflow sid wfl return w defaultLayout $(widgetFile "workflow/one") deleteWorkflowR :: ShrIdent -> WflIdent -> Handler Html deleteWorkflowR shr wfl = error "Not implemented, not sure whether to allow it" postWorkflowR :: ShrIdent -> WflIdent -> Handler Html postWorkflowR shr wfl = do mmethod <- lookupPostParam "_method" case mmethod of Just "DELETE" -> deleteWorkflowR shr wfl _ -> notFound