{-# LANGUAGE MultiParamTypeClasses #-}

-- | It will help in using this library if you are familiar with
-- Parsec. (The best way to become familiar with Parsec is to read the
-- source. See also <http://www.cs.uu.nl/people/daan/parsec.html>)

module Text.ParserCombinators.Parsely.Class where

import Control.Monad
import qualified Text.ParserCombinators.Parsec as P

infix  0 <?>
infixr 1 <|>

-- | This is just a type-restricted version of 'mplus' (as in Parsec)
(<|>) :: Parsely m => m a -> m a -> m a
(<|>) = mplus

class (Functor m, MonadPlus m) => Parsely m where

    -- | Give a name to a parser (used in error messages, hopefully)

    (<?>) :: m a -> String -> m a
    (<?>) = const


    -- | This parser didn't expect that input. Try other branch of
    -- '<|>'? Nearly the same as 'mzero', but 'mzero' may produce a
    -- less informative message in case of error.

    unexpected :: String -> m a
    unexpected _ = mzero


    -- | Run given parser as many times as possible, returning
    -- results. In the typeclass because Parsec needs them as
    -- primitives to avoid stack overflow. (XXX how will we preserve
    -- space properties with monad transformers?)

    many :: m a -> m [a]
    many p = go []
        where 
        go xs = do x <- p; go (x:xs)
                   <|> return (reverse xs)

    -- | Run given parser as many times as possible, discarding
    -- results. Here for the same reason as 'many'.

    skipMany :: m a -> m ()
    skipMany p = (p >> skipMany p)
                 <|> return ()

class Parsely m => ParselyTry m where

    -- | If argument fails consuming input, act as if it wasn't consumed. (I.e. put
    -- it back)

    try :: m a -> m a

class ParselyTry m => MonadParsec m tok pos 
    | m -> tok, m -> pos where
    token :: (tok -> String) -> (tok -> pos) -> (tok -> Maybe a) -> m a
    tokenPrim
        :: (tok -> String) -> (pos -> tok -> [tok] -> pos)
        -> (tok -> Maybe a) -> m a
    tokens 
        :: Eq tok => ([tok] -> String) -> (pos -> [tok] -> pos) -> [tok] -> m [tok]
    lookAhead :: m a -> m a

instance Parsely (P.GenParser tok st) where
    (<?>)      = P.label
    unexpected = P.unexpected
    many       = P.many
    skipMany   = P.skipMany

instance ParselyTry (P.GenParser tok st) where
    try        = P.try

instance MonadParsec (P.GenParser tok st) tok P.SourcePos where
    token     = P.token
    tokenPrim = P.tokenPrim
    tokens    = P.tokens
    lookAhead = P.lookAhead