--	ParseLib.hs
--
--	Author: Yoshikuni Jujo <PAF01143@nifty.ne.jp>
--

{-# OPTIONS_GHC -fglasgow-exts #-}
{-# OPTIONS_GHC -fallow-undecidable-instances #-}

module Text.ParserCombinators.MTLParse.MTLParse (
  module Text.ParserCombinators.MTLParse.MTLParseCore
, tokens
, tokensBack
, build
, repeatParse
, greedyRepeatParse

, optional
, greedyOptional
, list
, greedyList
, neList
, greedyNeList

, beginningOfInput
, endOfInput
, (>++>)
, (>:>)
) where

import Text.ParserCombinators.MTLParse.MTLParseCore -- ( Parse(runParse), MonadParse(..), MonadPlus(..),
                           --  token, tokenBack )
import Control.Monad( replicateM )

tokens, tokensBack :: (Eq a, MonadParse a m) => [a] -> m [a]
tokens     = foldr (>:>) (return []) . map token
tokensBack = foldr (>:>) (return []) . map tokenBack

build :: Monad m => m a -> (a -> b) -> m b
build p f = p >>= return . f

repeatParse, greedyRepeatParse ::
  MonadPlus m => Int -> Maybe Int -> m b -> m [b]
repeatParse mn (Just mx) p
  | mn == mx  = replicateM mn p
  | mn <  mx  = replicateM mn p `mplus` (p >:> repeatParse mn (Just $ mx - 1) p)
  | otherwise = error "minimal larger than maximal"
repeatParse mn Nothing p
  = replicateM mn p `mplus` (p >:> repeatParse mn Nothing p)
greedyRepeatParse mn (Just mx) p
  | mn == mx  = replicateM mn p
  | mn <  mx  = (p >:> greedyRepeatParse mn (Just $ mx - 1) p) `mplus`
                  replicateM mn p
  | otherwise = error "minimal larger than maximal"
greedyRepeatParse mn Nothing p
  = (p >:> greedyRepeatParse mn Nothing p) `mplus` replicateM mn p

optional, greedyOptional, list, greedyList, neList, greedyNeList ::
						MonadPlus m => m a -> m [a]
optional       = repeatParse       0 (Just 1)
greedyOptional = greedyRepeatParse 0 (Just 1)
list           = repeatParse       0 Nothing
greedyList     = greedyRepeatParse 0 Nothing
neList         = repeatParse       1 Nothing
greedyNeList   = greedyRepeatParse 1 Nothing

-- beginning and end of input

beginningOfInput, endOfInput :: (MonadPlus m, MonadParse a m) => b -> m b
beginningOfInput x = do (pre,_) <- getHere
                        case pre of
			     [] -> return x
			     _  -> mzero
endOfInput x       = do (_,post) <- getHere
                        case post of
		             [] -> return x
		             _  -> mzero

(>++>) :: Monad m => m [a] -> m [a] -> m [a]
m1 >++> m2 = do x <- m1; y <- m2; return $ x ++ y
(>:>)  :: Monad m => m a -> m [a] -> m [a]
m1 >:>  m2 = do x <- m1; y <- m2; return $ x : y