{-# LANGUAGE CPP #-}
--------------------------------------------------------------------
-- |
-- Copyright :  © Edward Kmett 2010-2014, Johan Kiviniemi 2013
-- License   :  BSD3
-- Maintainer:  Edward Kmett <ekmett@gmail.com>
-- Stability :  experimental
-- Portability: non-portable
--
-- A trivial, inefficient parser with no support for error reporting.
--------------------------------------------------------------------
module Ersatz.Internal.Parser
  ( Parser
  , runParser
  , sepBy, sepBy1
  , token, string
  , integer, natural
  , eof
  , satisfy
  ) where

import Control.Applicative
import Control.Monad.State
import Data.Char (isDigit)
#if __GLASGOW_HASKELL__ < 710
import Data.Traversable (traverse)
#endif

type Parser t a = StateT [t] [] a

runParser :: Parser t a -> [t] -> [a]
runParser :: Parser t a -> [t] -> [a]
runParser = Parser t a -> [t] -> [a]
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT

sepBy :: Parser t a -> Parser t sep -> Parser t [a]
sepBy :: Parser t a -> Parser t sep -> Parser t [a]
sepBy Parser t a
p Parser t sep
sep = Parser t a -> Parser t sep -> Parser t [a]
forall t a sep. Parser t a -> Parser t sep -> Parser t [a]
sepBy1 Parser t a
p Parser t sep
sep Parser t [a] -> Parser t [a] -> Parser t [a]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [a] -> Parser t [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []

sepBy1 :: Parser t a -> Parser t sep -> Parser t [a]
sepBy1 :: Parser t a -> Parser t sep -> Parser t [a]
sepBy1 Parser t a
p Parser t sep
sep = (:) (a -> [a] -> [a]) -> Parser t a -> StateT [t] [] ([a] -> [a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser t a
p StateT [t] [] ([a] -> [a]) -> Parser t [a] -> Parser t [a]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser t a -> Parser t [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Parser t sep
sep Parser t sep -> Parser t a -> Parser t a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser t a
p)

token :: Eq t => t -> Parser t t
token :: t -> Parser t t
token t
t = (t -> Bool) -> Parser t t
forall t. (t -> Bool) -> Parser t t
satisfy (t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
t)

string :: Eq t => [t] -> Parser t [t]
string :: [t] -> Parser t [t]
string = (t -> StateT [t] [] t) -> [t] -> Parser t [t]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse t -> StateT [t] [] t
forall t. Eq t => t -> Parser t t
token

integer :: (Num i, Read i) => Parser Char i
integer :: Parser Char i
integer = Parser Char (i -> i)
forall n. Num n => Parser Char (n -> n)
negation Parser Char (i -> i) -> Parser Char i -> Parser Char i
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Char i
forall i. Read i => Parser Char i
natural

negation :: Num n => Parser Char (n -> n)
negation :: Parser Char (n -> n)
negation  =  n -> n
forall a. Num a => a -> a
negate (n -> n) -> StateT [Char] [] Char -> Parser Char (n -> n)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> StateT [Char] [] Char
forall t. Eq t => t -> Parser t t
token Char
'-'
         Parser Char (n -> n)
-> Parser Char (n -> n) -> Parser Char (n -> n)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (n -> n) -> Parser Char (n -> n)
forall (f :: * -> *) a. Applicative f => a -> f a
pure n -> n
forall a. a -> a
id

natural :: Read i => Parser Char i
natural :: Parser Char i
natural = [Char] -> i
forall a. Read a => [Char] -> a
read ([Char] -> i) -> StateT [Char] [] [Char] -> Parser Char i
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT [Char] [] Char -> StateT [Char] [] [Char]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some ((Char -> Bool) -> StateT [Char] [] Char
forall t. (t -> Bool) -> Parser t t
satisfy Char -> Bool
isDigit)

eof :: Parser t ()
eof :: Parser t ()
eof = do
  [] <- StateT [t] [] [t]
forall s (m :: * -> *). MonadState s m => m s
get
  () -> Parser t ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

satisfy :: (t -> Bool) -> Parser t t
satisfy :: (t -> Bool) -> Parser t t
satisfy t -> Bool
f = do
  (t
t:[t]
ts) <- StateT [t] [] [t]
forall s (m :: * -> *). MonadState s m => m s
get
  Bool -> StateT [t] [] ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (t -> Bool
f t
t)
  t
t t -> StateT [t] [] () -> Parser t t
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [t] -> StateT [t] [] ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put [t]
ts