vervis/src/Handler/Person.hs

{- 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 Handler.Person
    ( getPeopleR
    , getPersonNewR
    , getPersonR
    )
where

import Import hiding ((==.))
--import Prelude

import Text.Blaze (text)
import Database.Esqueleto
--import Model
--import Yesod.Core (Handler)

data PersonNew = PersonNew
    { uLogin :: Text
    , uPass  :: Text
    , uPass' :: Text
    , uEmail :: Maybe Text
    }

formPersonNew :: Form PersonNew
formPersonNew = renderDivs $ PersonNew
    <$> areq textField "Username" Nothing
    <*> areq passwordField "Password" Nothing
    <*> areq passwordField "Repeat password" Nothing
    <*> aopt emailField "E-mail" Nothing

-- | Get list of users
getPeopleR :: Handler Html
getPeopleR = do
    people <- runDB $ select $ from $ \ (sharer, person) -> do
        where_ $ sharer ^. SharerId ==. person ^. PersonIdent
        orderBy [asc $ sharer ^. SharerIdent]
        return $ sharer ^. SharerIdent
    defaultLayout $ do
        setTitle "Vervis > People"
        $(widgetFile "people")

-- | Create new user
--postPeopleR :: Handler Html
--postPeopleR =

getPersonNewR :: Handler Html
getPersonNewR = do
    mpid <- maybeAuthId
    if isJust mpid
        then redirect HomeR
        else do
            ((_result, widget), enctype) <- runFormPost formPersonNew
            defaultLayout $ do
                setTitle "Vervis > People > New"
                $(widgetFile "person-new")

getPersonR :: Text -> Handler Html
getPersonR ident = do
    people <- runDB $ select $ from $ \ (sharer, person) -> do
        where_ $
            sharer ^. SharerIdent ==. val ident &&.
            sharer ^. SharerId ==. person ^. PersonIdent
        return person
    case people of
        []   -> notFound
        p:ps -> defaultLayout $ do
            let mperson = if null ps then Just p else Nothing
            setTitle $ text $ "Vervis > People > " <> ident
            $(widgetFile "person")