fraport/fradrive
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

feat(sheetlist): sort sheet file types in db by haskell Ord

Browse Source
This commit is contained in:
Steffen Jost 2019-07-16 09:33:54 +02:00
parent 05e7b52f08
commit 643cc4165f
2 changed files with 19 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
src/Database/Esqueleto/Utils.hs
View File

@ -10,10 +10,14 @@ module Database.Esqueleto.Utils
, mkContainsFilter, mkContainsFilterWith
, mkExistsFilter
, anyFilter, allFilter
, orderByOrd, orderByEnum
) where
import ClassyPrelude.Yesod hiding (isInfixOf, any, all, isJust)
import Data.Universe
import qualified Data.Set as Set
import qualified Data.List as List
import qualified Data.Foldable as F
import qualified Database.Esqueleto as E
import Database.Esqueleto.Utils.TH
@ -113,7 +117,7 @@ mkContainsFilter :: E.SqlString a
-> Set.Set a -- ^ needle collection
-> E.SqlExpr (E.Value Bool)
mkContainsFilter = mkContainsFilterWith id
-- | like `mkContainsFiler` but allows for conversion; convenient in conjunction with `anyFilter` and `allFilter`
mkContainsFilterWith :: E.SqlString b
=> (a -> b)
@ -153,3 +157,11 @@ allFilter :: (Foldable f)
allFilter fltrs needle criterias = F.foldr aux true fltrs
where
aux fltr acc = fltr needle criterias E.&&. acc
orderByOrd :: (Ord a, Finite a, PersistField a) => E.SqlExpr (E.Value a) -> E.SqlExpr (E.Value Int)
orderByOrd = let sortUni = zipWith (,) [1..] $ List.sort universeF in -- memoize this, might not work due to polymorphism
\x -> E.case_ [ (x E.==. E.val u, E.val i) | (i,u) <- sortUni ] (E.val (-1))
orderByEnum :: (Enum a, Finite a, PersistField a) => E.SqlExpr (E.Value a) -> E.SqlExpr (E.Value Int)
orderByEnum x = E.case_ [ (x E.==. E.val u, E.val $ fromEnum u) | u <- universeF ] (E.val (-1))

8
src/Handler/Sheet.hs
View File

@ -29,6 +29,7 @@ import qualified Data.Conduit.List as C
-- import qualified Data.CaseInsensitive as CI
import qualified Database.Esqueleto as E
import qualified Database.Esqueleto.Utils as E
-- import qualified Database.Esqueleto.Internal.Sql as E
import Control.Monad.Writer (MonadWriter(..), execWriterT)
@ -393,7 +394,7 @@ getSShowR tid ssh csh shn = do
, dbtIdent = "files" :: Text
, dbtSorting = Map.fromList
[ ( "type"
, SortColumn $ \(sheetFile `E.InnerJoin` _file) -> sheetFile E.^. SheetFileType
, SortColumn $ \(sheetFile `E.InnerJoin` _file) -> E.orderByEnum $ sheetFile E.^. SheetFileType
)
, ( "path"
, SortColumn $ \(_sheetFile `E.InnerJoin` file) -> file E.^. FileTitle
@ -819,7 +820,10 @@ correctorForm shid = wFormToAForm $ do
postProcess' (Right sheetCorrectorUser, (sheetCorrectorState, sheetCorrectorLoad)) = Right SheetCorrector{..}
postProcess' (Left email, (state, load)) = Left (email, shid, (InvDBDataSheetCorrector load state, InvTokenDataSheetCorrector))
fmap postProcess <$> massInputW MassInput{..} (fslI MsgCorrectors & setTooltip MsgMassInputTip) True (Just . Map.fromList . zip [0..] $ Map.toList loads)
filledData :: Maybe (Map ListPosition (Either UserEmail UserId, (CorrectorState, Load)))
filledData = Just . Map.fromList . zip [0..] $ Map.toList loads -- TODO orderBy Name?!
fmap postProcess <$> massInputW MassInput{..} (fslI MsgCorrectors & setTooltip MsgMassInputTip) True filledData
getSCorrR, postSCorrR :: TermId -> SchoolId -> CourseShorthand -> SheetName -> Handler Html
postSCorrR = getSCorrR