-- |
-- 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 ""        = ""
  rec ('\'':cs :: String
cs) = '\'' Char -> String -> String
forall a. a -> [a] -> [a]
: '\'' Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
rec String
cs
  rec (c :: Char
c:cs :: String
cs)    = Char
c Char -> String -> String
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 (String -> StringSQL) -> (String -> String) -> String -> StringSQL
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ('\'' Char -> String -> String
forall a. a -> [a] -> [a]
:) (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String -> String
forall a. [a] -> [a] -> [a]
++ "'") (String -> String) -> (String -> String) -> String -> 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 (String -> StringSQL) -> (Bool -> String) -> Bool -> StringSQL
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> String
d
  where
    d :: Bool -> String
d True  = "(0=0)"
    d False = "(0=1)"

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

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