{-# language DataKinds #-}

module Rel8.Expr.Text
  (
    -- * String concatenation
    (++.)

    -- * Regular expression operators
  , (~.), (~*), (!~), (!~*)

    -- * Standard SQL functions
  , bitLength, charLength, lower, octetLength, upper

    -- * PostgreSQL functions
  , ascii, btrim, chr, convert, convertFrom, convertTo, decode, encode
  , initcap, left, length, lengthEncoding, lpad, ltrim, md5
  , pgClientEncoding, quoteIdent, quoteLiteral, quoteNullable, regexpReplace
  , regexpSplitToArray, repeat, replace, reverse, right, rpad, rtrim
  , splitPart, strpos, substr, translate
  )
where

-- base
import Data.Bool ( Bool )
import Data.Int ( Int32 )
import Data.Maybe ( Maybe( Nothing, Just ) )
import Prelude ()

-- bytestring
import Data.ByteString ( ByteString )

-- rel8
import Rel8.Expr ( Expr )
import Rel8.Expr.Function ( binaryOperator, function, nullaryFunction )

-- text
import Data.Text (Text)


-- | The PostgreSQL string concatenation operator.
(++.) :: Expr Text -> Expr Text -> Expr Text
++. :: Expr Text -> Expr Text -> Expr Text
(++.) = String -> Expr Text -> Expr Text -> Expr Text
forall c a b. Sql DBType c => String -> Expr a -> Expr b -> Expr c
binaryOperator String
"||"
infixr 6 ++.


-- * Regular expression operators

-- See https://www.postgresql.org/docs/9.5/static/functions-matching.html#FUNCTIONS-POSIX-REGEXP


-- | Matches regular expression, case sensitive
-- 
-- Corresponds to the @~.@ operator.
(~.) :: Expr Text -> Expr Text -> Expr Bool
~. :: Expr Text -> Expr Text -> Expr Bool
(~.) = String -> Expr Text -> Expr Text -> Expr Bool
forall c a b. Sql DBType c => String -> Expr a -> Expr b -> Expr c
binaryOperator String
"~."
infix 2 ~.


-- | Matches regular expression, case insensitive
--
-- Corresponds to the @~*@ operator.
(~*) :: Expr Text -> Expr Text -> Expr Bool
~* :: Expr Text -> Expr Text -> Expr Bool
(~*) = String -> Expr Text -> Expr Text -> Expr Bool
forall c a b. Sql DBType c => String -> Expr a -> Expr b -> Expr c
binaryOperator String
"~*"
infix 2 ~*


-- | Does not match regular expression, case sensitive
--
-- Corresponds to the @!~@ operator.
(!~) :: Expr Text -> Expr Text -> Expr Bool
!~ :: Expr Text -> Expr Text -> Expr Bool
(!~) = String -> Expr Text -> Expr Text -> Expr Bool
forall c a b. Sql DBType c => String -> Expr a -> Expr b -> Expr c
binaryOperator String
"!~"
infix 2 !~


-- | Does not match regular expression, case insensitive
--
-- Corresponds to the @!~*@ operator.
(!~*) :: Expr Text -> Expr Text -> Expr Bool
!~* :: Expr Text -> Expr Text -> Expr Bool
(!~*) = String -> Expr Text -> Expr Text -> Expr Bool
forall c a b. Sql DBType c => String -> Expr a -> Expr b -> Expr c
binaryOperator String
"!~*"
infix 2 !~*


-- See https://www.postgresql.org/docs/9.5/static/functions-Expr.'PGHtml

-- * Standard SQL functions


-- | Corresponds to the @bit_length@ function.
bitLength :: Expr Text -> Expr Int32
bitLength :: Expr Text -> Expr Int32
bitLength = String -> Expr Text -> Expr Int32
forall args result.
Function args result =>
String -> args -> result
function String
"bit_length"


-- | Corresponds to the @char_length@ function.
charLength :: Expr Text -> Expr Int32
charLength :: Expr Text -> Expr Int32
charLength = String -> Expr Text -> Expr Int32
forall args result.
Function args result =>
String -> args -> result
function String
"char_length"


-- | Corresponds to the @lower@ function.
lower :: Expr Text -> Expr Text
lower :: Expr Text -> Expr Text
lower = String -> Expr Text -> Expr Text
forall args result.
Function args result =>
String -> args -> result
function String
"lower"


-- | Corresponds to the @octet_length@ function.
octetLength :: Expr Text -> Expr Int32
octetLength :: Expr Text -> Expr Int32
octetLength = String -> Expr Text -> Expr Int32
forall args result.
Function args result =>
String -> args -> result
function String
"octet_length"


-- | Corresponds to the @upper@ function.
upper :: Expr Text -> Expr Text
upper :: Expr Text -> Expr Text
upper = String -> Expr Text -> Expr Text
forall args result.
Function args result =>
String -> args -> result
function String
"upper"


-- | Corresponds to the @ascii@ function.
ascii :: Expr Text -> Expr Int32
ascii :: Expr Text -> Expr Int32
ascii = String -> Expr Text -> Expr Int32
forall args result.
Function args result =>
String -> args -> result
function String
"ascii"


-- | Corresponds to the @btrim@ function.
btrim :: Expr Text -> Maybe (Expr Text) -> Expr Text
btrim :: Expr Text -> Maybe (Expr Text) -> Expr Text
btrim Expr Text
a (Just Expr Text
b) = String -> Expr Text -> Expr Text -> Expr Text
forall args result.
Function args result =>
String -> args -> result
function String
"btrim" Expr Text
a Expr Text
b
btrim Expr Text
a Maybe (Expr Text)
Nothing = String -> Expr Text -> Expr Text
forall args result.
Function args result =>
String -> args -> result
function String
"btrim" Expr Text
a


-- | Corresponds to the @chr@ function.
chr :: Expr Int32 -> Expr Text
chr :: Expr Int32 -> Expr Text
chr = String -> Expr Int32 -> Expr Text
forall args result.
Function args result =>
String -> args -> result
function String
"chr"


-- | Corresponds to the @convert@ function.
convert :: Expr ByteString -> Expr Text -> Expr Text -> Expr ByteString
convert :: Expr ByteString -> Expr Text -> Expr Text -> Expr ByteString
convert = String
-> Expr ByteString -> Expr Text -> Expr Text -> Expr ByteString
forall args result.
Function args result =>
String -> args -> result
function String
"convert"


-- | Corresponds to the @convert_from@ function.
convertFrom :: Expr ByteString -> Expr Text -> Expr Text
convertFrom :: Expr ByteString -> Expr Text -> Expr Text
convertFrom = String -> Expr ByteString -> Expr Text -> Expr Text
forall args result.
Function args result =>
String -> args -> result
function String
"convert_from"


-- | Corresponds to the @convert_to@ function.
convertTo :: Expr Text -> Expr Text -> Expr ByteString
convertTo :: Expr Text -> Expr Text -> Expr ByteString
convertTo = String -> Expr Text -> Expr Text -> Expr ByteString
forall args result.
Function args result =>
String -> args -> result
function String
"convert_to"


-- | Corresponds to the @decode@ function.
decode :: Expr Text -> Expr Text -> Expr ByteString
decode :: Expr Text -> Expr Text -> Expr ByteString
decode = String -> Expr Text -> Expr Text -> Expr ByteString
forall args result.
Function args result =>
String -> args -> result
function String
"decode"


-- | Corresponds to the @encode@ function.
encode :: Expr ByteString -> Expr Text -> Expr Text
encode :: Expr ByteString -> Expr Text -> Expr Text
encode = String -> Expr ByteString -> Expr Text -> Expr Text
forall args result.
Function args result =>
String -> args -> result
function String
"encode"


-- | Corresponds to the @initcap@ function.
initcap :: Expr Text -> Expr Text
initcap :: Expr Text -> Expr Text
initcap = String -> Expr Text -> Expr Text
forall args result.
Function args result =>
String -> args -> result
function String
"initcap"


-- | Corresponds to the @left@ function.
left :: Expr Text -> Expr Int32 -> Expr Text
left :: Expr Text -> Expr Int32 -> Expr Text
left = String -> Expr Text -> Expr Int32 -> Expr Text
forall args result.
Function args result =>
String -> args -> result
function String
"left"


-- | Corresponds to the @length@ function.
length :: Expr Text -> Expr Int32
length :: Expr Text -> Expr Int32
length = String -> Expr Text -> Expr Int32
forall args result.
Function args result =>
String -> args -> result
function String
"length"


-- | Corresponds to the @length@ function.
lengthEncoding :: Expr ByteString -> Expr Text -> Expr Int32
lengthEncoding :: Expr ByteString -> Expr Text -> Expr Int32
lengthEncoding = String -> Expr ByteString -> Expr Text -> Expr Int32
forall args result.
Function args result =>
String -> args -> result
function String
"length"


-- | Corresponds to the @lpad@ function.
lpad :: Expr Text -> Expr Int32 -> Maybe (Expr Text) -> Expr Text
lpad :: Expr Text -> Expr Int32 -> Maybe (Expr Text) -> Expr Text
lpad Expr Text
a Expr Int32
b (Just Expr Text
c) = String -> Expr Text -> Expr Int32 -> Expr Text -> Expr Text
forall args result.
Function args result =>
String -> args -> result
function String
"lpad" Expr Text
a Expr Int32
b Expr Text
c
lpad Expr Text
a Expr Int32
b Maybe (Expr Text)
Nothing = String -> Expr Text -> Expr Int32 -> Expr Text
forall args result.
Function args result =>
String -> args -> result
function String
"lpad" Expr Text
a Expr Int32
b


-- | Corresponds to the @ltrim@ function.
ltrim :: Expr Text -> Maybe (Expr Text) -> Expr Text
ltrim :: Expr Text -> Maybe (Expr Text) -> Expr Text
ltrim Expr Text
a (Just Expr Text
b) = String -> Expr Text -> Expr Text -> Expr Text
forall args result.
Function args result =>
String -> args -> result
function String
"ltrim" Expr Text
a Expr Text
b
ltrim Expr Text
a Maybe (Expr Text)
Nothing = String -> Expr Text -> Expr Text
forall args result.
Function args result =>
String -> args -> result
function String
"ltrim" Expr Text
a


-- | Corresponds to the @md5@ function.
md5 :: Expr Text -> Expr Text
md5 :: Expr Text -> Expr Text
md5 = String -> Expr Text -> Expr Text
forall args result.
Function args result =>
String -> args -> result
function String
"md5"


-- | Corresponds to the @pg_client_encoding()@ expression.
pgClientEncoding :: Expr Text
pgClientEncoding :: Expr Text
pgClientEncoding = String -> Expr Text
forall a. Sql DBType a => String -> Expr a
nullaryFunction String
"pg_client_encoding"


-- | Corresponds to the @quote_ident@ function.
quoteIdent :: Expr Text -> Expr Text
quoteIdent :: Expr Text -> Expr Text
quoteIdent = String -> Expr Text -> Expr Text
forall args result.
Function args result =>
String -> args -> result
function String
"quote_ident"


-- | Corresponds to the @quote_literal@ function.
quoteLiteral :: Expr Text -> Expr Text
quoteLiteral :: Expr Text -> Expr Text
quoteLiteral = String -> Expr Text -> Expr Text
forall args result.
Function args result =>
String -> args -> result
function String
"quote_literal"


-- | Corresponds to the @quote_nullable@ function.
quoteNullable :: Expr Text -> Expr Text
quoteNullable :: Expr Text -> Expr Text
quoteNullable = String -> Expr Text -> Expr Text
forall args result.
Function args result =>
String -> args -> result
function String
"quote_nullable"


-- | Corresponds to the @regexp_replace@ function.
regexpReplace :: ()
  => Expr Text -> Expr Text -> Expr Text -> Maybe (Expr Text) -> Expr Text
regexpReplace :: Expr Text
-> Expr Text -> Expr Text -> Maybe (Expr Text) -> Expr Text
regexpReplace Expr Text
a Expr Text
b Expr Text
c (Just Expr Text
d) = String
-> Expr Text -> Expr Text -> Expr Text -> Expr Text -> Expr Text
forall args result.
Function args result =>
String -> args -> result
function String
"regexp_replace" Expr Text
a Expr Text
b Expr Text
c Expr Text
d
regexpReplace Expr Text
a Expr Text
b Expr Text
c Maybe (Expr Text)
Nothing = String -> Expr Text -> Expr Text -> Expr Text -> Expr Text
forall args result.
Function args result =>
String -> args -> result
function String
"regexp_replace" Expr Text
a Expr Text
b Expr Text
c


-- | Corresponds to the @regexp_split_to_array@ function.
regexpSplitToArray :: ()
  => Expr Text -> Expr Text -> Maybe (Expr Text) -> Expr [Text]
regexpSplitToArray :: Expr Text -> Expr Text -> Maybe (Expr Text) -> Expr [Text]
regexpSplitToArray Expr Text
a Expr Text
b (Just Expr Text
c) = String -> Expr Text -> Expr Text -> Expr Text -> Expr [Text]
forall args result.
Function args result =>
String -> args -> result
function String
"regexp_split_to_array" Expr Text
a Expr Text
b Expr Text
c
regexpSplitToArray Expr Text
a Expr Text
b Maybe (Expr Text)
Nothing = String -> Expr Text -> Expr Text -> Expr [Text]
forall args result.
Function args result =>
String -> args -> result
function String
"regexp_split_to_array" Expr Text
a Expr Text
b


-- | Corresponds to the @repeat@ function.
repeat :: Expr Text -> Expr Int32 -> Expr Text
repeat :: Expr Text -> Expr Int32 -> Expr Text
repeat = String -> Expr Text -> Expr Int32 -> Expr Text
forall args result.
Function args result =>
String -> args -> result
function String
"repeat"


-- | Corresponds to the @replace@ function.
replace :: Expr Text -> Expr Text -> Expr Text -> Expr Text
replace :: Expr Text -> Expr Text -> Expr Text -> Expr Text
replace = String -> Expr Text -> Expr Text -> Expr Text -> Expr Text
forall args result.
Function args result =>
String -> args -> result
function String
"replace"


-- | Corresponds to the @reverse@ function.
reverse :: Expr Text -> Expr Text
reverse :: Expr Text -> Expr Text
reverse = String -> Expr Text -> Expr Text
forall args result.
Function args result =>
String -> args -> result
function String
"reverse"


-- | Corresponds to the @right@ function.
right :: Expr Text -> Expr Int32 -> Expr Text
right :: Expr Text -> Expr Int32 -> Expr Text
right = String -> Expr Text -> Expr Int32 -> Expr Text
forall args result.
Function args result =>
String -> args -> result
function String
"right"


-- | Corresponds to the @rpad@ function.
rpad :: Expr Text -> Expr Int32 -> Maybe (Expr Text) -> Expr Text
rpad :: Expr Text -> Expr Int32 -> Maybe (Expr Text) -> Expr Text
rpad Expr Text
a Expr Int32
b (Just Expr Text
c) = String -> Expr Text -> Expr Int32 -> Expr Text -> Expr Text
forall args result.
Function args result =>
String -> args -> result
function String
"rpad" Expr Text
a Expr Int32
b Expr Text
c
rpad Expr Text
a Expr Int32
b Maybe (Expr Text)
Nothing = String -> Expr Text -> Expr Int32 -> Expr Text
forall args result.
Function args result =>
String -> args -> result
function String
"rpad" Expr Text
a Expr Int32
b


-- | Corresponds to the @rtrim@ function.
rtrim :: Expr Text -> Maybe (Expr Text) -> Expr Text
rtrim :: Expr Text -> Maybe (Expr Text) -> Expr Text
rtrim Expr Text
a (Just Expr Text
b) = String -> Expr Text -> Expr Text -> Expr Text
forall args result.
Function args result =>
String -> args -> result
function String
"rtrim" Expr Text
a Expr Text
b
rtrim Expr Text
a Maybe (Expr Text)
Nothing = String -> Expr Text -> Expr Text
forall args result.
Function args result =>
String -> args -> result
function String
"rtrim" Expr Text
a


-- | Corresponds to the @split_part@ function.
splitPart :: Expr Text -> Expr Text -> Expr Int32 -> Expr Text
splitPart :: Expr Text -> Expr Text -> Expr Int32 -> Expr Text
splitPart = String -> Expr Text -> Expr Text -> Expr Int32 -> Expr Text
forall args result.
Function args result =>
String -> args -> result
function String
"split_part"


-- | Corresponds to the @strpos@ function.
strpos :: Expr Text -> Expr Text -> Expr Int32
strpos :: Expr Text -> Expr Text -> Expr Int32
strpos = String -> Expr Text -> Expr Text -> Expr Int32
forall args result.
Function args result =>
String -> args -> result
function String
"strpos"


-- | Corresponds to the @substr@ function.
substr :: Expr Text -> Expr Int32 -> Maybe (Expr Int32) -> Expr Text
substr :: Expr Text -> Expr Int32 -> Maybe (Expr Int32) -> Expr Text
substr Expr Text
a Expr Int32
b (Just Expr Int32
c) = String -> Expr Text -> Expr Int32 -> Expr Int32 -> Expr Text
forall args result.
Function args result =>
String -> args -> result
function String
"substr" Expr Text
a Expr Int32
b Expr Int32
c
substr Expr Text
a Expr Int32
b Maybe (Expr Int32)
Nothing = String -> Expr Text -> Expr Int32 -> Expr Text
forall args result.
Function args result =>
String -> args -> result
function String
"substr" Expr Text
a Expr Int32
b


-- | Corresponds to the @translate@ function.
translate :: Expr Text -> Expr Text -> Expr Text -> Expr Text
translate :: Expr Text -> Expr Text -> Expr Text -> Expr Text
translate = String -> Expr Text -> Expr Text -> Expr Text -> Expr Text
forall args result.
Function args result =>
String -> args -> result
function String
"translate"