fradrive/src/Handler/Users.hs

46 lines
1.7 KiB
Haskell

{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
module Handler.Users where
import Import
-- import Data.Text
import Handler.Utils
import Colonnade hiding (fromMaybe)
import Yesod.Colonnade
-- import qualified Database.Esqueleto as E
-- import Database.Esqueleto ((^.))
getUsersR :: Handler Html
getUsersR = do
-- TODO: Esqueleto, combine the two queries into one
(users,schools) <- runDB $ (,)
<$> (selectList [] [Asc UserDisplayName]
>>= mapM (\usr -> (,,)
<$> pure usr
<*> selectList [UserAdminUser ==. entityKey usr] [Asc UserAdminSchool]
<*> selectList [UserLecturerUser ==. entityKey usr] [Asc UserLecturerSchool]
))
<*> selectList [] [Asc SchoolShorthand]
let schoolnames = entities2map schools
let getSchoolname = \sid ->
case lookup sid schoolnames of
Nothing -> "???"
(Just school) -> schoolShorthand school
let colonnadeUsers = mconcat $
[ headed "User" $ text2widget.userDisplayName.entityVal.fst3
, headed "Admin for Schools" $ (\u -> text2widget $ intercalate ", " $ map (getSchoolname.userAdminSchool .entityVal) $ snd3 u)
, headed "Lecturer at Schools" $ (\u -> text2widget $ intercalate ", " $ map (getSchoolname.userLecturerSchool.entityVal) $ trd3 u)
]
-- ++ map (\school -> headed (text2widget $ schoolName $ entityVal school) (\u -> "xx")) schools
defaultLayout $ do
setTitle "Comprehensive User List"
let userList = encodeWidgetTable tableSortable colonnadeUsers users
$(widgetFile "users")