fix(displayable): fixed faulty display of db keys (SchoolId, TermId)
This commit is contained in:
parent
b0ed911849
commit
c7312e8ec6
@ -349,12 +349,6 @@ instance HasResolution a => ToMessage (Fixed a) where
|
|||||||
-- toMessage = toMessage . fromRational'
|
-- toMessage = toMessage . fromRational'
|
||||||
-- where fromRational' = fromRational :: Rational -> Fixed E3
|
-- where fromRational' = fromRational :: Rational -> Fixed E3
|
||||||
|
|
||||||
-- ToMessage instances for *selected* database IDs
|
|
||||||
instance ToMessage TermId where
|
|
||||||
toMessage = tshow
|
|
||||||
instance ToMessage SchoolId where
|
|
||||||
toMessage = tshow
|
|
||||||
|
|
||||||
|
|
||||||
newtype ErrorResponseTitle = ErrorResponseTitle ErrorResponse
|
newtype ErrorResponseTitle = ErrorResponseTitle ErrorResponse
|
||||||
embedRenderMessageVariant ''UniWorX ''ErrorResponseTitle ("ErrorResponseTitle" <>)
|
embedRenderMessageVariant ''UniWorX ''ErrorResponseTitle ("ErrorResponseTitle" <>)
|
||||||
|
|||||||
13
src/Model.hs
13
src/Model.hs
@ -16,7 +16,7 @@ import Cron.Types
|
|||||||
|
|
||||||
import Data.Aeson (Value)
|
import Data.Aeson (Value)
|
||||||
|
|
||||||
import Data.CaseInsensitive (CI)
|
import Data.CaseInsensitive (CI, original)
|
||||||
import Data.CaseInsensitive.Instances ()
|
import Data.CaseInsensitive.Instances ()
|
||||||
|
|
||||||
import Utils.Message (MessageStatus)
|
import Utils.Message (MessageStatus)
|
||||||
@ -52,11 +52,16 @@ instance Ord User where
|
|||||||
submissionRatingDone :: Submission -> Bool
|
submissionRatingDone :: Submission -> Bool
|
||||||
submissionRatingDone Submission{..} = isJust submissionRatingTime
|
submissionRatingDone Submission{..} = isJust submissionRatingTime
|
||||||
|
|
||||||
-- ToMarkup instances for displaying certain database primary keys
|
-- ToMarkup and ToMessage instances for displaying selected database primary keys
|
||||||
-- TODO: is there a better place for this?
|
|
||||||
|
|
||||||
instance ToMarkup (Key School) where
|
instance ToMarkup (Key School) where
|
||||||
toMarkup = toMarkup . unSchoolKey
|
toMarkup = toMarkup . unSchoolKey
|
||||||
|
|
||||||
|
instance ToMessage (Key School) where
|
||||||
|
toMessage = original . unSchoolKey
|
||||||
|
|
||||||
instance ToMarkup (Key Term) where
|
instance ToMarkup (Key Term) where
|
||||||
toMarkup = toMarkup . termToText . unTermKey
|
toMarkup = toMarkup . termToText . unTermKey
|
||||||
|
|
||||||
|
instance ToMessage (Key Term) where
|
||||||
|
toMessage = termToText . unTermKey
|
||||||
@ -251,8 +251,11 @@ str2widget s = [whamlet|#{s}|]
|
|||||||
withFragment :: Monad m => MForm m (a, WidgetT site IO ()) -> Markup -> MForm m (a, WidgetT site IO ())
|
withFragment :: Monad m => MForm m (a, WidgetT site IO ()) -> Markup -> MForm m (a, WidgetT site IO ())
|
||||||
withFragment form html = flip fmap form $ over _2 (toWidget html >>)
|
withFragment form html = flip fmap form $ over _2 (toWidget html >>)
|
||||||
|
|
||||||
|
rationalToFixed :: forall a. HasResolution a => Rational -> Fixed a
|
||||||
|
rationalToFixed = MkFixed . round . (* (fromIntegral $ resolution (Proxy :: HasResolution a => Proxy a)))
|
||||||
|
|
||||||
rationalToFixed3 :: Rational -> Fixed E3
|
rationalToFixed3 :: Rational -> Fixed E3
|
||||||
rationalToFixed3 = fromRational
|
rationalToFixed3 = rationalToFixed
|
||||||
|
|
||||||
-- | Convert `part` and `whole` into percentage including symbol
|
-- | Convert `part` and `whole` into percentage including symbol
|
||||||
-- showing trailing zeroes and to decimal digits
|
-- showing trailing zeroes and to decimal digits
|
||||||
@ -270,8 +273,8 @@ textPercent' trailZero precision part whole
|
|||||||
| precision == 4 = showPercent (frac :: Micro)
|
| precision == 4 = showPercent (frac :: Micro)
|
||||||
| otherwise = showPercent (frac :: Pico)
|
| otherwise = showPercent (frac :: Pico)
|
||||||
where
|
where
|
||||||
frac :: forall a . HasResolution a => Fixed a
|
frac :: forall a. HasResolution a => Fixed a
|
||||||
frac = MkFixed $ round $ (* (fromInteger $ resolution (Proxy :: Proxy a))) $ (100*) $ toRational part / toRational whole
|
frac = rationalToFixed $ (100*) $ toRational part / toRational whole
|
||||||
|
|
||||||
showPercent :: HasResolution a => Fixed a -> Text
|
showPercent :: HasResolution a => Fixed a -> Text
|
||||||
showPercent f = pack $ showFixed trailZero f <> "%"
|
showPercent f = pack $ showFixed trailZero f <> "%"
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user