{-# language MonoLocalBinds #-}
{-# language NamedFieldPuns #-}

module Rel8.Statement.Set
  ( ppSet
  )
where

-- base
import Data.Foldable ( toList )
import Prelude ()

-- opaleye
import qualified Opaleye.Internal.HaskellDB.Sql.Print as Opaleye
import qualified Opaleye.Internal.Sql as Opaleye

-- pretty
import Text.PrettyPrint ( Doc, (<+>), equals, text )

-- rel8
import Rel8.Schema.Name ( Selects, ppColumn )
import Rel8.Schema.Table ( TableSchema(..) )
import Rel8.Table.Opaleye ( attributes, exprsWithNames )


ppSet :: Selects names exprs
  => TableSchema names -> (exprs -> exprs) -> Doc
ppSet :: TableSchema names -> (exprs -> exprs) -> Doc
ppSet schema :: TableSchema names
schema@TableSchema {names
columns :: forall names. TableSchema names -> names
columns :: names
columns} exprs -> exprs
f =
  String -> Doc
text String
"SET" Doc -> Doc -> Doc
<+> ((String, PrimExpr) -> Doc) -> [(String, PrimExpr)] -> Doc
forall a. (a -> Doc) -> [a] -> Doc
Opaleye.commaV (String, PrimExpr) -> Doc
ppAssign (NonEmpty (String, PrimExpr) -> [(String, PrimExpr)]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty (String, PrimExpr)
assigns)
  where
    assigns :: NonEmpty (String, PrimExpr)
assigns = names -> exprs -> NonEmpty (String, PrimExpr)
forall names exprs.
Selects names exprs =>
names -> exprs -> NonEmpty (String, PrimExpr)
exprsWithNames names
columns (exprs -> exprs
f (TableSchema names -> exprs
forall names exprs.
Selects names exprs =>
TableSchema names -> exprs
attributes TableSchema names
schema))
    ppAssign :: (String, PrimExpr) -> Doc
ppAssign (String
column, PrimExpr
expr) =
      String -> Doc
ppColumn String
column Doc -> Doc -> Doc
<+> Doc
equals Doc -> Doc -> Doc
<+> SqlExpr -> Doc
Opaleye.ppSqlExpr (PrimExpr -> SqlExpr
Opaleye.sqlExpr PrimExpr
expr)