{-# 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
  , inParens
  , quoteName
  , getTableName
  , expandFields
  , expandQualifiedFields
  , expandQualifiedFields'
  , qualifyFields
  , placeholder
  , generatePlaceholders
  , textToQuery
  , queryToText
  , intercalateVector
  ) 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 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.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
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t Text -> Text -> Text
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
"\"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
n Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\""

-- | Safe getter that quotes a table name
--
-- __Examples__
--
-- >>> getTableName @Author
-- "\"authors\""
getTableName :: forall e. Entity e => Text
getTableName :: Text
getTableName = Text -> Text
quoteName (Entity e => Text
forall e. Entity e => Text
tableName @e)

getFieldName :: Field -> Text
getFieldName :: Field -> Text
getFieldName = Text -> Text
quoteName (Text -> Text) -> (Field -> Text) -> Field -> Text
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 :: Text
expandFields = (Text -> Text -> Text) -> Vector Text -> Text
forall a. (a -> a -> a) -> Vector a -> a
V.foldl1' (\Text
element Text
acc -> Text
element Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
acc) (Field -> Text
getFieldName (Field -> Text) -> Vector Field -> Vector Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Entity e => Vector Field
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 :: Text
expandQualifiedFields = Vector Field -> Text -> Text
expandQualifiedFields' (Entity e => Vector Field
forall e. Entity e => Vector Field
fields @e) Text
prefix
  where
    prefix :: Text
prefix = Entity e => Text
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
prefix = (Text -> Text -> Text) -> Vector Text -> Text
forall a. (a -> a -> a) -> Vector a -> a
V.foldl1' (\Text
element Text
acc -> Text
element Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
acc) Vector Text
fs'
  where
    fs' :: Vector Text
fs' = Field -> Text
fieldName (Field -> Text) -> Vector Field -> Vector Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Vector Field -> Vector Field
qualifyFields Text
prefix Vector Field
fs

-- | 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\"" (Just "uuid[]"),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 = (Field -> Field) -> Vector Field -> Vector Field
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 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> 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 :: uuid[] |]
-- "\"ids\" = ?::uuid[]"
--
-- >>> fmap placeholder $ fields @BlogPost
-- ["\"blogpost_id\" = ?","\"author_id\" = ?","\"uuid_list\" = ?::uuid[]","\"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 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" = ?"
placeholder (Field Text
f (Just Text
t)) = Text -> Text
quoteName Text
f Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" = ?::" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t

-- | Generate an appropriate number of “?” placeholders given a vector of fields.
--
-- Used to generate INSERT queries.
--
-- __Examples__
--
-- >>> generatePlaceholders $ fields @BlogPost
-- "?, ?, ?::uuid[], ?, ?, ?"
--
-- @since 0.0.1.0
generatePlaceholders :: Vector Field -> Text
generatePlaceholders :: Vector Field -> Text
generatePlaceholders Vector Field
vf = Vector Text -> Text
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (Vector Text -> Text) -> Vector Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Vector Text -> Vector Text
intercalateVector Text
", " (Vector Text -> Vector Text) -> Vector Text -> Vector Text
forall a b. (a -> b) -> a -> b
$ (Field -> Text) -> Vector Field -> Vector Text
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) = Text -> (Text -> Text) -> Maybe Text -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"?" (\Text
t' -> Text
"?::" Text -> Text -> 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' = Vector Text -> Text
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (Vector Text -> Text) -> Vector Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Vector Text -> Vector Text
intercalateVector Text
" AND " ((Text -> Text) -> Vector Text -> Vector Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Text
process Vector Text
fieldNames)
  where
    fieldNames :: Vector Text
fieldNames = (Field -> Text) -> Vector Field -> Vector Text
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 Text -> Text -> Text
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' = Vector Text -> Text
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (Vector Text -> Text) -> Vector Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Vector Text -> Vector Text
intercalateVector Text
" AND " ((Text -> Text) -> Vector Text -> Vector Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Text
process Vector Text
fieldNames)
  where
    fieldNames :: Vector Text
fieldNames = (Field -> Text) -> Vector Field -> Vector Text
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 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" IS NULL"

-- | 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 = String -> Query
forall a. IsString a => String -> a
fromString (String -> Query) -> (Text -> String) -> Text -> Query
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 (ByteString -> Text) -> (Query -> ByteString) -> Query -> Text
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 | Vector Text -> Bool
forall a. Vector a -> Bool
V.null Vector Text
vt = Vector Text
vt
                         | Bool
otherwise = Text -> Vector Text -> Vector Text
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) = (Vector Text -> Text
forall a. Vector a -> a
V.head Vector Text
vt, Vector Text -> Vector Text
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 | Vector Text -> Bool
forall a. Vector a -> Bool
V.null Vector Text
ys = Vector Text
ys
          | Bool
otherwise = Text -> Vector Text -> Vector Text
forall a. a -> Vector a -> Vector a
V.cons Text
sep (Text -> Vector Text -> Vector Text
forall a. a -> Vector a -> Vector a
V.cons (Vector Text -> Text
forall a. Vector a -> a
V.head Vector Text
ys) (Vector Text -> Vector Text
go (Vector Text -> Vector Text
forall a. Vector a -> Vector a
V.tail Vector Text
ys)))