module TestParserComb
where

import Data.Char
import Data.List
import ParserComb


{- Parsers for language S -}

parseS = parseAlt parseA parseB
parseA = parseSeq parseC parseD
parseB = parseStar parseB
parseC = parseOpt parseF

parseD ('1':xs) = (True, xs)       -- try "1" (shortcut)
parseD ('@':xs) =                  -- try "@" (shortcut)
    case parseS xs of              -- try S
        (True,  ys) -> (True, ys)
        (False, _ ) -> (False,xs) 
parseD xs      = (False, xs)

parseE xs = parseChar '3' xs
parseF xs = parseChar '2' xs

parseChar :: Char -> String -> (Bool,String)
parseChar c (x:xs')
    | x == c   = (True, xs')
parseChar _ xs = (False,xs )


{- Parsers for prefix expression language -}

parse = parseSeq parseSpaces parseExpr

parseSpaces :: Parser String Bool
parseSpaces =
    \xs -> (True, dropWhile isSpace xs)

parseExpr :: Parser String Bool
parseExpr =
    parseAltList
        [ parseVar
        , parseVal
        , parseOpExpr
        ]

parseVar :: Parser String Bool
parseVar = 
    \xs ->
        case xs of
            []    -> (False, [])
            (y:_) ->
                let isFirstId c = isAlpha c || c == '_' 
                    isRestId  c = isAlphaNum c || c == '_' 
                    (id, rest)  = span isRestId xs
                in if isFirstId y then (True, rest) else (False, xs)

parseVal :: Parser String Bool
parseVal =
    parseSeq
        (parseOpt (parseSym "-"))
        parseUnsigned
        
parseUnsigned :: Parser String Bool
parseUnsigned =
    \xs ->
        case xs of
            []    -> (False, [])
            (y:_) ->
                let (num,rest) = span isDigit xs
                in if isDigit y then (True, rest) else (False, xs)

parseOpExpr :: Parser String Bool
parseOpExpr =
    parseSeqList
        [ parseSpaces
        , parseSym "("
        , parseSpaces
        , parseOp
        , parseSpaces
        , parseOperands
        , parseSpaces
        , parseSym ")"
        ]

parseSym :: String -> Parser String Bool
parseSym s =
    \xs ->
        case stripPrefix s xs of
            Just ys -> (True,  ys)
            Nothing -> (False, xs)

parseOp :: Parser String Bool
parseOp =
    parseAltList
        [ parseSym "+"
        , parseSym "-"
        , parseSym "*"
        , parseSym "/"
        ]
 
parseOperands :: Parser String Bool
parseOperands =
    parseStar (parseSeq parseSpaces parseExpr)



{- PARTIAL TESTING -}

{- Function "test" takes a string and prints both the "Expr"
   and "[Token]" returns from "expr".
-}

test :: String -> IO()
test xs = putStrLn ("\nExpression:  " ++ (show xs) ++
                    "\nResult:      " ++ (show (parse xs)))

-- A few test cases

test00  = test ""                    -- Fails
test01  = test "x3"
test02  = test "3"
test03  = test "(+ xx 1)"
test04  = test "(+ yy 3)"
test05  = test "(+ x (* 0 (+ 3 x2)))"
test06  = test "(+ x (* 0 (+ 3 x2))" -- Fails
test07  = test ")*(&)("              -- Fails
test08  = test "x1xd!"               -- Succeeds, remaining input
test09  = test "-12"
test10  = test "-   12"              -- Fails (diff from ParsePrefix)
test11  = test "(-12)"               -- Succeeds (diff from ParsePrefix)
test12  = test "(+ 3 - 12)"          
test13  = test "(- 3 - 12)" 
test14  = test "(- 3 - - 12)"        -- Fails
test15  = test "(neg (+ 1 2))"
test16  = test "(cos (+ 1 2))"
test17  = test "(sin (+ 1 2))"
test18  = test "(if z (+ x 1) (- y 1))"
test19  = test "(neg (+ 1 2) 13)"
test20  = test "(+ (+ 1 2))"
test21  = test "(+ (+ 1 2) x y z)"
test22  = test "min"
test23  = test "(<= 2 3 )"
test24  = test "(<= (== 2 3) x)"
test25  = test "(! 0)"
test26  = test "(! 1  2)"
test27  = test "(&& 0 1)"
test28  = test "(|| 0 1)"
test29  = test "(, 0 1)"
test30  = test "()"
test31  = test "(())"

main =
    do
        test00
        test01
        test02
        test03
        test04
        test05
        test06
        test07
        test08
        test09
        test10
        test11
        test12
        test13
        test14
        test15
        test16
        test17
        test18
        test19
        test20
        test21
        test22
        test23
        test24
        test25
        test26
        test27
        test28
        test29
        test30
        test31