36 lines
1.3 KiB
Haskell
36 lines
1.3 KiB
Haskell
{-# LANGUAGE NoImplicitPrelude #-}
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
{-# LANGUAGE TemplateHaskell #-}
|
|
module Widget.Card ( hCard ) where
|
|
|
|
import Import
|
|
|
|
import qualified Site
|
|
|
|
import Data.Maybe (fromJust)
|
|
import Text.Mustache ( Template, substitute )
|
|
import qualified Data.Map as M
|
|
import qualified Data.Text as T
|
|
|
|
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 . fst
|
|
|
|
prettyPgp :: PgpKey -> Text
|
|
prettyPgp = T.unwords . T.chunksOf 4 . pgpKeyFingerprint
|
|
|
|
routeFromPgp :: PgpKey -> Route App
|
|
routeFromPgp PgpKey { pgpKeyFingerprint = f } = staticR ["pgp", T.takeEnd 8 f ++ ".asc"]
|
|
|
|
hCard :: Entity User -> Widget
|
|
hCard (Entity userId user) = do
|
|
mcurrentRoute <- getCurrentRoute
|
|
userProfiles <- handlerToWidget $ do
|
|
profiles <- runDB $ map entityVal <$> selectList [ProfileUserId ==. userId] []
|
|
sites <- Site.fetch $ profileSiteId <$> profiles
|
|
return . arrangeProfiles profiles $ sites
|
|
pgpKeys <- handlerToWidget . runDB $ map entityVal <$> selectList [PgpKeyUserId ==. userId] []
|
|
$(widgetFile "mf2/h-card")
|