{-# LANGUAGE OverloadedStrings #-}

-- |
-- Module      : Database.Relational.SimpleSql
-- Copyright   : 2013-2017 Kei Hibino
-- License     : BSD3
--
-- Maintainer  : ex8k.hibino@gmail.com
-- Stability   : experimental
-- Portability : unknown
--
-- This module defines functions to generate simple SQL strings.
module Database.Relational.SimpleSql (
  -- * Query suffix
  QuerySuffix, showsQuerySuffix,

  -- * Update SQL
  updatePrefixSQL,
  updateOtherThanKeySQL,

  -- * Insert SQL
  insertPrefixSQL,

  -- * Delete SQL
  deletePrefixSQL
  ) where

import Data.Array (listArray, (!))
import Data.Monoid (mconcat, (<>))

import Language.SQL.Keyword (Keyword(..), (.=.), (|*|))
import qualified Language.SQL.Keyword as SQL
import Database.Record.ToSql (untypedUpdateValuesIndex)

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

import Database.Relational.Pi (Pi, expandIndexes')
import Database.Relational.Table (Table, name, columns, recordWidth)
import qualified Database.Relational.Record as Record


-- | Type for query suffix words
type QuerySuffix = [Keyword]

-- | Expand query suffix words
showsQuerySuffix :: QuerySuffix -> StringSQL
showsQuerySuffix :: QuerySuffix -> StringSQL
showsQuerySuffix =  QuerySuffix -> StringSQL
forall a. Monoid a => [a] -> a
mconcat

-- | Generate prefix string of update SQL.
updatePrefixSQL :: Table r -> StringSQL
updatePrefixSQL :: Table r -> StringSQL
updatePrefixSQL Table r
table = StringSQL
UPDATE StringSQL -> StringSQL -> StringSQL
forall a. Semigroup a => a -> a -> a
<> String -> StringSQL
stringSQL (Table r -> String
forall r. Table r -> String
name Table r
table)

-- | Generate update SQL by specified key and table.
--   Columns name list of table are also required.
updateSQL' :: String      -- ^ Table name
           -> [StringSQL] -- ^ Column name list to update
           -> [StringSQL] -- ^ Key column name list
           -> String      -- ^ Result SQL
updateSQL' :: String -> QuerySuffix -> QuerySuffix -> String
updateSQL' String
table QuerySuffix
cols QuerySuffix
key =
  StringSQL -> String
showStringSQL (StringSQL -> String) -> StringSQL -> String
forall a b. (a -> b) -> a -> b
$ QuerySuffix -> StringSQL
forall a. Monoid a => [a] -> a
mconcat
  [StringSQL
UPDATE, String -> StringSQL
stringSQL String
table, StringSQL
SET, (StringSQL -> StringSQL -> StringSQL) -> QuerySuffix -> StringSQL
SQL.fold StringSQL -> StringSQL -> StringSQL
(|*|) QuerySuffix
updAssigns,
   StringSQL
WHERE, (StringSQL -> StringSQL -> StringSQL) -> QuerySuffix -> StringSQL
SQL.fold StringSQL -> StringSQL -> StringSQL
SQL.and QuerySuffix
keyAssigns]
  where
    assigns :: QuerySuffix -> QuerySuffix
assigns QuerySuffix
cs = [ StringSQL
c StringSQL -> StringSQL -> StringSQL
.=. StringSQL
"?" | StringSQL
c <- QuerySuffix
cs ]
    updAssigns :: QuerySuffix
updAssigns = QuerySuffix -> QuerySuffix
assigns QuerySuffix
cols
    keyAssigns :: QuerySuffix
keyAssigns = QuerySuffix -> QuerySuffix
assigns QuerySuffix
key

-- | Generate update SQL by specified key and table.
--   Columns name list of table are also required.
updateOtherThanKeySQL' :: String      -- ^ Table name
                       -> [StringSQL] -- ^ Column name list
                       -> [Int]       -- ^ Key column indexes
                       -> String      -- ^ Result SQL
updateOtherThanKeySQL' :: String -> QuerySuffix -> [Int] -> String
updateOtherThanKeySQL' String
table QuerySuffix
cols [Int]
ixs =
  String -> QuerySuffix -> QuerySuffix -> String
updateSQL' String
table QuerySuffix
updColumns QuerySuffix
keyColumns
  where
    width' :: Int
width' = QuerySuffix -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length QuerySuffix
cols
    cols' :: Array Int StringSQL
cols' = (Int, Int) -> QuerySuffix -> Array Int StringSQL
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0, Int
width' Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) QuerySuffix
cols
    otherThanKey :: [Int]
otherThanKey = [Int] -> Int -> [Int]
untypedUpdateValuesIndex [Int]
ixs Int
width'
    columns' :: [Int] -> QuerySuffix
columns' [Int]
is = [ Array Int StringSQL
cols' Array Int StringSQL -> Int -> StringSQL
forall i e. Ix i => Array i e -> i -> e
! Int
i | Int
i <- [Int]
is ]
    updColumns :: QuerySuffix
updColumns = [Int] -> QuerySuffix
columns' [Int]
otherThanKey
    keyColumns :: QuerySuffix
keyColumns = [Int] -> QuerySuffix
columns' [Int]
ixs

-- | Generate update SQL specified by single key.
updateOtherThanKeySQL :: Table r -- ^ Table metadata
          -> Pi r p  -- ^ Key columns
          -> String  -- ^ Result SQL
updateOtherThanKeySQL :: Table r -> Pi r p -> String
updateOtherThanKeySQL Table r
tbl Pi r p
key =
  String -> QuerySuffix -> [Int] -> String
updateOtherThanKeySQL' (Table r -> String
forall r. Table r -> String
name Table r
tbl) (Table r -> QuerySuffix
forall r. Table r -> QuerySuffix
columns Table r
tbl) (PersistableRecordWidth r -> Pi r p -> [Int]
forall a b. PersistableRecordWidth a -> Pi a b -> [Int]
expandIndexes' (Table r -> PersistableRecordWidth r
forall r. Table r -> PersistableRecordWidth r
recordWidth Table r
tbl) Pi r p
key)

