fix: improve custom enum api

This commit is contained in:
orion 2024-04-05 20:56:46 -05:00
parent 651bc8cb8d
commit 4aab05300b
Signed by: orion
GPG Key ID: 6D4165AE4C928719

View File

@ -8,24 +8,42 @@ import Data.Array.NonEmpty.Internal (NonEmptyArray)
import Data.Foldable (intercalate) import Data.Foldable (intercalate)
import Data.Generic.Rep (class Generic) import Data.Generic.Rep (class Generic)
import Data.Generic.Rep as G import Data.Generic.Rep as G
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..), fromMaybe)
import Data.Newtype as Newtype import Data.Newtype as Newtype
import Data.Postgres (class Rep, RepT, deserialize, serialize) import Data.Postgres (class Rep, RepT, deserialize, serialize)
import Data.Postgres.Custom (quoted) import Data.Postgres.Custom (quoted)
import Data.Postgres.Query (Query, emptyQuery) import Data.Postgres.Query (Query, emptyQuery)
import Data.Postgres.Raw (Raw) import Data.Postgres.Raw (Raw)
import Data.Symbol (class IsSymbol) import Data.Symbol (class IsSymbol)
import Data.Traversable (find)
import Data.Tuple (fst, snd)
import Data.Tuple.Nested (type (/\))
import Foreign (ForeignError(..)) import Foreign (ForeignError(..))
import Type.Prelude (Proxy(..), reflectSymbol) import Type.Prelude (Proxy(..), reflectSymbol)
typeName :: forall @a ty. CustomEnum a ty => String typeName :: forall @a ty. CustomEnum a ty => String
typeName = reflectSymbol (Proxy @ty) typeName = reflectSymbol (Proxy @ty)
class (IsSymbol ty, Rep a) <= CustomEnum a ty | a -> ty where class (IsSymbol ty, Rep a, Eq a) <= CustomEnum a ty | a -> ty where
enumVariants :: NonEmptyArray a enumVariants :: NonEmptyArray (a /\ String)
parseEnum :: String -> Maybe a parseEnum :: String -> Maybe a
printEnum :: a -> String printEnum :: a -> String
defaultParseEnum :: forall a ty. CustomEnum a ty => String -> Maybe a
defaultParseEnum s = map fst $ find (eq s <<< snd) enumVariants
defaultPrintEnum :: forall a ty. CustomEnum a ty => a -> String
defaultPrintEnum a = fromMaybe "ERROR: CustomEnum enumVariants was not exhaustive" $ map snd $ find (eq a <<< fst) enumVariants
defaultDeserializeEnum :: forall @a ty. CustomEnum a ty => Raw -> RepT a
defaultDeserializeEnum raw = do
s <- deserialize raw
let e = pure $ ForeignError $ "unsupported enum variant for " <> typeName @a <> ": " <> quoted s
liftMaybe e $ parseEnum s
defaultSerializeEnum :: forall @a ty. CustomEnum a ty => a -> RepT Raw
defaultSerializeEnum = serialize <<< printEnum
class GenericCustomEnum a where class GenericCustomEnum a where
genericEnumVariants' :: NonEmptyArray a genericEnumVariants' :: NonEmptyArray a
genericParseEnum' :: String -> Maybe a genericParseEnum' :: String -> Maybe a
@ -44,15 +62,6 @@ instance (GenericCustomEnum a, GenericCustomEnum b) => GenericCustomEnum (G.Sum
genericPrintEnum' (G.Inl a) = genericPrintEnum' a genericPrintEnum' (G.Inl a) = genericPrintEnum' a
genericPrintEnum' (G.Inr a) = genericPrintEnum' a genericPrintEnum' (G.Inr a) = genericPrintEnum' a
enumDeserialize :: forall @a ty. CustomEnum a ty => Raw -> RepT a
enumDeserialize raw = do
s <- deserialize raw
let e = pure $ ForeignError $ "unsupported enum variant for " <> typeName @a <> ": " <> quoted s
liftMaybe e $ parseEnum s
enumSerialize :: forall @a ty. CustomEnum a ty => a -> RepT Raw
enumSerialize = serialize <<< printEnum
enumPrintExpr :: forall @a ty. CustomEnum a ty => a -> Maybe String enumPrintExpr :: forall @a ty. CustomEnum a ty => a -> Maybe String
enumPrintExpr = Just <<< (\s -> quoted s <> " :: " <> typeName @a) <<< printEnum enumPrintExpr = Just <<< (\s -> quoted s <> " :: " <> typeName @a) <<< printEnum
@ -68,9 +77,7 @@ genericPrintEnum = genericPrintEnum' <<< G.from
create :: forall @a ty. CustomEnum a ty => Query create :: forall @a ty. CustomEnum a ty => Query
create = create =
let let
variants' :: NonEmptyArray a variants = intercalate ", " $ quoted <$> snd <$> enumVariants @a
variants' = enumVariants
variants = intercalate ", " $ quoted <$> printEnum <$> variants'
q = "create type " <> typeName @a <> " as enum (" <> variants <> ");" q = "create type " <> typeName @a <> " as enum (" <> variants <> ");"
in in
Newtype.modify (_ { text = q }) emptyQuery Newtype.modify (_ { text = q }) emptyQuery