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

fix: hlint & build

Browse Source
This commit is contained in:
Gregor Kleen 2020-06-18 10:12:08 +02:00
parent bbbfa946e1
commit 036c74ef49
3 changed files with 11 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
src/Handler/Utils/Rating/Format.hs
View File

@ -88,11 +88,11 @@ formatRating (MsgRenderer mr) DateTimeFormatter{..} cID Rating{ ratingValues = R
| is _PassAlways mode
-> mempty
| has (_passingBound . _Left) mode
-> mapEvents (str' "passed") (maybe (YAML.Scalar () YAML.SNull) (YAML.Scalar () . YAML.SBool) $ gradingPassed mode =<< ratingPoints)
-> mapEvents (str' "passed") (YAML.Scalar () . maybe YAML.SNull YAML.SBool $ gradingPassed mode =<< ratingPoints)
| otherwise
-> mapEvents (str' "points") (maybe (YAML.Scalar () YAML.SNull) (YAML.Scalar () . YAML.SFloat . realToFrac) ratingPoints)
-> mapEvents (str' "points") (YAML.Scalar () $ maybe YAML.SNull (YAML.SFloat . realToFrac) ratingPoints)
, mapEvents (str' "rating_done") (YAML.Scalar () $ YAML.SBool ratingDone)
, pure $ YAML.Event.MappingEnd
, pure YAML.Event.MappingEnd
]
, [ YAML.Event.DocumentEnd True
, YAML.Event.StreamEnd
@ -107,7 +107,7 @@ formatRating (MsgRenderer mr) DateTimeFormatter{..} cID Rating{ ratingValues = R
mapEvents :: YAML.Node () -> YAML.Node () -> [YAML.Event.Event]
mapEvents k v = filterEvs . nodeEvents . YAML.Mapping () YAML.untagged $ singletonMap k v
where filterEvs ((YAML.Event.MappingStart _ _ _ : inner) :> YAML.Event.MappingEnd) = inner
where filterEvs ((YAML.Event.MappingStart{} : inner) :> YAML.Event.MappingEnd) = inner
filterEvs _other = error "Could not strip Mapping"
nodeEvents :: YAML.Node () -> [YAML.Event.Event]
@ -123,9 +123,9 @@ formatRating (MsgRenderer mr) DateTimeFormatter{..} cID Rating{ ratingValues = R
where
transduce' (Left _ : _) = error "Parse error on uglyYAML"
transduce' (Right YAML.Event.EvPos{ eEvent, ePos = pos1 } : es@(Right YAML.Event.EvPos{ ePos = pos2 }: _))
= (:) <$> ((YAML.Event.posByteOffset pos1, YAML.Event.posByteOffset pos2, ) <$> state (flip transduce eEvent)) <*> transduce' es
transduce' (Right YAML.Event.EvPos{..} : es@_)
= (:) <$> ((YAML.Event.posByteOffset ePos, fromIntegral $ Lazy.ByteString.length uglyYAML, ) <$> state (flip transduce eEvent)) <*> transduce' es
= (:) <$> ((YAML.Event.posByteOffset pos1, YAML.Event.posByteOffset pos2, ) <$> state (`transduce` eEvent)) <*> transduce' es
transduce' (Right YAML.Event.EvPos{..} : es)
= (:) <$> ((YAML.Event.posByteOffset ePos, fromIntegral $ Lazy.ByteString.length uglyYAML, ) <$> state (`transduce` eEvent)) <*> transduce' es
transduce' [] = return []
annotate = fst . foldl' annotate' (uglyYAML, Lazy.ByteString.length uglyYAML) . reverse
@ -140,11 +140,11 @@ formatRating (MsgRenderer mr) DateTimeFormatter{..} cID Rating{ ratingValues = R
in (before <> ann1 <> fromStrict (encodeUtf8 event'') <> fromStrict (encodeUtf8 $ ann2 ws) <> after, pos1')
transduce :: PrettifyState -> YAML.Event.Event -> ((Text, Text -> Text), PrettifyState)
transduce PrettifyInitial (YAML.Event.MappingStart _ _ _) = (("# " <> mr MsgRatingYAMLMetaComment <> "\n", id), PrettifyMetadata 0)
transduce PrettifyInitial YAML.Event.MappingStart{} = (("# " <> mr MsgRatingYAMLMetaComment <> "\n", id), PrettifyMetadata 0)
transduce PrettifyInitial _ = ((mempty, id), PrettifyInitial)
transduce (PrettifyMetadata 0) (YAML.Event.Scalar _ _ _ k)
| k == "submission" = (("\n# " <> mr MsgRatingYAMLSubmissionIdComment <> "\n", id), PrettifySubmissionId)
transduce (PrettifyMetadata n) (YAML.Event.MappingStart _ _ _) = ((mempty, id), PrettifyMetadata $ succ n)
transduce (PrettifyMetadata n) YAML.Event.MappingStart{} = ((mempty, id), PrettifyMetadata $ succ n)
transduce (PrettifyMetadata 0) _ = ((mempty, id), PrettifyMetadata 0)
transduce (PrettifyMetadata n) YAML.Event.MappingEnd = ((mempty, id), PrettifyMetadata $ pred n)
transduce cState@(PrettifyMetadata _) _ = ((mempty, id), cState)

2
src/Utils/DateTime.hs
View File

@ -122,7 +122,7 @@ instance BoundedJoinSemiLattice SelDateTimeFormat where
instance BoundedMeetSemiLattice SelDateTimeFormat where
top = SelFormatDateTime
data DateTimeFormatter = DateTimeFormatter { format :: forall t. HasLocalTime t => SelDateTimeFormat -> t -> Text }
newtype DateTimeFormatter = DateTimeFormatter { format :: forall t. HasLocalTime t => SelDateTimeFormat -> t -> Text }
mkDateTimeFormatter :: TimeLocale -> (SelDateTimeFormat -> DateTimeFormat) -> TZ -> DateTimeFormatter
mkDateTimeFormatter locale formatMap appTZ = DateTimeFormatter (\(formatMap -> fmt) t -> pack . Time.formatTime locale (unDateTimeFormat fmt) $ ZonedTime (toLocalTime t) (timeZoneForUTCTime appTZ . localTimeToUTCTZ appTZ $ toLocalTime t))

2
test/Handler/Utils/RatingSpec.hs
View File

@ -25,7 +25,7 @@ spec = describe "Rating file parsing/pretty-printing" $ do
mr' = MsgRenderer $ renderMessage (error "foundation inspected" :: site) []
parseRating' :: LBS.ByteString -> Maybe Rating'
parseRating' = either (\(_ :: SomeException) -> Nothing) Just . parseRating . flip (File "bewertung.txt") time . Just . LBS.toStrict
parseRating' = either (\(_ :: SomeException) -> Nothing) (Just . fst) . parseRating . flip (File "bewertung.txt") time . Just . LBS.toStrict
time = UTCTime systemEpochDay 0
mRating rating = rating { ratingValues = mRating' rating $ ratingValues rating }