39 lines
1.4 KiB
Haskell
39 lines
1.4 KiB
Haskell
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
module Model.Markdown ( Markdown(..) ) where
|
|
|
|
import Data.Aeson ( FromJSON(..), ToJSON(..), Value(Object), object, (.=), (.:) )
|
|
import Data.Default ( def )
|
|
import Database.Persist ( PersistField(..), PersistValue(PersistText) )
|
|
import Database.Persist.Sql ( PersistFieldSql(..), SqlType(SqlString) )
|
|
import Data.String ( IsString )
|
|
import Text.Blaze ( ToMarkup(..) )
|
|
import Text.Markdown ( markdown )
|
|
|
|
import qualified Data.Text as T
|
|
import qualified Data.Text.Lazy as TL
|
|
|
|
newtype Markdown = Markdown { unMarkdown :: TL.Text }
|
|
deriving (Eq, Ord, Monoid, IsString, Show)
|
|
|
|
instance ToMarkup Markdown where
|
|
toMarkup (Markdown t) = markdown def t
|
|
|
|
instance PersistField Markdown where
|
|
toPersistValue (Markdown t) = PersistText $ TL.toStrict t
|
|
fromPersistValue (PersistText t) = Right . Markdown $ TL.fromStrict t
|
|
fromPersistValue wrongValue = Left $ T.concat
|
|
[ "Model.Markdown: When attempting to create Markdown from a PersistValue, received "
|
|
, T.pack $ show wrongValue
|
|
, " when a value of type PersistText was expected."
|
|
]
|
|
instance PersistFieldSql Markdown where
|
|
sqlType _ = SqlString
|
|
|
|
instance ToJSON Markdown where
|
|
toJSON (Markdown text) = object ["markdown" .= text]
|
|
|
|
instance FromJSON Markdown where
|
|
parseJSON (Object v) = Markdown <$> v .: "markdown"
|
|
parseJSON _ = mempty
|