{-# LANGUAGE Strict #-}

{-|
  Module      : Database.PostgreSQL.Entity.Internal
  Copyright   : © Clément Delafargue, 2018
                  Théophile Choutri, 2021
  License     : MIT
  Maintainer  : theophile@choutri.eu
  Stability   : stable

  Internal helpers used to implement the high-level API and SQL combinators.

  You can re-use those building blocks freely to create your own wrappers.
-}
module Database.PostgreSQL.Entity.Internal
  ( -- * Helpers
    isNotNull
  , isNull
  , isIn
  , inParens
  , quoteName
  , literal
  , getTableName
  , getFieldName
  , getPrimaryKey
  , prefix
  , expandFields
  , expandQualifiedFields
  , expandQualifiedFields'
  , qualifyField
  , qualifyFields
  , placeholder
  , placeholder'
  , generatePlaceholders
  , textToQuery
  , queryToText
  , intercalateVector
  , renderSortExpression
  )
where

import Data.String (fromString)
import Data.Text (Text, unpack)
import Data.Text.Encoding (decodeUtf8)
import Data.Vector (Vector)
import qualified Data.Vector as V
import Database.PostgreSQL.Simple.Types (Query (..))

import Data.Foldable (fold)
import qualified Data.Text as T
import Data.Text.Display (display)
import Database.PostgreSQL.Entity.Internal.Unsafe (Field (Field))
import Database.PostgreSQL.Entity.Types

{- $setup
 >>> :set -XQuasiQuotes
 >>> :set -XOverloadedLists
 >>> :set -XTypeApplications
 >>> import Database.PostgreSQL.Entity
 >>> import Database.PostgreSQL.Entity.Types
 >>> import Database.PostgreSQL.Entity.Internal.BlogPost
 >>> import Database.PostgreSQL.Entity.Internal.QQ
 >>> import Database.PostgreSQL.Entity.Internal.Unsafe
-}

{-| Wrap the given text between parentheses

 __Examples__

 >>> inParens "wrap me!"
 "(wrap me!)"

 @since 0.0.1.0
-}
inParens :: Text -> Text
inParens :: Text -> Text
inParens Text
t = Text
"(" forall a. Semigroup a => a -> a -> a
<> Text
t forall a. Semigroup a => a -> a -> a
<> Text
")"

{-| Wrap the given text between double quotes

 __Examples__

 >>> quoteName "meow."
 "\"meow.\""

 @since 0.0.1.0
-}
quoteName :: Text -> Text
quoteName :: Text -> Text
quoteName Text
n = Text
"\"" forall a. Semigroup a => a -> a -> a
<> Text
n forall a. Semigroup a => a -> a -> a
<> Text
"\""

{-| Wrap the given text between single quotes, for literal text in an SQL query.

 __Examples__

 >>> literal "meow."
 "'meow.'"

 @since 0.0.2.0
-}
literal :: Text -> Text
literal :: Text -> Text
literal Text
n = Text
"\'" forall a. Semigroup a => a -> a -> a
<> Text -> Text
escapeSingleQuotes Text
n forall a. Semigroup a => a -> a -> a
<> Text
"\'"
  where
    escapeSingleQuotes :: Text -> Text
escapeSingleQuotes Text
x = HasCallStack => Text -> Text -> Text -> Text
T.replace Text
"'" Text
"''" Text
x

{-| Safe getter that quotes a table name

 __Examples__

 >>> getTableName @Author
 "\"authors\""
 >>> getTableName @Tags
 "public.\"tags\""

 @since 0.0.1.0
-}
getTableName :: forall e. Entity e => Text
getTableName :: forall e. Entity e => Text
getTableName = Maybe Text -> Text
prefix (forall e. Entity e => Maybe Text
schema @e) forall a. Semigroup a => a -> a -> a
<> Text -> Text
quoteName (forall e. Entity e => Text
tableName @e)

{-| Safe getter that quotes a table's primary key

 __Examples__

 >>> getPrimaryKey @Author
 "\"author_id\""
 >>> getPrimaryKey @Tags
 "\"category\""

 @since 0.0.2.0
-}
getPrimaryKey :: forall e. Entity e => Text
getPrimaryKey :: forall e. Entity e => Text
getPrimaryKey = Field -> Text
getFieldName forall a b. (a -> b) -> a -> b
$ forall e. Entity e => Field
primaryKey @e

prefix :: Maybe Text -> Text
prefix :: Maybe Text -> Text
prefix = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" (forall a. Semigroup a => a -> a -> a
<> Text
".")

