fradrive/src/Handler/Utils/Table/Columns.hs
2019-03-10 11:43:59 +01:00

135 lines
5.7 KiB
Haskell

module Handler.Utils.Table.Columns where
import Import
-- import Data.CaseInsensitive (CI)
-- import qualified Data.CaseInsensitive as CI
-- import Data.Monoid (Any(..))
-- import Control.Monad.Writer.Class (MonadWriter(..))
-- import Control.Monad.Trans.Writer (WriterT)
-- import Text.Blaze (ToMarkup(..))
import qualified Database.Esqueleto as E
import Database.Esqueleto.Utils
import Utils.Lens
import Handler.Utils
import Handler.Utils.Table.Cells
--------------------------------
-- Generic Columns
-- reuse encourages consistency
--
-- The constant string for sort/filter keys
-- should never be mentioned outside of this module
-- to ensure consistency!
--
-- Each section should have the following parts:
-- * colXYZ : column definitions plus variants
-- * sortXYZ : sorting definitions for these columns
-- * fltrXYZ : filter definitions for these columns
-- * additional helper, such as default sorting
---------------
-- User names
-- | Generic sort key from msg does not work, since we have no show Instance for RenderMesage UniWorX msg. Dangerous anyway!
colUserName' :: (IsDBTable m c, HasUser a, RenderMessage UniWorX msg, Show msg) => msg -> Colonnade Sortable a (DBCell m c)
colUserName' msg = sortable (Just $ fromString $ show msg) (i18nCell msg) cellHasUser
colUserName :: (IsDBTable m c, HasUser a) => Colonnade Sortable a (DBCell m c)
colUserName = sortable (Just "user-name") (i18nCell MsgCourseMembers) cellHasUser
colUserNameLink :: (IsDBTable m c, HasEntity a User) => (CryptoUUIDUser -> Route UniWorX) -> Colonnade Sortable a (DBCell m c)
colUserNameLink userLink = sortable (Just "user-name") (i18nCell MsgCourseMembers) (cellHasUserLink userLink)
-- | Intended to work with @nameWidget@, showing highlighter Surname within Displayname
-- TOOD: We want to sort first by UserSurname and then by UserDisplayName, not supportet by dbTable
-- see also @defaultSortingName@
sortUserName :: IsString a => (t -> E.SqlExpr (Entity User)) -> (a, SortColumn t)
sortUserName queryUser = ("user-name", SortColumn $ toSortKey . queryUser)
where toSortKey user = (user E.^. UserSurname) E.++. (user E.^. UserDisplayName)
-- | Alias for sortUserName for consistency, since column comes in two variants
sortUserNameLink :: IsString a => (t -> E.SqlExpr (Entity User)) -> (a, SortColumn t)
sortUserNameLink = sortUserName
sortUserSurname :: IsString a => (t -> E.SqlExpr (Entity User)) -> (a, SortColumn t)
sortUserSurname queryUser = ("user-surname", SortColumn $ compose queryUser (E.^. UserSurname))
sortUserDisplayName :: IsString a => (t -> E.SqlExpr (Entity User)) -> (a, SortColumn t)
sortUserDisplayName queryUser = ("user-display-name", SortColumn $ compose queryUser (E.^. UserDisplayName))
defaultSortingByName :: PSValidator m x -> PSValidator m x
defaultSortingByName =
-- defaultSorting [SortAscBy "user-surname", SortAscBy "user-display-name"] -- old way, requiring two exta sorters
defaultSorting [SortAscBy "user-name"] -- new way, untested, working with single sorter
-- | Alias for sortUserName for consistency
fltrUserNameLink :: (IsFilterColumn t (a -> Set Text -> E.SqlExpr (E.Value Bool)), IsString d) => (a -> E.SqlExpr (Entity User)) -> (d, FilterColumn t)
fltrUserNameLink = fltrUserName
fltrUserName :: (IsFilterColumn t (a -> Set Text -> E.SqlExpr (E.Value Bool)), IsString d)
=> (a -> E.SqlExpr (Entity User))
-> (d, FilterColumn t)
fltrUserName queryUser = ( "user-name", FilterColumn $ mkContainsFilter queryName )
where
queryName = compose queryUser (E.^. UserDisplayName)
fltrUserNameExact :: (IsFilterColumn t (a -> Set Text -> E.SqlExpr (E.Value Bool)), IsString d)
=> (a -> E.SqlExpr (Entity User))
-> (d, FilterColumn t)
fltrUserNameExact queryUser = ( "user-name", FilterColumn $ mkExactFilter queryName )
where
queryName = compose queryUser (E.^. UserDisplayName)
fltrUserSurname :: (IsFilterColumn t (a -> Set Text -> E.SqlExpr (E.Value Bool)), IsString d)
=> (a -> E.SqlExpr (Entity User))
-> (d, FilterColumn t)
fltrUserSurname queryUser = ( "user-surname", FilterColumn $ mkContainsFilter queryName )
where
queryName = compose queryUser (E.^. UserSurname)
fltrUserDisplayName :: (IsFilterColumn t (a -> Set Text -> E.SqlExpr (E.Value Bool)), IsString d)
=> (a -> E.SqlExpr (Entity User))
-> (d, FilterColumn t)
fltrUserDisplayName queryUser = ( "user-display-name", FilterColumn $ mkContainsFilter queryName )
where
queryName = compose queryUser (E.^. UserDisplayName)
-------------------
-- Matriclenumber
colUserMatriclenr :: (IsDBTable m c, HasUser a) => Colonnade Sortable a (DBCell m c)
colUserMatriclenr = sortable (Just "user-matriclenumber") (i18nCell MsgMatrikelNr) cellHasMatrikelnummer
sortUserMatriclenr :: IsString d => (t -> E.SqlExpr (Entity User)) -> (d, SortColumn t)
sortUserMatriclenr queryUser = ( "user-matriclenumber", SortColumn $ compose queryUser (E.^. UserMatrikelnummer))
fltrUserMatriclenr :: (IsFilterColumn t (a -> Set Text -> E.SqlExpr (E.Value Bool)), IsString d)
=> (a -> E.SqlExpr (Entity User))
-> (d, FilterColumn t)
fltrUserMatriclenr queryUser = ( "user-matriclenumber", FilterColumn $ mkContainsFilter $ compose queryUser (E.^. UserMatrikelnummer))
----------------
-- User E-Mail
colUserEmail :: (IsDBTable m c, HasUser a) => Colonnade Sortable a (DBCell m c)
colUserEmail = sortable (Just "user-email") (i18nCell MsgEMail) cellHasEMail
sortUserEmail :: IsString d => (t -> E.SqlExpr (Entity User)) -> (d, SortColumn t)
sortUserEmail queryUser = ( "user-email", SortColumn $ compose queryUser (E.^. UserEmail))
fltrUserEmail :: (IsFilterColumn t (a -> Set Text -> E.SqlExpr (E.Value Bool)), IsString d)
=> (a -> E.SqlExpr (Entity User))
-> (d, FilterColumn t)
fltrUserEmail queryUser = ( "user-email", FilterColumn $ mkContainsFilter $ compose queryUser (E.^. UserEmail))