{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} module Widget.Card ( hCard ) where import Import import Data.Maybe (fromJust) 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)] arrangeProfiles sites profiles = sortBy icon $ zip profileSites profiles where findSite = fromJust . flip M.lookup sites . profileSiteId profileSites = findSite <$> profiles icon = comparing $ siteIcon . 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 . runDB $ do profiles <- map entityVal <$> selectList [ProfileUserId ==. userId] [] sites <- M.fromList . map entityToTuple <$> selectList [SiteId <-. (profileSiteId <$> profiles)] [] return $ arrangeProfiles sites profiles pgpKeys <- handlerToWidget . runDB $ map entityVal <$> selectList [PgpKeyUserId ==. userId] [] $(widgetFile "mf2/h-card")