{-| Accessor to the name of a field, with quotation.

 >>> getFieldName ([field| author_id |])
 "\"author_id\""

 @since 0.0.2.0
-}
getFieldName :: Field -> Text
getFieldName :: Field -> Text
getFieldName = Text -> Text
quoteName forall b c a. (b -> c) -> (a -> b) -> a -> c
. Field -> Text
fieldName

{-| Produce a comma-separated list of an entity's fields.

 __Examples__

 >>> expandFields @BlogPost
 "\"blogpost_id\", \"author_id\", \"uuid_list\", \"title\", \"content\", \"created_at\""

 @since 0.0.1.0
-}
expandFields :: forall e. Entity e => Text
expandFields :: forall e. Entity e => Text
expandFields = forall a. (a -> a -> a) -> Vector a -> a
V.foldl1' (\Text
element Text
acc -> Text
element forall a. Semigroup a => a -> a -> a
<> Text
", " forall a. Semigroup a => a -> a -> a
<> Text
acc) (Field -> Text
getFieldName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e. Entity e => Vector Field
fields @e)

{-| Produce a comma-separated list of an entity's fields, qualified with the table name

 __Examples__

 >>> expandQualifiedFields @BlogPost
 "blogposts.\"blogpost_id\", blogposts.\"author_id\", blogposts.\"uuid_list\", blogposts.\"title\", blogposts.\"content\", blogposts.\"created_at\""

 @since 0.0.1.0
-}
expandQualifiedFields :: forall e. Entity e => Text
expandQualifiedFields :: forall e. Entity e => Text
expandQualifiedFields = Vector Field -> Text -> Text
expandQualifiedFields' (forall e. Entity e => Vector Field
fields @e) Text
prefixName
  where
    prefixName :: Text
prefixName = forall e. Entity e => Text
tableName @e

{-| Produce a comma-separated list of an entity's 'fields', qualified with an arbitrary prefix

 __Examples__

 >>> expandQualifiedFields' (fields @BlogPost) "legacy"
 "legacy.\"blogpost_id\", legacy.\"author_id\", legacy.\"uuid_list\", legacy.\"title\", legacy.\"content\", legacy.\"created_at\""

 @since 0.0.1.0
-}
expandQualifiedFields' :: Vector Field -> Text -> Text
expandQualifiedFields' :: Vector Field -> Text -> Text
expandQualifiedFields' Vector Field
fs Text
prefixName = forall a. (a -> a -> a) -> Vector a -> a
V.foldl1' (\Text
element Text
acc -> Text
element forall a. Semigroup a => a -> a -> a
<> Text
", " forall a. Semigroup a => a -> a -> a
<> Text
acc) Vector Text
fs'
  where
    fs' :: Vector Text
fs' = Field -> Text
fieldName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Vector Field -> Vector Field
qualifyFields Text
prefixName Vector Field
fs

--

{-| Take a prefix and a vector of fields, and qualifies each field with the prefix

 __Examples__

 >>> qualifyField @Author [field| name |]
 "authors.\"name\""

 @since 0.0.2.0
-}
qualifyField :: forall e. Entity e => Field -> Text
qualifyField :: forall e. Entity e => Field -> Text
qualifyField Field
f = (\(Field Text
fName Maybe Text
_) -> Text
p forall a. Semigroup a => a -> a -> a
<> Text
"." forall a. Semigroup a => a -> a -> a
<> Text -> Text
quoteName Text
fName) Field
f
  where
    p :: Text
p = forall e. Entity e => Text
tableName @e

{-| Take a prefix and a vector of fields, and qualifies each field with the prefix

 __Examples__

 >>> qualifyFields "legacy" (fields @BlogPost)
 [Field "legacy.\"blogpost_id\"" Nothing,Field "legacy.\"author_id\"" Nothing,Field "legacy.\"uuid_list\"" Nothing,Field "legacy.\"title\"" Nothing,Field "legacy.\"content\"" Nothing,Field "legacy.\"created_at\"" Nothing]

 @since 0.0.1.0
-}
qualifyFields :: Text -> Vector Field -> Vector Field
qualifyFields :: Text -> Vector Field -> Vector Field
qualifyFields Text
p Vector Field
fs = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Field Text
f Maybe Text
t) -> Text -> Maybe Text -> Field
Field (Text
p forall a. Semigroup a => a -> a -> a
<> Text
"." forall a. Semigroup a => a -> a -> a
<> Text -> Text
quoteName Text
f) Maybe Text
t) Vector Field
fs

