{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeSynonymInstances #-}

#if __GLASGOW_HASKELL__ >= 800
{-# OPTIONS_GHC -Wno-orphans #-}
#else
{-# OPTIONS_GHC -fno-warn-orphans #-}
#endif

module Happy.Frontend.ParseMonad where

import Control.Monad.Reader
import Happy.Frontend.ParseMonad.Class

type P = ReaderT (String, Int) ParseResult

mkP :: (String -> Int -> ParseResult a) -> P a
mkP :: forall a. (String -> Int -> ParseResult a) -> P a
mkP = ((String, Int) -> ParseResult a)
-> ReaderT (String, Int) ParseResult a
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT (((String, Int) -> ParseResult a)
 -> ReaderT (String, Int) ParseResult a)
-> ((String -> Int -> ParseResult a)
    -> (String, Int) -> ParseResult a)
-> (String -> Int -> ParseResult a)
-> ReaderT (String, Int) ParseResult a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Int -> ParseResult a) -> (String, Int) -> ParseResult a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry

runP :: P a -> String -> Int -> ParseResult a
runP :: forall a. P a -> String -> Int -> ParseResult a
runP P a
f String
s Int
l = P a -> (String, Int) -> Either String a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT P a
f (String
s, Int
l)

instance ParseMonad P where
  failP :: forall a. (Int -> String) -> P a
failP Int -> String
mkStr = ((String, Int) -> ParseResult a)
-> ReaderT (String, Int) ParseResult a
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT (\(String
_, Int
l) -> String -> ParseResult a
forall a b. a -> Either a b
Left (String -> ParseResult a) -> String -> ParseResult a
forall a b. (a -> b) -> a -> b
$ Int -> String
mkStr Int
l)
  lineP :: P Int
lineP = ((String, Int) -> Int) -> P Int
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (String, Int) -> Int
forall a b. (a, b) -> b
snd
  runFromStartP :: forall a. P a -> String -> Int -> ParseResult a
runFromStartP P a
m String
s Int
l = P a -> String -> Int -> ParseResult a
forall a. P a -> String -> Int -> ParseResult a
runP P a
m String
s Int
l

lexTokenP :: HasLexer token => (token -> P r) -> P r
lexTokenP :: forall token r. HasLexer token => (token -> P r) -> P r
lexTokenP token -> P r
k = ((String, Int) -> ParseResult r) -> P r
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT (((String, Int) -> ParseResult r) -> P r)
-> ((String, Int) -> ParseResult r) -> P r
forall a b. (a -> b) -> a -> b
$ (String -> Int -> ParseResult r) -> (String, Int) -> ParseResult r
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((String -> Int -> ParseResult r)
 -> (String, Int) -> ParseResult r)
-> (String -> Int -> ParseResult r)
-> (String, Int)
-> ParseResult r
forall a b. (a -> b) -> a -> b
$ (token -> String -> Int -> ParseResult r)
-> String -> Int -> ParseResult r
forall token r. HasLexer token => (token -> Pfunc r) -> Pfunc r
forall r. (token -> Pfunc r) -> Pfunc r
lexToken (\token
t -> P r -> String -> Int -> ParseResult r
forall a. P a -> String -> Int -> ParseResult a
runP (P r -> String -> Int -> ParseResult r)
-> P r -> String -> Int -> ParseResult r
forall a b. (a -> b) -> a -> b
$ token -> P r
k token
t)