{-# 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 }