-- |
-- Module      : Database.Relational.Internal.Literal
-- Copyright   : 2019 Kei Hibino
-- License     : BSD3
--
-- Maintainer  : ex8k.hibino@gmail.com
-- Stability   : experimental
-- Portability : unknown
--
-- This module provides definitions to lift haskell expressions
-- into SQL expressions.
module Database.Relational.Internal.Literal (
  stringExpr,
  bool, integral, timestamp,
  ) where

import Data.Monoid ((<>))
import Data.Time (FormatTime, formatTime)
import Data.Time.Locale.Compat (defaultTimeLocale)

import Language.SQL.Keyword (Keyword)

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


-- | Escape 'String' for constant SQL string expression.
escapeStringToSqlExpr :: String -> String
escapeStringToSqlExpr :: String -> String
escapeStringToSqlExpr = String -> String
rec where
  rec :: String -> String
rec String
""        = String
""
  rec (Char
'\'':String
cs) = Char
'\'' forall a. a -> [a] -> [a]
: Char
'\'' forall a. a -> [a] -> [a]
: String -> String
rec String
cs
  rec (Char
c:String
cs)    = Char
c forall a. a -> [a] -> [a]
: String -> String
rec String
cs

-- | From 'String' into constant SQL string expression.
stringExpr :: String -> StringSQL
stringExpr :: String -> StringSQL
stringExpr = String -> StringSQL
stringSQL forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
'\'' forall a. a -> [a] -> [a]
:) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. [a] -> [a] -> [a]
++ String
"'") forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
escapeStringToSqlExpr

-- | SQL expressions for Bool type.
bool :: Bool -> StringSQL
bool :: Bool -> StringSQL
bool =
    String -> StringSQL
stringSQL forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> String
d
  where
    d :: Bool -> String
d Bool
True  = String
"(0=0)"
    d Bool
False = String
"(0=1)"

-- | Constant integral SQL term.
integral :: (Show a, Integral a) => a -> StringSQL
integral :: forall a. (Show a, Integral a) => a -> StringSQL
integral = String -> StringSQL
stringSQL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show

timestamp :: FormatTime t => Keyword -> String -> t -> StringSQL
timestamp :: forall t. FormatTime t => StringSQL -> String -> t -> StringSQL
timestamp StringSQL
kw String
fmt t
t = StringSQL
kw forall a. Semigroup a => a -> a -> a
<> String -> StringSQL
stringExpr (forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
fmt t
t)