--
-- MTLParse.hs
--
-- Author: Yoshikuni Jujo <PAF01143@nifty.ne.jp>
--
-- This file is part of mtlparse library
--
-- mtlparse is free software: you can redistribute it and/or modify
-- it under the terms of the GNU Lesser General Public License as
-- published by the Free Software Foundation, either version 3 of the
-- License, or any later version.
--
-- mtlparse is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANGY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-- GNU Lesser General Public License for more details.
--
-- You should have received a copy of the GNU Lesser General Public
-- License along with this program. If not, see
-- <http://www.gnu.org/licenses/>.

module Text.ParserCombinators.MTLParse (

  module Text.ParserCombinators.MTLParse.MTLParseCore

, tokens
, tokensBack
, build

, repeatParse
, optional
, list
, neList

, greedyRepeatParse
, greedyOptional
, greedyList
, greedyNeList

, beginningOfInput
, endOfInput

, apply2M
, (>++>)
, (>:>)

) where

import Text.ParserCombinators.MTLParse.MTLParseCore
import Control.Monad( replicateM )

tokens, tokensBack :: ( Eq a, MonadParse a m ) => [ a ] -> m [ a ]
tokens :: forall a (m :: * -> *). (Eq a, MonadParse a m) => [a] -> m [a]
tokens     = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ( forall (m :: * -> *) a. Monad m => m a -> m [a] -> m [a]
(>:>)forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a (m :: * -> *). (Eq a, MonadParse a m) => a -> m a
token     ) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return []
tokensBack :: forall a (m :: * -> *). (Eq a, MonadParse a m) => [a] -> m [a]
tokensBack = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ( forall (m :: * -> *) a. Monad m => m a -> m [a] -> m [a]
(>:>)forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a (m :: * -> *). (Eq a, MonadParse a m) => a -> m a
tokenBack ) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return []

build :: Monad m => m a -> ( a -> b ) -> m b
build :: forall (m :: * -> *) a b. Monad m => m a -> (a -> b) -> m b
build = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM

repeatParse, greedyRepeatParse ::
  MonadPlus m => Int -> Maybe Int -> m b -> m [ b ]

repeatParse :: forall (m :: * -> *) b.
MonadPlus m =>
Int -> Maybe Int -> m b -> m [b]
repeatParse Int
mn ( Just Int
mx ) m b
p
  | Int
mn forall a. Eq a => a -> a -> Bool
== Int
mx  = forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
mn m b
p
  | Int
mn forall a. Ord a => a -> a -> Bool
<  Int
mx  = forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
mn m b
p
                forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus`
                ( m b
p forall (m :: * -> *) a. Monad m => m a -> m [a] -> m [a]
>:> forall (m :: * -> *) b.
MonadPlus m =>
Int -> Maybe Int -> m b -> m [b]
repeatParse Int
mn (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Int
mx forall a. Num a => a -> a -> a
- Int
1) m b
p )
  | Bool
otherwise = forall a. HasCallStack => [Char] -> a
error [Char]
"minimal larger than maximal"
repeatParse Int
mn Maybe Int
Nothing m b
p
  = forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
mn m b
p
    forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus`
    ( m b
p forall (m :: * -> *) a. Monad m => m a -> m [a] -> m [a]
>:> forall (m :: * -> *) b.
MonadPlus m =>
Int -> Maybe Int -> m b -> m [b]
repeatParse Int
mn forall a. Maybe a
Nothing m b
p )

greedyRepeatParse :: forall (m :: * -> *) b.
MonadPlus m =>
Int -> Maybe Int -> m b -> m [b]
greedyRepeatParse Int
mn ( Just Int
mx ) m b
p
  | Int
mn forall a. Eq a => a -> a -> Bool
== Int
mx  = forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
mn m b
p
  | Int
