diff --git a/src/Database/Esqueleto/Utils.hs b/src/Database/Esqueleto/Utils.hs index cc8ffbb24..8381869b8 100644 --- a/src/Database/Esqueleto/Utils.hs +++ b/src/Database/Esqueleto/Utils.hs @@ -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)) \ No newline at end of file diff --git a/src/Handler/Sheet.hs b/src/Handler/Sheet.hs index df31ec398..792fd11ef 100644 --- a/src/Handler/Sheet.hs +++ b/src/Handler/Sheet.hs @@ -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