{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

-- | This module contains bits and pieces to work with the Spider SQL language.
--
-- TODO:
-- * don't accept reserved keywords in names without quoting
-- * aliases have to be defined in scope, otherwise fall back to table id
-- * don't define an alias twice in the same scope
-- * optionally (?) use the schema to constrain column and table names
-- * test the parser(s) on more examples
-- * pretty printing
-- * random generation of 'SpiderSQL' values
module Torch.Language.SpiderSQL where

import Control.Applicative (Alternative (..), liftA2, optional)
import Control.Monad (MonadPlus, guard)
import Control.Monad.Logic.Class (MonadLogic (..))
import Data.Char (isAlphaNum, isDigit, isSpace, toLower)
import Data.Foldable (Foldable (toList))
import Data.Functor (($>))
import Data.List (nub)
import Data.Maybe (fromMaybe)
import Text.Parser.Char (CharParsing (char, notChar, satisfy, string), spaces)
import Text.Parser.Combinators
  ( Parsing ((<?>)),
    between,
    choice,
    many,
    optional,
    sepBy,
    sepBy1,
    some,
  )
import Text.Parser.Token (TokenParsing (someSpace))
import Text.Read (readMaybe)
import Torch.Data.Parser (combine, doubleP, eitherP, intP, isToken, parseString)

data SpiderSQL = SpiderSQL
  { SpiderSQL -> Select
spiderSQLSelect :: Select,
    SpiderSQL -> From
spiderSQLFrom :: From,
    SpiderSQL -> Maybe Cond
spiderSQLWhere :: Maybe Cond,
    SpiderSQL -> [ColUnit]
spiderSQLGroupBy :: [ColUnit],
    SpiderSQL -> Maybe OrderBy
spiderSQLOrderBy :: Maybe OrderBy,
    SpiderSQL -> Maybe Cond
spiderSQLHaving :: Maybe Cond,
    SpiderSQL -> Maybe Int
spiderSQLLimit :: Maybe Int,
    SpiderSQL -> Maybe SpiderSQL
spiderSQLIntersect :: Maybe SpiderSQL,
    SpiderSQL -> Maybe SpiderSQL
spiderSQLExcept :: Maybe SpiderSQL,
    SpiderSQL -> Maybe SpiderSQL
spiderSQLUnion :: Maybe SpiderSQL
  }
  deriving (SpiderSQL -> SpiderSQL -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SpiderSQL -> SpiderSQL -> Bool
$c/= :: SpiderSQL -> SpiderSQL -> Bool
== :: SpiderSQL -> SpiderSQL -> Bool
$c== :: SpiderSQL -> SpiderSQL -> Bool
Eq, Int -> SpiderSQL -> ShowS
[SpiderSQL] -> ShowS
SpiderSQL -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SpiderSQL] -> ShowS
$cshowList :: [SpiderSQL] -> ShowS
show :: SpiderSQL -> String
$cshow :: SpiderSQL -> String
showsPrec :: Int -> SpiderSQL -> ShowS
$cshowsPrec :: Int -> SpiderSQL -> ShowS
Show)

data Select
  = Select [Agg]
  | SelectDistinct [Agg]
  deriving (Select -> Select -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Select -> Select -> Bool
$c/= :: Select -> Select -> Bool
== :: Select -> Select -> Bool
$c== :: Select -> Select -> Bool
Eq, Int -> Select -> ShowS
[Select] -> ShowS
Select -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Select] -> ShowS
$cshowList :: [Select] -> ShowS
show :: Select -> String
$cshow :: Select -> String
showsPrec :: Int -> Select -> ShowS
$cshowsPrec :: Int -> Select -> ShowS
Show)

data From = From
  { From -> [TableUnit]
fromTableUnits :: [TableUnit],
    From -> Maybe Cond
fromCond :: Maybe Cond
  }
  deriving (From -> From -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: From -> From -> Bool
$c/= :: From -> From -> Bool
== :: From -> From -> Bool
$c== :: From -> From -> Bool
Eq, Int -> From -> ShowS
[From] -> ShowS
From -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [From] -> ShowS
$cshowList :: [From] -> ShowS
show :: From -> String
$cshow :: From -> String
showsPrec :: Int -> From -> ShowS
$cshowsPrec :: Int -> From -> ShowS
Show)

data Cond
  = And Cond Cond
  | Or Cond Cond
  | Not Cond
  | Between ValUnit Val Val
  | Eq ValUnit Val
  | Gt ValUnit Val
  | Lt ValUnit Val
  | Ge ValUnit Val
  | Le ValUnit Val
  | Ne ValUnit Val
  | In ValUnit Val
  | Like ValUnit Val
  deriving (Cond -> Cond -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Cond -> Cond -> Bool
$c/= :: Cond -> Cond -> Bool
== :: Cond -> Cond -> Bool
$c== :: Cond -> Cond -> Bool
Eq, Int -> Cond -> ShowS
[Cond] -> ShowS
Cond -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Cond] -> ShowS
$cshowList :: [Cond] -> ShowS
show :: Cond -> String
$cshow :: Cond -> String
showsPrec :: Int -> Cond -> ShowS
$cshowsPrec :: Int -> Cond -> ShowS
Show)

data ColUnit
  = ColUnit
      { ColUnit -> AggType
colUnitAggId :: AggType,
        ColUnit -> Maybe (Either Alias TableId)
colUnitTable :: Maybe (Either Alias TableId),
        ColUnit -> ColumnId
colUnitColId :: ColumnId
      }
  | DistinctColUnit
      { ColUnit -> AggType
distinctColUnitAggId :: AggType,
        ColUnit -> Maybe (Either Alias TableId)
distinctColUnitTable :: Maybe (Either Alias TableId),
        ColUnit -> ColumnId
distinctColUnitColdId :: ColumnId
      }
  deriving (ColUnit -> ColUnit -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ColUnit -> ColUnit -> Bool
$c/= :: ColUnit -> ColUnit -> Bool
== :: ColUnit -> ColUnit -> Bool
$c== :: ColUnit -> ColUnit -> Bool
Eq, Int -> ColUnit -> ShowS
[ColUnit] -> ShowS
ColUnit -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ColUnit] -> ShowS
$cshowList :: [ColUnit] -> ShowS
show :: ColUnit -> String
$cshow :: ColUnit -> String
showsPrec :: Int -> ColUnit -> ShowS
$cshowsPrec :: Int -> ColUnit -> ShowS
Show)

data OrderBy = OrderBy OrderByOrder [ValUnit] deriving (OrderBy -> OrderBy -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OrderBy -> OrderBy -> Bool
$c/= :: OrderBy -> OrderBy -> Bool
== :: OrderBy -> OrderBy -> Bool
$c== :: OrderBy -> OrderBy -> Bool
Eq, Int -> OrderBy -> ShowS
[OrderBy] -> ShowS
OrderBy -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OrderBy] -> ShowS
$cshowList :: [OrderBy] -> ShowS
show :: OrderBy -> String
$cshow :: OrderBy -> String
showsPrec :: Int -> OrderBy -> ShowS
$cshowsPrec :: Int -> OrderBy -> ShowS
Show)

data OrderByOrder = Asc | Desc deriving (OrderByOrder -> OrderByOrder -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OrderByOrder -> OrderByOrder -> Bool
$c/= :: OrderByOrder -> OrderByOrder -> Bool
== :: OrderByOrder -> OrderByOrder -> Bool
$c== :: OrderByOrder -> OrderByOrder -> Bool
Eq, Int -> OrderByOrder -> ShowS
[OrderByOrder] -> ShowS
OrderByOrder -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OrderByOrder] -> ShowS
$cshowList :: [OrderByOrder] -> ShowS
show :: OrderByOrder -> String
$cshow :: OrderByOrder -> String
showsPrec :: Int -> OrderByOrder -> ShowS
$cshowsPrec :: Int -> OrderByOrder -> ShowS
Show)

data Agg = Agg AggType ValUnit deriving (Agg -> Agg -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Agg -> Agg -> Bool
$c/= :: Agg -> Agg -> Bool
== :: Agg -> Agg -> Bool
$c== :: Agg -> Agg -> Bool
Eq, Int -> Agg -> ShowS
[Agg] -> ShowS
Agg -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Agg] -> ShowS
$cshowList :: [Agg] -> ShowS
show :: Agg -> String
$cshow :: Agg -> String
showsPrec :: Int -> Agg -> ShowS
$cshowsPrec :: Int -> Agg -> ShowS
Show)

data TableUnit
  = TableUnitSQL SpiderSQL (Maybe Alias)
  | Table TableId (Maybe Alias)
  deriving (TableUnit -> TableUnit -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TableUnit -> TableUnit -> Bool
$c/= :: TableUnit -> TableUnit -> Bool
== :: TableUnit -> TableUnit -> Bool
$c== :: TableUnit -> TableUnit -> Bool
Eq, Int -> TableUnit -> ShowS
[TableUnit] -> ShowS
TableUnit -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TableUnit] -> ShowS
$cshowList :: [TableUnit] -> ShowS
show :: TableUnit -> String
$cshow :: TableUnit -> String
showsPrec :: Int -> TableUnit -> ShowS
$cshowsPrec :: Int -> TableUnit -> ShowS
Show)

