Use Mustache templates for site URL so that the username can be inserted anywhere in the template rather than only at the end

config/models

@@ -16,7 +16,7 @@ PgpKey
 
 Site
     icon Text sqltype=varchar(255)
-    url Text sqltype=varchar(255)
+    template Text sqltype=varchar(255)
 
 Profile
     userId UserId

package.yaml

@@ -51,6 +51,8 @@ dependencies:
 - conduit-combinators >= 1.1 && <1.2
 - friendly-time >=0.4 && <0.5
 - foreign-store >=0.2 && <0.3
+- mustache >=2.2 && <2.3
+- parsec >=3.1 && <3.2
 - slug >=0.1 && <0.2
 - split >=0.2 && <0.3
 - unix >=2.7 && <2.8

src/Model.hs

@@ -13,6 +13,8 @@ import ClassyPrelude.Yesod
 import Database.Persist.Quasi
 import Yesod.Auth.HashDB ( HashDBUser(..) )
 import Web.Slug ( Slug )
+import Text.Mustache ( (~>) )
+import qualified Text.Mustache as M
 
 import Entry.Kind ( EntryKind )
 
@@ -26,3 +28,8 @@ share [mkPersist sqlSettings, mkMigrate "migrateAll"]
 instance HashDBUser User where
   userPasswordHash = Just . userPassword
   setPasswordHash pw u = u { userPassword = pw }
+
+instance M.ToMustache Profile where
+  toMustache p = M.object
+    [ "username" ~> profileUsername p
+    ]

src/Util.hs

@@ -1,5 +1,22 @@
-module Util where
+module Util ( compileMustache, mapFirst ) where
+
+import Text.Mustache ( Template(..), compileTemplate )
+import Text.Mustache.Types ( Node(TextBlock) )
+import Text.Parsec.Error ( ParseError )
+
+import qualified Data.Text as T
+import qualified Data.HashMap.Lazy as M
 
 mapFirst :: (a -> a) -> [a] -> [a]
 mapFirst f (x:xs) = f x : xs
 mapFirst _ [] = []
+
+compileMustache :: String -> T.Text -> Template
+compileMustache n = either errorTemplate id . compileTemplate n
+
+errorTemplate :: ParseError -> Template
+errorTemplate err = Template
+    { name = "error"
+    , ast = [TextBlock . T.pack $ show err]
+    , partials = M.empty
+    }

src/Widget/Card.hs

@@ -4,18 +4,25 @@
 module Widget.Card ( hCard ) where
 
 import Import
+import Util ( compileMustache )
+
 import Data.Maybe (fromJust)
+import Text.Mustache ( Template, substitute )
 import qualified Data.Map as M
 import qualified Data.Text as T
 
 entityToTuple :: Entity t -> (Key t, t)
 entityToTuple (Entity key value) = (key, value)
 
-arrangeProfiles :: M.Map (Key Site) Site -> [Profile] -> [(Site,Profile)]
+compileTemplates :: M.Map (Key Site) Site -> M.Map (Key Site) (Site, Template)
-arrangeProfiles sites profiles = sortBy icon $ zip profileSites profiles
+compileTemplates = fmap $ \site -> (site, compile site)
+    where compile site = T.unpack (siteIcon site) `compileMustache` siteTemplate site
+
+arrangeProfiles :: [Profile] -> M.Map (Key Site) (Site, Template) -> [((Site, Template), Profile)]
+arrangeProfiles profiles sites = sortBy icon $ zip profileSites profiles
     where findSite = fromJust . flip M.lookup sites . profileSiteId
           profileSites = findSite <$> profiles
-          icon = comparing $ siteIcon . fst
+          icon = comparing $ siteIcon . fst . fst
 
 prettyPgp :: PgpKey -> Text
 prettyPgp = T.unwords . T.chunksOf 4 . pgpKeyFingerprint
@@ -29,6 +36,6 @@ hCard (Entity userId user) = do
     userProfiles <- handlerToWidget . runDB $ do
         profiles <- map entityVal <$> selectList [ProfileUserId ==. userId] []
         sites <- M.fromList . map entityToTuple <$> selectList [SiteId <-. (profileSiteId <$> profiles)] []
-        return $ arrangeProfiles sites profiles
+        return . arrangeProfiles profiles . compileTemplates $ sites
     pgpKeys <- handlerToWidget . runDB $ map entityVal <$> selectList [PgpKeyUserId ==. userId] []
     $(widgetFile "mf2/h-card")

templates/mf2/h-card.hamlet

@@ -18,8 +18,8 @@
         <a .u-email itemprop="email" rel="me" href="mailto:#{userEmail user}">
           <i .fa.fa-envelope>
           #{userEmail user}
-      $forall (site, profile) <- userProfiles
+      $forall ((site, template), profile) <- userProfiles
         <li>
-          <a .u-url itemprop="sameAs" rel="me" href="#{siteUrl site}#{profileUsername profile}">
+          <a .u-url itemprop="sameAs" rel="me" href="#{substitute template profile}">
             <i .fa.fa-#{siteIcon site}>
             #{profileUsername profile}