{-| Produce a placeholder of the form @\"field\" = ?@ with an optional type annotation.

 __Examples__

 >>> placeholder [field| id |]
 "\"id\" = ?"

 >>> placeholder $ [field| ids |]
 "\"ids\" = ?"

 >>> fmap placeholder $ fields @BlogPost
 ["\"blogpost_id\" = ?","\"author_id\" = ?","\"uuid_list\" = ?","\"title\" = ?","\"content\" = ?","\"created_at\" = ?"]

 @since 0.0.1.0
-}
placeholder :: Field -> Text
placeholder :: Field -> Text
placeholder (Field Text
f Maybe Text
Nothing) = Text -> Text
quoteName Text
f forall a. Semigroup a => a -> a -> a
<> Text
" = ?"
placeholder (Field Text
f (Just Text
t)) = Text -> Text
quoteName Text
f forall a. Semigroup a => a -> a -> a
<> Text
" = ?::" forall a. Semigroup a => a -> a -> a
<> Text
t

{-| Produce a placeholder of the form @table.\"field\" = ?@ with an optional type annotation.

 __Examples__

 >>> placeholder' @BlogPost [field| id |]
 "blogposts.\"id\" = ?"

 >>> placeholder' @BlogPost $ [field| ids |]
 "blogposts.\"ids\" = ?"

 @since 0.0.2.0
-}
placeholder' :: forall e. Entity e => Field -> Text
placeholder' :: forall e. Entity e => Field -> Text
placeholder' f :: Field
f@(Field Text
_ (Just Text
t)) = forall e. Entity e => Field -> Text
qualifyField @e Field
f forall a. Semigroup a => a -> a -> a
<> Text
" = ?::" forall a. Semigroup a => a -> a -> a
<> Text
t
placeholder' Field
f = forall e. Entity e => Field -> Text
qualifyField @e Field
f forall a. Semigroup a => a -> a -> a
<> Text
" = ?"

{-| Generate an appropriate number of “?” placeholders given a vector of fields.

 Used to generate INSERT queries.

 __Examples__

 >>> generatePlaceholders $ fields @BlogPost
 "?, ?, ?, ?, ?, ?"

 @since 0.0.1.0
-}
generatePlaceholders :: Vector Field -> Text
generatePlaceholders :: Vector Field -> Text
generatePlaceholders Vector Field
vf = forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold forall a b. (a -> b) -> a -> b
$ Text -> Vector Text -> Vector Text
intercalateVector Text
", " forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Field -> Text
ph Vector Field
vf
  where
    ph :: Field -> Text