data ValUnit
  = Column ColUnit
  | Minus ColUnit ColUnit
  | Plus ColUnit ColUnit
  | Times ColUnit ColUnit
  | Divide ColUnit ColUnit
  deriving (ValUnit -> ValUnit -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ValUnit -> ValUnit -> Bool
$c/= :: ValUnit -> ValUnit -> Bool
== :: ValUnit -> ValUnit -> Bool
$c== :: ValUnit -> ValUnit -> Bool
Eq, Int -> ValUnit -> ShowS
[ValUnit] -> ShowS
ValUnit -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ValUnit] -> ShowS
$cshowList :: [ValUnit] -> ShowS
show :: ValUnit -> String
$cshow :: ValUnit -> String
showsPrec :: Int -> ValUnit -> ShowS
$cshowsPrec :: Int -> ValUnit -> ShowS
Show)

data Val
  = ValColUnit ColUnit
  | Number Double
  | ValString String
  | ValSQL SpiderSQL
  | Terminal
  deriving (Val -> Val -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Val -> Val -> Bool
$c/= :: Val -> Val -> Bool
== :: Val -> Val -> Bool
$c== :: Val -> Val -> Bool
Eq, Int -> Val -> ShowS
[Val] -> ShowS
Val -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Val] -> ShowS
$cshowList :: [Val] -> ShowS
show :: Val -> String
$cshow :: Val -> String
showsPrec :: Int -> Val -> ShowS
$cshowsPrec :: Int -> Val -> ShowS
Show)

data AggType = NoneAggOp | Max | Min | Count | Sum | Avg deriving (AggType -> AggType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AggType -> AggType -> Bool
$c/= :: AggType -> AggType -> Bool
== :: AggType -> AggType -> Bool
$c== :: AggType -> AggType -> Bool
Eq, Int -> AggType -> ShowS
[AggType] -> ShowS
AggType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AggType] -> ShowS
$cshowList :: [AggType] -> ShowS
show :: AggType -> String
$cshow :: AggType -> String
showsPrec :: Int -> AggType -> ShowS
$cshowsPrec :: Int -> AggType -> ShowS
Show)

data ColumnId = Star | ColumnId String deriving (ColumnId -> ColumnId -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ColumnId -> ColumnId -> Bool
$c/= :: ColumnId -> ColumnId -> Bool
== :: ColumnId -> ColumnId -> Bool
$c== :: ColumnId -> ColumnId -> Bool
Eq, Int -> ColumnId -> ShowS
[ColumnId] -> ShowS
ColumnId -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ColumnId] -> ShowS
$cshowList :: [ColumnId] -> ShowS
show :: ColumnId -> String
$cshow :: ColumnId -> String
showsPrec :: Int -> ColumnId -> ShowS
$cshowsPrec :: Int -> ColumnId -> ShowS
Show)

newtype TableId = TableId String deriving (TableId -> TableId -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TableId -> TableId -> Bool
$c/= :: TableId -> TableId -> Bool
== :: TableId -> TableId -> Bool
$c== :: TableId -> TableId -> Bool
Eq, Int -> TableId -> ShowS
[TableId] -> ShowS
TableId -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TableId] -> ShowS
$cshowList :: [TableId] -> ShowS
show :: TableId -> String
$cshow :: TableId -> String
showsPrec :: Int -> TableId -> ShowS
$cshowsPrec :: Int -> TableId -> ShowS
Show)

newtype Alias = Alias String deriving (Alias -> Alias -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Alias -> Alias -> Bool
$c/= :: Alias -> Alias -> Bool
== :: Alias -> Alias -> Bool
$c== :: Alias -> Alias -> Bool
Eq, Int -> Alias -> ShowS
[Alias] -> ShowS
Alias -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Alias] -> ShowS
$cshowList :: [Alias] -> ShowS
show :: Alias -> String
$cshow :: Alias -> String
showsPrec :: Int -> Alias -> ShowS
$cshowsPrec :: Int -> Alias -> ShowS
Show)

-- | @keyword k@ is a parser that consumes 'Char' tokens and yields them
-- if and only if they assemble the 'String' @s@. The parser is not sensitive to
-- letter casing.
--
-- >>> head $ parseString @[] (isKeyword "mykeyword") "MYKEYWORD"
-- ("MYKEYWORD","")
isKeyword :: CharParsing m => String -> m String
isKeyword :: forall (m :: * -> *). CharParsing m => String -> m String
isKeyword String
s = forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m Char
satisfy forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Char
toLower) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => a -> a -> Bool
(==) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Char
toLower)) String
s forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> String
s

isSelect :: CharParsing m => m String
isSelect :: forall (m :: * -> *). CharParsing m => m String
isSelect = forall (m :: * -> *). CharParsing m => String -> m String
isKeyword String
"select"

isDistinct :: CharParsing m => m String
isDistinct :: forall (m :: * -> *). CharParsing m => m String
isDistinct = forall (m :: * -> *). CharParsing m => String -> m String
isKeyword String
"distinct"

isStar :: CharParsing m => m String
isStar :: forall (m :: * -> *). CharParsing m => m String
isStar = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). CharParsing m => Char -> m Char
char Char
'*'

isComma :: CharParsing m => m String
isComma :: forall (m :: * -> *). CharParsing m => m String
isComma = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). CharParsing m => Char -> m Char
char Char
','

isDot :: CharParsing m => m String
isDot :: forall (m :: * -> *). CharParsing m => m String
isDot = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). CharParsing m => Char -> m Char
char Char
'.'

isSemicolon :: CharParsing m => m String
isSemicolon :: forall (m :: * -> *). CharParsing m => m String
isSemicolon = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). CharParsing m => Char -> m Char
char Char
';'

isEq :: CharParsing m => m String
isEq :: forall (m :: * -> *). CharParsing m => m String
isEq = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). CharParsing m => Char -> m Char
char Char
'='

isGt :: CharParsing m => m String
isGt :: forall (m :: * -> *). CharParsing m => m String
isGt = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). CharParsing m => Char -> m Char
char Char
'>'

isLt :: CharParsing m => m String
isLt :: forall (m :: * -> *). CharParsing m => m String
isLt = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). CharParsing m => Char -> m Char
char Char
'<'

isGe :: CharParsing m => m String
isGe :: forall (m :: * -> *). CharParsing m => m String
isGe = forall (m :: * -> *). CharParsing m => String -> m String
string String
">="

isLe :: CharParsing m => m String
isLe :: forall (m :: * -> *). CharParsing m => m String
isLe = forall (m :: * -> *). CharParsing m => String -> m String
string String
"<="

isNe :: CharParsing m => m String
isNe :: forall (m :: * -> *). CharParsing m => m String
isNe = forall (m :: * -> *). CharParsing m => String -> m String
string String
"!="

isIn :: CharParsing m => m String
isIn :: forall (m :: * -> *). CharParsing m => m String
isIn = forall (m :: * -> *). CharParsing m => String -> m String
isKeyword String
"in"

isLike :: CharParsing m => m String
isLike :: forall (m :: * -> *). CharParsing m => m String
isLike = forall (m :: * -> *). CharParsing m => String -> m String
isKeyword String
"like"

isBetween :: CharParsing m => m String
isBetween :: forall (m :: * -> *). CharParsing m => m String
isBetween = forall (m :: * -> *). CharParsing m => String -> m String
isKeyword String
"between"

isAnd :: CharParsing m => m String
isAnd :: forall (m :: * -> *). CharParsing m => m String
isAnd = forall (m :: * -> *). CharParsing m => String -> m String
isKeyword String
"and"

isOr :: CharParsing m => m String
isOr :: forall (m :: * -> *). CharParsing m => m String
isOr = forall (m :: * -> *). CharParsing m => String -> m String
isKeyword String
"or"

isNot :: CharParsing m => m String
isNot :: forall (m :: * -> *). CharParsing m => m String
isNot = forall (m :: * -> *). CharParsing m => String -> m String
isKeyword String
"not"

isMinus :: CharParsing m => m String
isMinus :: forall (m :: * -> *). CharParsing m => m String
isMinus = forall (m :: * -> *). CharParsing m => String -> m String
string String
"-"

isPlus :: CharParsing m => m String
isPlus :: forall (m :: * -> *). CharParsing m => m String
isPlus = forall (m :: * -> *). CharParsing m => String -> m String
string String
"+"

isTimes :: CharParsing m => m String
isTimes :: forall (m :: * -> *). CharParsing m => m String
isTimes = forall (m :: * -> *). CharParsing m => String -> m String
string String
"*"

isDivide :: CharParsing m => m String
isDivide :: forall (m :: * -> *). CharParsing m => m String
isDivide = forall (m :: * -> *). CharParsing m => String -> m String
string String
"/"

isMax :: CharParsing m => m String
isMax :: forall (m :: * -> *). CharParsing m => m String
isMax = forall (m :: * -> *). CharParsing m => String -> m String
isKeyword String
"max"

isMin :: CharParsing m => m String
isMin :: forall (m :: * -> *). CharParsing m => m String
isMin = forall (m :: * -> *). CharParsing m => String -> m String
isKeyword String
"min"

isCount :: CharParsing m => m String
isCount :: forall (m :: * -> *). CharParsing m => m String
isCount = forall (m :: * -> *). CharParsing m => String -> m String
isKeyword String
"count"

isSum :: CharParsing m => m String
isSum :: forall (m :: * -> *). CharParsing m => m String
isSum = forall (m :: * -> *). CharParsing m => String -> m String
isKeyword String
"sum"

isAvg :: CharParsing m => m String
isAvg :: forall (m :: * -> *). CharParsing m => m String
isAvg = forall (m :: * -> *). CharParsing m => String -> m String
isKeyword String
"avg"

