{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}

{-|
This is subset of Parsec.

Parsec 3 provides features which Parsec 2 does not provide:

* Applicative style

* ByteString as input

But Haskell Platform includes Parsec 2, not Parsec 3. Installing
Parsec 3 to Haskell Platform environment makes it mess. So, this library
was implemented.
-}

module Text.Appar.Parser (
  -- ** Running parser
    parse
  -- ** 'Char' parsers
  , char
  , anyChar
  , oneOf
  , noneOf
  , alphaNum
  , digit
  , hexDigit
  , space
  -- ** 'String' parser
  , string
  -- ** Parser combinators
  , try
  , choice
  , option
  , skipMany
  , skipSome
  , sepBy1
  , manyTill
  -- ** 'Applicative' parser combinators
  , (<$>)
  , (<$)
  , (<*>)
  , (*>)
  , (<*)
  , (<**>)
  , (<|>)
  , some
  , many
  , pure
  -- ** Internals
  , MkParser(..)
  , Input(..)
  , satisfy
  ) where

import Control.Applicative
import Control.Monad
import Control.Monad.Fail as Fail
import Data.Char
import Text.Appar.Input

----------------------------------------------------------------

data MkParser inp a = P {
  -- | Getting the internal parser.
    forall inp a. MkParser inp a -> inp -> (Maybe a, inp)
runParser :: inp -> (Maybe a, inp)
  }

----------------------------------------------------------------

instance Functor (MkParser inp) where
    a -> b
f fmap :: forall a b. (a -> b) -> MkParser inp a -> MkParser inp b
`fmap` MkParser inp a
p = (a -> b) -> MkParser inp (a -> b)
forall a. a -> MkParser inp a
forall (m :: * -> *) a. Monad m => a -> m a
return a -> b
f MkParser inp (a -> b) -> MkParser inp a -> MkParser inp b
forall a b.
MkParser inp (a -> b) -> MkParser inp a -> MkParser inp b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> MkParser inp a
p

instance Applicative (MkParser inp) where
    pure :: forall a. a -> MkParser inp a
pure a
a = (inp -> (Maybe a, inp)) -> MkParser inp a
forall inp a. (inp -> (Maybe a, inp)) -> MkParser inp a
P ((inp -> (Maybe a, inp)) -> MkParser inp a)
-> (inp -> (Maybe a, inp)) -> MkParser inp a
forall a b. (a -> b) -> a -> b
$ \inp
bs -> (a -> Maybe a
forall a. a -> Maybe a
Just a
a, inp
bs)
    <*> :: forall a b.
MkParser inp (a -> b) -> MkParser inp a -> MkParser inp b
(<*>)  = MkParser inp (a -> b) -> MkParser inp a -> MkParser inp b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap

instance Alternative (MkParser inp) where
    empty :: forall a. MkParser inp a
empty = MkParser inp a
forall a. MkParser inp a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
    <|> :: forall a. MkParser inp a -> MkParser inp a -> MkParser inp a
(<|>) = MkParser inp a -> MkParser inp a -> MkParser inp a
forall a. MkParser inp a -> MkParser inp a -> MkParser inp a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus

instance Monad (MkParser inp) where
    return :: forall a. a -> MkParser inp a
