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 / Types /

Paste.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
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166

{-# OPTIONS -Wall -fno-warn-orphans #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}

-- | The paste type.

module Hpaste.Types.Paste
       (Paste(..)
       ,PasteType(..)
       ,PasteSubmit(..)
       ,PasteFormlet(..)
       ,ExprFormlet(..)
       ,PastePage(..)
       ,StepsPage(..)
       ,Hint(..)
       ,ReportFormlet(..)
       ,ReportSubmit(..))
       where

import Hpaste.Types.Newtypes
import Hpaste.Types.Language
import Hpaste.Types.Channel
import Control.Applicative
import Blaze.ByteString.Builder                (toByteString)
import Blaze.ByteString.Builder.Char.Utf8      as Utf8 (fromString)
import Data.Text                               (Text,pack)
import Data.Time                               (UTCTime,zonedTimeToUTC)
import Database.PostgreSQL.Simple
import Database.PostgreSQL.Simple.FromRow
import Database.PostgreSQL.Simple.FromField
import Database.PostgreSQL.Simple.ToField
import Language.Haskell.HLint                  (Severity)
import Snap.Core
import Text.Blaze                              (ToMarkup(..),toMarkup)
import Text.Blaze.Html5                        (Markup)

-- | A paste.
data Paste = Paste {
   pasteId       :: PasteId
  ,pasteTitle    :: Text
  ,pasteDate     :: UTCTime
  ,pasteAuthor   :: Text
  ,pasteLanguage :: Maybe LanguageId
  ,pasteChannel  :: Maybe ChannelId
  ,pastePaste    :: Text
  ,pasteViews    :: Integer
  ,pasteType     :: PasteType
} deriving Show

instance ToMarkup Paste where
  toMarkup paste@Paste{..} = toMarkup $ pack $ show paste

instance FromRow Paste where
  fromRow = do
    (pid,title,content,author,date,views,language,channel,annotation_of,revision_of) <- fromRow
    return $ Paste
      { pasteTitle = title
      , pasteAuthor = author
      , pasteLanguage = language
      , pasteChannel = channel
      , pastePaste = content
      , pasteDate = zonedTimeToUTC date
      , pasteId = pid
      , pasteViews = views
      , pasteType = case annotation_of of
	Just pid' -> AnnotationOf pid'
	_ -> case revision_of of
	  Just pid' -> RevisionOf pid'
	  _ -> NormalPaste
      }

-- | The type of a paste.
data PasteType
  = NormalPaste
  | AnnotationOf PasteId
  | RevisionOf PasteId
  deriving (Eq,Show)

-- | A paste submission or annotate.
data PasteSubmit = PasteSubmit {
   pasteSubmitId       :: Maybe PasteId
  ,pasteSubmitType     :: PasteType
  ,pasteSubmitTitle    :: Text
  ,pasteSubmitAuthor   :: Text
  ,pasteSubmitLanguage :: Maybe LanguageId
  ,pasteSubmitChannel  :: Maybe ChannelId
  ,pasteSubmitPaste    :: Text
  ,pasteSubmitSpamTrap :: Maybe Text
} deriving Show

data PasteFormlet = PasteFormlet {
   pfSubmitted :: Bool
 , pfErrors    :: [Text]
 , pfParams    :: Params
 , pfLanguages :: [Language]
 , pfChannels  :: [Channel]
 , pfDefChan   :: Maybe Text
 , pfAnnotatePaste :: Maybe Paste
 , pfEditPaste :: Maybe Paste
 , pfContent :: Maybe Text
}

data ExprFormlet = ExprFormlet {
   efSubmitted :: Bool
 , efParams    :: Params
}

data PastePage = PastePage {
    ppPaste           :: Paste
  , ppChans           :: [Channel]
  , ppLangs           :: [Language]
  , ppHints           :: [Hint]
  , ppAnnotations     :: [Paste]
  , ppRevisions       :: [Paste]
  , ppAnnotationHints :: [[Hint]]
  , ppRevisionsHints  :: [[Hint]]
  , ppRevision        :: Bool
}

data StepsPage = StepsPage {
    spPaste           :: Paste
  , spChans           :: [Channel]
  , spLangs           :: [Language]
  , spHints           :: [Hint]
  , spSteps           :: [Text]
  , spAnnotations     :: [Paste]
  , spAnnotationHints :: [[Hint]]
  , spForm :: Markup
}

instance ToField Severity where
  toField = toField . show

--  render = Escape . toByteString . Utf8.fromString . show
--  {-# INLINE render #-}

instance FromField Severity where
  fromField x y = fmap read (fromField x y)
  {-# INLINE fromField #-}

-- | A hlint (or like) suggestion.
data Hint = Hint {
   hintType    :: Severity
 , hintContent :: String
}

instance FromRow Hint where
  fromRow = Hint <$> field <*> field

-- instance QueryResults Hint where
--   convertResults field values = Hint {
--       hintType = severity
--     , hintContent = content
--     }
--     where (severity,content) = convertResults field values

data ReportFormlet = ReportFormlet {
   rfSubmitted :: Bool
 , rfParams    :: Params
}

data ReportSubmit = ReportSubmit {
   rsPaste :: PasteId
  ,rsComments :: String
}
[See repo JSON]