{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE RankNTypes #-}
module Opaleye.Experimental.Enum
(
enumMapper,
EnumMapper,
enumMapperWithSchema,
enumFromField,
enumToFields,
enumShowSqlType,
) where
import Opaleye.Field (Field)
import qualified Opaleye as O
import qualified Opaleye.Internal.PGTypes as IPT
import qualified Opaleye.Internal.RunQuery as RQ
import Data.ByteString.Char8 (unpack)
import Text.PrettyPrint.HughesPJ (doubleQuotes, render, text)
import Prelude hiding ((<>))
data EnumMapper sqlEnum haskellSum = EnumMapper {
forall sqlEnum haskellSum.
EnumMapper sqlEnum haskellSum -> FromField sqlEnum haskellSum
enumFromField :: RQ.FromField sqlEnum haskellSum
, forall sqlEnum haskellSum.
EnumMapper sqlEnum haskellSum
-> ToFields haskellSum (Field sqlEnum)
enumToFields :: O.ToFields haskellSum (Field sqlEnum)
, forall sqlEnum haskellSum.
EnumMapper sqlEnum haskellSum
-> forall (proxy :: * -> *). proxy sqlEnum -> String
enumShowSqlType :: forall proxy. proxy sqlEnum -> String
}
enumMapper :: String
-> (String -> Maybe haskellSum)
-> (haskellSum -> String)
-> EnumMapper sqlEnum haskellSum
enumMapper :: forall haskellSum sqlEnum.
String
-> (String -> Maybe haskellSum)
-> (haskellSum -> String)
-> EnumMapper sqlEnum haskellSum
enumMapper String
type_ = String
-> (String -> Maybe haskellSum)
-> (haskellSum -> String)
-> EnumMapper sqlEnum haskellSum
forall haskellSum sqlEnum.
String
-> (String -> Maybe haskellSum)
-> (haskellSum -> String)
-> EnumMapper sqlEnum haskellSum
enumMapper' (Doc -> String
render (Doc -> Doc
doubleQuotes (String -> Doc
text String
type_)))
enumMapperWithSchema :: String
-> String
-> (String -> Maybe haskellSum)
-> (haskellSum -> String)
-> EnumMapper sqlEnum haskellSum
enumMapperWithSchema :: forall haskellSum sqlEnum.
String
-> String
-> (String -> Maybe haskellSum)
-> (haskellSum -> String)
-> EnumMapper sqlEnum haskellSum
enumMapperWithSchema String
schema String
type_ =
String
-> (String -> Maybe haskellSum)
-> (haskellSum -> String)
-> EnumMapper sqlEnum haskellSum
forall haskellSum sqlEnum.
String
-> (String -> Maybe haskellSum)
-> (haskellSum -> String)
-> EnumMapper sqlEnum haskellSum
enumMapper'
(String -> String -> String
IPT.sqlTypeWithSchema String
schema String
type_)
enumMapper' :: String
-> (String -> Maybe haskellSum)
-> (haskellSum -> String)
-> EnumMapper sqlEnum haskellSum
enumMapper' :: forall haskellSum sqlEnum.
String
-> (String -> Maybe haskellSum)
-> (haskellSum -> String)
-> EnumMapper sqlEnum haskellSum
enumMapper' String
type_ String -> Maybe haskellSum
from haskellSum -> String
to_ = EnumMapper {
enumFromField :: FromField sqlEnum haskellSum
enumFromField = FromField sqlEnum haskellSum
forall {a}. FromField a haskellSum
fromFieldEnum
, enumToFields :: ToFields haskellSum (Field sqlEnum)
enumToFields = ToFields haskellSum (Field sqlEnum)
forall {b}. ToFields haskellSum (Field_ 'NonNullable b)
toFieldsEnum
, enumShowSqlType :: forall (proxy :: * -> *). proxy sqlEnum -> String
enumShowSqlType = \proxy sqlEnum
_ -> String
type_
}
where
toFieldsEnum :: ToFields haskellSum (Field_ 'NonNullable b)
toFieldsEnum = (haskellSum -> Field_ 'NonNullable b)
-> ToFields haskellSum (Field_ 'NonNullable b)
forall haskells fields.
(haskells -> fields) -> ToFields haskells fields
O.toToFields (String -> Field_ 'NonNullable SqlText -> Field_ 'NonNullable b
forall (n :: Nullability) a b. String -> Field_ n a -> Field_ n b
O.unsafeCast String
type_ (Field_ 'NonNullable SqlText -> Field_ 'NonNullable b)
-> (haskellSum -> Field_ 'NonNullable SqlText)
-> haskellSum
-> Field_ 'NonNullable b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Field_ 'NonNullable SqlText
O.sqlString (String -> Field_ 'NonNullable SqlText)
-> (haskellSum -> String)
-> haskellSum
-> Field_ 'NonNullable SqlText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. haskellSum -> String
to_)
fromFieldEnum :: FromField a haskellSum
fromFieldEnum = (((Field, Maybe ByteString) -> haskellSum)
-> FromField a (Field, Maybe ByteString) -> FromField a haskellSum)
-> FromField a (Field, Maybe ByteString)
-> ((Field, Maybe ByteString) -> haskellSum)
-> FromField a haskellSum
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((Field, Maybe ByteString) -> haskellSum)
-> FromField a (Field, Maybe ByteString) -> FromField a haskellSum
forall a b. (a -> b) -> FromField a a -> FromField a b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FromField a (Field, Maybe ByteString)
forall a. FromField a (Field, Maybe ByteString)
RQ.unsafeFromFieldRaw (((Field, Maybe ByteString) -> haskellSum)
-> FromField a haskellSum)
-> ((Field, Maybe ByteString) -> haskellSum)
-> FromField a haskellSum
forall a b. (a -> b) -> a -> b
$ \(Field
_, Maybe ByteString
mdata) -> case Maybe ByteString
mdata of
Maybe ByteString
Nothing -> String -> haskellSum
forall a. HasCallStack => String -> a
error String
"Unexpected NULL"
Just ByteString
s -> case String -> Maybe haskellSum
from (ByteString -> String
unpack ByteString
s) of
Just haskellSum
r -> haskellSum
r
Maybe haskellSum
Nothing -> String -> haskellSum
forall a. HasCallStack => String -> a
error (String
"Unexpected: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ByteString -> String
unpack ByteString
s)