-- |
-- Module      : Database.Relational.SqlSyntax.Updates
-- Copyright   : 2013-2018 Kei Hibino
-- License     : BSD3
--
-- Maintainer  : ex8k.hibino@gmail.com
-- Stability   : experimental
-- Portability : unknown
--
-- This module provides types and expanding operations of SQL update and insert structure.
module Database.Relational.SqlSyntax.Updates (
  -- * Update and Insert assignments
  AssignColumn, AssignTerm, Assignment,

  composeSets,
  composeChunkValues,
  composeChunkValuesWithColumns,
  composeValuesListWithColumns,
  ) where

import Data.Monoid ((<>))

import Language.SQL.Keyword (Keyword(..), (|*|), (.=.))
import qualified Language.SQL.Keyword as SQL

import Database.Relational.Internal.String (StringSQL, rowConsStringSQL)


-- | Column SQL String of assignment
type AssignColumn = StringSQL

-- | Value SQL String of assignment
type AssignTerm   = StringSQL

-- | Assignment pair
type Assignment = (AssignColumn, AssignTerm)

-- | Compose SET clause from ['Assignment'].
composeSets :: [Assignment] -> StringSQL
composeSets :: [Assignment] -> StringSQL
composeSets [Assignment]
as = StringSQL
assigns  where
  assignList :: [StringSQL]
assignList = (Assignment -> [StringSQL] -> [StringSQL])
-> [StringSQL] -> [Assignment] -> [StringSQL]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\ (StringSQL
col, StringSQL
term) [StringSQL]
r ->
                       (StringSQL
col StringSQL -> StringSQL -> StringSQL
.=. StringSQL
term) StringSQL -> [StringSQL] -> [StringSQL]
forall a. a -> [a] -> [a]
: [StringSQL]
r)
               [] [Assignment]
as
  assigns :: StringSQL
assigns | [StringSQL] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [StringSQL]
assignList = [Char] -> StringSQL
forall a. HasCallStack => [Char] -> a
error [Char]
"Update assignment list is null!"
          | Bool
otherwise       = StringSQL
SET StringSQL -> StringSQL -> StringSQL
forall a. Semigroup a => a -> a -> a
<> (StringSQL -> StringSQL -> StringSQL) -> [StringSQL] -> StringSQL
SQL.fold StringSQL -> StringSQL -> StringSQL
(|*|) [StringSQL]
assignList

-- | Compose VALUES clause from a row of value expressions.
composeChunkValues :: Int          -- ^ record count per chunk
                   -> [AssignTerm] -- ^ value expression list
                   -> Keyword
composeChunkValues :: Int -> [StringSQL] -> StringSQL
composeChunkValues Int
n0 [StringSQL]
vs =
    StringSQL
VALUES StringSQL -> StringSQL -> StringSQL
forall a. Semigroup a => a -> a -> a
<> StringSQL
cvs
  where
    n :: Int
n | Int
n0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
1    =  Int
n0
      | Bool
otherwise  =  [Char] -> Int
forall a. HasCallStack => [Char] -> a
error ([Char] -> Int) -> [Char] -> Int
forall a b. (a -> b) -> a -> b
$ [Char]
"Invalid record count value: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
n0
    cvs :: StringSQL
cvs = (StringSQL -> StringSQL -> StringSQL) -> [StringSQL] -> StringSQL
SQL.fold StringSQL -> StringSQL -> StringSQL
(|*|) ([StringSQL] -> StringSQL)
-> (StringSQL -> [StringSQL]) -> StringSQL -> StringSQL
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> StringSQL -> [StringSQL]
forall a. Int -> a -> [a]
replicate Int
n (StringSQL -> StringSQL) -> StringSQL -> StringSQL
forall a b. (a -> b) -> a -> b
$ [StringSQL] -> StringSQL
rowConsStringSQL [StringSQL]
vs

-- | Compose columns row and VALUES clause from a row of value expressions.
composeChunkValuesWithColumns :: Int          -- ^ record count per chunk
                              -> [Assignment] -- ^
                              -> StringSQL
composeChunkValuesWithColumns :: Int -> [Assignment] -> StringSQL
composeChunkValuesWithColumns Int
sz [Assignment]
as =
    [StringSQL] -> StringSQL
rowConsStringSQL [StringSQL]
cs StringSQL -> StringSQL -> StringSQL
forall a. Semigroup a => a -> a -> a
<> Int -> [StringSQL] -> StringSQL
composeChunkValues Int
sz [StringSQL]
vs
  where
    ([StringSQL]
cs, [StringSQL]
vs) = [Assignment] -> ([StringSQL], [StringSQL])
forall a b. [(a, b)] -> ([a], [b])
unzip [Assignment]
as

-- | Compose columns row and VALUES clause from rows list of value expressions.
composeValuesListWithColumns :: [[Assignment]]
                             -> StringSQL
composeValuesListWithColumns :: [[Assignment]] -> StringSQL
composeValuesListWithColumns [[Assignment]]
pss =
    [StringSQL] -> StringSQL
rowConsStringSQL [StringSQL]
cs StringSQL -> StringSQL -> StringSQL
forall a. Semigroup a => a -> a -> a
<> StringSQL
VALUES StringSQL -> StringSQL -> StringSQL
forall a. Semigroup a => a -> a -> a
<> (StringSQL -> StringSQL -> StringSQL) -> [StringSQL] -> StringSQL
SQL.fold StringSQL -> StringSQL -> StringSQL
(|*|) (([StringSQL] -> StringSQL) -> [[StringSQL]] -> [StringSQL]
forall a b. (a -> b) -> [a] -> [b]
map [StringSQL] -> StringSQL
rowConsStringSQL [[StringSQL]]
vss)
  where
    cs :: [StringSQL]
cs = case [[Assignment]]
pss of
           []    ->  [Char] -> [StringSQL]
forall a. HasCallStack => [Char] -> a
error [Char]
"insertValueList: no assignment chunks"
           [Assignment]
ps:[[Assignment]]
_  ->  ([StringSQL], [StringSQL]) -> [StringSQL]
forall a b. (a, b) -> a
fst (([StringSQL], [StringSQL]) -> [StringSQL])
-> ([StringSQL], [StringSQL]) -> [StringSQL]
forall a b. (a -> b) -> a -> b
$ [Assignment] -> ([StringSQL], [StringSQL])
forall a b. [(a, b)] -> ([a], [b])
unzip [Assignment]
ps
    vss :: [[StringSQL]]
vss = ([Assignment] -> [StringSQL]) -> [[Assignment]] -> [[StringSQL]]
forall a b. (a -> b) -> [a] -> [b]
map (([StringSQL], [StringSQL]) -> [StringSQL]
forall a b. (a, b) -> b
snd (([StringSQL], [StringSQL]) -> [StringSQL])
-> ([Assignment] -> ([StringSQL], [StringSQL]))
-> [Assignment]
-> [StringSQL]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Assignment] -> ([StringSQL], [StringSQL])
forall a b. [(a, b)] -> ([a], [b])
unzip) [[Assignment]]
pss