ExprParser.hs

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}

-- | This is an internal module. This module may have breaking changes without
-- a corresponding major version bump. If you use this module, please open an
-- issue with your use-case so we can safely support it.
module Database.Esqueleto.Internal.ExprParser where

import Prelude hiding (takeWhile)

import Control.Applicative ((<|>))
import Control.Monad (void)
import Data.Attoparsec.Text
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Text (Text)
import qualified Data.Text as Text
import Database.Persist.Sql

-- | A type representing the access of a table value. In Esqueleto, we get
-- a guarantee that the access will look something like:
--
-- @
-- escape-char [character] escape-char . escape-char [character] escape-char
--             ^^^^^^^^^^^                           ^^^^^^^^^^^
--             table name                            column name
-- @
data TableAccess = TableAccess
    { tableAccessTable  :: Text
    , tableAccessColumn :: Text
    }
    deriving (Eq, Ord, Show)

-- | Parse a @SqlExpr (Value Bool)@'s textual representation into a list of
-- 'TableAccess'
parseOnExpr :: SqlBackend -> Text -> Either String (Set TableAccess)
parseOnExpr sqlBackend text = do
    c <- mkEscapeChar sqlBackend
    parseOnly (onExpr c) text

-- | This function uses the 'connEscapeName' function in the 'SqlBackend' with an
-- empty identifier to pull out an escape character. This implementation works
-- with postgresql, mysql, and sqlite backends.
mkEscapeChar :: SqlBackend -> Either String Char
mkEscapeChar sqlBackend =
    case Text.uncons (connEscapeRawName sqlBackend "") of
        Nothing ->
            Left "Failed to get an escape character from the SQL backend."
        Just (c, _) ->
            Right c

type ExprParser a = Char -> Parser a

onExpr :: ExprParser (Set TableAccess)
onExpr e = Set.fromList <$> many' tableAccesses
  where
    tableAccesses = do
        skipToEscape e <?> "Skipping to an escape char"
        parseTableAccess e <?> "Parsing a table access"

skipToEscape :: ExprParser ()
skipToEscape escapeChar = void (takeWhile (/= escapeChar))

parseEscapedIdentifier :: ExprParser [Char]
parseEscapedIdentifier escapeChar = do
    char escapeChar
    str <- parseEscapedChars escapeChar
    char escapeChar
    pure str

parseTableAccess :: ExprParser TableAccess
parseTableAccess ec = do
    tableAccessTable <- Text.pack <$> parseEscapedIdentifier ec
    _ <- char '.'
    tableAccessColumn <- Text.pack <$> parseEscapedIdentifier ec
    pure TableAccess {..}

parseEscapedChars :: ExprParser [Char]
parseEscapedChars escapeChar = go
  where
    twoEscapes = char escapeChar *> char escapeChar
    go = many' (notChar escapeChar <|> twoEscapes)