module RestyScript.Parser.View (
    readView, parseView
) where

import RestyScript.Parser
import RestyScript.AST
import Text.ParserCombinators.Parsec
import Text.ParserCombinators.Parsec.Expr
import Monad (liftM)

readView :: String -> String -> Either ParseError RSVal
readView = parse (do {
    ast <- parseView;
    many (string ";" >> spaces) >> eof;
    return ast })

parseView :: Parser RSVal
parseView = do ast <- (spaces >> parseSetExpr)
               spaces
               return ast

parseSetExpr :: Parser RSVal
parseSetExpr = buildExpressionParser setOpTable parseQuery

setOpTable = [[
                op "union", op "except", op "intersect" ]]
      where
        op s
           = Infix (do { reservedWord s;
                         spaces;
                         suffix <- option "" (keyword "all");
                         spaces;
                         return $ SetOp $
                            if suffix == "" then s else s ++ " all" }
                <?> "operator") AssocLeft

parseQuery :: Parser RSVal
parseQuery = do select <- spaces >> parseSelect
                from <- option Empty parseFrom
                whereClause <- option Empty parseWhere
                moreClauses <- sepBy parseMoreClause spaces
                return $ Query $ filter (Empty /=)
                    [select, from, whereClause] ++ moreClauses
         <|> parens parseSetExpr
         <?> "select statement"

parseSet :: Parser RSVal
parseSet = try(parseFuncCall)
        <|> parseModel
        <|> parseQuery
        <?> "model"

parseMoreClause :: Parser RSVal
parseMoreClause = parseOrderBy
              <|> parseLimit
              <|> parseOffset
              <|> parseGroupBy

parseLimit :: Parser RSVal
parseLimit = liftM Limit (keyword "limit" >> many1 space >> parseExpr)
         <?> "limit clause"

parseOffset :: Parser RSVal
parseOffset = liftM Offset (keyword "offset" >> many1 space >> parseExpr)
          <?> "offset clause"

parseOrderBy :: Parser RSVal
parseOrderBy = do try (keyword "order") >> many1 space >>
                    keyword "by" >> many1 space
                  liftM OrderBy $ sepBy1 parseOrderPair listSep
           <?> "order by clause"

parseOrderPair :: Parser RSVal
parseOrderPair = do col <- parseColumn
                    dir <- parseDir
                    spaces
                    return $ OrderPair col dir

parseDir :: Parser RSVal
parseDir = liftM Keyword (keyword "asc")
       <|> liftM Keyword (keyword "desc")
       <|> parseVariable
       <|> (return $ Keyword "asc")

parseGroupBy :: Parser RSVal
parseGroupBy = liftM GroupBy (keyword "group" >> many1 space >>
                    keyword "by" >> many1 space >> parseColumn)

parseFrom :: Parser RSVal
parseFrom = liftM From (keyword "from" >> many1 space >>
                sepBy1 parseFromItem listSep)
        <?> "from clause"

parseFromItem :: Parser RSVal
parseFromItem = do set <- parseSet
                   alias <- option Null parseSetAlias
                   return $ case alias of
                                Null -> set
                                otherwise -> Alias set alias

parseSetAlias :: Parser RSVal
parseSetAlias = keyword "as" >> many1 space >> (parseIdent <|> parseCapture)

parseCapture :: Parser RSVal
parseCapture = liftM Capture $ parens (sepBy1 parseParam listSep)

parseParam :: Parser (RSVal, RSVal)
parseParam = do param <- parseIdent
                typ <- spaces >> parseType
                return (param, typ)

parseType :: Parser RSVal
parseType = do s <- symbol
               spaces
               return $ Type s

parseSelect :: Parser RSVal
parseSelect = do keyword "select" >> many1 space
                 cols <- parseModifiedQuery
                 return $ Select cols

parseModifiedQuery :: Parser [RSVal]
parseModifiedQuery = do
    mod <- option "" (keyword "distinct" <|> keyword "all")
    spaces
    lst <- parseSelectedItemList
    spaces
    return $ case mod of
        "distinct" -> [Distinct lst]
        "all" -> [All lst]
        otherwise -> lst

parseSelectedItemList :: Parser [RSVal]
parseSelectedItemList = do
    cols <- sepBy1 (parseSelectedItem <|> parseAnyColumn) listSep
    spaces
    return cols

parseSelectedItem :: Parser RSVal
parseSelectedItem = do col <- parseExpr
                       alias <- option Null
                            (keyword "as" >> spaces >> parseIdent)
                       return $ case alias of
                            Null -> col
                            otherwise -> Alias col alias