isFrom :: CharParsing m => m String
isFrom :: forall (m :: * -> *). CharParsing m => m String
isFrom = forall (m :: * -> *). CharParsing m => String -> m String
isKeyword String
"from"

isJoin :: CharParsing m => m String
isJoin :: forall (m :: * -> *). CharParsing m => m String
isJoin = forall (m :: * -> *). CharParsing m => String -> m String
isKeyword String
"join"

isAs :: CharParsing m => m String
isAs :: forall (m :: * -> *). CharParsing m => m String
isAs = forall (m :: * -> *). CharParsing m => String -> m String
isKeyword String
"as"

isOn :: CharParsing m => m String
isOn :: forall (m :: * -> *). CharParsing m => m String
isOn = forall (m :: * -> *). CharParsing m => String -> m String
isKeyword String
"on"

isWhere :: CharParsing m => m String
isWhere :: forall (m :: * -> *). CharParsing m => m String
isWhere = forall (m :: * -> *). CharParsing m => String -> m String
isKeyword String
"where"

isGroupBy :: CharParsing m => m String
isGroupBy :: forall (m :: * -> *). CharParsing m => m String
isGroupBy = forall (m :: * -> *). CharParsing m => String -> m String
isKeyword String
"group by"

isOrderBy :: CharParsing m => m String
isOrderBy :: forall (m :: * -> *). CharParsing m => m String
isOrderBy = forall (m :: * -> *). CharParsing m => String -> m String
isKeyword String
"order by"

isAsc :: CharParsing m => m String
isAsc :: forall (m :: * -> *). CharParsing m => m String
isAsc = forall (m :: * -> *). CharParsing m => String -> m String
isKeyword String
"asc"

isDesc :: CharParsing m => m String
isDesc :: forall (m :: * -> *). CharParsing m => m String
isDesc = forall (m :: * -> *). CharParsing m => String -> m String
isKeyword String
"desc"

isHaving :: CharParsing m => m String
isHaving :: forall (m :: * -> *). CharParsing m => m String
isHaving = forall (m :: * -> *). CharParsing m => String -> m String
isKeyword String
"having"

isLimit :: CharParsing m => m String
isLimit :: forall (m :: * -> *). CharParsing m => m String
isLimit = forall (m :: * -> *). CharParsing m => String -> m String
isKeyword String
"limit"

isIntersect :: CharParsing m => m String
isIntersect :: forall (m :: * -> *). CharParsing m => m String
isIntersect = forall (m :: * -> *). CharParsing m => String -> m String
isKeyword String
"intersect"

isExcept :: CharParsing m => m String
isExcept :: forall (m :: * -> *). CharParsing m => m String
isExcept = forall (m :: * -> *). CharParsing m => String -> m String
isKeyword String
"except"

isUnion :: CharParsing m => m String
isUnion :: forall (m :: * -> *). CharParsing m => m String
isUnion = forall (m :: * -> *). CharParsing m => String -> m String
isKeyword String
"union"

betweenParentheses :: CharParsing m => m a -> m a
betweenParentheses :: forall (m :: * -> *) a. CharParsing m => m a -> m a
betweenParentheses = forall (m :: * -> *) bra ket a.
Applicative m =>
m bra -> m ket -> m a -> m a
between (forall (m :: * -> *). CharParsing m => m ()
spaces forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *). CharParsing m => Char -> m Char
char Char
'(' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (m :: * -> *). CharParsing m => m ()
spaces) (forall (m :: * -> *). CharParsing m => m ()
spaces forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *). CharParsing m => Char -> m Char
char Char
')' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (m :: * -> *). CharParsing m => m ()
spaces)

betweenOptionalParentheses :: CharParsing m => m a -> m a
betweenOptionalParentheses :: forall (m :: * -> *) a. CharParsing m => m a -> m a
betweenOptionalParentheses m a
p = forall (m :: * -> *) a. CharParsing m => m a -> m a
betweenParentheses m a
p forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m a
p

-- | 'Select' parser
--
-- >>> head $ parseString @[] select "select count table.*"
-- (Select [Agg Count (Column (ColUnit {colUnitAggId = NoneAggOp, colUnitTable = Just (Left (Alias "table")), colUnitColId = Star}))],"")
--
-- >>> head $ parseString @[] select "SELECT COUNT (DISTINCT t5.title)"
-- (Select [Agg Count (Column (DistinctColUnit {distinctColUnitAggId = NoneAggOp, distinctColUnitTable = Just (Left (Alias "t5")), distinctColUnitColdId = ColumnId "title"}))],"")
select :: (TokenParsing m, Monad m) => m Select
select :: forall (m :: * -> *). (TokenParsing m, Monad m) => m Select
select = do
  forall (m :: * -> *). CharParsing m => m String
isSelect
  forall (m :: * -> *). TokenParsing m => m ()
someSpace
  Maybe String
distinct <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall (m :: * -> *). CharParsing m => m String
isDistinct forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (m :: * -> *). TokenParsing m => m ()
someSpace)
  [Agg]
aggs <- forall (m :: * -> *) a sep. Alternative m => m a -> m sep -> m [a]
sepBy forall (m :: * -> *). (TokenParsing m, Monad m) => m Agg
agg forall (m :: * -> *). CharParsing m => m String
isComma
  case Maybe String
distinct of
    Just String
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ [Agg] -> Select
SelectDistinct [Agg]
aggs
    Maybe String
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ [Agg] -> Select
Select [Agg]
aggs

-- | 'Agg' parser.
--
-- >>> head $ parseString @[] agg "count table.id"
-- (Agg Count (Column (ColUnit {colUnitAggId = NoneAggOp, colUnitTable = Just (Left (Alias "table")), colUnitColId = ColumnId "id"})),"")
agg :: (TokenParsing m, Monad m) => m Agg
agg :: forall (m :: * -> *). (TokenParsing m, Monad m) => m Agg
agg =
  AggType -> ValUnit -> Agg
Agg
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ( forall (m :: * -> *). CharParsing m => m AggType
aggType forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            AggType
NoneAggOp -> forall (f :: * -> *) a. Applicative f => a -> f a
pure AggType
NoneAggOp
            AggType
at -> AggType
at forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *). TokenParsing m => m ()
someSpace
        )
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *). (TokenParsing m, Monad m) => m ValUnit
valUnit

-- | 'AggType' parser.
--
-- >>> head $ parseString @[] aggType ""
-- (NoneAggOp,"")
aggType :: CharParsing m => m AggType
aggType :: forall (m :: * -> *). CharParsing m => m AggType
aggType = forall (m :: * -> *) a. Alternative m => [m a] -> m a
choice [m AggType]
choices
  where
    choices :: [m AggType]
choices =
      [ forall (m :: * -> *). CharParsing m => m String
isMax forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> AggType
Max,
        forall (m :: * -> *). CharParsing m => m String
isMin forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> AggType
Min,
        forall (m :: * -> *). CharParsing m => m String
isCount forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> AggType
Count,
        forall (m :: * -> *). CharParsing m => m String
isSum forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> AggType
Sum,
        forall (m :: * -> *). CharParsing m => m String
isAvg forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> AggType
Avg,
        forall (f :: * -> *) a. Applicative f => a -> f a
pure AggType
NoneAggOp
      ]

-- | 'ValUnit' parser.
--
-- >>> head $ parseString @[] valUnit "t1.stadium_id"
-- (Column (ColUnit {colUnitAggId = NoneAggOp, colUnitTable = Just (Left (Alias "t1")), colUnitColId = ColumnId "stadium_id"}),"")
--
-- >>> head . filter (null . snd) $ parseString @[] valUnit "t1.stadium_length * t1.stadium_width"
-- (Times (ColUnit {colUnitAggId = NoneAggOp, colUnitTable = Just (Left (Alias "t1")), colUnitColId = ColumnId "stadium_length"}) (ColUnit {colUnitAggId = NoneAggOp, colUnitTable = Just (Left (Alias "t1")), colUnitColId = ColumnId "stadium_width"}),"")
valUnit :: (TokenParsing m, Monad m) => m ValUnit
valUnit :: forall (m :: * -> *). (TokenParsing m, Monad m) => m ValUnit
valUnit =
  forall (m :: * -> *) a. CharParsing m => m a -> m a
betweenOptionalParentheses
    ( forall (m :: * -> *). CharParsing m => m ()
spaces forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *) a. Alternative m => [m a] -> m a
choice [m ValUnit]
choices forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (m :: * -> *). CharParsing m => m ()
spaces
    )
  where
    choices :: [m ValUnit]
choices = [m ValUnit
column, m ValUnit
minus, m ValUnit
plus, m ValUnit
times, m ValUnit
divide]
    column :: m ValUnit
column = ColUnit -> ValUnit
Column forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). (TokenParsing m, Monad m) => m ColUnit
colUnit
    binary :: (ColUnit -> ColUnit -> b) -> f a -> f b
binary ColUnit -> ColUnit -> b
f f a
p = ColUnit -> ColUnit -> b
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). (TokenParsing m, Monad m) => m ColUnit
colUnit forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall (m :: * -> *). TokenParsing m => m ()
someSpace forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> f a
p forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *). TokenParsing m => m ()
someSpace forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *). (TokenParsing m, Monad m) => m ColUnit
colUnit)
    minus :: m ValUnit
minus = forall {f :: * -> *} {b} {a}.
(TokenParsing f, Monad f) =>
(ColUnit -> ColUnit -> b) -> f a -> f b
binary ColUnit -> ColUnit -> ValUnit
Minus forall (m :: * -> *). CharParsing m => m String
isMinus
    plus :: m ValUnit
