{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ConstraintKinds #-}
module Opaleye.Experimental.Enum
(
enumMapper,
EnumMapper,
enumMapperWithSchema,
enumFromField,
enumToFields,
fromFieldToFieldsEnum,
) where
import Opaleye.Field (Field)
import qualified Opaleye as O
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 {
EnumMapper sqlEnum haskellSum -> FromField sqlEnum haskellSum
enumFromField :: RQ.FromField sqlEnum haskellSum
, EnumMapper sqlEnum haskellSum
-> ToFields haskellSum (Field sqlEnum)
enumToFields :: O.ToFields haskellSum (Field sqlEnum)
}
enumMapper :: String
-> (String -> Maybe haskellSum)
-> (haskellSum -> String)
-> EnumMapper sqlEnum haskellSum
enumMapper :: 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 :: 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' (Doc -> String
render (Doc -> Doc
doubleQuotes (String -> Doc
text String
schema) Doc -> Doc -> Doc
<> String -> Doc
text String
"." Doc -> Doc -> Doc
<> Doc -> Doc
doubleQuotes (String -> Doc
text String
type_)))
enumMapper' :: String
-> (String -> Maybe haskellSum)
-> (haskellSum -> String)
-> EnumMapper sqlEnum haskellSum
enumMapper' :: String
-> (String -> Maybe haskellSum)
-> (haskellSum -> String)
-> EnumMapper sqlEnum haskellSum
enumMapper' String
type_ String -> Maybe haskellSum
from haskellSum -> String
to_ = EnumMapper :: forall sqlEnum haskellSum.
FromField sqlEnum haskellSum
-> ToFields haskellSum (Field sqlEnum)
-> EnumMapper sqlEnum haskellSum
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
}
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 (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)
{-# DEPRECATED fromFieldToFieldsEnum "Use 'enumMapper' instead. Will be removed in 0.10." #-}
fromFieldToFieldsEnum :: String
-> (String -> Maybe haskellSum)
-> (haskellSum -> String)
-> (RQ.FromField sqlEnum haskellSum,
O.ToFields haskellSum (Field sqlEnum))
fromFieldToFieldsEnum :: String
-> (String -> Maybe haskellSum)
-> (haskellSum -> String)
-> (FromField sqlEnum haskellSum,
ToFields haskellSum (Field sqlEnum))
fromFieldToFieldsEnum String
type_ String -> Maybe haskellSum
from haskellSum -> String
to_ = (EnumMapper sqlEnum haskellSum -> FromField sqlEnum haskellSum
forall sqlEnum haskellSum.
EnumMapper sqlEnum haskellSum -> FromField sqlEnum haskellSum
enumFromField EnumMapper sqlEnum haskellSum
forall sqlEnum. EnumMapper sqlEnum haskellSum
e, EnumMapper sqlEnum haskellSum
-> ToFields haskellSum (Field sqlEnum)
forall sqlEnum haskellSum.
EnumMapper sqlEnum haskellSum
-> ToFields haskellSum (Field sqlEnum)
enumToFields EnumMapper sqlEnum haskellSum
forall sqlEnum. EnumMapper sqlEnum haskellSum
e)
where e :: EnumMapper sqlEnum haskellSum
e = String
-> (String -> Maybe haskellSum)
-> (haskellSum -> String)
-> EnumMapper sqlEnum haskellSum
forall haskellSum sqlEnum.
String
-> (String -> Maybe haskellSum)
-> (haskellSum -> String)
-> EnumMapper sqlEnum haskellSum
enumMapper String
type_ String -> Maybe haskellSum
from haskellSum -> String
to_