module Opaleye.Internal.JSONBuildObjectFields
  ( JSONBuildObjectFields,
    jsonBuildObjectField,
    jsonBuildObject,
  )
where

import Opaleye.Internal.Column (Column (Column))
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 ([(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
(<>)

-- | Given a label and a column, generates a pair for use with @jsonBuildObject@
jsonBuildObjectField :: String
                     -- ^ Field name
                     -> Column a
                     -- ^ Field value
                     -> JSONBuildObjectFields
jsonBuildObjectField :: String -> Column 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 -> Column SqlJson
jsonBuildObject :: JSONBuildObjectFields -> Column SqlJson
jsonBuildObject (JSONBuildObjectFields [(String, PrimExpr)]
jbofs) = PrimExpr -> Column SqlJson
forall pgType. PrimExpr -> Column pgType
Column (PrimExpr -> Column SqlJson) -> PrimExpr -> Column 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]