plus = forall {f :: * -> *} {b} {a}.
(TokenParsing f, Monad f) =>
(ColUnit -> ColUnit -> b) -> f a -> f b
binary ColUnit -> ColUnit -> ValUnit
Plus forall (m :: * -> *). CharParsing m => m String
isPlus
    times :: m ValUnit
times = forall {f :: * -> *} {b} {a}.
(TokenParsing f, Monad f) =>
(ColUnit -> ColUnit -> b) -> f a -> f b
binary ColUnit -> ColUnit -> ValUnit
Times forall (m :: * -> *). CharParsing m => m String
isTimes
    divide :: m ValUnit
divide = forall {f :: * -> *} {b} {a}.
(TokenParsing f, Monad f) =>
(ColUnit -> ColUnit -> b) -> f a -> f b
binary ColUnit -> ColUnit -> ValUnit
Divide forall (m :: * -> *). CharParsing m => m String
isDivide

-- | 'ColUnit' parser.
--
-- >>> head $ parseString @[] colUnit "count ( distinct my_table.* )"
-- (DistinctColUnit {distinctColUnitAggId = Count, distinctColUnitTable = Just (Left (Alias "my_table")), distinctColUnitColdId = Star},"")
colUnit :: (TokenParsing m, Monad m) => m ColUnit
colUnit :: forall (m :: * -> *). (TokenParsing m, Monad m) => m ColUnit
colUnit = do
  AggType
at <- forall (m :: * -> *). CharParsing m => m AggType
aggType
  (Maybe String
distinct, Maybe (Either Alias TableId)
tabAli, ColumnId
col) <-
    forall (m :: * -> *) a. CharParsing m => m a -> m a
betweenOptionalParentheses forall a b. (a -> b) -> a -> b
$
      (,,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall (m :: * -> *). CharParsing m => m String
isDistinct forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (m :: * -> *). TokenParsing m => m ()
someSpace)
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall (f :: * -> *) a b.
Alternative f =>
f a -> f b -> f (Either a b)
eitherP forall (m :: * -> *). CharParsing m => m Alias
alias forall (m :: * -> *). CharParsing m => m TableId
tableId forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (m :: * -> *). CharParsing m => m String
isDot)
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *). CharParsing m => m ColumnId
columnId
  case Maybe String
distinct of
    Just String
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ AggType -> Maybe (Either Alias TableId) -> ColumnId -> ColUnit
DistinctColUnit AggType
at Maybe (Either Alias TableId)
tabAli ColumnId
col
    Maybe String
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ AggType -> Maybe (Either Alias TableId) -> ColumnId -> ColUnit
ColUnit AggType
at Maybe (Either Alias TableId)
tabAli ColumnId
col

-- | 'TableId' parser.
tableId :: CharParsing m => m TableId
tableId :: forall (m :: * -> *). CharParsing m => m TableId
tableId = String -> TableId
TableId forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). CharParsing m => m String
name

-- | 'Alias' parser.
alias :: CharParsing m => m Alias
alias :: forall (m :: * -> *). CharParsing m => m Alias
alias = String -> Alias
Alias forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). CharParsing m => m String
name

-- | 'ColumnId' parser.
--
-- >>> parseString @[] columnId "*"
-- [(Star,"")]
--
-- >>> parseString @[] columnId "c"
-- [(ColumnId "c","")]
columnId :: CharParsing m => m ColumnId
columnId :: forall (m :: * -> *). CharParsing m => m ColumnId
columnId = forall (m :: * -> *). CharParsing m => m String
isStar forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ColumnId
Star forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> ColumnId
ColumnId forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). CharParsing m => m String
name

tableUnitAlias :: TableUnit -> Maybe Alias
tableUnitAlias :: TableUnit -> Maybe Alias
tableUnitAlias (TableUnitSQL SpiderSQL
_ Maybe Alias
malias) = Maybe Alias
malias
tableUnitAlias (Table TableId
_ Maybe Alias
malias) = Maybe Alias
malias

tableUnitTableId :: TableUnit -> Maybe TableId
tableUnitTableId :: TableUnit -> Maybe TableId
tableUnitTableId (TableUnitSQL SpiderSQL
_ Maybe Alias
_) = forall a. Maybe a
Nothing
tableUnitTableId (Table TableId
tableId Maybe Alias
_) = forall a. a -> Maybe a
Just TableId
tableId

condAliases :: Cond -> [Alias]
condAliases :: Cond -> [Alias]
condAliases = Cond -> [Alias]
go
  where
    go :: Cond -> [Alias]
go (And Cond
cond Cond
cond') = Cond -> [Alias]
go Cond
cond forall a. Semigroup a => a -> a -> a
<> Cond -> [Alias]
go Cond
cond'
    go (Or Cond
cond Cond
cond') = Cond -> [Alias]
go Cond
cond forall a. Semigroup a => a -> a -> a
<> Cond -> [Alias]
go Cond
cond'
    go (Not Cond
cond) = Cond -> [Alias]
go Cond
cond
    go (Between ValUnit
valUnit Val
val Val
val') =
      ValUnit -> [Alias]
valUnitAliases ValUnit
valUnit forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Val -> Maybe Alias
valAlias Val
val) forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Val -> Maybe Alias
valAlias Val
val')
    go (Eq ValUnit
valUnit Val
val) =
      ValUnit -> [Alias]
valUnitAliases ValUnit
valUnit forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Val -> Maybe Alias
valAlias Val
val)
    go (Gt ValUnit
valUnit Val
val) =
      ValUnit -> [Alias]
valUnitAliases ValUnit
valUnit forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Val -> Maybe Alias
valAlias Val
val)
    go (Lt ValUnit
valUnit Val
val) =
      ValUnit -> [Alias]
valUnitAliases ValUnit
valUnit forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Val -> Maybe Alias
valAlias Val
val)
    go (Ge ValUnit
valUnit Val
val) =
      ValUnit -> [Alias]
valUnitAliases ValUnit
valUnit forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Val -> Maybe Alias
valAlias Val
val)
    go (Le ValUnit
valUnit Val
val) =
      ValUnit -> [Alias]
valUnitAliases ValUnit
valUnit forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Val -> Maybe Alias
valAlias Val
val)
    go (Ne ValUnit
valUnit Val
val) =
      ValUnit -> [Alias]
valUnitAliases ValUnit
valUnit forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Val -> Maybe Alias
valAlias Val
val)
    go (In ValUnit
valUnit Val
val) =
      ValUnit -> [Alias]
valUnitAliases ValUnit
valUnit forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Val -> Maybe Alias
valAlias Val
val)
    go (Like ValUnit
valUnit Val
val) =
      ValUnit -> [Alias]
valUnitAliases ValUnit
valUnit forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Val -> Maybe Alias
valAlias Val
val)

condTableIds :: Cond -> [TableId]
condTableIds :: Cond -> [TableId]
condTableIds = Cond -> [TableId]
go
  where
    go :: Cond -> [TableId]
go (And Cond
cond Cond
cond') = Cond -> [TableId]
go Cond
cond forall a. Semigroup a => a -> a -> a
<> Cond -> [TableId]
go Cond
cond'
    go (Or Cond
cond Cond
cond') = Cond -> [TableId]
go Cond
cond forall a. Semigroup a => a -> a -> a
<> Cond -> [TableId]
go Cond
cond'
    go (Not Cond
cond) = Cond -> [TableId]
go Cond
cond
    go (Between ValUnit
valUnit Val
val Val
val') =
      ValUnit -> [TableId]
valUnitTableIds ValUnit
valUnit forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Val -> Maybe TableId
valTableId Val
val) forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Val -> Maybe TableId
valTableId Val
val')
    go (Eq ValUnit
valUnit Val
val) =
      ValUnit -> [TableId]
valUnitTableIds ValUnit
valUnit forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Val -> Maybe TableId
valTableId Val
val)
    go (Gt ValUnit
valUnit Val
val) =
      ValUnit -> [TableId]
valUnitTableIds ValUnit
valUnit forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Val -> Maybe TableId
valTableId Val
val)
    go (Lt ValUnit
valUnit Val
val) =
      ValUnit -> [TableId]
valUnitTableIds ValUnit
valUnit forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Val -> Maybe TableId
valTableId Val
val)
    go (Ge ValUnit
valUnit Val
val) =
      ValUnit -> [TableId]
valUnitTableIds ValUnit
valUnit forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Val -> Maybe TableId
valTableId Val
val)
    go (Le ValUnit
valUnit Val
val) =
      ValUnit -> [TableId]
valUnitTableIds ValUnit
valUnit forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Val -> Maybe TableId
valTableId Val
val)
    go (Ne ValUnit
valUnit Val
val) =
      ValUnit -> [TableId]
valUnitTableIds ValUnit
valUnit forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Val -> Maybe TableId
valTableId Val
val)
    go (In ValUnit
valUnit Val
val) =
      ValUnit -> [TableId]
valUnitTableIds ValUnit
valUnit forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Val -> Maybe TableId
valTableId Val
val)
    go (Like ValUnit
valUnit Val
val) =
      ValUnit -> [TableId]
valUnitTableIds ValUnit
valUnit forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Val -> Maybe TableId
valTableId Val
val)

