From 805e422ebad7b744bc4c4e77b32084015eaab89d Mon Sep 17 00:00:00 2001
From: Danielle McLean <dani@00dani.me>
Date: Sun, 15 Oct 2017 01:00:12 +1100
Subject: [PATCH] Render the p-note as Markdown - this is mostly useful because
 it means other h-card fields can be defined inside it

---
 config/models               |  2 +-
 package.yaml                |  1 +
 src/Model.hs                |  1 +
 src/Model/Markdown.hs       | 38 +++++++++++++++++++++++++++++++++++++
 src/Widget/Card.hs          |  3 ++-
 templates/mf2/h-card.hamlet |  2 +-
 6 files changed, 44 insertions(+), 3 deletions(-)
 create mode 100644 src/Model/Markdown.hs

diff --git a/config/models b/config/models
index f103a40..03713bb 100644
--- a/config/models
+++ b/config/models
@@ -4,7 +4,7 @@ User
     fullName Text maxlen=500
     email Text maxlen=190
     avatar Text maxlen=190
-    note Text sqltype=mediumtext
+    note Markdown sqltype=mediumtext
     UniqueUser username
     UniqueEmail email
     deriving Typeable
diff --git a/package.yaml b/package.yaml
index 0429c32..c4c7744 100644
--- a/package.yaml
+++ b/package.yaml
@@ -52,6 +52,7 @@ dependencies:
 - esqueleto >=2.5 && <2.6
 - friendly-time >=0.4 && <0.5
 - foreign-store >=0.2 && <0.3
+- markdown >=0.1 && <0.2
 - mustache >=2.2 && <2.3
 - parsec >=3.1 && <3.2
 - slug >=0.1 && <0.2
diff --git a/src/Model.hs b/src/Model.hs
index 8864b63..8bcc462 100644
--- a/src/Model.hs
+++ b/src/Model.hs
@@ -17,6 +17,7 @@ import Text.Mustache ( (~>) )
 import qualified Text.Mustache as M
 
 import Model.Entry.Kind ( EntryKind )
+import Model.Markdown ( Markdown )
 
 -- You can define all of your database entities in the entities file.
 -- You can find more information on persistent and how to declare entities
diff --git a/src/Model/Markdown.hs b/src/Model/Markdown.hs
new file mode 100644
index 0000000..5ee4cd5
--- /dev/null
+++ b/src/Model/Markdown.hs
@@ -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
diff --git a/src/Widget/Card.hs b/src/Widget/Card.hs
index 542ddd2..f2fe1b3 100644
--- a/src/Widget/Card.hs
+++ b/src/Widget/Card.hs
@@ -9,6 +9,7 @@ import Import
 import Database.Esqueleto ( (^.) )
 import qualified Database.Esqueleto as E
 
+import Model.Markdown ( unMarkdown )
 import Text.Mustache ( substitute )
 import Util ( compileMustache )
 
@@ -40,7 +41,7 @@ hCard (Entity userId user) = do
         <link rel="author" href=@{HomeR}>
         <meta property="og:type" content="profile">
         <meta property="og:title" content="#{userFullName user}">
-        <meta property="og:description" content=#{userNote user}>
+        <meta property="og:description" content=#{unMarkdown $ userNote user}>
         <meta property="og:image" content=@{staticR ["img", userAvatar user]}>
         <meta property="profile:first_name" content=#{firstName}>
         <meta property="profile:last_name" content=#{T.unwords lastName}>
diff --git a/templates/mf2/h-card.hamlet b/templates/mf2/h-card.hamlet
index 6447796..9e9158c 100644
--- a/templates/mf2/h-card.hamlet
+++ b/templates/mf2/h-card.hamlet
@@ -10,7 +10,7 @@
       <a .card-subtitle.u-key type="application/pgp-keys" href=@{routeFromPgp key}>
         <i .fa.fa-key>
         #{prettyPgp key}
-    <p .card-text.p-note .text-muted>#{userNote user}
+    <div .p-note .text-muted>#{userNote user}
 
     <ul .profiles>
       <li>