{-|
Module      : Data.JustParse.Common
Description : Common Parser Combinators
Copyright   : Copyright Waived
License     : PublicDomain
Maintainer  : grantslatton@gmail.com
Stability   : experimental
Portability : portable

Many common parsing needs in one place.
-}

{-# LANGUAGE Safe #-}
module Data.JustParse.Common (
-- Parsing
    Stream(..),
    Result(..),
    Parser( parse ),
    finalize,
    extend,
    justParse,
    runParser,
    isDone,
    isFail,
    isPartial,
    rename,
    (<?>),

-- Primitive parsers
    satisfy,
    mN,

-- Derived Parsers

-- Generic Parsers
    test,
    greedy,
    option,
    many,
    many1,
    manyN,
    atLeast,
    exactly,
    eof,
    oneOf,
    noneOf,
    anyToken,
    lookAhead,

-- Char Parsers
    char,
    anyChar,
    ascii,
    latin1,
    control,
    space,
    lower,
    upper,
    alpha,
    alphaNum,
    print,
    digit,
    octDigit,
    hexDigit,
    eol,

-- String Parsers
    string,

) where

import Prelude hiding ( print, length )
import Data.JustParse.Internal ( Stream(..), Parser(..), Result(..), extend, finalize, isDone, isPartial, isFail, rename, (<?>) )
import Data.Monoid ( mempty, Monoid )
import Data.Maybe ( fromMaybe )
import Data.List ( minimumBy )
import Data.Char ( isControl, isSpace, isLower, isUpper, isAlpha, isAlphaNum, isPrint, 
                   isDigit, isOctDigit, isHexDigit, isLetter, isMark, isNumber, isPunctuation, 
                   isSymbol, isSeparator, isAscii, isLatin1, isAsciiUpper, isAsciiLower )
import Data.Ord ( comparing )
import Control.Monad ( void, (>=>), liftM )
import Control.Applicative ( (<|>), optional, (<*) )

-- | Supplies the input to the 'Parser'. Returns all 'Result' types, 
-- including 'Partial' and 'Fail' types.
runParser :: Parser s a -> s -> [Result s a]
runParser p = parse p . Just

-- | This is a \"newbie\" command that one should probably only use out of frustration.
-- It runs the 'Parser' greedily over the input, 'finalize's all the results, and returns
-- the first successful result. If there are no successful results, it returns Nothing.
justParse :: Stream s t => Parser s a -> s -> Maybe a
justParse p s = 
    case finalize (parse (greedy p) (Just s)) of
        [] -> Nothing
        (Done v _:_) -> Just v
        (Fail m _:_) -> Nothing

-- | Parse a token that satisfies a predicate.
satisfy :: Stream s t => (t -> Bool) -> Parser s t
satisfy f = Parser $ \s -> 
    case s of
        Nothing -> [Fail ["satisfy"] s]
        Just s' -> case uncons s' of
            Nothing -> [Partial $ parse (satisfy f)]
            Just (x, xs) -> 
                if f x 
                    then [Done x (Just xs)]
                    else [Fail ["satisfy"] s]

-- | Parse from @m@ to @n@ occurences of a 'Parser'. Let @n@ be negative
-- if one wishes for no upper bound.
mN :: Int -> Int -> Parser s a -> Parser s [a]
mN m n p = mN' m n p <?> "mN"

mN' :: Int -> Int -> Parser s a -> Parser s [a]
mN' _ 0 _ = Parser $ \s -> [Done [] s] 
mN' m n p = Parser $ \s -> 
    if m == 0 
        then Done [] s : (parse p s >>= g)
        else             parse p s >>= g
    where
        m' = if m == 0 then 0 else m-1
        g (Done a s) = parse (mN' m' (n-1) p) s >>= h a
        g (Partial p') = [Partial $ p' >=> g]
        g (Fail m l) = [Fail m l]
        h a (Done as s) = [Done (a:as) s]
        h a (Partial p') = [Partial $ p' >=> h a]
        h a (Fail m l) = [Fail m l]

-- | Return @True@ if the 'Parser' would succeed if one were to apply it,
-- otherwise, @False@.
test :: Parser s a -> Parser s Bool
test p = 
    do 
        a <- optional (lookAhead p)
        case a of
            Nothing -> return False
            _ -> return True

-- | Modifies a 'Parser' so that it will ony return the most consumptive
-- succesful results. If there are no successful results, it will only
-- return the most consumptive failures. One can use @greedy@ to emulate
-- parsers from @Parsec@ or @attoparsec@.
greedy :: Stream s t => Parser s a -> Parser s a
greedy (Parser p) = Parser $ \s -> g (p s) 
    where
        b (Done _ _) = True
        b (Fail _ _) = True
        b _ = False
        f Nothing = 0
        f (Just s) = length s
        g [] = []
        g xs 
            | all b xs = 
                let
                    ds = filter isDone xs
                    dm = minimum (map (f . leftover) ds)
                    fs = filter isFail xs
                    fm = minimum (map (f . leftover) fs)
                in
                    if not (null ds)
                        then filter ((dm==) . f . leftover) ds
                        else filter ((fm==) . f . leftover) fs
            | otherwise = [Partial $ \s -> g $ extend s xs] 

-- | Attempts to apply a parser and returns a default value if it fails.
option :: a -> Parser s a -> Parser s a
option v p = 
    do
        r <- optional p
        case r of
            Nothing -> return v
            Just v' -> return v'

-- | Parse any number of occurences of the 'Parser'. Equivalent to @'mN' 0 (-1)@.
many :: Parser s a -> Parser s [a]
many p = rename "many" (mN 0 (-1) p)

-- | Parse one or more occurence of the 'Parser'. Equivalent to @'mN' 1 (-1)@.
many1 :: Parser s a -> Parser s [a]
many1 p = rename "many1" (mN 1 (-1) p)

-- | Parse at least @n@ occurences of the 'Parser'. Equivalent to @'mN' n (-1)@.
manyN :: Int -> Parser s a -> Parser s [a]
manyN n p = rename "manyN" (mN n (-1) p)

-- | Identical to 'manyN', just a more intuitive name.
atLeast :: Int -> Parser s a -> Parser s [a]
atLeast n p = rename "atLeast" (mN n (-1) p)

-- | Parse exactly @n@ occurences of the 'Parser'. Equivalent to @'mN' n n@.
exactly :: Int -> Parser s a -> Parser s [a]
exactly n p = rename "exactly" (mN n n p)

-- | Only succeeds when supplied with @Nothing@.
eof :: (Eq s, Monoid s) => Parser s ()
eof = Parser $ \s ->
    case s of
        Nothing -> [Done () s]
        Just s' -> 
            if s' == mempty
                then [Partial $ parse eof]
                else [Fail ["eof"] (Just s')]

oneOf :: (Eq t, Stream s t) => [t] -> Parser s t
oneOf ts = rename "oneOf" (satisfy (`elem` ts))

noneOf :: (Eq t, Stream s t) => [t] -> Parser s t
noneOf ts = rename "noneOf" (satisfy (not . (`elem` ts)))

-- | Parse a specific token.
token :: (Eq t, Stream s t) => t -> Parser s t
token t = rename "token" (satisfy (==t))

anyToken :: Stream s t => Parser s t
anyToken = rename "anyToken" (satisfy (const True))

-- | Applies the parser and returns its result, but resets
-- the leftovers as if it consumed nothing.
lookAhead :: Parser s a -> Parser s a
lookAhead (Parser p) = rename "lookAhead" $ Parser $ \s -> 
    let 
        g (Done a _) = [Done a s]
        g (Partial p') = [Partial $ p' >=> g]
        g (Fail m _) = [Fail m s]
    in
        p s >>= g

-- | Parse a specic char.
char :: Stream s Char => Char -> Parser s Char
char c = rename ("char "++[c]) (token c)

anyChar :: Stream s Char =>  Parser s Char
anyChar = rename "anyChar" anyToken

ascii :: Stream s Char =>  Parser s Char
ascii = rename "ascii" (satisfy isAscii)

latin1 :: Stream s Char =>  Parser s Char
latin1 = rename "latin1" (satisfy isLatin1)

control :: Stream s Char =>  Parser s Char
control = rename "control" (satisfy isControl)

space :: Stream s Char =>  Parser s Char
space = rename "space" (satisfy isSpace)

lower :: Stream s Char =>  Parser s Char
lower = rename "lower" (satisfy isLower)

upper :: Stream s Char =>  Parser s Char
upper = rename "upper" (satisfy isUpper)

alpha :: Stream s Char =>  Parser s Char
alpha = rename "alpha" (satisfy isAlpha)

alphaNum :: Stream s Char =>  Parser s Char
alphaNum = rename "alphaNum" (satisfy isAlphaNum)

print :: Stream s Char =>  Parser s Char
print = rename "print" (satisfy isPrint)

digit :: Stream s Char =>  Parser s Char
digit = rename "digit" (satisfy isDigit)

octDigit :: Stream s Char =>  Parser s Char
octDigit = rename "octDigit" (satisfy isOctDigit)

hexDigit :: Stream s Char =>  Parser s Char
hexDigit = rename "hexDigit" (satisfy isHexDigit)

-- | Parse a specific string.
string :: Stream s Char => String -> Parser s String
string s = rename ("string "++s) (mapM char s)

-- | Parses until a newline, carriage return + newline, or newline + carriage return.
eol :: Stream s Char => Parser s String
eol = rename "eol" (string "\r\n" <|> string "\n\r" <|> string "\n")

-- | Makes common types such as Strings into a Stream.
instance (Eq t) => Stream [t] t where
    uncons [] = Nothing
    uncons (x:xs) = Just (x, xs)