valUnitAliases :: ValUnit -> [Alias]
valUnitAliases :: ValUnit -> [Alias]
valUnitAliases (Column ColUnit
colUnit) =
  forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (ColUnit -> Maybe Alias
colUnitAlias ColUnit
colUnit)
valUnitAliases (Minus ColUnit
colUnit ColUnit
colUnit') =
  forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (ColUnit -> Maybe Alias
colUnitAlias ColUnit
colUnit) forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (ColUnit -> Maybe Alias
colUnitAlias ColUnit
colUnit')
valUnitAliases (Plus ColUnit
colUnit ColUnit
colUnit') =
  forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (ColUnit -> Maybe Alias
colUnitAlias ColUnit
colUnit) forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (ColUnit -> Maybe Alias
colUnitAlias ColUnit
colUnit')
valUnitAliases (Times ColUnit
colUnit ColUnit
colUnit') =
  forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (ColUnit -> Maybe Alias
colUnitAlias ColUnit
colUnit) forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (ColUnit -> Maybe Alias
colUnitAlias ColUnit
colUnit')
valUnitAliases (Divide ColUnit
colUnit ColUnit
colUnit') =
  forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (ColUnit -> Maybe Alias
colUnitAlias ColUnit
colUnit) forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (ColUnit -> Maybe Alias
colUnitAlias ColUnit
colUnit')

valUnitTableIds :: ValUnit -> [TableId]
valUnitTableIds :: ValUnit -> [TableId]
valUnitTableIds (Column ColUnit
colUnit) =
  forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (ColUnit -> Maybe TableId
colUnitTableId ColUnit
colUnit)
valUnitTableIds (Minus ColUnit
colUnit ColUnit
colUnit') =
  forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (ColUnit -> Maybe TableId
colUnitTableId ColUnit
colUnit) forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (ColUnit -> Maybe TableId
colUnitTableId ColUnit
colUnit')
valUnitTableIds (Plus ColUnit
colUnit ColUnit
colUnit') =
  forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (ColUnit -> Maybe TableId
colUnitTableId ColUnit
colUnit) forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (ColUnit -> Maybe TableId
colUnitTableId ColUnit
colUnit')
valUnitTableIds (Times ColUnit
colUnit ColUnit
colUnit') =
  forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (ColUnit -> Maybe TableId
colUnitTableId ColUnit
colUnit) forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (ColUnit -> Maybe TableId
colUnitTableId ColUnit
colUnit')
valUnitTableIds (Divide ColUnit
colUnit ColUnit
colUnit') =
  forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (ColUnit -> Maybe TableId
colUnitTableId ColUnit
colUnit) forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (ColUnit -> Maybe TableId
colUnitTableId ColUnit
colUnit')

colUnitAlias :: ColUnit -> Maybe Alias
colUnitAlias :: ColUnit -> Maybe Alias
colUnitAlias ColUnit {Maybe (Either Alias TableId)
ColumnId
AggType
colUnitColId :: ColumnId
colUnitTable :: Maybe (Either Alias TableId)
colUnitAggId :: AggType
colUnitColId :: ColUnit -> ColumnId
colUnitTable :: ColUnit -> Maybe (Either Alias TableId)
colUnitAggId :: ColUnit -> AggType
..} = Maybe (Either Alias TableId)
colUnitTable forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a. a -> Maybe a
Just (forall a b. a -> b -> a
const forall a. Maybe a
Nothing)
colUnitAlias DistinctColUnit {Maybe (Either Alias TableId)
ColumnId
AggType
distinctColUnitColdId :: ColumnId
distinctColUnitTable :: Maybe (Either Alias TableId)
distinctColUnitAggId :: AggType
distinctColUnitColdId :: ColUnit -> ColumnId
distinctColUnitTable :: ColUnit -> Maybe (Either Alias TableId)
distinctColUnitAggId :: ColUnit -> AggType
..} = Maybe (Either Alias TableId)
distinctColUnitTable forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a. a -> Maybe a
Just (forall a b. a -> b -> a
const forall a. Maybe a
Nothing)

colUnitTableId :: ColUnit -> Maybe TableId
colUnitTableId :: ColUnit -> Maybe TableId
colUnitTableId ColUnit {Maybe (Either Alias TableId)
ColumnId
AggType
colUnitColId :: ColumnId
colUnitTable :: Maybe (Either Alias TableId)
colUnitAggId :: AggType
colUnitColId :: ColUnit -> ColumnId
colUnitTable :: ColUnit -> Maybe (Either Alias TableId)
colUnitAggId :: ColUnit -> AggType
..} = Maybe (Either Alias TableId)
colUnitTable forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) forall a. a -> Maybe a
Just
colUnitTableId DistinctColUnit {Maybe (Either Alias TableId)
ColumnId
AggType
distinctColUnitColdId :: ColumnId
distinctColUnitTable :: Maybe (Either Alias TableId)
distinctColUnitAggId :: AggType
distinctColUnitColdId :: ColUnit -> ColumnId
distinctColUnitTable :: ColUnit -> Maybe (Either Alias TableId)
distinctColUnitAggId :: ColUnit -> AggType
..} = Maybe (Either Alias TableId)
distinctColUnitTable forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) forall a. a -> Maybe a
Just

valAlias :: Val -> Maybe Alias
valAlias :: Val -> Maybe Alias
valAlias (ValColUnit ColUnit
colUnit) = ColUnit -> Maybe Alias
colUnitAlias ColUnit
colUnit
valAlias (Number Double
_) = forall a. Maybe a
Nothing
valAlias (ValString String
_) = forall a. Maybe a
Nothing
valAlias (ValSQL SpiderSQL
_) = forall a. Maybe a
Nothing
valAlias Val
Terminal = forall a. Maybe a
Nothing

valTableId :: Val -> Maybe TableId
valTableId :: Val -> Maybe TableId
valTableId (ValColUnit ColUnit
colUnit) = ColUnit -> Maybe TableId
colUnitTableId ColUnit
colUnit
valTableId (Number Double
_) = forall a. Maybe a
Nothing
valTableId (ValString String
_) = forall a. Maybe a
Nothing
valTableId (ValSQL SpiderSQL
_) = forall a. Maybe a
Nothing
valTableId Val
Terminal = forall a. Maybe a
Nothing

-- | 'From' parser.
--
-- >>> head $ parseString @[] from "FROM people AS t1 JOIN pets AS t2 ON t1.pet_id = t2.pet_id"
-- (From {fromTableUnits = [Table (TableId "people") (Just (Alias "t1")),Table (TableId "pets") (Just (Alias "t2"))], fromCond = Just (Eq (Column (ColUnit {colUnitAggId = NoneAggOp, colUnitTable = Just (Left (Alias "t1")), colUnitColId = ColumnId "pet_id"})) (ValColUnit (ColUnit {colUnitAggId = NoneAggOp, colUnitTable = Just (Left (Alias "t2")), colUnitColId = ColumnId "pet_id"})))},"")
--
-- >>> head $ parseString @[] from "FROM organization AS t3 JOIN author AS t1 ON t3.oid = t1.oid JOIN writes AS t4 ON t4.aid = t1.aid JOIN publication AS t5 ON t4.pid = t5.pid JOIN conference AS t2 ON t5.cid = t2.cid"
-- (From {fromTableUnits = [Table (TableId "organization") (Just (Alias "t3")),Table (TableId "author") (Just (Alias "t1")),Table (TableId "writes") (Just (Alias "t4")),Table (TableId "publication") (Just (Alias "t5")),Table (TableId "conference") (Just (Alias "t2"))], fromCond = Just (And (And (And (Eq (Column (ColUnit {colUnitAggId = NoneAggOp, colUnitTable = Just (Left (Alias "t3")), colUnitColId = ColumnId "oid"})) (ValColUnit (ColUnit {colUnitAggId = NoneAggOp, colUnitTable = Just (Left (Alias "t1")), colUnitColId = ColumnId "oid"}))) (Eq (Column (ColUnit {colUnitAggId = NoneAggOp, colUnitTable = Just (Left (Alias "t4")), colUnitColId = ColumnId "aid"})) (ValColUnit (ColUnit {colUnitAggId = NoneAggOp, colUnitTable = Just (Left (Alias "t1")), colUnitColId = ColumnId "aid"})))) (Eq (Column (ColUnit {colUnitAggId = NoneAggOp, colUnitTable = Just (Left (Alias "t4")), colUnitColId = ColumnId "pid"})) (ValColUnit (ColUnit {colUnitAggId = NoneAggOp, colUnitTable = Just (Left (Alias "t5")), colUnitColId = ColumnId "pid"})))) (Eq (Column (ColUnit {colUnitAggId = NoneAggOp, colUnitTable = Just (Left (Alias "t5")), colUnitColId = ColumnId "cid"})) (ValColUnit (ColUnit {colUnitAggId = NoneAggOp, colUnitTable = Just (Left (Alias "t2")), colUnitColId = ColumnId "cid"}))))},"")
from :: forall m. (TokenParsing m, Monad m) => m From
from :: forall (m :: * -> *). (TokenParsing m, Monad m) => m From
from = do
  forall (m :: * -> *). CharParsing m => m String
isFrom
  forall (m :: * -> *). TokenParsing m => m ()
someSpace
  from :: From
from@From {[TableUnit]
Maybe Cond
fromCond :: Maybe Cond
fromTableUnits :: [TableUnit]
fromCond :: From -> Maybe Cond
fromTableUnits :: From -> [TableUnit]
..} <- forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry TableUnit -> [(TableUnit, Maybe Cond)] -> From
mkFrom forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (TableUnit, [(TableUnit, Maybe Cond)])
p
  let boundAliases :: [Alias]
boundAliases = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. TableUnit -> Maybe Alias
tableUnitAlias) [TableUnit]
fromTableUnits
      aliasReferences :: [Alias]
aliasReferences = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Cond -> [Alias]
condAliases Maybe Cond
fromCond
  forall (f :: * -> *). Alternative f => Bool -> f ()
guard ([Alias]
boundAliases forall a. Eq a => a -> a -> Bool
== forall a. Eq a => [a] -> [a]
nub [Alias]
boundAliases)
  forall (f :: * -> *). Alternative f => Bool -> f ()
guard (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Alias]
boundAliases) [Alias]
aliasReferences)
  let boundTableIds :: [TableId]
boundTableIds = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. TableUnit -> Maybe TableId
tableUnitTableId) [TableUnit]
fromTableUnits
      tableIdReferences :: [TableId]
tableIdReferences = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Cond -> [TableId]
condTableIds Maybe Cond
fromCond
  forall (f :: * -> *). Alternative f => Bool -> f ()
guard (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [TableId]
boundTableIds) [TableId]
tableIdReferences)
  forall (f :: * -> *) a. Applicative f => a -> f a
pure From
from
  where
    p :: m (TableUnit, [(TableUnit, Maybe Cond)])
    p :: m (TableUnit, [(TableUnit, Maybe Cond)])
p =
      (,)
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). (TokenParsing m, Monad m) => m TableUnit
tableUnit
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f [a]
many
          ( forall (m :: * -> *). TokenParsing m => m ()
someSpace
              forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *). CharParsing m => m String
isJoin
              forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *). TokenParsing m => m ()
someSpace
              forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ( (,)
                     forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). (TokenParsing m, Monad m) => m TableUnit
tableUnit
                     forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional
                       ( forall (m :: * -> *). TokenParsing m => m ()
someSpace
                           forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *). CharParsing m => m String
isOn
                           forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *). TokenParsing m => m ()
someSpace
                           forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *). (TokenParsing m, Monad m) => m Cond
cond
                       )
                 )
          )
    mkFrom :: TableUnit -> [(TableUnit, Maybe Cond)] -> From
    mkFrom :: TableUnit -> [(TableUnit, Maybe Cond)] -> From
mkFrom TableUnit
tu [(TableUnit, Maybe Cond)]
tus =
      [TableUnit] -> Maybe Cond -> From
From
        (TableUnit
tu forall a. a -> [a] -> [a]
: forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst [(TableUnit, Maybe Cond)]
tus)
        ( forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl
            ( \Maybe Cond
a Maybe Cond
b ->
                case (Maybe Cond
a, Maybe Cond
b) of
                  (Just Cond
c, Just Cond
c') -> forall a. a -> Maybe a
Just (Cond -> Cond -> Cond
And Cond
c Cond
c')
                  (Just Cond
c, Maybe Cond
Nothing) -> forall a. a -> Maybe a
Just Cond
c
                  (Maybe Cond
Nothing, Just Cond
c') -> forall a. a -> Maybe a
Just Cond
c'
                  (Maybe Cond
Nothing, Maybe Cond
Nothing) -> forall a. Maybe a
Nothing
            )
            forall a. Maybe a
Nothing
            (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd [(TableUnit, Maybe Cond)]
tus)
        )

-- | 'TableUnit' parser.
--
-- >>> head $ parseString @[] tableUnit "people as t1"
-- (Table (TableId "people") (Just (Alias "t1")),"")
tableUnit :: (TokenParsing m, Monad m) => m TableUnit
tableUnit :: forall (m :: * -> *). (TokenParsing m, Monad m) => m TableUnit
tableUnit =
  let tableUnitSQL :: m TableUnit
tableUnitSQL =
        SpiderSQL -> Maybe Alias -> TableUnit
TableUnitSQL
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. CharParsing m => m a -> m a
betweenParentheses forall (m :: * -> *). (TokenParsing m, Monad m) => m SpiderSQL
spiderSQL
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall (m :: * -> *). TokenParsing m => m ()
someSpace forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *). CharParsing m => m String
isAs forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *). TokenParsing m => m ()
someSpace forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *). CharParsing m => m Alias
alias)
      table :: m TableUnit
table =
        TableId -> Maybe Alias -> TableUnit
Table
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). CharParsing m => m TableId
tableId
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall (m :: * -> *). TokenParsing m => m ()
someSpace forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *). CharParsing m => m String
isAs forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *). TokenParsing m => m ()
someSpace forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *). CharParsing m => m Alias
alias)
   in m TableUnit
