module Opaleye.Internal.JSONBuildObjectFields
( JSONBuildObjectFields,
jsonBuildObjectField,
jsonBuildObject,
)
where
import Opaleye.Internal.Column (Field_(Column))
import Opaleye.Field (Field)
import Opaleye.Internal.HaskellDB.PrimQuery (Literal (StringLit), PrimExpr (ConstExpr, FunExpr))
import Opaleye.Internal.PGTypesExternal (SqlJson)
import Data.Semigroup
newtype JSONBuildObjectFields
= JSONBuildObjectFields [(String, PrimExpr)]
instance Semigroup JSONBuildObjectFields where
<> :: JSONBuildObjectFields
-> JSONBuildObjectFields -> JSONBuildObjectFields
(<>)
(JSONBuildObjectFields [(String, PrimExpr)]
a)
(JSONBuildObjectFields [(String, PrimExpr)]
b) =
[(String, PrimExpr)] -> JSONBuildObjectFields
JSONBuildObjectFields ([(String, PrimExpr)] -> JSONBuildObjectFields)
-> [(String, PrimExpr)] -> JSONBuildObjectFields
forall a b. (a -> b) -> a -> b
$ [(String, PrimExpr)]
a [(String, PrimExpr)]
-> [(String, PrimExpr)] -> [(String, PrimExpr)]
forall a. Semigroup a => a -> a -> a
<> [(String, PrimExpr)]
b
instance Monoid JSONBuildObjectFields where
mempty :: JSONBuildObjectFields
mempty = [(String, PrimExpr)] -> JSONBuildObjectFields
JSONBuildObjectFields [(String, PrimExpr)]
forall a. Monoid a => a
mempty
mappend :: JSONBuildObjectFields
-> JSONBuildObjectFields -> JSONBuildObjectFields
mappend = JSONBuildObjectFields
-> JSONBuildObjectFields -> JSONBuildObjectFields
forall a. Semigroup a => a -> a -> a
(<>)
jsonBuildObjectField :: String
-> Field_ n a
-> JSONBuildObjectFields
jsonBuildObjectField :: String -> Field_ n a -> JSONBuildObjectFields
jsonBuildObjectField String
f (Column PrimExpr
v) = [(String, PrimExpr)] -> JSONBuildObjectFields
JSONBuildObjectFields [(String
f, PrimExpr
v)]
jsonBuildObject :: JSONBuildObjectFields -> Field SqlJson
jsonBuildObject :: JSONBuildObjectFields -> Field SqlJson
jsonBuildObject (JSONBuildObjectFields [(String, PrimExpr)]
jbofs) = PrimExpr -> Field SqlJson
forall (n :: Nullability) sqlType. PrimExpr -> Field_ n sqlType
Column (PrimExpr -> Field SqlJson) -> PrimExpr -> Field SqlJson
forall a b. (a -> b) -> a -> b
$ String -> [PrimExpr] -> PrimExpr
FunExpr String
"json_build_object" [PrimExpr]
args
where
args :: [PrimExpr]
args = ((String, PrimExpr) -> [PrimExpr])
-> [(String, PrimExpr)] -> [PrimExpr]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (String, PrimExpr) -> [PrimExpr]
mapLabelsToPrimExpr [(String, PrimExpr)]
jbofs
mapLabelsToPrimExpr :: (String, PrimExpr) -> [PrimExpr]
mapLabelsToPrimExpr (String
label, PrimExpr
expr) = [Literal -> PrimExpr
ConstExpr (Literal -> PrimExpr) -> Literal -> PrimExpr
forall a b. (a -> b) -> a -> b
$ String -> Literal
StringLit String
label, PrimExpr
expr]