-- Copyright (c) 2010, Diego Souza
-- All rights reserved.
--
-- Redistribution and use in source and binary forms, with or without
-- modification, are permitted provided that the following conditions are met:
--
--   * Redistributions of source code must retain the above copyright notice,
--     this list of conditions and the following disclaimer.
--   * Redistributions in binary form must reproduce the above copyright notice,
--     this list of conditions and the following disclaimer in the documentation
--     and/or other materials provided with the distribution.
--   * Neither the name of the <ORGANIZATION> nor the names of its contributors
--     may be used to endorse or promote products derived from this software
--     without specific prior written permission.
--
-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
-- ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
-- WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
-- DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
-- FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-- DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
-- SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
-- CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
-- OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
-- OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

-- | Syntactic analysis of Yql statements
module Yql.Core.Parser
       ( -- * Types
         ParserEvents(..)
       , AssertOperator(..)
       , SingleOperator(..)
       , ListOperator(..)
       , Limit
       , ParseError
         -- * Parser
       , parseYql
       )
       where

import Text.ParserCombinators.Parsec
import Yql.Core.Lexer

type YqlParser a = GenParser Token () a

-- | Limit in terms of (offset,amount)
type Limit = (Integer,Integer)

-- | Tests if column satisfies a given property
data AssertOperator i = IsNullOp i
                      | IsNotNullOp i

-- | Operators in where clause that takes a single value
data SingleOperator i v = EqOp i v
                        | NeOp i v
                        | GtOp i v
                        | GeOp i v
                        | LtOp i v
                        | LeOp i v
                        | LikeOp i v
                        | NotLikeOp i v
                        | MatchesOp i v
                        | NotMatchesOp i v

-- | Operator in where clause that takes a list of values
data ListOperator i v = InOp i [v]

-- | Events the parser generates. The main purpose of this is to allow
-- you constructing types that represents yql statements.
data ParserEvents i v w f s = ParserEvents { onIdentifier :: String -> i
                                           , onTxtValue   :: String -> v
                                           , onNumValue   :: String -> v
                                           , onSubSelect  :: s -> v
                                           , onMeValue    :: v
                                           , onSelect     :: [i] -> i -> Maybe w -> Maybe Limit -> Maybe Limit -> [f] -> s
                                           , onUpdate     :: [(i,v)] -> i -> Maybe w -> [f] -> s
                                           , onInsert     :: [(i,v)] -> i -> [f] -> s
                                           , onDelete     :: i -> Maybe w -> [f] -> s
                                           , onUse        :: String -> i -> s -> s
                                           , onShowTables :: [f] -> s
                                           , onDesc       :: i -> [f] -> s
                                           , onAssertOp   :: AssertOperator i -> w
                                           , onSingleOp   :: SingleOperator i v -> w
                                           , onListOp     :: ListOperator i v -> w
                                           , onAndExpr    :: w -> w -> w
                                           , onOrExpr     :: w -> w -> w
                                           , onLocalFunc  :: i -> [(i,v)] -> f
                                           , onRemoteFunc :: i -> [(i,v)] -> f
                                           }

-- | Parses an string, which must be a valid yql expression, using
-- ParserEvents to create generic types.
parseYql :: String -> ParserEvents i v w f s -> Either ParseError s
parseYql input e = case tokStream
                   of Left err     -> Left err
                      Right input_ -> runParser myParser () "stdin" input_
  where tokStream = runParser scan "" "stdin" input
        
        myParser = do expr <- parseYql_ e
                      tkEof
                      return expr

parseYql_ :: ParserEvents i v w f s -> YqlParser s
parseYql_ e = do (parseDesc e >>= semiColon)
                 <|> (parseSelect e >>= semiColon )
                 <|> (parseUpdate e >>= semiColon )
                 <|> (parseInsert e >>= semiColon )
                 <|> (parseDelete e >>= semiColon )
                 <|> (parseShowTables e >>= semiColon)
                 <|> parseUse e
  where semiColon v = do keyword (==";")
                         return v

