Render the p-note as Markdown - this is mostly useful because it means other h-card fields can be defined inside it
This commit is contained in:
parent
012c62dd09
commit
805e422eba
6 changed files with 44 additions and 3 deletions
38
src/Model/Markdown.hs
Normal file
38
src/Model/Markdown.hs
Normal file
|
|
@ -0,0 +1,38 @@
|
|||
{-# 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
|
||||
Loading…
Add table
Add a link
Reference in a new issue