-----------------------------------------------------------------------------
-- |
-- Module      :  Text.ParserCombinators.Parsely.Combinator
-- Copyright   :  (c) Daan Leijen 1999-2001, (c) Samuel Bronson 2007
-- License     :  BSD-style
-- 
-- Maintainer  :  naesten@gmail.com
-- Stability   :  provisional
-- Portability :  non-portable (multi-param classes, functional dependencies)
--
-- Commonly used generic combinators
-- 
-----------------------------------------------------------------------------

module Text.ParserCombinators.Parsely.Combinator
                        ( choice
                        , count
                        , between
                        , option, optional
                        , skipMany1
                        , many1
                        , sepBy, sepBy1
                        , endBy, endBy1
                        , sepEndBy, sepEndBy1
                        , chainl, chainl1
                        , chainr, chainr1
                        , eof, notFollowedBy
                        
                        -- tricky combinators
                        , manyTill, lookAhead, anyToken
                        ) where

import Control.Monad
import Text.ParserCombinators.Parsely.Class


----------------------------------------------------------------
--
----------------------------------------------------------------
choice :: Parsely m => [m a] -> m a
choice ps           = foldr (<|>) mzero ps

option :: Parsely m => a -> m a -> m a
option x p          = p <|> return x

optional :: Parsely m => m t -> m ()
optional p          = do{ p; return ()} <|> return ()

between :: Parsely m => m open -> m close -> m a -> m a
between open close p
                    = do{ open; x <- p; close; return x }
                
                
skipMany1 :: Parsely m => m a -> m ()
skipMany1 p         = do{ p; skipMany p }
{-
skipMany p          = scan
                    where
                      scan  = do{ p; scan } <|> return ()
-}

many1 :: Parsely m => m a -> m [a]
many1 p             = do{ x <- p; xs <- many p; return (x:xs) }
{-
many p              = scan id
                    where
                      scan f    = do{ x <- p
                                    ; scan (\tail -> f (x:tail))
                                    }
                                <|> return (f [])
-}

sepBy1,sepBy :: Parsely m => m a -> m sep -> m [a]
sepBy p sep         = sepBy1 p sep <|> return []
sepBy1 p sep        = do{ x <- p
                        ; xs <- many (sep >> p)
                        ; return (x:xs)
                        }

sepEndBy1, sepEndBy :: Parsely m => m a -> m sep -> m [a]
sepEndBy1 p sep     = do{ x <- p
                        ; do{ sep
                            ; xs <- sepEndBy p sep
                            ; return (x:xs)
                            }
                          <|> return [x]
                        }
        
sepEndBy p sep      = sepEndBy1 p sep <|> return []


endBy1,endBy :: Parsely m => m a -> m sep -> m [a]
endBy1 p sep        = many1 (do{ x <- p; sep; return x })
endBy p sep         = many (do{ x <- p; sep; return x })

count :: Parsely m => Int -> m a -> m [a]
count n p           | n <= 0    = return []
                    | otherwise = sequence (replicate n p)


chainr,chainl :: Parsely m => m a -> m (a -> a -> a) -> a -> m a
chainr p op x       = chainr1 p op <|> return x
chainl p op x       = chainl1 p op <|> return x

chainr1,chainl1 :: Parsely m => m a -> m (a -> a -> a) -> m a
chainl1 p op        = do{ x <- p; rest x }
                    where
                      rest x    = do{ f <- op
                                    ; y <- p
                                    ; rest (f x y)
                                    }
                                <|> return x
                              
chainr1 p op        = scan
                    where
                      scan      = do{ x <- p; rest x }
                      
                      rest x    = do{ f <- op
                                    ; y <- scan
                                    ; return (f x y)
                                    }
                                <|> return x

-----------------------------------------------------------
-- Tricky combinators
-----------------------------------------------------------
-- XXX have to think about these two...
anyToken :: (Show tok, MonadParsec m tok pos) => m tok
anyToken            = tokenPrim show (\pos tok toks -> pos) Just

eof :: (Show tok, MonadParsec m tok pos) => m ()
eof                 = notFollowedBy anyToken <?> "end of input"

notFollowedBy :: (Show tok, ParselyTry m) => m tok -> m ()
notFollowedBy p     = try (do{ c <- p; unexpected (show [c]) }
                           <|> return ()
                          )

manyTill :: Parsely m => m a -> m end -> m [a]
manyTill p end      = scan
                    where
                      scan  = do{ end; return [] }
                            <|>
                              do{ x <- p; xs <- scan; return (x:xs) }


--lookAhead :: GenParser tok st a -> GenParser tok st a
{-
lookAhead p         = do{ state <- getParserState
                        ; x <- p
                        ; setParserState state
                        ; return x
                        }
-}