tableUnitSQL forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m TableUnit
table

-- | 'Cond' parser.
--
-- >>> head $ parseString @[] cond "t1.stadium_id = t2.stadium_id"
-- (Eq (Column (ColUnit {colUnitAggId = NoneAggOp, colUnitTable = Just (Left (Alias "t1")), colUnitColId = ColumnId "stadium_id"})) (ValColUnit (ColUnit {colUnitAggId = NoneAggOp, colUnitTable = Just (Left (Alias "t2")), colUnitColId = ColumnId "stadium_id"})),"")
--
-- >>> head $ parseString @[] (cond <* isToken ';') "t2.name = \"VLDB\" AND t3.name = \"University of Michigan\";"
-- (And (Eq (Column (ColUnit {colUnitAggId = NoneAggOp, colUnitTable = Just (Left (Alias "t2")), colUnitColId = ColumnId "name"})) (ValString "VLDB")) (Eq (Column (ColUnit {colUnitAggId = NoneAggOp, colUnitTable = Just (Left (Alias "t3")), colUnitColId = ColumnId "name"})) (ValString "University of Michigan")),"")
cond :: (TokenParsing m, Monad m) => m Cond
cond :: forall (m :: * -> *). (TokenParsing m, Monad m) => m Cond
cond =
  let mkCond :: m Cond -> m Cond
mkCond m Cond
p' =
        let suffix :: Cond -> m Cond
suffix Cond
r' =
              let q :: m Cond
q = m Cond -> m Cond
mkCond m Cond
p'
               in forall (m :: * -> *) a. Alternative m => [m a] -> m a
choice
                    [ Cond -> Cond -> Cond
And Cond
r' forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (m :: * -> *). TokenParsing m => m ()
someSpace forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *). CharParsing m => m String
isAnd forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *). TokenParsing m => m ()
someSpace forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m Cond
q),
                      Cond -> Cond -> Cond
Or Cond
r' forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (m :: * -> *). TokenParsing m => m ()
someSpace forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *). CharParsing m => m String
isOr forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *). TokenParsing m => m ()
someSpace forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m Cond
q)
                    ]
            suffixRec :: m Cond -> m Cond
suffixRec m Cond
base = do
              Cond
c <- m Cond
base
              m Cond -> m Cond
suffixRec (Cond -> m Cond
suffix Cond
c) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure Cond
c
            r :: m Cond
r =
              forall (m :: * -> *) a. Alternative m => [m a] -> m a
choice
                [ Cond -> Cond
Not forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (m :: * -> *). CharParsing m => m String
isNot forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *). CharParsing m => m ()
spaces forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m Cond
p'),
                  m Cond
p'
                ]
         in m Cond -> m Cond
suffixRec m Cond
r
      p :: m Cond
p =
        forall (m :: * -> *) a. Alternative m => [m a] -> m a
choice
          [ forall {f :: * -> *} {b} {a}.
(TokenParsing f, Monad f) =>
(ValUnit -> Val -> b) -> f a -> f b
binary ValUnit -> Val -> Cond
Eq forall (m :: * -> *). CharParsing m => m String
isEq,
            forall {f :: * -> *} {b} {a}.
(TokenParsing f, Monad f) =>
(ValUnit -> Val -> b) -> f a -> f b
binary ValUnit -> Val -> Cond
Gt forall (m :: * -> *). CharParsing m => m String
isGt,
            forall {f :: * -> *} {b} {a}.
(TokenParsing f, Monad f) =>
(ValUnit -> Val -> b) -> f a -> f b
binary ValUnit -> Val -> Cond
Lt forall (m :: * -> *). CharParsing m => m String
isLt,
            forall {f :: * -> *} {b} {a}.
(TokenParsing f, Monad f) =>
(ValUnit -> Val -> b) -> f a -> f b
binary ValUnit -> Val -> Cond
Ge forall (m :: * -> *). CharParsing m => m String
isGe,
            forall {f :: * -> *} {b} {a}.
(TokenParsing f, Monad f) =>
(ValUnit -> Val -> b) -> f a -> f b
binary ValUnit -> Val -> Cond
Le forall (m :: * -> *). CharParsing m => m String
isLe,
            forall {f :: * -> *} {b} {a}.
(TokenParsing f, Monad f) =>
(ValUnit -> Val -> b) -> f a -> f b
binary ValUnit -> Val -> Cond
Ne forall (m :: * -> *). CharParsing m => m String
isNe,
            forall {f :: * -> *} {b} {a}.
(TokenParsing f, Monad f) =>
(ValUnit -> Val -> b) -> f a -> f b
binary ValUnit -> Val -> Cond
In forall (m :: * -> *). CharParsing m => m String
isIn,
            forall {f :: * -> *} {b} {a}.
(TokenParsing f, Monad f) =>
(ValUnit -> Val -> b) -> f a -> f b
binary ValUnit -> Val -> Cond
Like forall (m :: * -> *). CharParsing m => m String
isLike,
            ValUnit -> Val -> Val -> Cond
Between forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). (TokenParsing m, Monad m) => m ValUnit
valUnit forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall (m :: * -> *). TokenParsing m => m ()
someSpace forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *). CharParsing m => m String
isBetween forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *). TokenParsing m => m ()
someSpace forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *). (TokenParsing m, Monad m) => m Val
val) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall (m :: * -> *). TokenParsing m => m ()
someSpace forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *). CharParsing m => m String
isAnd forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *). TokenParsing m => m ()
someSpace forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *). (TokenParsing m, Monad m) => m Val
val)
          ]
      binary :: (ValUnit -> Val -> b) -> f a -> f b
