    {-# 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
    import Database.Persist.SqlBackend

    -- | 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
        { TableAccess -> Text
    tableAccessTable  :: Text
        , TableAccess -> Text
    tableAccessColumn :: Text
        }
        deriving (TableAccess -> TableAccess -> Bool
    (TableAccess -> TableAccess -> Bool)
    -> (TableAccess -> TableAccess -> Bool) -> Eq TableAccess
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: TableAccess -> TableAccess -> Bool
    == :: TableAccess -> TableAccess -> Bool
    $c/= :: TableAccess -> TableAccess -> Bool
    /= :: TableAccess -> TableAccess -> Bool
    Eq, Eq TableAccess
    Eq TableAccess
    -> (TableAccess -> TableAccess -> Ordering)
    -> (TableAccess -> TableAccess -> Bool)
    -> (TableAccess -> TableAccess -> Bool)
    -> (TableAccess -> TableAccess -> Bool)
    -> (TableAccess -> TableAccess -> Bool)
    -> (TableAccess -> TableAccess -> TableAccess)
    -> (TableAccess -> TableAccess -> TableAccess)
    -> Ord TableAccess
    TableAccess -> TableAccess -> Bool
    TableAccess -> TableAccess -> Ordering
    TableAccess -> TableAccess -> TableAccess
    forall a.
    Eq a
    -> (a -> a -> Ordering)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> Ord a
    $ccompare :: TableAccess -> TableAccess -> Ordering
    compare :: TableAccess -> TableAccess -> Ordering
    $c< :: TableAccess -> TableAccess -> Bool
    < :: TableAccess -> TableAccess -> Bool
    $c<= :: TableAccess -> TableAccess -> Bool
    <= :: TableAccess -> TableAccess -> Bool
    $c> :: TableAccess -> TableAccess -> Bool
    > :: TableAccess -> TableAccess -> Bool
    $c>= :: TableAccess -> TableAccess -> Bool
    >= :: TableAccess -> TableAccess -> Bool
    $cmax :: TableAccess -> TableAccess -> TableAccess
    max :: TableAccess -> TableAccess -> TableAccess
    $cmin :: TableAccess -> TableAccess -> TableAccess
    min :: TableAccess -> TableAccess -> TableAccess
    Ord, Int -> TableAccess -> ShowS
    [TableAccess] -> ShowS
    TableAccess -> String
    (Int -> TableAccess -> ShowS)
    -> (TableAccess -> String)
    -> ([TableAccess] -> ShowS)
    -> Show TableAccess
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> TableAccess -> ShowS
    showsPrec :: Int -> TableAccess -> ShowS
    $cshow :: TableAccess -> String
    show :: TableAccess -> String
    $cshowList :: [TableAccess] -> ShowS
    showList :: [TableAccess] -> ShowS
    Show)

    -- | Parse a @SqlExpr (Value Bool)@'s textual representation into a list of
    -- 'TableAccess'
    parseOnExpr :: SqlBackend -> Text -> Either String (Set TableAccess)
    parseOnExpr :: SqlBackend -> Text -> Either String (Set TableAccess)
    parseOnExpr SqlBackend
    sqlBackend Text
    text = do
        Char
    c <- SqlBackend -> Either String Char
    mkEscapeChar SqlBackend
    sqlBackend
        Parser (Set TableAccess) -> Text -> Either String (Set TableAccess)
    forall a. Parser a -> Text -> Either String a
    parseOnly (ExprParser (Set TableAccess)
    onExpr Char
    c) Text
    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 -> Either String Char
    mkEscapeChar SqlBackend
    sqlBackend =
        case Text -> Maybe (Char, Text)
    Text.uncons (Text -> SqlBackend -> Text
    forall backend (m :: * -> *).
    (BackendCompatible SqlBackend backend, MonadReader backend m) =>
    Text -> m Text
    getEscapedRawName Text
    "" SqlBackend
    sqlBackend) of
            Maybe (Char, Text)
    Nothing ->
                String -> Either String Char
    forall a b. a -> Either a b
    Left String
    "Failed to get an escape character from the SQL backend."
            Just (Char
    c, Text
    _) ->
                Char -> Either String Char
    forall a b. b -> Either a b
    Right Char
    c

    type ExprParser a = Char -> Parser a

    onExpr :: ExprParser (Set TableAccess)
    onExpr :: ExprParser (Set TableAccess)
    onExpr Char
    e = [TableAccess] -> Set TableAccess
    forall a. Ord a => [a] -> Set a
    Set.fromList ([TableAccess] -> Set TableAccess)
    -> Parser Text [TableAccess] -> Parser (Set TableAccess)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Parser Text TableAccess -> Parser Text [TableAccess]
    forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
    many' Parser Text TableAccess
    tableAccesses
      where
        tableAccesses :: Parser Text TableAccess
    tableAccesses = do
            ExprParser ()
    skipToEscape Char
    e Parser Text () -> String -> Parser Text ()
    forall i a. Parser i a -> String -> Parser i a
    <?> String
    "Skipping to an escape char"
            ExprParser TableAccess
    parseTableAccess Char
    e Parser Text TableAccess -> String -> Parser Text TableAccess
    forall i a. Parser i a -> String -> Parser i a
    <?> String
    "Parsing a table access"

    skipToEscape :: ExprParser ()
    skipToEscape :: ExprParser ()
    skipToEscape Char
    escapeChar = Parser Text Text -> Parser Text ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void ((Char -> Bool) -> Parser Text Text
    takeWhile (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Char
    escapeChar))

    parseEscapedIdentifier :: ExprParser [Char]
    parseEscapedIdentifier :: ExprParser String
    parseEscapedIdentifier Char
    escapeChar = do
        Char
    _ <- Char -> Parser Char
    char Char
    escapeChar
        String
    str <- ExprParser String
    parseEscapedChars Char
    escapeChar
        Char
    _ <- Char -> Parser Char
    char Char
    escapeChar
        String -> Parser String
    forall a. a -> Parser Text a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure String
    str

    parseTableAccess :: ExprParser TableAccess
    parseTableAccess :: ExprParser TableAccess
    parseTableAccess Char
    ec = do
        Text
    tableAccessTable <- String -> Text
    Text.pack (String -> Text) -> Parser String -> Parser Text Text
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ExprParser String
    parseEscapedIdentifier Char
    ec
        Char
    _ <- Char -> Parser Char
    char Char
    '.'
        Text
    tableAccessColumn <- String -> Text
    Text.pack (String -> Text) -> Parser String -> Parser Text Text
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ExprParser String
    parseEscapedIdentifier Char
    ec
        TableAccess -> Parser Text TableAccess
    forall a. a -> Parser Text a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure TableAccess {Text
    tableAccessTable :: Text
    tableAccessColumn :: Text
    tableAccessTable :: Text
    tableAccessColumn :: Text
    ..}

    parseEscapedChars :: ExprParser [Char]
    parseEscapedChars :: ExprParser String
    parseEscapedChars Char
    escapeChar = Parser String
    go
      where
        twoEscapes :: Parser Char
    twoEscapes = Char -> Parser Char
    char Char
    escapeChar Parser Char -> Parser Char -> Parser Char
    forall a b. Parser Text a -> Parser Text b -> Parser Text b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> Char -> Parser Char
    char Char
    escapeChar
        go :: Parser String
    go = Parser Char -> Parser String
    forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
    many' (Char -> Parser Char
    notChar Char
    escapeChar Parser Char -> Parser Char -> Parser Char
    forall a. Parser Text a -> Parser Text a -> Parser Text a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> Parser Char
    twoEscapes)