-- | Generate prefix string of insert SQL.
insertPrefixSQL :: Pi r r' -> Table r -> StringSQL
insertPrefixSQL :: Pi r r' -> Table r -> StringSQL
insertPrefixSQL Pi r r'
pi' Table r
table =
  StringSQL
INSERT StringSQL -> StringSQL -> StringSQL
forall a. Semigroup a => a -> a -> a
<> StringSQL
INTO StringSQL -> StringSQL -> StringSQL
forall a. Semigroup a => a -> a -> a
<> String -> StringSQL
stringSQL (Table r -> String
forall r. Table r -> String
name Table r
table) StringSQL -> StringSQL -> StringSQL
forall a. Semigroup a => a -> a -> a
<> QuerySuffix -> StringSQL
rowConsStringSQL QuerySuffix
cols  where
    cols :: QuerySuffix
cols = Record Any r' -> QuerySuffix
forall c r. Record c r -> QuerySuffix
Record.columns (Record Any r' -> QuerySuffix)
-> (Pi r r' -> Record Any r') -> Pi r r' -> QuerySuffix
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PersistableRecordWidth r
-> Record Any r -> Pi r r' -> Record Any r'
forall a c b.
PersistableRecordWidth a -> Record c a -> Pi a b -> Record c b
Record.wpi (Table r -> PersistableRecordWidth r
forall r. Table r -> PersistableRecordWidth r
recordWidth Table r
table) (Table r -> Record Any r
forall r c. Table r -> Record c r
Record.unsafeFromTable Table r
table) (Pi r r' -> QuerySuffix) -> Pi r r' -> QuerySuffix
forall a b. (a -> b) -> a -> b
$ Pi r r'
pi'

-- | Generate all column delete SQL by specified table. Untyped table version.
deletePrefixSQL' :: String -> StringSQL
deletePrefixSQL' :: String -> StringSQL
deletePrefixSQL' String
table = StringSQL
DELETE StringSQL -> StringSQL -> StringSQL
forall a. Semigroup a => a -> a -> a
<> StringSQL
FROM StringSQL -> StringSQL -> StringSQL
forall a. Semigroup a => a -> a -> a
<> String -> StringSQL
stringSQL String
table

-- | Generate all column delete SQL by specified table.
deletePrefixSQL :: Table r   -- ^ Table metadata
                -> StringSQL -- ^ Result SQL
deletePrefixSQL :: Table r -> StringSQL
deletePrefixSQL = String -> StringSQL
deletePrefixSQL' (String -> StringSQL)
-> (Table r -> String) -> Table r -> StringSQL
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Table r -> String
forall r. Table r -> String
name