ph (Field Text
_ Maybe Text
t) = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"?" (\Text
t' -> Text
"?::" forall a. Semigroup a => a -> a -> a
<> Text
t') Maybe Text
t

{-| Produce an IS NOT NULL statement given a vector of fields

 >>> isNotNull [ [field| possibly_empty |] ]
 "\"possibly_empty\" IS NOT NULL"

 >>> isNotNull [[field| possibly_empty |], [field| that_one_too |]]
 "\"possibly_empty\" IS NOT NULL AND \"that_one_too\" IS NOT NULL"

 @since 0.0.1.0
-}
isNotNull :: Vector Field -> Text
isNotNull :: Vector Field -> Text
isNotNull Vector Field
fs' = forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold forall a b. (a -> b) -> a -> b
$ Text -> Vector Text -> Vector Text
intercalateVector Text
" AND " (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Text
process Vector Text
fieldNames)
  where
    fieldNames :: Vector Text
fieldNames = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Field -> Text
fieldName Vector Field
fs'
    process :: Text -> Text
process Text
f = Text -> Text
quoteName Text
f forall a. Semigroup a => a -> a -> a
<> Text
" IS NOT NULL"

{-| Produce an IS NULL statement given a vector of fields

 >>> isNull [ [field| possibly_empty |] ]
 "\"possibly_empty\" IS NULL"

 >>> isNull [[field| possibly_empty |], [field| that_one_too |]]
 "\"possibly_empty\" IS NULL AND \"that_one_too\" IS NULL"

 @since 0.0.1.0
-}
isNull :: Vector Field -> Text
isNull :: Vector Field -> Text
isNull Vector Field
fs' = forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold forall a b. (a -> b) -> a -> b
$ Text -> Vector Text -> Vector Text
intercalateVector Text
" AND " (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Text
process Vector Text
fieldNames)
  where
    fieldNames :: Vector Text
fieldNames = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Field -> Text
fieldName Vector Field
fs'
    process :: Text -> Text
process Text
f = Text -> Text
quoteName Text
f forall a. Semigroup a => a -> a -> a
<> Text
" IS NULL"

isIn :: Field -> Vector Text -> Text
isIn :: Field -> Vector Text -> Text
isIn Field
f Vector Text
values = Field -> Text
process Field
f forall a. Semigroup a => a -> a -> a
<> Text
" IN (" forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (Text -> Vector Text -> Vector Text
intercalateVector Text
", " Vector Text
vals) forall a. Semigroup a => a -> a -> a
<> Text
")"
  where
    vals :: Vector Text
vals = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Text
literal Vector Text
values
    process :: Field -> Text
process Field
f' = Text -> Text
quoteName forall a b. (a -> b) -> a -> b
$ Field -> Text
fieldName Field
f'

{-| Since the 'Query' type has an 'IsString' instance, the process of converting from 'Text' to 'String' to 'Query' is
 factored into this function

 ⚠ This may be dangerous and an unregulated usage of this function may expose to you SQL injection attacks
 @since 0.0.1.0
-}
textToQuery :: Text -> Query
textToQuery :: Text -> Query
textToQuery = forall a. IsString a => String -> a
fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
unpack

{-| For cases where combinator composition is tricky, we can safely get back to a 'Text' string from a 'Query'

 ⚠ This may be dangerous and an unregulated usage of this function may expose to you SQL injection attacks
 @since 0.0.1.0
-}
queryToText :: Query -> Text
queryToText :: Query -> Text
queryToText = ByteString -> Text
decodeUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Query -> ByteString
fromQuery

{-| The 'intercalateVector' function takes a Text and a Vector Text and concatenates the vector after interspersing
 the first argument between each element of the list.

 __Examples__

 >>> intercalateVector "~" []
 []

 >>> intercalateVector "~" ["nyan"]
 ["nyan"]

 >>> intercalateVector "~" ["nyan", "nyan", "nyan"]
 ["nyan","~","nyan","~","nyan"]

 @since 0.0.1.0
-}
intercalateVector :: Text -> Vector Text -> Vector Text
intercalateVector :: Text -> Vector Text -> Vector Text
intercalateVector Text
sep Vector Text
vt
  | forall a. Vector a -> Bool
V.null Vector Text
vt = Vector Text
vt
  | Bool
otherwise = forall a. a -> Vector a -> Vector a
V.cons Text
x (Vector Text -> Vector Text
go Vector Text
xs)
  where
    (Text
x, Vector Text
xs) = (forall a. Vector a -> a
V.head Vector Text
vt, forall a. Vector a -> Vector a
V.tail Vector Text
vt)
    go :: Vector Text -> Vector Text
    go :: Vector Text -> Vector Text
go Vector Text
ys
      | forall a. Vector a -> Bool
V.null Vector Text
ys = Vector Text
ys
      | Bool
otherwise = forall a. a -> Vector a -> Vector a
V.cons Text
sep (forall a. a -> Vector a -> Vector a
V.cons (forall a. Vector a -> a
V.head Vector Text
ys) (Vector Text -> Vector Text
go (forall a. Vector a -> Vector a
V.tail Vector Text
ys)))

{-|

 __Examples__

 >>> renderSortExpression ([field| title |], ASC)
 "\"title\" ASC"

 @since 0.0.2.0
-}
renderSortExpression :: (Field, SortKeyword) -> Text
renderSortExpression :: (Field, SortKeyword) -> Text
renderSortExpression (Field
f, SortKeyword
sort) = (Text -> Text
quoteName forall b c a. (b -> c) -> (a -> b) -> a -> c
. Field -> Text
fieldName) Field
f forall a. Semigroup a => a -> a -> a
<> Text
" " forall a. Semigroup a => a -> a -> a
<> forall a. Display a => a -> Text
display SortKeyword
sort