--
-- 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     = (a -> m [a] -> m [a]) -> m [a] -> [a] -> m [a]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ( m a -> m [a] -> m [a]
forall (m :: * -> *) a. Monad m => m a -> m [a] -> m [a]
(>:>)(m a -> m [a] -> m [a]) -> (a -> m a) -> a -> m [a] -> m [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.a -> m a
forall a (m :: * -> *). (Eq a, MonadParse a m) => a -> m a
token     ) (m [a] -> [a] -> m [a]) -> m [a] -> [a] -> m [a]
forall a b. (a -> b) -> a -> b
$ [a] -> m [a]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return []
tokensBack :: forall a (m :: * -> *). (Eq a, MonadParse a m) => [a] -> m [a]
tokensBack = (a -> m [a] -> m [a]) -> m [a] -> [a] -> m [a]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ( m a -> m [a] -> m [a]
forall (m :: * -> *) a. Monad m => m a -> m [a] -> m [a]
(>:>)(m a -> m [a] -> m [a]) -> (a -> m a) -> a -> m [a] -> m [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.a -> m a
forall a (m :: * -> *). (Eq a, MonadParse a m) => a -> m a
tokenBack ) (m [a] -> [a] -> m [a]) -> m [a] -> [a] -> m [a]
forall a b. (a -> b) -> a -> b
$ [a] -> m [a]
forall a. a -> m a
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 = ((a -> b) -> m a -> m b) -> m a -> (a -> b) -> m b
forall a b c. (a -> b -> c) -> b -> a -> c
flip (a -> b) -> m a -> m b
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 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
mx  = Int -> m b -> m [b]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
mn m b
p
  | Int
mn Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<  Int
mx  = Int -> m b -> m [b]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
mn m b
p
                m [b] -> m [b] -> m [b]
forall a. m a -> m a -> m a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus`
                ( m b
p m b -> m [b] -> m [b]
forall (m :: * -> *) a. Monad m => m a -> m [a] -> m [a]
>:> Int -> Maybe Int -> m b -> m [b]
forall (m :: * -> *) b.
MonadPlus m =>
Int -> Maybe Int -> m b -> m [b]
repeatParse Int
mn (Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Int
mx Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) m b
p )
  | Bool
otherwise = [Char] -> m [b]
forall a. HasCallStack => [Char] -> a
error [Char]
"minimal larger than maximal"
repeatParse Int
mn Maybe Int
Nothing m b
p
  = Int -> m b -> m [b]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
mn m b
p
    m [b] -> m [b] -> m [b]
forall a. m a -> m a -> m a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus`
    ( m b
p m b -> m [b] -> m [b]
forall (m :: * -> *) a. Monad m => m a -> m [a] -> m [a]
>:> Int -> Maybe Int -> m b -> m [b]
forall (m :: * -> *) b.
MonadPlus m =>
Int -> Maybe Int -> m b -> m [b]
repeatParse Int
mn Maybe Int
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 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
mx  = Int -> m b -> m [b]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
mn m b
p
  | Int
mn Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<  Int
mx  = ( m b
p m b -> m [b] -> m [b]
forall (m :: * -> *) a. Monad m => m a -> m [a] -> m [a]
>:> Int -> Maybe Int -> m b -> m [b]
forall (m :: * -> *) b.
MonadPlus m =>
Int -> Maybe Int -> m b -> m [b]
greedyRepeatParse Int
mn (Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Int
mx Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) m b
p )
                m [b] -> m [b] -> m [b]
forall a. m a -> m a -> m a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus`
		Int -> m b -> m [b]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
mn m b
p
  | Bool
otherwise = [Char] -> m [b]
forall a. HasCallStack => [Char] -> a
error [Char]
"minimal larger than maximal"
greedyRepeatParse Int
mn Maybe Int
Nothing m b
p
  = ( m b
p m b -> m [b] -> m [b]
forall (m :: * -> *) a. Monad m => m a -> m [a] -> m [a]
>:> Int -> Maybe Int -> m b -> m [b]
forall (m :: * -> *) b.
MonadPlus m =>
Int -> Maybe Int -> m b -> m [b]
greedyRepeatParse Int
mn Maybe Int
forall a. Maybe a
Nothing m b
p )
    m [b] -> m [b] -> m [b]
forall a. m a -> m a -> m a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus`
    Int -> m b -> m [b]
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       = Int -> Maybe Int -> m a -> m [a]
forall (m :: * -> *) b.
MonadPlus m =>
Int -> Maybe Int -> m b -> m [b]
repeatParse       Int
0 (Maybe Int -> m a -> m [a]) -> Maybe Int -> m a -> m [a]
forall a b. (a -> b) -> a -> b
$ Int -> Maybe Int
forall a. a -> Maybe a
Just Int
1
greedyOptional :: forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
greedyOptional = Int -> Maybe Int -> m a -> m [a]
forall (m :: * -> *) b.
MonadPlus m =>
Int -> Maybe Int -> m b -> m [b]
greedyRepeatParse Int
0 (Maybe Int -> m a -> m [a]) -> Maybe Int -> m a -> m [a]
forall a b. (a -> b) -> a -> b
$ Int -> Maybe Int
forall a. a -> Maybe a
Just Int
1
list :: forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
list           = Int -> Maybe Int -> m a -> m [a]
forall (m :: * -> *) b.
MonadPlus m =>
Int -> Maybe Int -> m b -> m [b]
repeatParse       Int
0 Maybe Int
forall a. Maybe a
Nothing
greedyList :: forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
greedyList     = Int -> Maybe Int -> m a -> m [a]
forall (m :: * -> *) b.
MonadPlus m =>
Int -> Maybe Int -> m b -> m [b]
greedyRepeatParse Int
0 Maybe Int
forall a. Maybe a
Nothing
neList :: forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
neList         = Int -> Maybe Int -> m a -> m [a]
forall (m :: * -> *) b.
MonadPlus m =>
Int -> Maybe Int -> m b -> m [b]
repeatParse       Int
1 Maybe Int
forall a. Maybe a
Nothing
greedyNeList :: forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
greedyNeList   = Int -> Maybe Int -> m a -> m [a]
forall (m :: * -> *) b.
MonadPlus m =>
Int -> Maybe Int -> m b -> m [b]
greedyRepeatParse Int
1 Maybe Int
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]
_ ) <- m ([a], [a])
forall a (m :: * -> *). MonadParse a m => m ([a], [a])
getHere
                        if [a] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
pre then b -> m b
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return b
x
			            else m b
forall a. m a
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 ) <- m ([a], [a])
forall a (m :: * -> *). MonadParse a m => m ([a], [a])
getHere
                        if [a] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
post then b -> m b
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return b
x
			             else m b
forall a. m a
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; c -> m c
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (c -> m c) -> c -> m c
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]
(>++>) = ([a] -> [a] -> [a]) -> m [a] -> m [a] -> m [a]
forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> m a -> m b -> m c
apply2M [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
(++)

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