{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}

-- |
-- Description : Helpers for running queries.
--
-- This module expose some helpers for running postgresql-typed queries. They
-- return the correct amount of results in a Servant handler, or throw a
-- Rollbarred error.
module Postgres.Query
  ( sql,
    Query (..),
    Error (..),
    format,
    details,
  )
where

import Control.Monad (void)
import Data.String (String)
import qualified Data.Text.Encoding
import Database.PostgreSQL.Typed (PGConnection, pgSQL, useTPGDatabase)
import Database.PostgreSQL.Typed.Array ()
import Database.PostgreSQL.Typed.Query (getQueryString, pgQuery)
import qualified Database.PostgreSQL.Typed.Types as PGTypes
import qualified Environment
import Language.Haskell.TH (ExpQ)
import Language.Haskell.TH.Quote
  ( QuasiQuoter (QuasiQuoter, quoteDec, quoteExp, quotePat, quoteType),
  )
import Language.Haskell.TH.Syntax (runIO)
import qualified List
import qualified Log
import qualified Log.SqlQuery as SqlQuery
import Postgres.Error (Error (..))
import qualified Postgres.QueryParser as Parser
import qualified Postgres.Settings
import qualified Text
import Prelude (IO)
import qualified Prelude

-- | A Postgres query. Create one of these using the `sql` quasiquoter.
data Query row = Query
  { -- | Run a query against Postgres
    Query row -> PGConnection -> IO [row]
runQuery :: PGConnection -> IO [row],
    -- | The raw SQL string
    Query row -> Text
sqlString :: Text,
    -- | The query string as extracted from an `sql` quasi quote.
    Query row -> Text
quasiQuotedString :: Text,
    -- | SELECT / INSERT / UPDATE / INSERT ON DUPLICATE KEY UPDATE ...
    Query row -> Text
sqlOperation :: Text,
    -- | The main table/view/.. queried.
    Query row -> Text
queriedRelation :: Text
  }

qqSQL :: String -> ExpQ
qqSQL :: String -> ExpQ
qqSQL String
query = do
  let db :: IO PGDatabase
db =
        Decoder Settings -> IO Settings
forall a. Decoder a -> IO a
Environment.decode Decoder Settings
Postgres.Settings.decoder
          IO Settings -> (IO Settings -> IO PGDatabase) -> IO PGDatabase
forall a b. a -> (a -> b) -> b
|> (Settings -> PGDatabase) -> IO Settings -> IO PGDatabase
forall (m :: * -> *) a value.
Functor m =>
(a -> value) -> m a -> m value
map Settings -> PGDatabase
Postgres.Settings.toPGDatabase
  PGDatabase
db' <- IO PGDatabase -> Q PGDatabase
forall a. IO a -> Q a
runIO IO PGDatabase
db
  Q [Dec] -> Q ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (PGDatabase -> Q [Dec]
useTPGDatabase PGDatabase
db')
  let meta :: QueryMeta
meta = Text -> QueryMeta
Parser.parse (String -> Text
Text.fromList String
query)
  let op :: String
op = Text -> String
Text.toList (QueryMeta -> Text
Parser.sqlOperation QueryMeta
meta)
  let rel :: String
rel = Text -> String
Text.toList (QueryMeta -> Text
Parser.queriedRelation QueryMeta
meta)
  [e|
    let q = $(quoteExp pgSQL query)
     in Query
          { runQuery = \c -> pgQuery c q,
            sqlString = Data.Text.Encoding.decodeUtf8 (getQueryString PGTypes.unknownPGTypeEnv q),
            quasiQuotedString = Text.fromList query,
            sqlOperation = op,
            queriedRelation = rel
          }
    |]

-- | Quasi-quoter that allows you to write plain SQL in your code. The query is
-- checked at compile-time using the 'postgresql-typed' library.
--
-- Requires the QuasiQuotes language extension to be enabled.
--
-- > [sql| SELECT name, breed FROM doggos |]
sql :: QuasiQuoter
sql :: QuasiQuoter
sql =
  QuasiQuoter :: (String -> ExpQ)
-> (String -> Q Pat)
-> (String -> Q Type)
-> (String -> Q [Dec])
-> QuasiQuoter
QuasiQuoter
    { quoteExp :: String -> ExpQ
quoteExp = String -> ExpQ
qqSQL,
      quoteType :: String -> Q Type
quoteType = String -> String -> Q Type
forall a. HasCallStack => String -> a
Prelude.error String
"sql not supported in types",
      quotePat :: String -> Q Pat
quotePat = String -> String -> Q Pat
forall a. HasCallStack => String -> a
Prelude.error String
"sql not supported in patterns",
      quoteDec :: String -> Q [Dec]
quoteDec = String -> String -> Q [Dec]
forall a. HasCallStack => String -> a
Prelude.error String
"sql not supported in declarations"
    }

format :: Query row -> Text.Text
format :: Query row -> Text
format Query row
query =
  let fixBang :: Text -> Text
fixBang Text
query_ =
        case Text -> Maybe (Char, Text)
Text.uncons Text
query_ of
          Just (Char
'!', Text
rest) -> Text
"! " Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Text -> Text
Text.trim Text
rest
          Just (Char, Text)
_ -> Text
query_
          Maybe (Char, Text)
Nothing -> Text
query_
      indent :: appendable -> appendable
indent appendable
string =
        appendable
"    " appendable -> appendable -> appendable
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ appendable
string
   in Query row -> Text
forall row. Query row -> Text
quasiQuotedString Query row
query
        Text -> (Text -> List Text) -> List Text
forall a b. a -> (a -> b) -> b
|> Text -> Text -> List Text
Text.split Text
"\n"
        List Text -> (List Text -> List Text) -> List Text
forall a b. a -> (a -> b) -> b
|> (Text -> Text) -> List Text -> List Text
forall a b. (a -> b) -> List a -> List b
List.map Text -> Text
Text.trim
        List Text -> (List Text -> Text) -> Text
forall a b. a -> (a -> b) -> b
|> Text -> List Text -> Text
Text.join Text
"\n        "
        Text -> (Text -> Text) -> Text
forall a b. a -> (a -> b) -> b
|> Text -> Text
fixBang
        Text -> (Text -> Text) -> Text
forall a b. a -> (a -> b) -> b
|> Text -> Text
forall appendable.
(Semigroup appendable, IsString appendable) =>
appendable -> appendable
indent

details :: Query row -> SqlQuery.Details -> SqlQuery.Details
details :: Query row -> Details -> Details
details Query row
query Details
connectionDetails =
  Details
connectionDetails
    { query :: Maybe (Secret Text)
SqlQuery.query = Secret Text -> Maybe (Secret Text)
forall a. a -> Maybe a
Just (Text -> Secret Text
forall a. a -> Secret a
Log.mkSecret (Query row -> Text
forall row. Query row -> Text
sqlString Query row
query)),
      queryTemplate :: Maybe Text
SqlQuery.queryTemplate = Text -> Maybe Text
forall a. a -> Maybe a
Just (Query row -> Text
forall row. Query row -> Text
quasiQuotedString Query row
query),
      sqlOperation :: Maybe Text
SqlQuery.sqlOperation = Text -> Maybe Text
forall a. a -> Maybe a
Just (Query row -> Text
forall row. Query row -> Text
sqlOperation Query row
query),
      queriedRelation :: Maybe Text
SqlQuery.queriedRelation = Text -> Maybe Text
forall a. a -> Maybe a
Just (Query row -> Text
forall row. Query row -> Text
queriedRelation Query row
query)
    }