binary ValUnit -> Val -> b
f f a
q = ValUnit -> Val -> b
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). (TokenParsing m, Monad m) => m ValUnit
valUnit forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall (m :: * -> *). CharParsing m => m ()
spaces forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> f a
q forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *). CharParsing m => m ()
spaces forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *). (TokenParsing m, Monad m) => m Val
val)
   in forall {m :: * -> *}. (TokenParsing m, Monad m) => m Cond -> m Cond
mkCond m Cond
p

-- | 'Val' parser.
--
-- >>> head $ parseString @[] val "count t1.stadium_id"
-- (ValColUnit (ColUnit {colUnitAggId = NoneAggOp, colUnitTable = Nothing, colUnitColId = ColumnId "count"})," t1.stadium_id")
--
-- >>> head $ parseString @[] val "(select *)"
-- (ValSQL (SpiderSQL {spiderSQLSelect = Select [Agg NoneAggOp (Column (ColUnit {colUnitAggId = NoneAggOp, colUnitTable = Nothing, colUnitColId = Star}))], spiderSQLFrom = From {fromTableUnits = [], fromCond = Nothing}, spiderSQLWhere = Nothing, spiderSQLGroupBy = [], spiderSQLOrderBy = Nothing, spiderSQLHaving = Nothing, spiderSQLLimit = Nothing, spiderSQLIntersect = Nothing, spiderSQLExcept = Nothing, spiderSQLUnion = Nothing}),"")
val :: (TokenParsing m, Monad m) => m Val
val :: forall (m :: * -> *). (TokenParsing m, Monad m) => m Val
val = forall (m :: * -> *) a. Alternative m => [m a] -> m a
choice [m Val]
choices
  where
    choices :: [m Val]
choices = [m Val
valColUnit, m Val
number, m Val
valString, m Val
valSQL, m Val
terminal]
    valColUnit :: m Val
valColUnit = ColUnit -> Val
ValColUnit forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). (TokenParsing m, Monad m) => m ColUnit
colUnit
    number :: m Val
number = Double -> Val
Number forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). (CharParsing m, Monad m) => m Double
doubleP
    valString :: m Val
valString = String -> Val
ValString forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). CharParsing m => m String
quotedString
    valSQL :: m Val
valSQL = SpiderSQL -> Val
ValSQL forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. CharParsing m => m a -> m a
betweenParentheses forall (m :: * -> *). (TokenParsing m, Monad m) => m SpiderSQL
spiderSQL
    terminal :: m Val
terminal = forall (f :: * -> *) a. Applicative f => a -> f a
pure Val
Terminal

-- | Parser for quoted strings.
--
-- >>> head $ parseString @[] quotedString "\"hello world\""
-- ("hello world","")
quotedString :: CharParsing m => m String
quotedString :: forall (m :: * -> *). CharParsing m => m String
quotedString =
  let q :: m Char
q = forall (m :: * -> *). CharParsing m => Char -> m Char
char Char
'"'
      s :: m String
s = forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (forall (m :: * -> *). CharParsing m => Char -> m Char
notChar Char
'"')
   in forall (m :: * -> *) bra ket a.
Applicative m =>
m bra -> m ket -> m a -> m a
between m Char
q m Char
q m String
s

-- | Parser for where clauses.
--
-- >>> head $ parseString @[] whereCond "where t1.id = t2.id"
-- (Eq (Column (ColUnit {colUnitAggId = NoneAggOp, colUnitTable = Just (Left (Alias "t1")), colUnitColId = ColumnId "id"})) (ValColUnit (ColUnit {colUnitAggId = NoneAggOp, colUnitTable = Just (Left (Alias "t2")), colUnitColId = ColumnId "id"})),"")
whereCond :: (TokenParsing m, Monad m) => m Cond
whereCond :: forall (m :: * -> *). (TokenParsing m, Monad m) => m Cond
whereCond = forall (m :: * -> *). CharParsing m => m String
isWhere forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *). TokenParsing m => m ()
someSpace forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *). (TokenParsing m, Monad m) => m Cond
cond

-- | Parser for group-by clauses.
--
-- >>> head $ parseString @[] groupBy "group by count t1.id, t2.id"
-- ([ColUnit {colUnitAggId = NoneAggOp, colUnitTable = Nothing, colUnitColId = ColumnId "count"}]," t1.id, t2.id")
groupBy :: (TokenParsing m, Monad m) => m [ColUnit]
groupBy :: forall (m :: * -> *). (TokenParsing m, Monad m) => m [ColUnit]
groupBy = forall (m :: * -> *). CharParsing m => m String
isGroupBy forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *). TokenParsing m => m ()
someSpace forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *) a sep. Alternative m => m a -> m sep -> m [a]
sepBy1 forall (m :: * -> *). (TokenParsing m, Monad m) => m ColUnit
colUnit (forall (m :: * -> *). CharParsing m => m String
isComma forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (m :: * -> *). TokenParsing m => m ()
someSpace)

-- | 'OrderBy' Parser.
--
-- >>> head . filter (null . snd) $ parseString @[] orderBy "order by t1.stadium_id, t2.pet_id desc"
-- (OrderBy Desc [Column (ColUnit {colUnitAggId = NoneAggOp, colUnitTable = Just (Left (Alias "t1")), colUnitColId = ColumnId "stadium_id"}),Column (ColUnit {colUnitAggId = NoneAggOp, colUnitTable = Just (Left (Alias "t2")), colUnitColId = ColumnId "pet_id"})],"")
orderBy :: (TokenParsing m, Monad m) => m OrderBy
orderBy :: forall (m :: * -> *). (TokenParsing m, Monad m) => m OrderBy
orderBy = do
  forall (m :: * -> *). CharParsing m => m String
isOrderBy
  forall (m :: * -> *). TokenParsing m => m ()
someSpace
  [ValUnit]
valUnits <- forall (m :: * -> *) a sep. Alternative m => m a -> m sep -> m [a]
sepBy1 forall (m :: * -> *). (TokenParsing m, Monad m) => m ValUnit
valUnit (forall (m :: * -> *). CharParsing m => m String
isComma forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (m :: * -> *). TokenParsing m => m ()
someSpace)
  OrderByOrder
order <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall (m :: * -> *). TokenParsing m => m ()
someSpace forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (forall (m :: * -> *). CharParsing m => m String
isAsc forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> OrderByOrder
Asc forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *). CharParsing m => m String
isDesc forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> OrderByOrder
Desc)) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (f :: * -> *) a. Applicative f => a -> f a
pure OrderByOrder
Asc) forall (f :: * -> *) a. Applicative f => a -> f a
pure
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ OrderByOrder -> [ValUnit] -> OrderBy
OrderBy OrderByOrder
order [ValUnit]
valUnits

-- | Parser for having clauses.
--
-- >>> head $ parseString @[] havingCond "having count(t1.customer_id) = 10"
-- (Eq (Column (ColUnit {colUnitAggId = Count, colUnitTable = Just (Left (Alias "t1")), colUnitColId = ColumnId "customer_id"})) (ValColUnit (ColUnit {colUnitAggId = NoneAggOp, colUnitTable = Nothing, colUnitColId = ColumnId "10"})),"")
havingCond :: (TokenParsing m, Monad m) => m Cond
havingCond :: forall (m :: * -> *). (TokenParsing m, Monad m) => m Cond
havingCond = forall (m :: * -> *). CharParsing m => m String
isHaving forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *). TokenParsing m => m ()
someSpace forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *). (TokenParsing m, Monad m) => m Cond
cond

-- | Parser for limit clauses.
--
-- >>> head $ parseString @[] limit "limit 10"
-- (10,"")
limit :: (TokenParsing m, Monad m) => m Int
limit :: forall (m :: * -> *). (TokenParsing m, Monad m) => m Int
limit = forall (m :: * -> *). CharParsing m => m String
isLimit forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *). TokenParsing m => m ()
someSpace forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *). (CharParsing m, Monad m) => m Int
intP

