chore(users/Profpatsch): Update postgres module n stuff
Improvements from “upstream”, fresh served. Change-Id: I60e02835730f6a65739eaa729f3e3eed1a0693e6 Reviewed-on: https://cl.tvl.fyi/c/depot/+/9025 Autosubmit: Profpatsch <mail@profpatsch.de> Tested-by: BuildkiteCI Reviewed-by: Profpatsch <mail@profpatsch.de>
This commit is contained in:
parent
fa8288823b
commit
33fa42a1a3
7 changed files with 443 additions and 197 deletions
51
users/Profpatsch/my-prelude/src/AtLeast.hs
Normal file
51
users/Profpatsch/my-prelude/src/AtLeast.hs
Normal file
|
|
@ -0,0 +1,51 @@
|
|||
{-# LANGUAGE QuasiQuotes #-}
|
||||
|
||||
module AtLeast where
|
||||
|
||||
import Data.Aeson (FromJSON (parseJSON))
|
||||
import Data.Aeson.BetterErrors qualified as Json
|
||||
import FieldParser (FieldParser)
|
||||
import FieldParser qualified as Field
|
||||
import GHC.Records (HasField (..))
|
||||
import GHC.TypeLits (KnownNat, natVal)
|
||||
import PossehlAnalyticsPrelude
|
||||
( Natural,
|
||||
Proxy (Proxy),
|
||||
fmt,
|
||||
prettyError,
|
||||
(&),
|
||||
)
|
||||
|
||||
-- | A natural number that must be at least as big as the type literal.
|
||||
newtype AtLeast (min :: Natural) num = AtLeast num
|
||||
-- Just use the instances of the wrapped number type
|
||||
deriving newtype (Eq, Show)
|
||||
|
||||
-- | This is the “destructor” for `AtLeast`, because of the phantom type (@min@) it cannot be inferred automatically.
|
||||
instance HasField "unAtLeast" (AtLeast min num) num where
|
||||
getField (AtLeast num) = num
|
||||
|
||||
parseAtLeast ::
|
||||
forall min num.
|
||||
(KnownNat min, Integral num, Show num) =>
|
||||
FieldParser num (AtLeast min num)
|
||||
parseAtLeast =
|
||||
let minInt = natVal (Proxy @min)
|
||||
in Field.FieldParser $ \from ->
|
||||
if from >= (minInt & fromIntegral)
|
||||
then Right (AtLeast from)
|
||||
else Left [fmt|Must be at least {minInt & show} but was {from & show}|]
|
||||
|
||||
instance
|
||||
(KnownNat min, FromJSON num, Integral num, Bounded num, Show num) =>
|
||||
FromJSON (AtLeast min num)
|
||||
where
|
||||
parseJSON =
|
||||
Json.toAesonParser
|
||||
prettyError
|
||||
( do
|
||||
num <- Json.fromAesonParser @_ @num
|
||||
case Field.runFieldParser (parseAtLeast @min @num) num of
|
||||
Left err -> Json.throwCustomError err
|
||||
Right a -> pure a
|
||||
)
|
||||
Loading…
Add table
Add a link
Reference in a new issue