mn forall a. Ord a => a -> a -> Bool
<  Int
mx  = ( m b
p forall (m :: * -> *) a. Monad m => m a -> m [a] -> m [a]
>:> forall (m :: * -> *) b.
MonadPlus m =>
Int -> Maybe Int -> m b -> m [b]
greedyRepeatParse Int
mn (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Int
mx forall a. Num a => a -> a -> a
- Int
1) m b
p )
                forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus`
		forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
mn m b
p
  | Bool
otherwise = forall a. HasCallStack => [Char] -> a
error [Char]
"minimal larger than maximal"
greedyRepeatParse Int
mn Maybe Int
Nothing m b
p
  = ( m b
p forall (m :: * -> *) a. Monad m => m a -> m [a] -> m [a]
>:> forall (m :: * -> *) b.
MonadPlus m =>
Int -> Maybe Int -> m b -> m [b]
greedyRepeatParse Int
mn forall a. Maybe a
Nothing m b
p )
    forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus`
    forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
mn m b
p

optional, greedyOptional, list, greedyList, neList, greedyNeList
  :: MonadPlus m => m a -> m [ a ]
optional :: forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
optional       = forall (m :: * -> *) b.
MonadPlus m =>
Int -> Maybe Int -> m b -> m [b]
repeatParse       Int
0 forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Int
1
greedyOptional :: forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
greedyOptional = forall (m :: * -> *) b.
MonadPlus m =>
Int -> Maybe Int -> m b -> m [b]
greedyRepeatParse Int
0 forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Int
1
list :: forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
list           = forall (m :: * -> *) b.
MonadPlus m =>
Int -> Maybe Int -> m b -> m [b]
repeatParse       Int
0 forall a. Maybe a
Nothing
greedyList :: forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
greedyList     = forall (m :: * -> *) b.
MonadPlus m =>
Int -> Maybe Int -> m b -> m [b]
greedyRepeatParse Int
0 forall a. Maybe a
Nothing
neList :: forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
neList         = forall (m :: * -> *) b.
MonadPlus m =>
Int -> Maybe Int -> m b -> m [b]
repeatParse       Int
1 forall a. Maybe a
Nothing
greedyNeList :: forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
greedyNeList   = forall (m :: * -> *) b.
MonadPlus m =>
Int -> Maybe Int -> m b -> m [b]
greedyRepeatParse Int
1 forall a. Maybe a
Nothing

-- beginning and end of input

beginningOfInput, endOfInput
  :: ( MonadPlus m, MonadParse a m ) => b -> m b
beginningOfInput :: forall (m :: * -> *) a b. (MonadPlus m, MonadParse a m) => b -> m b
beginningOfInput b
x = do ( [a]
pre, [a]
_ ) <- forall a (m :: * -> *). MonadParse a m => m ([a], [a])
getHere
                        if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
pre then forall (m :: * -> *) a. Monad m => a -> m a
return b
x
			            else forall (m :: * -> *) a. MonadPlus m => m a
mzero
endOfInput :: forall (m :: * -> *) a b. (MonadPlus m, MonadParse a m) => b -> m b
endOfInput       b
x = do ( [a]
_, [a]
post ) <- forall a (m :: * -> *). MonadParse a m => m ([a], [a])
getHere
                        if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
post then forall (m :: * -> *) a. Monad m => a -> m a
return b
x
			             else forall (m :: * -> *) a. MonadPlus m => m a
mzero

-- some tools for monad returning list

apply2M :: Monad m => ( a -> b -> c ) -> m a -> m b -> m c
apply2M :: forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> m a -> m b -> m c
apply2M a -> b -> c
op m a
m1 m b
m2 = do { a
r1 <- m a
m1; b
r2 <- m b
m2; forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ a
r1 a -> b -> c
`op` b
r2 }

(>++>) :: Monad m => m [a] -> m [a] -> m [a]
>++> :: forall (m :: * -> *) a. Monad m => m [a] -> m [a] -> m [a]
(>++>) = forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> m a -> m b -> m c
apply2M forall a. [a] -> [a] -> [a]
(++)

(>:>)  :: Monad m => m a -> m [a] -> m [a]
>:> :: forall (m :: * -> *) a. Monad m => m a -> m [a] -> m [a]
(>:>) = forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> m a -> m b -> m c
apply2M (:)