-- | 'SpiderSQL' parser.
--
-- >>> head $ parseString @[] (spiderSQL <* spaces <* isSemicolon) "select * ;"
-- (SpiderSQL {spiderSQLSelect = Select [Agg NoneAggOp (Column (ColUnit {colUnitAggId = NoneAggOp, colUnitTable = Nothing, colUnitColId = Star}))], spiderSQLFrom = From {fromTableUnits = [], fromCond = Nothing}, spiderSQLWhere = Nothing, spiderSQLGroupBy = [], spiderSQLOrderBy = Nothing, spiderSQLHaving = Nothing, spiderSQLLimit = Nothing, spiderSQLIntersect = Nothing, spiderSQLExcept = Nothing, spiderSQLUnion = Nothing},"")
--
-- >>> head $ parseString @[] (spiderSQL <* spaces <* isSemicolon) "select * from concert;"
-- (SpiderSQL {spiderSQLSelect = Select [Agg NoneAggOp (Column (ColUnit {colUnitAggId = NoneAggOp, colUnitTable = Nothing, colUnitColId = Star}))], spiderSQLFrom = From {fromTableUnits = [Table (TableId "concert") Nothing], fromCond = Nothing}, spiderSQLWhere = Nothing, spiderSQLGroupBy = [], spiderSQLOrderBy = Nothing, spiderSQLHaving = Nothing, spiderSQLLimit = Nothing, spiderSQLIntersect = Nothing, spiderSQLExcept = Nothing, spiderSQLUnion = Nothing},"")
--
-- >>> head $ parseString @[] (spiderSQL <* spaces <* isSemicolon) "select T2.name, count(*) from concert as t1 join stadium as t2 on t1.stadium_id = t2.stadium_id group by t1.stadium_id;"
-- (SpiderSQL {spiderSQLSelect = Select [Agg NoneAggOp (Column (ColUnit {colUnitAggId = NoneAggOp, colUnitTable = Just (Left (Alias "T2")), colUnitColId = ColumnId "name"})),Agg NoneAggOp (Column (ColUnit {colUnitAggId = Count, colUnitTable = Nothing, colUnitColId = Star}))], spiderSQLFrom = From {fromTableUnits = [Table (TableId "concert") (Just (Alias "t1")),Table (TableId "stadium") (Just (Alias "t2"))], fromCond = Just (Eq (Column (ColUnit {colUnitAggId = NoneAggOp, colUnitTable = Just (Left (Alias "t1")), colUnitColId = ColumnId "stadium_id"})) (ValColUnit (ColUnit {colUnitAggId = NoneAggOp, colUnitTable = Just (Left (Alias "t2")), colUnitColId = ColumnId "stadium_id"})))}, spiderSQLWhere = Nothing, spiderSQLGroupBy = [ColUnit {colUnitAggId = NoneAggOp, colUnitTable = Just (Left (Alias "t1")), colUnitColId = ColumnId "stadium_id"}], spiderSQLOrderBy = Nothing, spiderSQLHaving = Nothing, spiderSQLLimit = Nothing, spiderSQLIntersect = Nothing, spiderSQLExcept = Nothing, spiderSQLUnion = Nothing},"")
--
-- >>> head $ parseString @[] (spiderSQL <* spaces <* isSemicolon) "SELECT COUNT ( DISTINCT t5.title ) FROM organization AS t3 JOIN author AS t1 ON t3.oid = t1.oid JOIN writes AS t4 ON t4.aid = t1.aid JOIN publication AS t5 ON t4.pid = t5.pid JOIN conference AS t2 ON t5.cid = t2.cid WHERE t2.name = \"VLDB\" AND t3.name = \"University of Michigan\";"
-- (SpiderSQL {spiderSQLSelect = Select [Agg Count (Column (DistinctColUnit {distinctColUnitAggId = NoneAggOp, distinctColUnitTable = Just (Left (Alias "t5")), distinctColUnitColdId = ColumnId "title"}))], spiderSQLFrom = From {fromTableUnits = [Table (TableId "organization") (Just (Alias "t3")),Table (TableId "author") (Just (Alias "t1")),Table (TableId "writes") (Just (Alias "t4")),Table (TableId "publication") (Just (Alias "t5")),Table (TableId "conference") (Just (Alias "t2"))], fromCond = Just (And (And (And (Eq (Column (ColUnit {colUnitAggId = NoneAggOp, colUnitTable = Just (Left (Alias "t3")), colUnitColId = ColumnId "oid"})) (ValColUnit (ColUnit {colUnitAggId = NoneAggOp, colUnitTable = Just (Left (Alias "t1")), colUnitColId = ColumnId "oid"}))) (Eq (Column (ColUnit {colUnitAggId = NoneAggOp, colUnitTable = Just (Left (Alias "t4")), colUnitColId = ColumnId "aid"})) (ValColUnit (ColUnit {colUnitAggId = NoneAggOp, colUnitTable = Just (Left (Alias "t1")), colUnitColId = ColumnId "aid"})))) (Eq (Column (ColUnit {colUnitAggId = NoneAggOp, colUnitTable = Just (Left (Alias "t4")), colUnitColId = ColumnId "pid"})) (ValColUnit (ColUnit {colUnitAggId = NoneAggOp, colUnitTable = Just (Left (Alias "t5")), colUnitColId = ColumnId "pid"})))) (Eq (Column (ColUnit {colUnitAggId = NoneAggOp, colUnitTable = Just (Left (Alias "t5")), colUnitColId = ColumnId "cid"})) (ValColUnit (ColUnit {colUnitAggId = NoneAggOp, colUnitTable = Just (Left (Alias "t2")), colUnitColId = ColumnId "cid"}))))}, spiderSQLWhere = Just (And (Eq (Column (ColUnit {colUnitAggId = NoneAggOp, colUnitTable = Just (Left (Alias "t2")), colUnitColId = ColumnId "name"})) (ValString "VLDB")) (Eq (Column (ColUnit {colUnitAggId = NoneAggOp, colUnitTable = Just (Left (Alias "t3")), colUnitColId = ColumnId "name"})) (ValString "University of Michigan"))), spiderSQLGroupBy = [], spiderSQLOrderBy = Nothing, spiderSQLHaving = Nothing, spiderSQLLimit = Nothing, spiderSQLIntersect = Nothing, spiderSQLExcept = Nothing, spiderSQLUnion = Nothing},"")
spiderSQL :: (TokenParsing m, Monad m) => m SpiderSQL
spiderSQL :: forall (m :: * -> *). (TokenParsing m, Monad m) => m SpiderSQL
spiderSQL = do
  Select
sel <- forall (m :: * -> *). (TokenParsing m, Monad m) => m Select
select
  From
fro <- forall a. a -> Maybe a -> a
fromMaybe ([TableUnit] -> Maybe Cond -> From
From [] forall a. Maybe a
Nothing) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall (m :: * -> *). CharParsing m => m ()
spaces forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *). (TokenParsing m, Monad m) => m From
from)
  Maybe Cond
whe <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall (m :: * -> *). TokenParsing m => m ()
someSpace forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *). (TokenParsing m, Monad m) => m Cond
whereCond)
  [ColUnit]
grp <- forall a. a -> Maybe a -> a
fromMaybe [] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall (m :: * -> *). TokenParsing m => m ()
someSpace forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *). (TokenParsing m, Monad m) => m [ColUnit]
groupBy)
  Maybe OrderBy
ord <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall (m :: * -> *). TokenParsing m => m ()
someSpace forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *). (TokenParsing m, Monad m) => m OrderBy
orderBy)
  Maybe Cond
hav <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall (m :: * -> *). TokenParsing m => m ()
someSpace forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *). (TokenParsing m, Monad m) => m Cond
havingCond)
  Maybe Int
lim <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall (m :: * -> *). TokenParsing m => m ()
someSpace forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *). (TokenParsing m, Monad m) => m Int
limit)
  Maybe SpiderSQL
int <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall (m :: * -> *). TokenParsing m => m ()
someSpace forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *). CharParsing m => m String
isIntersect forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *). TokenParsing m => m ()
someSpace forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *). (TokenParsing m, Monad m) => m SpiderSQL
spiderSQL)
  Maybe SpiderSQL
exc <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall (m :: * -> *). TokenParsing m => m ()
someSpace forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *). CharParsing m => m String
isExcept forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *). TokenParsing m => m ()
someSpace forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *). (TokenParsing m, Monad m) => m SpiderSQL
spiderSQL)
  Maybe SpiderSQL
uni <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall (m :: * -> *). TokenParsing m => m ()
someSpace forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *). CharParsing m => m String
isUnion forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *). TokenParsing m => m ()
someSpace forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *). (TokenParsing m, Monad m) => m SpiderSQL
spiderSQL)
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Select
-> From
-> Maybe Cond
-> [ColUnit]
-> Maybe OrderBy
-> Maybe Cond
-> Maybe Int
-> Maybe SpiderSQL
-> Maybe SpiderSQL
-> Maybe SpiderSQL
-> SpiderSQL
SpiderSQL Select
sel From
fro Maybe Cond
whe [ColUnit]
grp Maybe OrderBy
ord Maybe Cond
hav Maybe Int
lim Maybe SpiderSQL
int Maybe SpiderSQL
exc Maybe SpiderSQL
uni

-- | Auxiliary parser for table names, column names, and aliases.
name :: CharParsing m => m String
name :: forall (m :: * -> *). CharParsing m => m String
name =
  let p :: m Char
p = forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m Char
satisfy (Bool -> Bool -> Bool
(||) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Char -> Bool
isAlphaNum forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Eq a => a -> a -> Bool
== Char
'_'))
   in forall (f :: * -> *) a. Alternative f => f a -> f [a]
some m Char
p -- liftA2 (:) p (atMost 16 p)

-- space1' :: MonadPlus b => Parser b Char String
-- space1' = pure <$> satisfy isSpace

-- digits1' :: MonadPlus b => Parser b Char String
-- digits1' =
--   let p = satisfy isDigit
--    in liftA2 (:) p (atMost 8 p)

-- intP' :: MonadPlus b => Parser b Char Int
-- intP' = digits1' >>= maybe empty pure . readMaybe

-- doubleP' :: MonadPlus b => Parser b Char Double
-- doubleP' =
--   let p = satisfy (not . isSpace)
--    in liftA2 (:) p (atMost 8 p) >>= maybe empty pure . readMaybe

-- sepBy' :: MonadPlus m => m a -> m sep -> m [a]
-- sepBy' p sep = (p `sepBy1'` sep) <|> pure []

-- sepBy1' :: MonadPlus m => m a -> m sep -> m [a]
-- sepBy1' p sep = (:) <$> p <*> atMost 4 (sep *> p)