158 lines
7.1 KiB
Haskell
158 lines
7.1 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 as E
|
|
|
|
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 $ queryUser >>> (E.^. UserSurname))
|
|
|
|
sortUserDisplayName :: IsString a => (t -> E.SqlExpr (Entity User)) -> (a, SortColumn t)
|
|
sortUserDisplayName queryUser = ("user-display-name", SortColumn $ 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 = 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 = 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 $ 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 $ queryUser >>> (E.^. UserDisplayName))
|
|
|
|
-- | Searche all names, i.e. DisplayName, Surname, EMail
|
|
fltrUserNameEmail :: (IsFilterColumn t (a -> Set Text -> E.SqlExpr (E.Value Bool)), IsString d)
|
|
=> (a -> E.SqlExpr (Entity User))
|
|
-> (d, FilterColumn t)
|
|
fltrUserNameEmail queryUser = ( "user-name-email", FilterColumn $ anyFilter
|
|
[ mkContainsFilter $ queryUser >>> (E.^. UserDisplayName)
|
|
, mkContainsFilter $ queryUser >>> (E.^. UserSurname)
|
|
, mkContainsFilter $ queryUser >>> (E.^. UserEmail)
|
|
]
|
|
)
|
|
|
|
fltrUserNameLinkUI :: Maybe (Map FilterKey [Text]) -> AForm (YesodDB UniWorX) (Map FilterKey [Text])
|
|
fltrUserNameLinkUI = fltrUserNameUI
|
|
|
|
fltrUserNameUI :: Maybe (Map FilterKey [Text]) -> AForm (YesodDB UniWorX) (Map FilterKey [Text])
|
|
fltrUserNameUI mPrev =
|
|
prismAForm (singletonFilter "user-name") mPrev $ aopt (searchField True) (fslI MsgCourseMembers)
|
|
|
|
fltrUserNameEmailUI :: Maybe (Map FilterKey [Text]) -> AForm (YesodDB UniWorX) (Map FilterKey [Text])
|
|
fltrUserNameEmailUI mPrev =
|
|
prismAForm (singletonFilter "user-name-email") mPrev $ aopt (searchField True) (fslI MsgCourseMembers)
|
|
|
|
-------------------
|
|
-- 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 $ 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 $ queryUser >>> (E.^. UserMatrikelnummer))
|
|
|
|
fltrUserMatriclenrUI :: Maybe (Map FilterKey [Text]) -> AForm (YesodDB UniWorX) (Map FilterKey [Text])
|
|
fltrUserMatriclenrUI mPrev =
|
|
prismAForm (singletonFilter "user-matriclenumber") mPrev $ aopt (searchField False) (fslI MsgMatrikelNr)
|
|
|
|
|
|
----------------
|
|
-- 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 $ 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 $ queryUser >>> (E.^. UserEmail))
|
|
|
|
fltrUserEmailUI :: Maybe (Map FilterKey [Text]) -> AForm (YesodDB UniWorX) (Map FilterKey [Text])
|
|
fltrUserEmailUI mPrev =
|
|
prismAForm (singletonFilter "user-email") mPrev $ aopt (searchField False) (fslI MsgEMail)
|
|
|
|
|