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

-- | Combine @JSONBuildObjectFields@ using @('<>')@
newtype JSONBuildObjectFields
  = JSONBuildObjectFields [(String, PrimExpr)]

instance Semigroup JSONBuildObjectFields where
  <> :: JSONBuildObjectFields
-> JSONBuildObjectFields -> JSONBuildObjectFields
(<>)
    (JSONBuildObjectFields [(String, PrimExpr)]
a)
    (JSONBuildObjectFields [(String, PrimExpr)]
b) =
      [(String, PrimExpr)] -> JSONBuildObjectFields
JSONBuildObjectFields forall a b. (a -> b) -> a -> b
$ [(String, PrimExpr)]
a forall a. Semigroup a => a -> a -> a
<> [(String, PrimExpr)]
b

instance Monoid JSONBuildObjectFields where
  mempty :: JSONBuildObjectFields
mempty = [(String, PrimExpr)] -> JSONBuildObjectFields
JSONBuildObjectFields forall a. Monoid a => a
mempty
  mappend :: JSONBuildObjectFields
-> JSONBuildObjectFields -> JSONBuildObjectFields
mappend = forall a. Semigroup a => a -> a -> a
(<>)

-- | Given a label and a field, generates a pair for use with @jsonBuildObject@
jsonBuildObjectField :: String
                     -- ^ Field name
                     -> Field_ n a
                     -- ^ Field value
                     -> JSONBuildObjectFields
jsonBuildObjectField :: forall (n :: Nullability) a.
String -> Field_ n a -> JSONBuildObjectFields
jsonBuildObjectField String
f (Column PrimExpr
v) = [(String, PrimExpr)] -> JSONBuildObjectFields
JSONBuildObjectFields [(String
f, PrimExpr
v)]

-- | Create an 'SqlJson' object from a collection of fields.
--
--   Note: This is implemented as a variadic function in postgres, and as such, is limited to 50 arguments, or 25 key-value pairs.
jsonBuildObject :: JSONBuildObjectFields -> Field SqlJson
jsonBuildObject :: JSONBuildObjectFields -> Field SqlJson
jsonBuildObject (JSONBuildObjectFields [(String, PrimExpr)]
jbofs) = forall (n :: Nullability) sqlType. PrimExpr -> Field_ n sqlType
Column forall a b. (a -> b) -> a -> b
$ String -> [PrimExpr] -> PrimExpr
FunExpr String
"json_build_object" [PrimExpr]
args
  where
    args :: [PrimExpr]
args = 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 forall a b. (a -> b) -> a -> b
$ String -> Literal
StringLit String
label, PrimExpr
expr]