Sorting/Filter refactro Profile Data
This commit is contained in:
SJost
parent
93a29d0ec9
commit
bf3a12d09d
@ -172,9 +172,12 @@ makeCourseTable whereClause colChoices psValidator = do
|
||||
| Set.null criterias -> E.val True :: E.SqlExpr (E.Value Bool)
|
||||
| otherwise -> course E.^. CourseTerm `E.in_` E.valList (Set.toList criterias)
|
||||
)
|
||||
, ( "school", FilterColumn $ \(_course `E.InnerJoin` school :: CourseTableExpr) criterias -> if
|
||||
| Set.null criterias -> E.val True :: E.SqlExpr (E.Value Bool)
|
||||
| otherwise -> school E.^. SchoolName `E.in_` E.valList (Set.toList criterias)
|
||||
-- , ( "school", FilterColumn $ \(_course `E.InnerJoin` school :: CourseTableExpr) criterias -> if
|
||||
-- | Set.null criterias -> E.val True :: E.SqlExpr (E.Value Bool)
|
||||
-- | otherwise -> school E.^. SchoolName `E.in_` E.valList (Set.toList criterias)
|
||||
-- )
|
||||
, ( "school", FilterColumn $ \(_course `E.InnerJoin` school :: CourseTableExpr) ->
|
||||
emptyOrIn $ school E.^. SchoolName -- TODO: Refactor all?!
|
||||
)
|
||||
, ( "schoolshort", FilterColumn $ \(_course `E.InnerJoin` school :: CourseTableExpr) criterias -> if
|
||||
| Set.null criterias -> E.val True :: E.SqlExpr (E.Value Bool)
|
||||
|
||||
@ -1,4 +1,5 @@
|
||||
{-# LANGUAGE NoImplicitPrelude #-}
|
||||
{-# LANGUAGE MultiWayIf, LambdaCase #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
{-# LANGUAGE PartialTypeSignatures #-}
|
||||
@ -7,6 +8,7 @@
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
{-# LANGUAGE TypeOperators #-}
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
|
||||
module Handler.Profile where
|
||||
@ -20,6 +22,7 @@ import Utils.Lens
|
||||
-- import Colonnade hiding (fromMaybe, singleton)
|
||||
-- import Yesod.Colonnade
|
||||
import qualified Data.Map as Map
|
||||
import qualified Data.Set as Set
|
||||
import qualified Database.Esqueleto as E
|
||||
-- import Database.Esqueleto ((^.))
|
||||
|
||||
@ -147,6 +150,21 @@ postProfileR = do
|
||||
----------------------------------------
|
||||
-- TODO: Are these really a good idea?
|
||||
-- If yes: Move to appropriate Place: Utils.Lens and Utils.Table.Convenience
|
||||
--
|
||||
-- Or Maybe make Course an instance of Data.Data and use biplate instead?
|
||||
-- λ> ("a",7,"b",["c","d"],(9,"e",8),"f",True) ^.. biplate :: [String]
|
||||
-- ["a","b","c","d","e","f"]
|
||||
-- it :: [String]
|
||||
-- *Main Control.Lens Data.Data.Lens
|
||||
-- λ> ("a",7,"b",["c","d"],(9,"e",8),"f",True) ^.. biplate :: [Int]
|
||||
-- []
|
||||
-- it :: [Int]
|
||||
-- *Main Control.Lens Data.Data.Lens
|
||||
-- λ> ("a",7,"b",["c","d"],(9,"e",8),"f",True) ^.. biplate :: [Integer]
|
||||
-- [7,9,8]
|
||||
-- it :: [Integer]
|
||||
|
||||
|
||||
|
||||
-- instance HasCourse (DBRow (Entity Course, a)) where
|
||||
-- course = _dbrOutput . _1 . _entityVal
|
||||
@ -168,6 +186,8 @@ instance HasCourse a => HasCourse (DBRow a) where
|
||||
|
||||
--
|
||||
|
||||
-- type CourseTableData = E.SqlExpr (Entity Course) `E.InnerJoin` E.SqlExpr (Entity CourseParticipant)
|
||||
-- NOTE: use procData instead as a flexible inlines Type signature
|
||||
|
||||
getProfileDataR :: Handler Html
|
||||
getProfileDataR = do
|
||||
@ -177,19 +197,24 @@ getProfileDataR = do
|
||||
-- Tabelle mit eigenen Kursen
|
||||
-- Tabelle mit allen Teilnehmer: Kurs (link), Datum
|
||||
courseTable <- do
|
||||
let -- should be inlined
|
||||
courseCol :: IsDBTable m a => Colonnade Sortable (DBRow (Entity Course, E.Value UTCTime)) (DBCell m a)
|
||||
courseCol = sortable (Just "course") (i18nCell MsgCourse) $ do -- (->) a Monad
|
||||
course <- view $ _dbrOutput . _1 . _entityVal -- view == ^.
|
||||
-- "preview _left" in order to match Either (result is Maybe)
|
||||
return $ courseCell course
|
||||
let
|
||||
procData :: ((E.SqlExpr (Entity Course) `E.InnerJoin` E.SqlExpr (Entity CourseParticipant)) -> a)
|
||||
-> ((E.SqlExpr (Entity Course) `E.InnerJoin` E.SqlExpr (Entity CourseParticipant)) -> a)
|
||||
procData = id
|
||||
|
||||
-- should be inlined
|
||||
-- courseCol :: IsDBTable m a => Colonnade Sortable (DBRow (Entity Course, E.Value UTCTime)) (DBCell m a)
|
||||
-- courseCol = sortable (Just "course") (i18nCell MsgCourse) $ do -- (->) a Monad
|
||||
-- course <- view $ _dbrOutput . _1 . _entityVal -- view == ^.
|
||||
-- -- "preview _left" in order to match Either (result is Maybe)
|
||||
-- return $ courseCell course
|
||||
|
||||
-- termCol = sortable (Just "school") (i18nCell MsgCourseSchool) $ do
|
||||
-- Course{..} <- view $ _dbrOutput . _1 . _entityVal
|
||||
-- return $ anchorCell (TermsSchoolCourseListR
|
||||
|
||||
courseData :: (E.InnerJoin (E.SqlExpr (Entity Course)) (E.SqlExpr (Entity CourseParticipant)))
|
||||
-> E.SqlQuery (E.SqlExpr (Entity Course), E.SqlExpr (E.Value UTCTime))
|
||||
-- courseData :: (E.InnerJoin (E.SqlExpr (Entity Course)) (E.SqlExpr (Entity CourseParticipant)))
|
||||
-- -> E.SqlQuery (E.SqlExpr (Entity Course), E.SqlExpr (E.Value UTCTime))
|
||||
courseData = \(course `E.InnerJoin` participant) -> do
|
||||
E.on $ course E.^. CourseId E.==. participant E.^. CourseParticipantCourse
|
||||
E.where_ $ participant E.^. CourseParticipantUser E.==. E.val uid
|
||||
@ -205,10 +230,14 @@ getProfileDataR = do
|
||||
]
|
||||
, dbtProj = return
|
||||
, dbtSorting = Map.fromList
|
||||
[ ( "course"
|
||||
, SortColumn $ \(course `E.InnerJoin` _) -> course E.^. CourseName )
|
||||
[ ( "course", SortColumn $ procData $ \(crse `E.InnerJoin` _) -> crse E.^. CourseName )
|
||||
, ( "time" , SortColumn $ \(_ `E.InnerJoin` participant) -> participant E.^. CourseParticipantRegistration)
|
||||
]
|
||||
, dbtFilter = Map.fromList
|
||||
[
|
||||
( "course", FilterColumn $ procData $ \(crse `E.InnerJoin` _) -> emptyOrIn $ crse E.^. CourseShorthand )
|
||||
-- , ( "time" , FilterColumn $ \(_ `E.InnerJoin` part :: CourseTableData) -> emptyOrIn $ part E.^. CourseParticipantRegistration )
|
||||
]
|
||||
, dbtFilter = mempty
|
||||
, dbtStyle = def
|
||||
}
|
||||
|
||||
|
||||
57
src/Handler/Utils/Table/Convenience.hs
Normal file
57
src/Handler/Utils/Table/Convenience.hs
Normal file
@ -0,0 +1,57 @@
|
||||
{-# LANGUAGE NoImplicitPrelude #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
{-# LANGUAGE PartialTypeSignatures #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
|
||||
module Handler.Utils.Table.Convenience where
|
||||
|
||||
import Import
|
||||
|
||||
import Utils.Lens
|
||||
import Handler.Utils
|
||||
-- import Handler.Utils.Table.Pagination
|
||||
|
||||
|
||||
-- Special cells
|
||||
|
||||
timeCell :: IsDBTable m a => UTCTime -> DBCell m a
|
||||
timeCell t = cell $ formatTime SelFormatDateTime t >>= toWidget
|
||||
|
||||
-- Just for documentation purposes; inline the code instead:
|
||||
maybeTimeCell :: IsDBTable m a => Maybe UTCTime -> DBCell m a
|
||||
maybeTimeCell = maybe mempty timeCell
|
||||
|
||||
courseCell :: IsDBTable m a => Course -> DBCell m a
|
||||
courseCell (Course {..}) = anchorCell link name `mappend` desc
|
||||
where
|
||||
link = CourseR courseTerm courseSchool courseShorthand CShowR
|
||||
name = citext2widget courseName
|
||||
desc = case courseDescription of
|
||||
Nothing -> mempty
|
||||
(Just descr) -> cell [whamlet| <span style="float:right"> ^{modalStatic descr} |]
|
||||
|
||||
|
||||
-- Generic Columns
|
||||
|
||||
colCourseDescr :: (HasEntity c Course, HasDBRow s r, IsDBTable m a) =>
|
||||
((c -> Const Course c) -> r -> Const Course r) -> Colonnade Sortable s (DBCell m a)
|
||||
colCourseDescr courseLens = sortable (Just "course") (i18nCell MsgCourse) $ do
|
||||
crs <- view $ _dbrOutput . courseLens . _entityVal
|
||||
return $ courseCell crs
|
||||
|
||||
colCourseDescr_ :: IsDBTable m a => Getting Course s Course -> Colonnade Sortable s (DBCell m a)
|
||||
colCourseDescr_ getter =
|
||||
sortable (Just "course") (i18nCell MsgCourse) $ do
|
||||
crs <- view getter
|
||||
return $ courseCell crs
|
||||
|
||||
colCourseDescrG :: (HasCourse s, IsDBTable m a) => Colonnade Sortable s (DBCell m a)
|
||||
colCourseDescrG =
|
||||
sortable (Just "course") (i18nCell MsgCourse) $ do
|
||||
crs <- view course
|
||||
return $ courseCell crs
|
||||
|
||||
|
||||
|
||||
@ -10,9 +10,18 @@ import ClassyPrelude.Yesod
|
||||
import qualified Data.List as List
|
||||
import Data.Map (Map)
|
||||
import qualified Data.Map as Map
|
||||
|
||||
import Data.Set (Set)
|
||||
import qualified Data.Set as Set
|
||||
import qualified Database.Esqueleto as E
|
||||
-- import Database.Persist -- currently not needed here
|
||||
|
||||
-- TODO: is this the right place?
|
||||
emptyOrIn :: PersistField typ =>
|
||||
E.SqlExpr (E.Value typ) -> Set typ -> E.SqlExpr (E.Value Bool)
|
||||
emptyOrIn criterion testSet
|
||||
| Set.null testSet = E.val True
|
||||
| otherwise = criterion `E.in_` E.valList (Set.toList testSet)
|
||||
|
||||
|
||||
entities2map :: PersistEntity record => [Entity record] -> Map (Key record) record
|
||||
entities2map = foldl' (\m entity -> Map.insert (entityKey entity) (entityVal entity) m) Map.empty
|
||||
|
||||
Loading…
Reference in New Issue
Block a user