quoted :: YqlParser String
quoted = accept test
  where test (TkStr s) = Just s
        test _         = Nothing

numeric :: YqlParser String
numeric = accept test
  where test (TkNum n) = Just n
        test _         = Nothing

keyword :: (String -> Bool) -> YqlParser String
keyword p = accept test
  where test (TkKey k) | p k       = Just k
                       | otherwise = Nothing
        test _                     = Nothing

symbol :: (String -> Bool) -> YqlParser String
symbol p = accept test
  where test (TkSym s) | p s       = Just s
                       | otherwise = Nothing
        test _                     = Nothing

symbol_ :: YqlParser String
symbol_ = symbol (const True)

-- anyTokenT :: YqlParser TokenT
-- anyTokenT = accept Just

tkEof :: YqlParser ()
tkEof = accept $ \t -> case t
                       of TkEOF -> Just ()
                          _     -> Nothing

parseDesc :: ParserEvents i v w f s -> YqlParser s
parseDesc e = do keyword (=="DESC")
                 t <- parseIdentifier e
                 f <- parseFunctions e
                 return (onDesc e t f)

parseShowTables :: ParserEvents i v w f s -> YqlParser s
parseShowTables e = do keyword (=="SHOW")
                       keyword (=="TABLES")
                       f <- parseFunctions e
                       return (onShowTables e f)

parseUse :: ParserEvents i v w f s -> YqlParser s
parseUse e = do keyword (=="USE")
                url  <- quoted
                keyword (=="AS")
                as   <- parseIdentifier e
                keyword (==";")
                stmt <- parseYql_ e
                return (onUse e url as stmt)

parseSelect :: ParserEvents i v w f s -> YqlParser s
parseSelect e = do keyword (=="SELECT")
                   c <- (fmap (const [onIdentifier e "*"]) (keyword (=="*"))
                         <|> parseIdentifier e `sepBy` keyword (==","))
                   keyword (=="FROM")
                   t <- parseIdentifier e
                   rl <- remoteLimit
                         <|> return Nothing
                   w <- whereClause
                        <|> return Nothing
                   ll <- localLimit
                         <|> return Nothing
                   f <- parseFunctions e
                   return (onSelect e c t w rl ll f)
  where whereClause = do keyword (=="WHERE")
                         fmap Just (parseWhere e)
        
        remoteLimit = do keyword (=="(")
                         off <- fmap read numeric
                         lim <- (do keyword (==",")
                                    sz <- fmap read numeric
                                    return (off,sz)
                                ) <|> return (0,off)
                         keyword (==")")
                         return (Just lim)
        
        localLimit = do keyword (=="LIMIT")
                        lim <- fmap read numeric
                        off <- (do keyword (=="OFFSET")
                                   fmap read numeric
                               ) <|> return 0
                        return (Just (off,lim))

parseUpdate :: ParserEvents i v w f s -> YqlParser s
parseUpdate e = do keyword (=="UPDATE")
                   t <- parseIdentifier e
                   keyword (=="SET")
                   c <- parseSet `sepBy` keyword (==",")
                   w <- whereClause
                        <|> return Nothing
                   f <- parseFunctions e
                   return (onUpdate e c t w f)
  where whereClause = do keyword (=="WHERE")
                         fmap Just (parseWhere e)
        
        parseSet = do k <- parseIdentifier e
                      keyword (=="=")
                      v <- parseValue False e
                      return (k,v)

parseDelete :: ParserEvents i v w f s -> YqlParser s
parseDelete e = do keyword (=="DELETE")
                   keyword (=="FROM")
                   t <- parseIdentifier e
                   w <- whereClause
                        <|> return Nothing
                   f <- parseFunctions e
                   return (onDelete e t w f)
  where whereClause = do keyword (=="WHERE")
                         fmap Just (parseWhere e)

