Paste server written in Haskell. Fork of Hpaste, fully freedom and privacy respecting and generally improved. At the time of writing there's an instance at <http://paste.rel4tion.org>.
Clone
HTTPS:
git clone https://vervis.peers.community/repos/aoqmo
SSH:
git clone USERNAME@vervis.peers.community:aoqmo
Branches
Tags
Browse.hs
{-# OPTIONS -Wall -fno-warn-name-shadowing #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
-- | Browse page view.
module Hpaste.View.Browse
(page)
where
import Hpaste.Types
import Hpaste.View.Html
import Hpaste.View.Layout
import Hpaste.View.Paste (pasteLink)
import Control.Monad
import Data.Maybe
import Data.Monoid.Operator
import Data.Pagination
import qualified Data.Text as T
import qualified Data.Text.Lazy as LT
import Data.Time
import Data.Time.Relative
import Network.URI
import Network.URI.Params
import Prelude hiding ((++))
import Snap.App.Types
import System.Locale
import Text.Blaze.Extra
import Text.Blaze.Html5 as H hiding (map)
import qualified Text.Blaze.Html5.Attributes as A
import Text.Blaze.Pagination
-- | Render the browse page.
page :: UTCTime -> PN -> [Channel] -> [Language] -> [Paste] -> Maybe String -> Html
page now pn chans langs ps mauthor =
layoutPage $ Page {
pageTitle = "Browse pastes"
, pageBody = browse now pn chans langs ps mauthor
, pageName = "browse"
}
-- | View the paginated pastes.
browse :: UTCTime -> PN -> [Channel] -> [Language] -> [Paste] -> Maybe String -> Html
browse now pn channels languages ps mauthor = do
darkSection title $ do
pagination pn
table ! aClass "latest-pastes" $ do
tr $ mapM_ (th . (toHtml :: String -> Html)) $
["Title"] ++ ["Author"|isNothing mauthor] ++ ["When","Language","Channel"]
pastes ps
pagination pn { pnPn = (pnPn pn) { pnShowDesc = False } }
where pastes = mapM_ $ \paste@Paste{..} -> tr $ do
td $ pasteLink paste pasteTitle
unless (isJust mauthor) $
td $ do
let author = T.unpack pasteAuthor
if True -- validNick author
then a ! hrefURI (authorUri author) $ toHtml pasteAuthor
else toHtml pasteAuthor
td $ ago pasteDate now
td $ showLanguage languages pasteLanguage
td $ showChannel Nothing channels pasteChannel
authorUri author = updateUrlParam "author" author
$ updateUrlParam "pastes_page" "0"
$ pnURI pn
title = LT.pack $ case mauthor of
Just author -> "Pastes by " ++ author
Nothing -> "Latest pastes"
epoch = formatTime defaultTimeLocale "%s"
ago t1 t2 = H.span !. "relative-time"
! dataAttribute "epoch" (toValue (epoch t1))
! A.title (toValue (show t1)) $
toHtml (relative t1 t2 True)
|