{-# LANGUAGE CPP        #-}
{-# LANGUAGE Rank2Types #-}
-- |
-- Module      :  Pinch.Internal.Pinchable.Parser
-- Copyright   :  (c) Abhinav Gupta 2015
-- License     :  BSD3
--
-- Maintainer  :  Abhinav Gupta <mail@abhinavg.net>
-- Stability   :  experimental
--
-- Implements a continuation based version of the @Either e@ monad.
--
module Pinch.Internal.Pinchable.Parser
    ( Parser
    , runParser
    , parserCatch
    ) where

import Control.Applicative
import Control.Monad
import qualified Control.Monad.Fail as Fail


-- | Failure continuation. Called with the failure message.
type Failure   r = String  -> r
type Success a r = a       -> r
-- ^ Success continuation. Called with the result.

-- | A simple continuation-based parser.
--
-- This is just @Either e a@ in continuation-passing style.
newtype Parser a = Parser
    { forall a. Parser a -> forall r. Failure r -> Success a r -> r
unParser :: forall r.
          Failure r    -- Failure continuation
       -> Success a r  -- Success continuation
       -> r
    } -- TODO can probably track position in the struct

instance Functor Parser where
    {-# INLINE fmap #-}
    fmap :: forall a b. (a -> b) -> Parser a -> Parser b
fmap a -> b
f (Parser forall r. Failure r -> Success a r -> r
g) = forall a. (forall r. Failure r -> Success a r -> r) -> Parser a
Parser forall a b. (a -> b) -> a -> b
$ \Failure r
kFail Success b r
kSucc -> forall r. Failure r -> Success a r -> r
g Failure r
kFail (Success b r
kSucc forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)

instance Applicative Parser where
    {-# INLINE pure #-}
    pure :: forall a. a -> Parser a
pure a
a = forall a. (forall r. Failure r -> Success a r -> r) -> Parser a
Parser forall a b. (a -> b) -> a -> b
$ \Failure r
_ Success a r
kSucc -> Success a r
kSucc a
a

    {-# INLINE (<*>) #-}
    Parser forall r. Failure r -> Success (a -> b) r -> r
f' <*> :: forall a b. Parser (a -> b) -> Parser a -> Parser b
<*> Parser forall r. Failure r -> Success a r -> r
a' =
        forall a. (forall r. Failure r -> Success a r -> r) -> Parser a
Parser forall a b. (a -> b) -> a -> b
$ \Failure r
kFail Success b r
kSuccB ->
            forall r. Failure r -> Success (a -> b) r -> r
f' Failure r
kFail forall a b. (a -> b) -> a -> b
$ \a -> b
f ->
            forall r. Failure r -> Success a r -> r
a' Failure r
kFail forall a b. (a -> b) -> a -> b
$ \a
a ->
                Success b r
kSuccB (a -> b
f a
a)

instance Alternative Parser where
    {-# INLINE empty #-}
    empty :: forall a. Parser a
empty = forall a. (forall r. Failure r -> Success a r -> r) -> Parser a
Parser forall a b. (a -> b) -> a -> b
$ \Failure r
kFail Success a r
_ -> Failure r
kFail String
"Alternative.empty"

    {-# INLINE (<|>) #-}
    Parser forall r. Failure r -> Success a r -> r
l' <|> :: forall a. Parser a -> Parser a -> Parser a
<|> Parser forall r. Failure r -> Success a r -> r
r' =
        forall a. (forall r. Failure r -> Success a r -> r) -> Parser a
Parser forall a b. (a -> b) -> a -> b
$ \Failure r
kFail Success a r
kSucc ->
            forall r. Failure r -> Success a r -> r
l' (\String
_ -> forall r. Failure r -> Success a r -> r
r' Failure r
kFail Success a r
kSucc) Success a r
kSucc

instance Monad Parser where
    {-# INLINE return #-}
    return :: forall a. a -> Parser a
return = forall (f :: * -> *) a. Applicative f => a -> f a
pure

    {-# INLINE (>>) #-}
    >> :: forall a b. Parser a -> Parser b -> Parser b
(>>) = forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
(*>)

    {-# INLINE (>>=) #-}
    Parser forall r. Failure r -> Success a r -> r
a' >>= :: forall a b. Parser a -> (a -> Parser b) -> Parser b
>>= a -> Parser b
k =
        forall a. (forall r. Failure r -> Success a r -> r) -> Parser a
Parser forall a b. (a -> b) -> a -> b
$ \Failure r
kFail Success b r
kSuccB ->
            forall r. Failure r -> Success a r -> r
a' Failure r
kFail forall a b. (a -> b) -> a -> b
$ \a
a ->
            forall a. Parser a -> forall r. Failure r -> Success a r -> r
unParser (a -> Parser b
k a
a) Failure r
kFail Success b r
kSuccB

#if !MIN_VERSION_base(4,13,0)
    -- Monad(fail) was removed in GHC 8.8.1
    {-# INLINE fail #-}
    fail = Fail.fail
#endif

instance Fail.MonadFail Parser where
    {-# INLINE fail #-}
    fail :: forall a. String -> Parser a
fail String
msg = forall a. (forall r. Failure r -> Success a r -> r) -> Parser a
Parser forall a b. (a -> b) -> a -> b
$ \Failure r
kFail Success a r
_ -> Failure r
kFail String
msg


instance MonadPlus Parser where
    {-# INLINE mzero #-}
    mzero :: forall a. Parser a
mzero = forall (f :: * -> *) a. Alternative f => f a
empty

    {-# INLINE mplus #-}
    mplus :: forall a. Parser a -> Parser a -> Parser a
mplus = forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>)

-- | Run a @Parser@ and return the result inside an @Either@.
runParser :: Parser a -> Either String a
runParser :: forall a. Parser a -> Either String a
runParser Parser a
p = forall a. Parser a -> forall r. Failure r -> Success a r -> r
unParser Parser a
p forall a b. a -> Either a b
Left forall a b. b -> Either a b
Right

-- | Allows handling parse errors.
parserCatch
    :: Parser a -> (String -> Parser b) -> (a -> Parser b) -> Parser b
parserCatch :: forall a b.
Parser a -> (String -> Parser b) -> (a -> Parser b) -> Parser b
parserCatch Parser a
p String -> Parser b
f a -> Parser b
g = forall a. Parser a -> forall r. Failure r -> Success a r -> r
unParser Parser a
p String -> Parser b
f a -> Parser b
g
{-# INLINE parserCatch #-}