2017-10-02 09:52:14 -04:00
|
|
|
{-# LANGUAGE NoImplicitPrelude #-}
|
|
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
|
|
{-# LANGUAGE TemplateHaskell #-}
|
2017-10-08 01:55:21 -04:00
|
|
|
module Widget.Card ( hCard ) where
|
2017-10-02 09:52:14 -04:00
|
|
|
|
|
|
|
import Import
|
2017-10-10 04:16:12 -04:00
|
|
|
|
2017-10-10 22:16:47 -04:00
|
|
|
import Database.Esqueleto ( (^.) )
|
|
|
|
import qualified Database.Esqueleto as E
|
2017-10-10 00:16:50 -04:00
|
|
|
|
2017-10-10 22:16:47 -04:00
|
|
|
import Text.Mustache ( substitute )
|
|
|
|
import Util ( compileMustache )
|
2017-10-03 19:37:37 -04:00
|
|
|
|
2017-10-10 22:16:47 -04:00
|
|
|
import qualified Data.Text as T
|
2017-10-02 23:21:08 -04:00
|
|
|
|
2017-10-03 18:09:39 -04:00
|
|
|
prettyPgp :: PgpKey -> Text
|
|
|
|
prettyPgp = T.unwords . T.chunksOf 4 . pgpKeyFingerprint
|
|
|
|
|
|
|
|
routeFromPgp :: PgpKey -> Route App
|
2017-10-05 06:33:44 -04:00
|
|
|
routeFromPgp PgpKey { pgpKeyFingerprint = f } = staticR ["pgp", T.takeEnd 8 f ++ ".asc"]
|
2017-10-03 18:09:39 -04:00
|
|
|
|
2017-10-10 22:16:47 -04:00
|
|
|
profileUrl :: Site -> Profile -> Text
|
|
|
|
profileUrl site = substitute $ T.unpack (siteName site) `compileMustache` siteTemplate site
|
|
|
|
|
2017-10-08 01:55:21 -04:00
|
|
|
hCard :: Entity User -> Widget
|
|
|
|
hCard (Entity userId user) = do
|
2017-10-03 19:07:51 -04:00
|
|
|
mcurrentRoute <- getCurrentRoute
|
2017-10-10 22:16:47 -04:00
|
|
|
userProfiles <- handlerToWidget . runDB . E.select . E.from $ \(profile `E.InnerJoin` site) -> do
|
|
|
|
E.on $ profile ^. ProfileSiteId E.==. site ^. SiteId
|
|
|
|
E.where_ $ profile ^. ProfileUserId E.==. E.val userId
|
|
|
|
E.orderBy [E.asc $ site ^. SiteName]
|
|
|
|
return (site, profile)
|
2017-10-03 18:09:39 -04:00
|
|
|
pgpKeys <- handlerToWidget . runDB $ map entityVal <$> selectList [PgpKeyUserId ==. userId] []
|
2017-10-08 01:55:21 -04:00
|
|
|
$(widgetFile "mf2/h-card")
|