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

Fix build & cleanup

Browse Source
This commit is contained in:
Gregor Kleen 2018-10-15 09:11:02 +02:00
parent 1f32f638f0
commit 2d90eef867
2 changed files with 20 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
src/Handler/Sheet.hs
View File

@ -1,6 +1,5 @@
{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE PartialTypeSignatures #-} {-# LANGUAGE PartialTypeSignatures #-}
{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
@ -314,16 +313,17 @@ getSShowR tid ssh csh shn = do
, dbtStyle = def , dbtStyle = def
, dbtFilter = Map.empty , dbtFilter = Map.empty
, dbtIdent = "files" :: Text , dbtIdent = "files" :: Text
, dbtSorting = [ ( "type" , dbtSorting = Map.fromList
, SortColumn $ \(sheet `E.InnerJoin` sheetFile `E.InnerJoin` file) -> sheetFile E.^. SheetFileType [ ( "type"
) , SortColumn $ \(sheet `E.InnerJoin` sheetFile `E.InnerJoin` file) -> sheetFile E.^. SheetFileType
, ( "path" )
, SortColumn $ \(sheet `E.InnerJoin` sheetFile `E.InnerJoin` file) -> file E.^. FileTitle , ( "path"
) , SortColumn $ \(sheet `E.InnerJoin` sheetFile `E.InnerJoin` file) -> file E.^. FileTitle
, ( "time" )
, SortColumn $ \(sheet `E.InnerJoin` sheetFile `E.InnerJoin` file) -> file E.^. FileModified , ( "time"
) , SortColumn $ \(sheet `E.InnerJoin` sheetFile `E.InnerJoin` file) -> file E.^. FileModified
] )
]
} }
(hasHints, hasSolution) <- runDB $ do (hasHints, hasSolution) <- runDB $ do
hasHints <- (/= 0) <$> count [ SheetFileSheet ==. sid, SheetFileType ==. SheetHint ] hasHints <- (/= 0) <$> count [ SheetFileSheet ==. sid, SheetFileType ==. SheetHint ]

15
src/Model/Types.hs
View File

@ -81,6 +81,7 @@ import Data.Bits
import Data.Ix import Data.Ix
import Data.List (genericIndex, elemIndex) import Data.List (genericIndex, elemIndex)
import System.Random (Random(..)) import System.Random (Random(..))
import Data.Data (Data)
import Model.Types.Wordlist import Model.Types.Wordlist
@ -536,7 +537,7 @@ derivePersistFieldJSON ''MailLanguages
newtype Pseudonym = Pseudonym Word24 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) 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" Nothing -> fail "Could not parse pseudonym words"
instance ToJSON Pseudonym where 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") pseudonymWordlist = $(wordlist "config/wordlist.txt")
pseudonymWords :: Prism' [CI Text] Pseudonym pseudonymWords :: Prism' [PseudonymWord] Pseudonym
pseudonymWords = prism' pToWords pFromWords pseudonymWords = prism' pToWords pFromWords
where where
pFromWords :: [CI Text] -> Maybe Pseudonym pFromWords :: [PseudonymWord] -> Maybe Pseudonym
pFromWords [w1, w2] pFromWords [w1, w2]
| Just i1 <- elemIndex w1 pseudonymWordlist | Just i1 <- elemIndex w1 pseudonymWordlist
, Just i2 <- elemIndex w2 pseudonymWordlist , Just i2 <- elemIndex w2 pseudonymWordlist
@ -594,7 +595,7 @@ pseudonymWords = prism' pToWords pFromWords
= Just $ shiftL (fromIntegral i1) 12 .|. fromIntegral i2 = Just $ shiftL (fromIntegral i1) 12 .|. fromIntegral i2
pFromWords _ = Nothing pFromWords _ = Nothing
pToWords :: Pseudonym -> [CI Text] pToWords :: Pseudonym -> [PseudonymWord]
pToWords (Pseudonym p) pToWords (Pseudonym p)
= [ genericIndex pseudonymWordlist $ shiftR p 12 .&. maxWord = [ genericIndex pseudonymWordlist $ shiftR p 12 .&. maxWord
, genericIndex pseudonymWordlist $ p .&. maxWord , genericIndex pseudonymWordlist $ p .&. maxWord
@ -606,6 +607,8 @@ pseudonymWords = prism' pToWords pFromWords
-- Type synonyms -- Type synonyms
type PseudonymWord = CI Text
type Email = Text type Email = Text
type SchoolName = CI Text type SchoolName = CI Text