diff --git a/src/Widget/Hcard.hs b/src/Widget/Hcard.hs index 5a1d1cb..bd663df 100644 --- a/src/Widget/Hcard.hs +++ b/src/Widget/Hcard.hs @@ -4,13 +4,24 @@ module Widget.Hcard (hcard) where import Import +import Data.Maybe (fromJust) +import qualified Data.Map as M import qualified Network.Libravatar as L +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 + hcard :: Entity User -> Widget hcard (Entity userId user) = do maybeAvatar <- liftIO $ L.avatarUrl (L.Email $ userEmail user) def { L.optSecure = True, L.optSize = L.Size 512 } userProfiles <- handlerToWidget . runDB $ do profiles <- map entityVal <$> selectList [ProfileUserId ==. userId] [] - sites <- belongsToJust profileSiteId `mapM` profiles - return . sortBy (comparing $ siteIcon . fst) $ zip sites profiles + sites <- M.fromList . map entityToTuple <$> selectList [SiteId <-. (profileSiteId <$> profiles)] [] + return $ arrangeProfiles sites profiles $(widgetFile "hcard")