parseInsert :: ParserEvents i v w f s -> YqlParser s
parseInsert e = do keyword (=="INSERT")
                   keyword (=="INTO")
                   t <- parseIdentifier e
                   keyword (=="(")
                   c <- parseIdentifier e `sepBy` keyword (==",")
                   keyword (==")")
                   keyword (=="VALUES")
                   keyword (=="(")
                   v <- parseValue False e `sepBy` keyword (==",")
                   keyword (==")")
                   f <- parseFunctions e
                   return (onInsert e (zip c v) t f)

parseIdentifier :: ParserEvents i v w f s -> YqlParser i
parseIdentifier e = fmap (onIdentifier e) symbol_

parseValue :: Bool -> ParserEvents i v w f s -> YqlParser v
parseValue allowss e = fmap (onTxtValue e) quoted
                       <|> fmap (onNumValue e) numeric
                       <|> fmap (const $ onMeValue e) (keyword (=="ME"))
                       <|> if (allowss)
                           then fmap (onSubSelect e) (parseSelect e)
                           else fail "expecting Numeric|String|me"

parseWhere :: ParserEvents i v w f s -> YqlParser w
parseWhere e = do c       <- parseIdentifier e
                  wclause <- parseScalar c
                             <|> parseList c
                             <|> parseAssert c
                  (keyword (=="AND") >> fmap (onAndExpr e wclause) (parseWhere e))
                   <|> (keyword (=="OR") >> fmap (onOrExpr e wclause) (parseWhere e))
                   <|> return wclause
  where parseScalar c = (keyword (=="=") >> fmap (onSingleOp e . EqOp c) (parseValue False e))
                        <|> (keyword (=="!=") >> fmap (onSingleOp e . NeOp c) (parseValue False e))
                        <|> (keyword (==">=") >> fmap (onSingleOp e . GeOp c) (parseValue False e))
                        <|> (keyword (=="<=") >> fmap (onSingleOp e . LeOp c) (parseValue False e))
                        <|> (keyword (==">") >> fmap (onSingleOp e . GtOp c) (parseValue False e))
                        <|> (keyword (=="<") >> fmap (onSingleOp e . LtOp c) (parseValue False e))
                        <|> (keyword (=="LIKE") >> fmap (onSingleOp e . LikeOp c) (parseValue False e))
                        <|> (keyword (=="MATCHES") >> fmap (onSingleOp e . MatchesOp c) (parseValue False e))
                        <|> (keyword (=="NOT") >> ((keyword (=="LIKE") >> fmap (onSingleOp e . NotLikeOp c) (parseValue False e))
                                                   <|> (keyword (=="MATCHES") >> fmap (onSingleOp e . NotMatchesOp c) (parseValue False e))))

        parseAssert c = keyword (=="IS") >> ((keyword (=="NOT") >> keyword (=="NULL") >> return (onAssertOp e (IsNotNullOp c)))
                                             <|> (keyword (=="NULL") >> return (onAssertOp e (IsNullOp c))))

        parseList c = do keyword (=="IN")
                         keyword (=="(")
                         list <- fmap (onListOp e . InOp c) (parseValue True e `sepBy` keyword (==","))
                         keyword (==")")
                         return list

parseFunctions :: ParserEvents i v w f s -> YqlParser [f]
parseFunctions e = (keyword (=="|") >> parseFunction e `sepBy` keyword (=="|"))
                   <|> return []

parseFunction :: ParserEvents i v w f s -> YqlParser f
parseFunction e = do n <- symbol_
                     keyword (=="(")
                     argv <- arguments `sepBy` keyword (==",")
                     keyword (==")")
                     mkFunc n argv
  where arguments = do k <- parseIdentifier e
                       keyword (=="=")
                       v <- parseValue False e
                       return (k,v)

        mkFunc ('.':n) argv = return (onLocalFunc e (onIdentifier e n) argv)
        mkFunc n argv       = return (onRemoteFunc e (onIdentifier e n) argv)