return   = a -> MkParser inp a
forall a. a -> MkParser inp a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    MkParser inp a
p >>= :: forall a b.
MkParser inp a -> (a -> MkParser inp b) -> MkParser inp b
>>= a -> MkParser inp b
f  = (inp -> (Maybe b, inp)) -> MkParser inp b
forall inp a. (inp -> (Maybe a, inp)) -> MkParser inp a
P ((inp -> (Maybe b, inp)) -> MkParser inp b)
-> (inp -> (Maybe b, inp)) -> MkParser inp b
forall a b. (a -> b) -> a -> b
$ \inp
bs -> case MkParser inp a -> inp -> (Maybe a, inp)
forall inp a. MkParser inp a -> inp -> (Maybe a, inp)
runParser MkParser inp a
p inp
bs of
        (Maybe a
Nothing, inp
bs') -> (Maybe b
forall a. Maybe a
Nothing, inp
bs')
        (Just a
a,  inp
bs') -> MkParser inp b -> inp -> (Maybe b, inp)
forall inp a. MkParser inp a -> inp -> (Maybe a, inp)
runParser (a -> MkParser inp b
f a
a) inp
bs'
    -- fixme: GHC 8.x will remove the fail method
#if !MIN_VERSION_base(4,13,0)
    fail = Fail.fail
#endif

instance MonadFail (MkParser inp) where
    fail :: forall a. String -> MkParser inp a
fail String
_   = (inp -> (Maybe a, inp)) -> MkParser inp a
forall inp a. (inp -> (Maybe a, inp)) -> MkParser inp a
P ((inp -> (Maybe a, inp)) -> MkParser inp a)
-> (inp -> (Maybe a, inp)) -> MkParser inp a
forall a b. (a -> b) -> a -> b
$ \inp
bs -> (Maybe a
forall a. Maybe a
Nothing, inp
bs)

instance MonadPlus (MkParser inp) where
    mzero :: forall a. MkParser inp a
mzero       = (inp -> (Maybe a, inp)) -> MkParser inp a
forall inp a. (inp -> (Maybe a, inp)) -> MkParser inp a
P ((inp -> (Maybe a, inp)) -> MkParser inp a)
-> (inp -> (Maybe a, inp)) -> MkParser inp a
forall a b. (a -> b) -> a -> b
$ \inp
bs -> (Maybe a
forall a. Maybe a
Nothing, inp
bs)
    MkParser inp a
p mplus :: forall a. MkParser inp a -> MkParser inp a -> MkParser inp a
`mplus` MkParser inp a
q = (inp -> (Maybe a, inp)) -> MkParser inp a
forall inp a. (inp -> (Maybe a, inp)) -> MkParser inp a
P ((inp -> (Maybe a, inp)) -> MkParser inp a)
-> (inp -> (Maybe a, inp)) -> MkParser inp a
forall a b. (a -> b) -> a -> b
$ \inp
bs -> case MkParser inp a -> inp -> (Maybe a, inp)
forall inp a. MkParser inp a -> inp -> (Maybe a, inp)
runParser MkParser inp a
p inp
bs of
        (Maybe a
Nothing, inp
bs') -> MkParser inp a -> inp -> (Maybe a, inp)
forall inp a. MkParser inp a -> inp -> (Maybe a, inp)
runParser MkParser inp a
q inp
bs'
        (Just a
a,  inp
bs') -> (a -> Maybe a
forall a. a -> Maybe a
Just a
a, inp
bs')

----------------------------------------------------------------

{-|
  Run a parser.
-}
parse :: Input inp => MkParser inp a -> inp -> Maybe a
parse :: forall inp a. Input inp => MkParser inp a -> inp -> Maybe a
parse MkParser inp a
p inp
bs = (Maybe a, inp) -> Maybe a
forall a b. (a, b) -> a
fst (MkParser inp a -> inp -> (Maybe a, inp)
forall inp a. MkParser inp a -> inp -> (Maybe a, inp)
runParser MkParser inp a
p inp
bs)

----------------------------------------------------------------
{-|
  The parser @satisfy f@ succeeds for any character for which the
  supplied function @f@ returns 'True'. Returns the character that is
  actually parsed.
-}
satisfy :: Input inp => (Char -> Bool) -> MkParser inp Char
satisfy :: forall inp. Input inp => (Char -> Bool) -> MkParser inp Char
satisfy Char -> Bool
predicate = (inp -> (Maybe Char, inp)) -> MkParser inp Char
forall inp a. (inp -> (Maybe a, inp)) -> MkParser inp a
P inp -> (Maybe Char, inp)
forall {b}. Input b => b -> (Maybe Char, b)
sat
  where
    sat :: b -> (Maybe Char, b)
sat b
bs
      | b -> Bool
forall inp. Input inp => inp -> Bool
isNil b
bs    = (Maybe Char
forall a. Maybe a
Nothing, b
forall inp. Input inp => inp
nil)
      | Char -> Bool
predicate Char
b = (Char -> Maybe Char
forall a. a -> Maybe a
Just Char
b,  b
bs')
      | Bool
otherwise   = (Maybe Char
forall a. Maybe a
Nothing, b
bs)
      where
        b :: Char
b = b -> Char
forall inp. Input inp => inp -> Char
car b
bs
        bs' :: b
bs' = b -> b
forall inp. Input inp => inp -> inp
cdr b
bs

----------------------------------------------------------------
{-|
  The parser try p behaves like parser p, except that it pretends
  that it hasn't consumed any input when an error occurs.
-}
try :: MkParser inp a -> MkParser inp a
try :: forall inp a. MkParser inp a -> MkParser inp a
try MkParser inp a
p = (inp -> (Maybe a, inp)) -> MkParser inp a
forall inp a. (inp -> (Maybe a, inp)) -> MkParser inp a
P ((inp -> (Maybe a, inp)) -> MkParser inp a)
-> (inp -> (Maybe a, inp)) -> MkParser inp a
forall a b. (a -> b) -> a -> b
$ \inp
bs -> case MkParser inp a -> inp -> (Maybe a, inp)
forall inp a. MkParser inp a -> inp -> (Maybe a, inp)
runParser MkParser inp a
p inp
bs of
        (Maybe a
Nothing, inp
_  ) -> (Maybe a
forall a. Maybe a
Nothing, inp
bs)
        (Just a
a,  inp
bs') -> (a -> Maybe a
forall a. a -> Maybe a
Just a
a,  inp
bs')

----------------------------------------------------------------

{-|
  @char c@ parses a single character @c@. Returns the parsed character.
-}
char :: Input inp => Char -> MkParser inp Char
char :: forall inp. Input inp => Char -> MkParser inp Char
char Char
c = (Char -> Bool) -> MkParser inp Char
forall inp. Input inp => (Char -> Bool) -> MkParser inp Char
satisfy (Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==)

{-|
  @string s@ parses a sequence of characters given by @s@. Returns
  the parsed string
-}
string :: Input inp => String -> MkParser inp String
string :: forall inp. Input inp => String -> MkParser inp String
string []     = String -> MkParser inp String
forall a. a -> MkParser inp a
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
""
string (Char
c:String
cs) = (:) (Char -> String -> String)
-> MkParser inp Char -> MkParser inp (String -> String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Char -> MkParser inp Char
forall inp. Input inp => Char -> MkParser inp Char
char Char
c MkParser inp (String -> String)
-> MkParser inp String -> MkParser inp String
forall a b.
MkParser inp (a -> b) -> MkParser inp a -> MkParser inp b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> MkParser inp String
forall inp. Input inp => String -> MkParser inp String
string String
cs

----------------------------------------------------------------

{-|
  This parser succeeds for any character. Returns the parsed character.
-}
anyChar :: Input inp => MkParser inp Char
anyChar :: forall inp. Input inp => MkParser inp Char
anyChar = (Char -> Bool) -> MkParser inp Char
forall inp. Input inp => (Char -> Bool) -> MkParser inp Char
satisfy (Bool -> Char -> Bool
forall a b. a -> b -> a
const Bool
True)

{-|
  @oneOf cs@ succeeds if the current character is in the supplied list of
  characters @cs@. Returns the parsed character.
-}
oneOf :: Input inp => String -> MkParser inp Char
oneOf :: forall inp. Input inp => String -> MkParser inp Char
oneOf String
cs = (Char -> Bool) -> MkParser inp Char
forall inp. Input inp => (Char -> Bool) -> MkParser inp Char
satisfy (Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
cs)

{-|
  As the dual of 'oneOf', @noneOf cs@ succeeds if the current
  character /not/ in the supplied list of characters @cs@. Returns the
  parsed character.
-}
noneOf :: Input inp => String -> MkParser inp Char
noneOf :: forall inp. Input inp => String -> MkParser inp Char
noneOf String
cs = (Char -> Bool) -> MkParser inp Char
forall inp. Input inp => (Char -> Bool) -> MkParser inp Char
satisfy (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` String
cs)

{-|
  Parses a letter or digit (a character between \'0\' and \'9\').
  Returns the parsed character.
-}
alphaNum :: Input inp => MkParser inp Char
alphaNum :: forall inp. Input inp => MkParser inp Char
alphaNum = (Char -> Bool) -> MkParser inp Char
forall inp. Input inp => (Char -> Bool) -> MkParser inp Char
satisfy Char -> Bool
isAlphaNum

{-|
  Parses a digit. Returns the parsed character.
-}
digit :: Input inp => MkParser inp Char
digit :: forall inp. Input inp => MkParser inp Char
digit = (Char -> Bool) -> MkParser inp Char
forall inp. Input inp => (Char -> Bool) -> MkParser inp Char
satisfy Char -> Bool
isDigit

{-|
  Parses a hexadecimal digit (a digit or a letter between \'a\' and
  \'f\' or \'A\' and \'F\'). Returns the parsed character.
-}
hexDigit :: Input inp => MkParser inp Char
hexDigit :: forall inp. Input inp => MkParser inp Char
hexDigit = (Char -> Bool) -> MkParser inp Char
forall inp. Input inp => (Char -> Bool) -> MkParser inp Char
satisfy Char -> Bool
isHexDigit

{-|
  Parses a white space character (any character which satisfies 'isSpace')
   Returns the parsed character.
-}
space :: Input inp => MkParser inp Char
space :: forall inp. Input inp => MkParser inp Char
space = (Char -> Bool) -> MkParser inp Char
forall inp. Input inp => (Char -> Bool) -> MkParser inp Char
satisfy Char -> Bool
isSpace

----------------------------------------------------------------

{-|
  @choice ps@ tries to apply the parsers in the list @ps@ in order,
  until one of them succeeds. Returns the value of the succeeding
  parser.
-}
choice :: [MkParser inp a] -> MkParser inp a
choice :: forall inp a. [MkParser inp a] -> MkParser inp a
choice = (MkParser inp a -> MkParser inp a -> MkParser inp a)
-> MkParser inp a -> [MkParser inp a] -> MkParser inp a
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr MkParser inp a -> MkParser inp a -> MkParser inp a
forall a. MkParser inp a -> MkParser inp a -> MkParser inp a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>) MkParser inp a
forall a. MkParser inp a
forall (m :: * -> *) a. MonadPlus m => m a
mzero

{-|
  @option x p@ tries to apply parser @p@. If @p@ fails without
  consuming input, it returns the value @x@, otherwise the value
  returned by @p@.
-}
option :: a -> MkParser inp a -> MkParser inp a
option :: forall a inp. a -> MkParser inp a -> MkParser inp a
option a
x MkParser inp a
p = MkParser inp a
p MkParser inp a -> MkParser inp a -> MkParser inp a
forall a. MkParser inp a -> MkParser inp a -> MkParser inp a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> a -> MkParser inp a
forall a. a -> MkParser inp a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x

{-|
  @skipMany p@ applies the parser @p@ /zero/ or more times, skipping
  its result.
-}
skipMany :: MkParser inp a -> MkParser inp ()
skipMany :: forall inp a. MkParser inp a -> MkParser inp ()
skipMany MkParser inp a
p = () () -> MkParser inp [a] -> MkParser inp ()
forall a b. a -> MkParser inp b -> MkParser inp a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ MkParser inp a -> MkParser inp [a]
forall a. MkParser inp a -> MkParser inp [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many MkParser inp a
p

{-|
  @skipSome p@ applies the parser @p@ /one/ or more times, skipping
  its result.
-}
skipSome :: MkParser inp a -> MkParser inp ()
skipSome :: forall inp a. MkParser inp a -> MkParser inp ()
skipSome MkParser inp a
p = () () -> MkParser inp [a] -> MkParser inp ()
forall a b. a -> MkParser inp b -> MkParser inp a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ MkParser inp a -> MkParser inp [a]
forall a. MkParser inp a -> MkParser inp [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some MkParser inp a
p

{-|
  @sepBy1 p sep@ parses /one/ or more occurrences of @p@, separated
  by @sep@. Returns a list of values returned by @p@.
-}
sepBy1 :: MkParser inp a -> MkParser inp b -> MkParser inp [a]
sepBy1 :: forall inp a b.
MkParser inp a -> MkParser inp b -> MkParser inp [a]
sepBy1 MkParser inp a
p MkParser inp b
sep = (:) (a -> [a] -> [a]) -> MkParser inp a -> MkParser inp ([a] -> [a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MkParser inp a
p MkParser inp ([a] -> [a]) -> MkParser inp [a] -> MkParser inp [a]
forall a b.
MkParser inp (a -> b) -> MkParser inp a -> MkParser inp b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> MkParser inp a -> MkParser inp [a]
forall a. MkParser inp a -> MkParser inp [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (MkParser inp b
sep MkParser inp b -> MkParser inp a -> MkParser inp a
forall a b. MkParser inp a -> MkParser inp b -> MkParser inp b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> MkParser inp a
p)

{-|
  @manyTill p end@ applies parser @p@ /zero/ or more times until
  parser @end@ succeeds. Returns the list of values returned by @p@.
-}
manyTill :: MkParser inp a -> MkParser inp b -> MkParser inp [a]
manyTill :: forall inp a b.
MkParser inp a -> MkParser inp b -> MkParser inp [a]
manyTill MkParser inp a
p MkParser inp b
end = MkParser inp [a]
scan
  where
    scan :: MkParser inp [a]
scan = [] [a] -> MkParser inp b -> MkParser inp [a]
forall a b. a -> MkParser inp b -> MkParser inp a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ MkParser inp b
end MkParser inp [a] -> MkParser inp [a] -> MkParser inp [a]
forall a. MkParser inp a -> MkParser inp a -> MkParser inp a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (:) (a -> [a] -> [a]) -> MkParser inp a -> MkParser inp ([a] -> [a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MkParser inp a
p MkParser inp ([a] -> [a]) -> MkParser inp [a] -> MkParser inp [a]
forall a b.
MkParser inp (a -> b) -> MkParser inp a -> MkParser inp b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> MkParser inp [a]
scan