{- 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.Project ( getProjectsR , postProjectsR , getProjectNewR , getProjectR ) where import Vervis.Import hiding ((==.)) --import Prelude import Text.Blaze (text) import Database.Esqueleto --import Model --import Yesod.Core (Handler) import Vervis.Form.Project getProjectsR :: Text -> Handler Html getProjectsR ident = do projects <- runDB $ select $ from $ \ (sharer, project) -> do where_ $ sharer ^. SharerIdent ==. val ident &&. sharer ^. SharerId ==. project ^. ProjectSharer orderBy [asc $ project ^. ProjectIdent] return $ project ^. ProjectIdent defaultLayout $ do setTitle $ text $ "Vervis > People > " <> ident <> " > Projects" $(widgetFile "projects") postProjectsR :: Text -> Handler Html postProjectsR ident = do Entity _pid person <- requireAuth let sid = personIdent person ((result, widget), enctype) <- runFormPost $ newProjectForm sid case result of FormSuccess project -> do runDB $ insert_ project setMessage "Project added." --redirect $ ProjectsR ident --redirect HomeR redirectUltDest HomeR FormMissing -> do setMessage "Field(s) missing" defaultLayout $(widgetFile "project-new") FormFailure l -> do setMessage $ toHtml $ intercalate "; " l defaultLayout $(widgetFile "project-new") getProjectNewR :: Text -> Handler Html getProjectNewR ident = do Entity _pid person <- requireAuth let sid = personIdent person ((_result, widget), enctype) <- runFormPost $ newProjectForm sid defaultLayout $ do setTitle $ toHtml $ "Vervis > People > " <> ident <> " > New Project" $(widgetFile "project-new") getProjectR :: Text -> Text -> Handler Html getProjectR user proj = do projects <- runDB $ select $ from $ \ (sharer, project) -> do where_ $ sharer ^. SharerIdent ==. val user &&. project ^. ProjectIdent ==. val proj &&. sharer ^. SharerId ==. project ^. ProjectSharer return project case projects of [] -> notFound p:ps -> defaultLayout $ do let mproject = if null ps then Just p else Nothing setTitle $ text $ mconcat [ "Vervis > People > " , user , " > Project > " , proj ] $(widgetFile "project")