diff --git a/src/Handler/Sheet.hs b/src/Handler/Sheet.hs index dfcb16d90..d59de841d 100644 --- a/src/Handler/Sheet.hs +++ b/src/Handler/Sheet.hs @@ -1,6 +1,5 @@ {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE OverloadedLists #-} {-# LANGUAGE PartialTypeSignatures #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TemplateHaskell #-} @@ -314,16 +313,17 @@ getSShowR tid ssh csh shn = do , dbtStyle = def , dbtFilter = Map.empty , dbtIdent = "files" :: Text - , dbtSorting = [ ( "type" - , SortColumn $ \(sheet `E.InnerJoin` sheetFile `E.InnerJoin` file) -> sheetFile E.^. SheetFileType - ) - , ( "path" - , SortColumn $ \(sheet `E.InnerJoin` sheetFile `E.InnerJoin` file) -> file E.^. FileTitle - ) - , ( "time" - , SortColumn $ \(sheet `E.InnerJoin` sheetFile `E.InnerJoin` file) -> file E.^. FileModified - ) - ] + , dbtSorting = Map.fromList + [ ( "type" + , SortColumn $ \(sheet `E.InnerJoin` sheetFile `E.InnerJoin` file) -> sheetFile E.^. SheetFileType + ) + , ( "path" + , SortColumn $ \(sheet `E.InnerJoin` sheetFile `E.InnerJoin` file) -> file E.^. FileTitle + ) + , ( "time" + , SortColumn $ \(sheet `E.InnerJoin` sheetFile `E.InnerJoin` file) -> file E.^. FileModified + ) + ] } (hasHints, hasSolution) <- runDB $ do hasHints <- (/= 0) <$> count [ SheetFileSheet ==. sid, SheetFileType ==. SheetHint ] diff --git a/src/Model/Types.hs b/src/Model/Types.hs index 8c0569cc3..d8f4c8820 100644 --- a/src/Model/Types.hs +++ b/src/Model/Types.hs @@ -81,6 +81,7 @@ import Data.Bits import Data.Ix import Data.List (genericIndex, elemIndex) import System.Random (Random(..)) +import Data.Data (Data) import Model.Types.Wordlist @@ -536,7 +537,7 @@ derivePersistFieldJSON ''MailLanguages newtype Pseudonym = Pseudonym Word24 - deriving (Eq, Ord, Read, Show) + deriving (Eq, Ord, Read, Show, Generic, Data) deriving newtype (Bounded, Enum, Integral, Num, Real, Bits, FiniteBits, Ix) @@ -578,15 +579,15 @@ instance FromJSON Pseudonym where Nothing -> fail "Could not parse pseudonym words" instance ToJSON Pseudonym where - toJSON = toJSON . (review pseudonymWords :: Pseudonym -> [CI Text]) + toJSON = toJSON . (review pseudonymWords :: Pseudonym -> [PseudonymWord]) -pseudonymWordlist :: [CI Text] +pseudonymWordlist :: [PseudonymWord] pseudonymWordlist = $(wordlist "config/wordlist.txt") -pseudonymWords :: Prism' [CI Text] Pseudonym +pseudonymWords :: Prism' [PseudonymWord] Pseudonym pseudonymWords = prism' pToWords pFromWords where - pFromWords :: [CI Text] -> Maybe Pseudonym + pFromWords :: [PseudonymWord] -> Maybe Pseudonym pFromWords [w1, w2] | Just i1 <- elemIndex w1 pseudonymWordlist , Just i2 <- elemIndex w2 pseudonymWordlist @@ -594,7 +595,7 @@ pseudonymWords = prism' pToWords pFromWords = Just $ shiftL (fromIntegral i1) 12 .|. fromIntegral i2 pFromWords _ = Nothing - pToWords :: Pseudonym -> [CI Text] + pToWords :: Pseudonym -> [PseudonymWord] pToWords (Pseudonym p) = [ genericIndex pseudonymWordlist $ shiftR p 12 .&. maxWord , genericIndex pseudonymWordlist $ p .&. maxWord @@ -606,6 +607,8 @@ pseudonymWords = prism' pToWords pFromWords -- Type synonyms +type PseudonymWord = CI Text + type Email = Text type SchoolName = CI Text