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>.

[[ 🗃 ^aoqmo toothpaste ]] :: [📥 Inbox] [📤 Outbox] [🐤 Followers] [🤝 Collaborators] [🛠 Commits]

Clone

HTTPS: git clone https://vervis.peers.community/repos/aoqmo

SSH: git clone USERNAME@vervis.peers.community:aoqmo

Branches

Tags

hpaste :: src / Hpaste / View /

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)
[See repo JSON]