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 import qualified Data.CaseInsensitive as CI -------------------------------- -- 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 ----------------------- -- Numbers and Indices -- | Simple index column, also indicating whether there is a row at all -- For a version without indication, use `Handler.Utils.Pagination.dbRow` instead. dbRowIndicator :: IsDBTable m Any => Colonnade Sortable (DBRow r) (DBCell m Any) dbRowIndicator = sortable Nothing (i18nCell MsgNrColumn) $ \DBRow{ dbrIndex } -> tellCell (Any True) $ textCell $ tshow dbrIndex --------------- -- Files -- | Generic column for links to FilePaths, where the link depends on the entire table row colFilePath :: (IsDBTable m c) => (t -> E.Value FilePath) -> (t -> Route UniWorX) -> Colonnade Sortable t (DBCell m c) colFilePath row2path row2link = sortable (Just "path") (i18nCell MsgFileTitle) makeCell where makeCell row = let filePath = E.unValue $ row2path row link = row2link row in anchorCell link $ str2widget filePath -- | Generic column for links to FilePaths, where the link only depends on the FilePath itself colFilePathSimple :: (IsDBTable m c) => (t -> E.Value FilePath) -> (FilePath -> Route UniWorX) -> Colonnade Sortable t (DBCell m c) colFilePathSimple row2path row2link = sortable (Just "path") (i18nCell MsgFileTitle) makeCell where makeCell row = let filePath = E.unValue $ row2path row link = row2link filePath in anchorCell link $ str2widget filePath -- | Generic column for File Modification colFileModification :: (IsDBTable m c) => (t -> E.Value UTCTime) -> Colonnade Sortable t (DBCell m c) colFileModification row2time = sortable (Just "time") (i18nCell MsgFileModified) (dateTimeCell . E.unValue . row2time) colFileModificationWhen :: (IsDBTable m c) => (UTCTime -> Bool) -> (t -> E.Value UTCTime) -> Colonnade Sortable t (DBCell m c) colFileModificationWhen condition row2time = sortable (Just "time") (i18nCell MsgFileModified) (conDTCell . E.unValue . row2time) where conDTCell = ifCell condition dateTimeCell $ const mempty sortFilePath :: IsString s => (r -> E.SqlExpr (Entity File)) -> (s, SortColumn r) sortFilePath queryPath = ("path", SortColumn $ queryPath >>> (E.^. FileTitle)) sortFileModification :: IsString s => (r -> E.SqlExpr (Entity File)) -> (s, SortColumn r) sortFileModification queryModification = ("time", SortColumn $ queryModification >>> (E.^. FileModified)) defaultSortingByFileTitle :: PSValidator m x -> PSValidator m x defaultSortingByFileTitle = defaultSorting [SortAscBy "path"] defaultSortingByFileModification :: PSValidator m x -> PSValidator m x defaultSortingByFileModification = defaultSorting [SortAscBy "time"] --------------- -- 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)) -- | Search 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) , mkContainsFilterWith CI.mk $ 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 textField (fslI MsgCourseMembers) fltrUserNameEmailUI :: Maybe (Map FilterKey [Text]) -> AForm (YesodDB UniWorX) (Map FilterKey [Text]) fltrUserNameEmailUI mPrev = prismAForm (singletonFilter "user-name-email") mPrev $ aopt textField (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 . mkContainsFilterWith Just $ queryUser >>> (E.^. UserMatrikelnummer)) fltrUserMatriclenrUI :: Maybe (Map FilterKey [Text]) -> AForm (YesodDB UniWorX) (Map FilterKey [Text]) fltrUserMatriclenrUI mPrev = prismAForm (singletonFilter "user-matriclenumber") mPrev $ aopt textField (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 (CI 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 textField (fslI MsgEMail) -------------------- -- Study features -- -------------------- colFeaturesSemester :: (IsDBTable m c, HasStudyFeatures x) => Getting (Leftmost x) a x -> Colonnade Sortable a (DBCell m c) colFeaturesSemester feature = sortable (Just "features-semester") (i18nCell MsgStudyFeatureAge) $ maybe mempty cellHasSemester . firstOf feature sortFeaturesSemester :: IsString d => (t -> E.SqlExpr (Maybe (Entity StudyFeatures))) -> (d, SortColumn t) sortFeaturesSemester queryFeatures = ("features-semester", SortColumn $ queryFeatures >>> (E.?. StudyFeaturesSemester)) fltrFeaturesSemester :: ( IsFilterColumn t (a -> Set Int -> E.SqlExpr (E.Value Bool)) , IsString d ) => (a -> E.SqlExpr (Maybe (Entity StudyFeatures))) -> (d, FilterColumn t) fltrFeaturesSemester queryFeatures = ("features-semester", FilterColumn . mkExactFilterWith Just $ queryFeatures >>> (E.?. StudyFeaturesSemester)) fltrFeaturesSemesterUI :: Maybe (Map FilterKey [Text]) -> AForm (YesodDB UniWorX) (Map FilterKey [Text]) fltrFeaturesSemesterUI mPrev = prismAForm (singletonFilter "features-semester" . maybePrism _PathPiece) mPrev $ aopt (intField :: Field (YesodDB UniWorX) Int) (fslI MsgStudyFeatureAge) colField :: (IsDBTable m c, HasStudyTerms x) => Getting (Leftmost x) a x -> Colonnade Sortable a (DBCell m c) colField terms = sortable (Just "terms") (i18nCell MsgStudyTerm) $ maybe mempty cellHasField . firstOf terms sortField :: IsString d => (t -> E.SqlExpr (Maybe (Entity StudyTerms))) -> (d, SortColumn t) sortField queryTerms = ("terms", SortColumn $ queryTerms >>> (E.?. StudyTermsName)) fltrField :: ( IsFilterColumn t (a -> Set Text -> E.SqlExpr (E.Value Bool)) , IsString d ) => (a -> E.SqlExpr (Maybe (Entity StudyTerms))) -> (d, FilterColumn t) fltrField queryFeatures = ( "terms" , FilterColumn $ anyFilter [ mkContainsFilterWith Just $ queryFeatures >>> E.joinV . (E.?. StudyTermsName) , mkContainsFilterWith Just $ queryFeatures >>> E.joinV . (E.?. StudyTermsShorthand) , mkExactFilterWith readMay $ queryFeatures >>> (E.?. StudyTermsKey) ] ) fltrFieldUI :: Maybe (Map FilterKey [Text]) -> AForm (YesodDB UniWorX) (Map FilterKey [Text]) fltrFieldUI mPrev = prismAForm (singletonFilter "terms") mPrev $ aopt textField (fslI MsgStudyTerm) colDegreeShort :: (IsDBTable m c, HasStudyDegree x) => Getting (Leftmost x) a x -> Colonnade Sortable a (DBCell m c) colDegreeShort terms = sortable (Just "degree-short") (i18nCell MsgDegreeShort) $ maybe mempty cellHasDegreeShort . firstOf terms sortDegreeShort :: IsString d => (t -> E.SqlExpr (Maybe (Entity StudyDegree))) -> (d, SortColumn t) sortDegreeShort queryTerms = ("degree-short", SortColumn $ queryTerms >>> (E.?. StudyDegreeShorthand)) fltrDegree :: ( IsFilterColumn t (a -> Set Text -> E.SqlExpr (E.Value Bool)) , IsString d ) => (a -> E.SqlExpr (Maybe (Entity StudyDegree))) -> (d, FilterColumn t) fltrDegree queryFeatures = ( "degree" , FilterColumn $ anyFilter [ mkContainsFilterWith Just $ queryFeatures >>> E.joinV . (E.?. StudyDegreeName) , mkContainsFilterWith Just $ queryFeatures >>> E.joinV . (E.?. StudyDegreeShorthand) , mkExactFilterWith readMay $ queryFeatures >>> (E.?. StudyDegreeKey) ] ) fltrDegreeUI :: Maybe (Map FilterKey [Text]) -> AForm (YesodDB UniWorX) (Map FilterKey [Text]) fltrDegreeUI mPrev = prismAForm (singletonFilter "degree") mPrev $ aopt textField (fslI MsgDegreeName)