{-# 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 {
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)
}
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_ = 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_ = 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' :: 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 = forall {a}. FromField a haskellSum
fromFieldEnum
, enumToFields :: ToFields haskellSum (Field sqlEnum)
enumToFields = forall {b}. ToFields haskellSum (Field_ 'NonNullable b)
toFieldsEnum
}
where
toFieldsEnum :: ToFields haskellSum (Field_ 'NonNullable b)
toFieldsEnum = forall haskells fields.
(haskells -> fields) -> ToFields haskells fields
O.toToFields (forall (n :: Nullability) a b. String -> Field_ n a -> Field_ n b
O.unsafeCast String
type_ forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Field_ 'NonNullable SqlText
O.sqlString forall b c a. (b -> c) -> (a -> b) -> a -> c
. haskellSum -> String
to_)
fromFieldEnum :: FromField a haskellSum
fromFieldEnum = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. FromField a (Field, Maybe ByteString)
RQ.unsafeFromFieldRaw forall a b. (a -> b) -> a -> b
$ \(Field
_, Maybe ByteString
mdata) -> case Maybe ByteString
mdata of
Maybe ByteString
Nothing -> 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 -> forall a. HasCallStack => String -> a
error (String
"Unexpected: " 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 :: forall haskellSum sqlEnum.
String
-> (String -> Maybe haskellSum)
-> (haskellSum -> String)
-> (FromField sqlEnum haskellSum,
ToFields haskellSum (Field sqlEnum))
fromFieldToFieldsEnum String
type_ String -> Maybe haskellSum
from haskellSum -> String
to_ = (forall sqlEnum haskellSum.
EnumMapper sqlEnum haskellSum -> FromField sqlEnum haskellSum
enumFromField forall {sqlEnum}. EnumMapper sqlEnum haskellSum
e, forall sqlEnum haskellSum.
EnumMapper sqlEnum haskellSum
-> ToFields haskellSum (Field sqlEnum)
enumToFields forall {sqlEnum}. EnumMapper sqlEnum haskellSum
e)
where e :: EnumMapper sqlEnum haskellSum
e = forall haskellSum sqlEnum.
String
-> (String -> Maybe haskellSum)
-> (haskellSum -> String)
-> EnumMapper sqlEnum haskellSum
enumMapper String
type_ String -> Maybe haskellSum
from haskellSum -> String
to_