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

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

module Hidden.ParseLib (
  module Hidden.ParseLibCore
, token
, tokenBack
, tokens
, tokensBack
, build
, repeatParse
, greedyRepeatParse

, optional
, greedyOptional
, list
, greedyList

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

import Hidden.ParseLibCore ( Parse(runParse), MonadParse(..), MonadPlus(..) )
import Control.Monad( replicateM )

--  
-- token t recognises t as the first value in the input.		
--  
token, tokenBack :: (Eq a, MonadParse a m) => a -> m a
token     x = spot     (==x)
tokenBack x = spotBack (==x)

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 min (Just max) p
  | min == max = replicateM min p
  | min <  max = replicateM min p `mplus`
                 (p >:> repeatParse min (Just $ max - 1) p)
repeatParse min Nothing p
  = replicateM min p `mplus` (p >:> repeatParse min Nothing p)
greedyRepeatParse min (Just max) p
  | min == max = replicateM min p
  | min <  max = (p >:> greedyRepeatParse min (Just $ max - 1) p) `mplus`
                 replicateM min p
greedyRepeatParse min Nothing p
  = (p >:> greedyRepeatParse min Nothing p) `mplus` replicateM min p

optional, greedyOptional :: MonadPlus m => m a -> m [a]
optional       = repeatParse       0 (Just 1)
greedyOptional = greedyRepeatParse 0 (Just 1)

list, greedyList :: MonadPlus m => m b -> m [b]
list       = repeatParse       0 Nothing
greedyList = greedyRepeatParse 0 Nothing

-- beginning and end of input

beginningOfInput, endOfInput :: (MonadPlus m, MonadParse a m) => b -> m b
beginningOfInput x = do (pre,_) <- askHere
                        case pre of
			     [] -> return x
			     _  -> mzero
endOfInput x       = do (_,post) <- askHere
                        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