Experimental changes to Vervis.

[[ 🗃 ^KrXYo vervis ]] :: [📥 Inbox] [📤 Outbox] [🐤 Followers] [🤝 Collaborators] [🛠 Changes]

Clone

HTTPS: darcs clone https://vervis.peers.community/repos/KrXYo

SSH: darcs clone USERNAME@vervis.peers.community:KrXYo

Tags

TODO

src / Vervis / Handler /

Sharer.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 Vervis.Handler.Sharer
    ( getSharersR
    , getSharerR
    )
where

import Prelude

import Control.Monad.Logger (logWarn)
import Data.Monoid ((<>))
import Database.Persist
import Text.Blaze.Html (Html)
import Yesod.Core (defaultLayout)
import Yesod.Core.Handler (redirect, notFound)
import Yesod.Persist.Core (runDB, getBy404)

import Vervis.Foundation
import Vervis.Model
import Vervis.Model.Ident (ShrIdent, shr2text)
import Vervis.Paginate
import Vervis.Settings (widgetFile)
import Vervis.Widget.Sharer (sharerLinkW)

getSharersR :: Handler Html
getSharersR = do
    (sharers, navModel) <- getPageAndNav $ \ off lim ->
        runDB $ do
            total <- count ([] :: [Filter Sharer])
            ss <- selectList [] [OffsetBy off, LimitTo lim, Asc SharerIdent]
            return (total, ss)
    let pageNav = navWidget navModel
    defaultLayout $(widgetFile "sharer/list")

getSharerR :: ShrIdent -> Handler Html
getSharerR shr = do
    isperson <- runDB $ do
        Entity sid _sharer <- getBy404 $ UniqueSharer shr
        mp <- getBy $ UniquePersonIdent sid
        case mp of
            Just _  -> return $ Just True
            Nothing -> do
                mg <- getBy $ UniqueGroup sid
                case mg of
                    Just _  -> return $ Just False
                    Nothing -> return Nothing
    case isperson of
        Nothing -> do
            $logWarn $ "Found non-person non-group sharer: " <> shr2text shr
            notFound
        Just True -> redirect $ PersonR shr
        Just False -> redirect $ GroupR shr
[See repo JSON]