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

master :: src / Hpaste / View /

Layout.hs

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90

{-# OPTIONS -Wall -fno-warn-unused-do-bind #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}

-- | Page layout.

module Hpaste.View.Layout
  (layoutPage)
  where

import           Hpaste.Types
import           Hpaste.View.Html

import           Data.Monoid.Operator        ((++))
import           Prelude                     hiding ((++))
import           Text.Blaze.Html5            as H hiding (map,nav)
import qualified Text.Blaze.Html5.Attributes as A

-- | Render the page in a layout.
layoutPage :: Page -> Markup
layoutPage Page{..} = do
  docTypeHtml $ do
    H.head $ do
      meta ! A.httpEquiv "Content-Type" ! A.content "text/html; charset=UTF-8"
      link ! A.rel "stylesheet" ! A.type_ "text/css" ! A.href "/css/amelie.css"
      js "jquery.js"
      js "amelie.js"
      js "highlight.pack.js"
      title $ toMarkup $ pageTitle ++ " :: toothpaste"
      script $
        "hljs.tabReplace = '    ';hljs.initHighlightingOnLoad();"
    body ! A.id (toValue pageName) $ do
      wrap $ do
        nav
        logo
        pageBody
        foot
      preEscapedString ""{-"<script type=\"text/javascript\"> var _gaq = _gaq \
                       \|| []; _gaq.push(['_setAccount', 'UA-7443395-10']);\
                       \ _gaq.push(['_trackPageview']); (function() {var ga\
                       \ = document.createElement('script'); ga.type = 'tex\
                       \t/javascript'; ga.async = true; ga.src = ('https:' \
                       \== document.location.protocol ? 'https://ssl' : \
                       \'http://www') + '.google-analytics.com/ga.js'; var\
                       \ s = document.getElementsByTagName('script')[0]; \
                       \s.parentNode.insertBefore(ga, s);})(); </script>"-}

    where js s = script ! A.type_ "text/javascript"
                        ! A.src ("/js/" ++ s) $
                        return ()

-- | Show the lpaste logo.
logo :: Markup
logo = return ()

-- | Layout wrapper.
wrap :: Markup -> Markup
wrap x = H.div ! aClass "wrap" $ x

-- | Navigation.
nav :: Markup
nav = do
  H.div ! aClass "nav" $ do
    a ! aClass "logo" ! A.href "/" $ "ToothPaste"
    a ! A.href "/browse" $ "Browse"
    a ! A.href "mailto:fr33domlover@riseup.net" $ "Contact"
    a ! A.href "http://freepo.st" $ "Community"
    a ! A.href "http://www.rel4tion.org/access/paste/" $ "About"
    -- " | "
    -- a ! A.href "/activity" $ "Changes"

-- | Page footer.
foot :: Markup
foot = H.div ! aClass "footer" $ p $
  lnk "https://notabug.org/fr33domlover/toothpaste" "Web site source code"
  //
  lnk "https://wikibooks.org/wiki/Haskell" "Haskell Wikibook"
  //
  lnk "http://haskell.org/" "Haskell.org"
  //
  lnk "http://planet.haskell.org/" "Planet Haskell"
  //
  lnk "https://snowdrift.coop" "Snowdrift"
  //
  lnk "https://notabug.org" "NotABug"
  //
  lnk "http://peers.community" "Peers"

    where lnk url t = href (url :: String) (t :: String)
          left // right = do _ <- left; (" / " :: Markup); right
[See repo JSON]