{-# OPTIONS_GHC -Wall #-}
{-# LANGUAGE StandaloneDeriving #-}
module Parser.Parser (
(<+>),
Parse_error',
Parser',
add_location,
filter_Parser,
fmap_filter_Parser,
parse,
parse_brackets,
parse_empty_list,
parse_line_and_char,
parse_list,
parse_many,
parse_non_empty_list,
parse_some,
parse_token,
parse_token',
write_parse_error) where
import Control.Monad.Except (ExceptT (..), MonadError (..), runExceptT, withExceptT)
import Control.Monad.State.Strict (MonadState (..), StateT (..), evalStateT, modify)
import Data.List (intercalate)
import Data.Set (Set, elems, empty, singleton, union)
import Parser.Errors (Error (..))
import Parser.Line_and_char (L (..), Line_and_char, write_file_name_and_line_and_char)
import Parser.Tokeniser (Tokeniser', Tokens', current_line_and_char, get_token, take_token, tokenise, tokens_ended)
data Lookahead token = Lookahead Line_and_char (Set String) (Maybe token)
data Parse_error' token = Filter_error Line_and_char String | Match_error (Lookahead token)
newtype Parser' token t = Parser {Parser' token t
-> StateT
(State token) (ExceptT (Parse_error' token) (Either Error)) t
run_Parser :: StateT (State token) (ExceptT (Parse_error' token) (Either Error)) t}
data State token = State {State token -> Tokens' token
state_tokens :: Tokens' token, State token -> Lookahead token
state_lookahead :: Lookahead token}
infixr 4 ===
(===) :: Eq t => t -> t -> t
t
x === :: t -> t -> t
=== t
y =
case t
x t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
y of
Bool
False -> t
forall a. HasCallStack => a
undefined
Bool
True -> t
x
infixr 3 <+>
(<+>) :: Eq token => Parser' token t -> Parser' token t -> Parser' token t
Parser (StateT State token
-> ExceptT (Parse_error' token) (Either Error) (t, State token)
parse_0) <+> :: Parser' token t -> Parser' token t -> Parser' token t
<+> Parser (StateT State token
-> ExceptT (Parse_error' token) (Either Error) (t, State token)
parse_1) =
StateT
(State token) (ExceptT (Parse_error' token) (Either Error)) t
-> Parser' token t
forall token t.
StateT
(State token) (ExceptT (Parse_error' token) (Either Error)) t
-> Parser' token t
Parser
((State token
-> ExceptT (Parse_error' token) (Either Error) (t, State token))
-> StateT
(State token) (ExceptT (Parse_error' token) (Either Error)) t
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT
(\State token
st ->
Either Error (Either (Parse_error' token) (t, State token))
-> ExceptT (Parse_error' token) (Either Error) (t, State token)
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT
(do
(Lookahead token
lookahead_0, Maybe (t, Tokens' token)
result_0) <- ExceptT (Parse_error' token) (Either Error) (t, State token)
-> Either Error (Either (Parse_error' token) (t, State token))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (State token
-> ExceptT (Parse_error' token) (Either Error) (t, State token)
parse_0 State token
st) Either Error (Either (Parse_error' token) (t, State token))
-> (Either (Parse_error' token) (t, State token)
-> Either Error (Lookahead token, Maybe (t, Tokens' token)))
-> Either Error (Lookahead token, Maybe (t, Tokens' token))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either (Parse_error' token) (t, State token)
-> Either Error (Lookahead token, Maybe (t, Tokens' token))
forall token t.
Either (Parse_error' token) (t, State token)
-> Either Error (Lookahead token, Maybe (t, Tokens' token))
deconstruct_result
(Lookahead token
lookahead_1, Maybe (t, Tokens' token)
result_1) <- ExceptT (Parse_error' token) (Either Error) (t, State token)
-> Either Error (Either (Parse_error' token) (t, State token))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (State token
-> ExceptT (Parse_error' token) (Either Error) (t, State token)
parse_1 State token
st) Either Error (Either (Parse_error' token) (t, State token))
-> (Either (Parse_error' token) (t, State token)
-> Either Error (Lookahead token, Maybe (t, Tokens' token)))
-> Either Error (Lookahead token, Maybe (t, Tokens' token))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either (Parse_error' token) (t, State token)
-> Either Error (Lookahead token, Maybe (t, Tokens' token))
forall token t.
Either (Parse_error' token) (t, State token)
-> Either Error (Lookahead token, Maybe (t, Tokens' token))
deconstruct_result
(
Lookahead token
-> Maybe (t, Tokens' token)
-> Either (Parse_error' token) (t, State token)
forall token t.
Lookahead token
-> Maybe (t, Tokens' token)
-> Either (Parse_error' token) (t, State token)
construct_result (Lookahead token -> Lookahead token -> Lookahead token
forall token.
Eq token =>
Lookahead token -> Lookahead token -> Lookahead token
add_lookaheads Lookahead token
lookahead_0 Lookahead token
lookahead_1) (Maybe (t, Tokens' token)
-> Either (Parse_error' token) (t, State token))
-> Either Error (Maybe (t, Tokens' token))
-> Either Error (Either (Parse_error' token) (t, State token))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
case (Maybe (t, Tokens' token)
result_0, Maybe (t, Tokens' token)
result_1) of
(Maybe (t, Tokens' token)
Nothing, Maybe (t, Tokens' token)
Nothing) -> Maybe (t, Tokens' token) -> Either Error (Maybe (t, Tokens' token))
forall a b. b -> Either a b
Right Maybe (t, Tokens' token)
forall a. Maybe a
Nothing
(Maybe (t, Tokens' token)
Nothing, Just (t, Tokens' token)
_) -> Maybe (t, Tokens' token) -> Either Error (Maybe (t, Tokens' token))
forall a b. b -> Either a b
Right Maybe (t, Tokens' token)
result_1
(Just (t, Tokens' token)
_, Maybe (t, Tokens' token)
Nothing) -> Maybe (t, Tokens' token) -> Either Error (Maybe (t, Tokens' token))
forall a b. b -> Either a b
Right Maybe (t, Tokens' token)
result_0
(Just (t
_, Tokens' token
tokens_0), Just (t
_, Tokens' token
tokens_1)) ->
case Line_and_char -> Line_and_char -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Tokens' token -> Line_and_char
forall token. Tokens' token -> Line_and_char
current_line_and_char Tokens' token
tokens_0) (Tokens' token -> Line_and_char
forall token. Tokens' token -> Line_and_char
current_line_and_char Tokens' token
tokens_1) of
Ordering
LT -> Maybe (t, Tokens' token) -> Either Error (Maybe (t, Tokens' token))
forall a b. b -> Either a b
Right Maybe (t, Tokens' token)
result_1
Ordering
EQ -> Error -> Either Error (Maybe (t, Tokens' token))
forall a b. a -> Either a b
Left Error
Ambiguity
Ordering
GT -> Maybe (t, Tokens' token) -> Either Error (Maybe (t, Tokens' token))
forall a b. b -> Either a b
Right Maybe (t, Tokens' token)
result_0))))
instance Applicative (Parser' token) where
Parser StateT
(State token)
(ExceptT (Parse_error' token) (Either Error))
(a -> b)
parse_0 <*> :: Parser' token (a -> b) -> Parser' token a -> Parser' token b
<*> Parser StateT
(State token) (ExceptT (Parse_error' token) (Either Error)) a
parse_1 = StateT
(State token) (ExceptT (Parse_error' token) (Either Error)) b
-> Parser' token b
forall token t.
StateT
(State token) (ExceptT (Parse_error' token) (Either Error)) t
-> Parser' token t
Parser (StateT
(State token)
(ExceptT (Parse_error' token) (Either Error))
(a -> b)
parse_0 StateT
(State token)
(ExceptT (Parse_error' token) (Either Error))
(a -> b)
-> StateT
(State token) (ExceptT (Parse_error' token) (Either Error)) a
-> StateT
(State token) (ExceptT (Parse_error' token) (Either Error)) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT
(State token) (ExceptT (Parse_error' token) (Either Error)) a
parse_1)
pure :: a -> Parser' token a
pure a
x = StateT
(State token) (ExceptT (Parse_error' token) (Either Error)) a
-> Parser' token a
forall token t.
StateT
(State token) (ExceptT (Parse_error' token) (Either Error)) t
-> Parser' token t
Parser (a
-> StateT
(State token) (ExceptT (Parse_error' token) (Either Error)) a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x)
instance Functor (Parser' token) where
fmap :: (a -> b) -> Parser' token a -> Parser' token b
fmap a -> b
f (Parser StateT
(State token) (ExceptT (Parse_error' token) (Either Error)) a
parse') = StateT
(State token) (ExceptT (Parse_error' token) (Either Error)) b
-> Parser' token b
forall token t.
StateT
(State token) (ExceptT (Parse_error' token) (Either Error)) t
-> Parser' token t
Parser (a -> b
f (a -> b)
-> StateT
(State token) (ExceptT (Parse_error' token) (Either Error)) a
-> StateT
(State token) (ExceptT (Parse_error' token) (Either Error)) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT
(State token) (ExceptT (Parse_error' token) (Either Error)) a
parse')
instance Monad (Parser' token) where
Parser StateT
(State token) (ExceptT (Parse_error' token) (Either Error)) a
parse' >>= :: Parser' token a -> (a -> Parser' token b) -> Parser' token b
>>= a -> Parser' token b
f = StateT
(State token) (ExceptT (Parse_error' token) (Either Error)) b
-> Parser' token b
forall token t.
StateT
(State token) (ExceptT (Parse_error' token) (Either Error)) t
-> Parser' token t
Parser (StateT
(State token) (ExceptT (Parse_error' token) (Either Error)) a
parse' StateT
(State token) (ExceptT (Parse_error' token) (Either Error)) a
-> (a
-> StateT
(State token) (ExceptT (Parse_error' token) (Either Error)) b)
-> StateT
(State token) (ExceptT (Parse_error' token) (Either Error)) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Parser' token b
-> StateT
(State token) (ExceptT (Parse_error' token) (Either Error)) b
forall token t.
Parser' token t
-> StateT
(State token) (ExceptT (Parse_error' token) (Either Error)) t
run_Parser (Parser' token b
-> StateT
(State token) (ExceptT (Parse_error' token) (Either Error)) b)
-> (a -> Parser' token b)
-> a
-> StateT
(State token) (ExceptT (Parse_error' token) (Either Error)) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> Parser' token b
f)
deriving instance Show token => Show (Lookahead token)
deriving instance Show token => Show (Parse_error' token)
deriving instance Show token => Show (State token)
add_location :: Parser' token t -> Parser' token (L t)
add_location :: Parser' token t -> Parser' token (L t)
add_location Parser' token t
parse_t = Line_and_char -> t -> L t
forall t. Line_and_char -> t -> L t
L (Line_and_char -> t -> L t)
-> Parser' token Line_and_char -> Parser' token (t -> L t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser' token Line_and_char
forall token. Parser' token Line_and_char
parse_line_and_char Parser' token (t -> L t) -> Parser' token t -> Parser' token (L t)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser' token t
parse_t
add_lookaheads :: Eq token => Lookahead token -> Lookahead token -> Lookahead token
add_lookaheads :: Lookahead token -> Lookahead token -> Lookahead token
add_lookaheads
(lookahead_0 :: Lookahead token
lookahead_0 @ (Lookahead Line_and_char
line_and_char_0 Set String
expected_0 Maybe token
found_0))
(lookahead_1 :: Lookahead token
lookahead_1 @ (Lookahead Line_and_char
line_and_char_1 Set String
expected_1 Maybe token
found_1)) =
case Line_and_char -> Line_and_char -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Line_and_char
line_and_char_0 Line_and_char
line_and_char_1 of
Ordering
LT -> Lookahead token
lookahead_1
Ordering
EQ -> Line_and_char -> Set String -> Maybe token -> Lookahead token
forall token.
Line_and_char -> Set String -> Maybe token -> Lookahead token
Lookahead (Line_and_char
line_and_char_0 Line_and_char -> Line_and_char -> Line_and_char
forall t. Eq t => t -> t -> t
=== Line_and_char
line_and_char_1) (Set String -> Set String -> Set String
forall a. Ord a => Set a -> Set a -> Set a
union Set String
expected_0 Set String
expected_1) (Maybe token
found_0 Maybe token -> Maybe token -> Maybe token
forall t. Eq t => t -> t -> t
=== Maybe token
found_1)
Ordering
GT -> Lookahead token
lookahead_0
certain_token :: Eq token => token -> token -> Maybe ()
certain_token :: token -> token -> Maybe ()
certain_token token
token token
token' =
case token
token token -> token -> Bool
forall a. Eq a => a -> a -> Bool
== token
token' of
Bool
False -> Maybe ()
forall a. Maybe a
Nothing
Bool
True -> () -> Maybe ()
forall a. a -> Maybe a
Just ()
construct_result :: Lookahead token -> Maybe (t, Tokens' token) -> Either (Parse_error' token) (t, State token)
construct_result :: Lookahead token
-> Maybe (t, Tokens' token)
-> Either (Parse_error' token) (t, State token)
construct_result Lookahead token
lookahead Maybe (t, Tokens' token)
result =
case Maybe (t, Tokens' token)
result of
Maybe (t, Tokens' token)
Nothing -> Parse_error' token -> Either (Parse_error' token) (t, State token)
forall a b. a -> Either a b
Left (Lookahead token -> Parse_error' token
forall token. Lookahead token -> Parse_error' token
Match_error Lookahead token
lookahead)
Just (t
x, Tokens' token
tokens) -> (t, State token) -> Either (Parse_error' token) (t, State token)
forall a b. b -> Either a b
Right (t
x, Tokens' token -> Lookahead token -> State token
forall token. Tokens' token -> Lookahead token -> State token
State Tokens' token
tokens Lookahead token
lookahead)
deconstruct_result :: Either (Parse_error' token) (t, State token) -> Either Error (Lookahead token, Maybe (t, Tokens' token))
deconstruct_result :: Either (Parse_error' token) (t, State token)
-> Either Error (Lookahead token, Maybe (t, Tokens' token))
deconstruct_result Either (Parse_error' token) (t, State token)
result =
case Either (Parse_error' token) (t, State token)
result of
Left Parse_error' token
err ->
case Parse_error' token
err of
Filter_error Line_and_char
_ String
_ -> Error -> Either Error (Lookahead token, Maybe (t, Tokens' token))
forall a b. a -> Either a b
Left Error
Attempt_to_recover_a_filter_error
Match_error Lookahead token
lookahead -> (Lookahead token, Maybe (t, Tokens' token))
-> Either Error (Lookahead token, Maybe (t, Tokens' token))
forall a b. b -> Either a b
Right (Lookahead token
lookahead, Maybe (t, Tokens' token)
forall a. Maybe a
Nothing)
Right (t
x, State Tokens' token
tokens Lookahead token
lookahead) -> (Lookahead token, Maybe (t, Tokens' token))
-> Either Error (Lookahead token, Maybe (t, Tokens' token))
forall a b. b -> Either a b
Right (Lookahead token
lookahead, (t, Tokens' token) -> Maybe (t, Tokens' token)
forall a. a -> Maybe a
Just (t
x, Tokens' token
tokens))
filter_Parser :: Ord token => String -> (t -> Bool) -> Parser' token t -> Parser' token t
filter_Parser :: String -> (t -> Bool) -> Parser' token t -> Parser' token t
filter_Parser String
err t -> Bool
f =
String -> (t -> Maybe t) -> Parser' token t -> Parser' token t
forall token t u.
Ord token =>
String -> (t -> Maybe u) -> Parser' token t -> Parser' token u
fmap_filter_Parser
String
err
(\t
x ->
case t -> Bool
f t
x of
Bool
False -> Maybe t
forall a. Maybe a
Nothing
Bool
True -> t -> Maybe t
forall a. a -> Maybe a
Just t
x)
fmap_filter_Parser :: Ord token => String -> (t -> Maybe u) -> Parser' token t -> Parser' token u
fmap_filter_Parser :: String -> (t -> Maybe u) -> Parser' token t -> Parser' token u
fmap_filter_Parser String
err t -> Maybe u
f Parser' token t
parse_t =
do
Line_and_char
line_and_char <- Parser' token Line_and_char
forall token. Parser' token Line_and_char
parse_line_and_char
t
x <- Parser' token t
parse_t
case t -> Maybe u
f t
x of
Maybe u
Nothing -> StateT
(State token) (ExceptT (Parse_error' token) (Either Error)) u
-> Parser' token u
forall token t.
StateT
(State token) (ExceptT (Parse_error' token) (Either Error)) t
-> Parser' token t
Parser (Parse_error' token
-> StateT
(State token) (ExceptT (Parse_error' token) (Either Error)) u
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Line_and_char -> String -> Parse_error' token
forall token. Line_and_char -> String -> Parse_error' token
Filter_error Line_and_char
line_and_char String
err))
Just u
y -> u -> Parser' token u
forall (m :: * -> *) a. Monad m => a -> m a
return u
y
match_error :: Eq token => String -> Parser' token t
match_error :: String -> Parser' token t
match_error String
expected =
do
State Tokens' token
tokens Lookahead token
lookahead <- StateT
(State token)
(ExceptT (Parse_error' token) (Either Error))
(State token)
-> Parser' token (State token)
forall token t.
StateT
(State token) (ExceptT (Parse_error' token) (Either Error)) t
-> Parser' token t
Parser StateT
(State token)
(ExceptT (Parse_error' token) (Either Error))
(State token)
forall s (m :: * -> *). MonadState s m => m s
get
StateT
(State token) (ExceptT (Parse_error' token) (Either Error)) t
-> Parser' token t
forall token t.
StateT
(State token) (ExceptT (Parse_error' token) (Either Error)) t
-> Parser' token t
Parser
(Parse_error' token
-> StateT
(State token) (ExceptT (Parse_error' token) (Either Error)) t
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError
(Lookahead token -> Parse_error' token
forall token. Lookahead token -> Parse_error' token
Match_error
(Lookahead token -> Lookahead token -> Lookahead token
forall token.
Eq token =>
Lookahead token -> Lookahead token -> Lookahead token
add_lookaheads Lookahead token
lookahead (Line_and_char -> Set String -> Maybe token -> Lookahead token
forall token.
Line_and_char -> Set String -> Maybe token -> Lookahead token
Lookahead (Tokens' token -> Line_and_char
forall token. Tokens' token -> Line_and_char
current_line_and_char Tokens' token
tokens) (String -> Set String
forall a. a -> Set a
singleton String
expected) (Tokens' token -> Maybe token
forall token. Tokens' token -> Maybe token
get_token Tokens' token
tokens)))))
parse ::
(
Eq token =>
(Char -> char_class) ->
(char_class -> Line_and_char -> Line_and_char) ->
Tokeniser' char_class token err () ->
Parser' token t ->
(Parse_error' token -> err) ->
String ->
Either Error (Either err t))
parse :: (Char -> char_class)
-> (char_class -> Line_and_char -> Line_and_char)
-> Tokeniser' char_class token err ()
-> Parser' token t
-> (Parse_error' token -> err)
-> String
-> Either Error (Either err t)
parse Char -> char_class
classify_char char_class -> Line_and_char -> Line_and_char
next_line_and_char Tokeniser' char_class token err ()
tokenise_t Parser' token t
parse_t Parse_error' token -> err
transform_parse_error String
text =
ExceptT err (Either Error) t -> Either Error (Either err t)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT
(do
Tokens' token
tokens <- Either Error (Either err (Tokens' token))
-> ExceptT err (Either Error) (Tokens' token)
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT ((Char -> char_class)
-> (char_class -> Line_and_char -> Line_and_char)
-> Tokeniser' char_class token err ()
-> String
-> Either Error (Either err (Tokens' token))
forall char_class token err.
(Char -> char_class)
-> (char_class -> Line_and_char -> Line_and_char)
-> Tokeniser' char_class token err ()
-> String
-> Either Error (Either err (Tokens' token))
tokenise Char -> char_class
classify_char char_class -> Line_and_char -> Line_and_char
next_line_and_char Tokeniser' char_class token err ()
tokenise_t String
text)
(Parse_error' token -> err)
-> ExceptT (Parse_error' token) (Either Error) t
-> ExceptT err (Either Error) t
forall (m :: * -> *) e e' a.
Functor m =>
(e -> e') -> ExceptT e m a -> ExceptT e' m a
withExceptT
Parse_error' token -> err
transform_parse_error
(StateT
(State token) (ExceptT (Parse_error' token) (Either Error)) t
-> State token -> ExceptT (Parse_error' token) (Either Error) t
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT
(Parser' token t
-> StateT
(State token) (ExceptT (Parse_error' token) (Either Error)) t
forall token t.
Parser' token t
-> StateT
(State token) (ExceptT (Parse_error' token) (Either Error)) t
run_Parser (Parser' token t -> Parser' token t
forall token t. Eq token => Parser' token t -> Parser' token t
parse_end Parser' token t
parse_t))
(Tokens' token -> Lookahead token -> State token
forall token. Tokens' token -> Lookahead token -> State token
State Tokens' token
tokens (Line_and_char -> Set String -> Maybe token -> Lookahead token
forall token.
Line_and_char -> Set String -> Maybe token -> Lookahead token
Lookahead (Tokens' token -> Line_and_char
forall token. Tokens' token -> Line_and_char
current_line_and_char Tokens' token
tokens) Set String
forall a. Set a
empty (Tokens' token -> Maybe token
forall token. Tokens' token -> Maybe token
get_token Tokens' token
tokens)))))
parse_brackets :: Parser' token () -> Parser' token () -> Parser' token t -> Parser' token t
parse_brackets :: Parser' token ()
-> Parser' token () -> Parser' token t -> Parser' token t
parse_brackets Parser' token ()
parse_left_bracket Parser' token ()
parse_right_bracket Parser' token t
parse_t =
do
Parser' token ()
parse_left_bracket
t
x <- Parser' token t
parse_t
Parser' token ()
parse_right_bracket
t -> Parser' token t
forall (m :: * -> *) a. Monad m => a -> m a
return t
x
parse_end :: Eq token => Parser' token t -> Parser' token t
parse_end :: Parser' token t -> Parser' token t
parse_end Parser' token t
parse_t =
do
t
x <- Parser' token t
parse_t
Parser' token ()
forall token. Eq token => Parser' token ()
parse_end'
t -> Parser' token t
forall (m :: * -> *) a. Monad m => a -> m a
return t
x
parse_end' :: Eq token => Parser' token ()
parse_end' :: Parser' token ()
parse_end' =
do
Tokens' token
tokens <- State token -> Tokens' token
forall token. State token -> Tokens' token
state_tokens (State token -> Tokens' token)
-> Parser' token (State token) -> Parser' token (Tokens' token)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT
(State token)
(ExceptT (Parse_error' token) (Either Error))
(State token)
-> Parser' token (State token)
forall token t.
StateT
(State token) (ExceptT (Parse_error' token) (Either Error)) t
-> Parser' token t
Parser StateT
(State token)
(ExceptT (Parse_error' token) (Either Error))
(State token)
forall s (m :: * -> *). MonadState s m => m s
get
case Tokens' token -> Bool
forall token. Tokens' token -> Bool
tokens_ended Tokens' token
tokens of
Bool
False -> String -> Parser' token ()
forall token t. Eq token => String -> Parser' token t
match_error String
"end of text"
Bool
True -> () -> Parser' token ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
parse_element :: Parser' token () -> Parser' token t -> Parser' token t
parse_element :: Parser' token () -> Parser' token t -> Parser' token t
parse_element Parser' token ()
parse_separator Parser' token t
parse_t =
do
Parser' token ()
parse_separator
Parser' token t
parse_t
parse_empty_list :: Parser' token [t]
parse_empty_list :: Parser' token [t]
parse_empty_list = [t] -> Parser' token [t]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
parse_line_and_char :: Parser' token Line_and_char
parse_line_and_char :: Parser' token Line_and_char
parse_line_and_char = Tokens' token -> Line_and_char
forall token. Tokens' token -> Line_and_char
current_line_and_char (Tokens' token -> Line_and_char)
-> (State token -> Tokens' token) -> State token -> Line_and_char
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> State token -> Tokens' token
forall token. State token -> Tokens' token
state_tokens (State token -> Line_and_char)
-> Parser' token (State token) -> Parser' token Line_and_char
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT
(State token)
(ExceptT (Parse_error' token) (Either Error))
(State token)
-> Parser' token (State token)
forall token t.
StateT
(State token) (ExceptT (Parse_error' token) (Either Error)) t
-> Parser' token t
Parser StateT
(State token)
(ExceptT (Parse_error' token) (Either Error))
(State token)
forall s (m :: * -> *). MonadState s m => m s
get
parse_list :: Eq token => Parser' token () -> Parser' token t -> Parser' token [t]
parse_list :: Parser' token () -> Parser' token t -> Parser' token [t]
parse_list Parser' token ()
parse_separator Parser' token t
parse_t = Parser' token [t]
forall token t. Parser' token [t]
parse_empty_list Parser' token [t] -> Parser' token [t] -> Parser' token [t]
forall token t.
Eq token =>
Parser' token t -> Parser' token t -> Parser' token t
<+> Parser' token () -> Parser' token t -> Parser' token [t]
forall token t.
Eq token =>
Parser' token () -> Parser' token t -> Parser' token [t]
parse_non_empty_list Parser' token ()
parse_separator Parser' token t
parse_t
parse_many :: Eq token => Parser' token t -> Parser' token [t]
parse_many :: Parser' token t -> Parser' token [t]
parse_many Parser' token t
parse_t = Parser' token [t]
forall token t. Parser' token [t]
parse_empty_list Parser' token [t] -> Parser' token [t] -> Parser' token [t]
forall token t.
Eq token =>
Parser' token t -> Parser' token t -> Parser' token t
<+> Parser' token t -> Parser' token [t]
forall token t. Eq token => Parser' token t -> Parser' token [t]
parse_some Parser' token t
parse_t
parse_non_empty_list :: Eq token => Parser' token () -> Parser' token t -> Parser' token [t]
parse_non_empty_list :: Parser' token () -> Parser' token t -> Parser' token [t]
parse_non_empty_list Parser' token ()
parse_separator Parser' token t
parse_t = (:) (t -> [t] -> [t]) -> Parser' token t -> Parser' token ([t] -> [t])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser' token t
parse_t Parser' token ([t] -> [t])
-> Parser' token [t] -> Parser' token [t]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser' token t -> Parser' token [t]
forall token t. Eq token => Parser' token t -> Parser' token [t]
parse_many (Parser' token () -> Parser' token t -> Parser' token t
forall token t.
Parser' token () -> Parser' token t -> Parser' token t
parse_element Parser' token ()
parse_separator Parser' token t
parse_t)
parse_some :: Eq token => Parser' token t -> Parser' token [t]
parse_some :: Parser' token t -> Parser' token [t]
parse_some Parser' token t
parse_t = (:) (t -> [t] -> [t]) -> Parser' token t -> Parser' token ([t] -> [t])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser' token t
parse_t Parser' token ([t] -> [t])
-> Parser' token [t] -> Parser' token [t]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser' token t -> Parser' token [t]
forall token t. Eq token => Parser' token t -> Parser' token [t]
parse_many Parser' token t
parse_t
parse_token :: Eq token => token -> String -> Parser' token ()
parse_token :: token -> String -> Parser' token ()
parse_token token
token = (token -> Maybe ()) -> String -> Parser' token ()
forall token t.
Eq token =>
(token -> Maybe t) -> String -> Parser' token t
parse_token' (token -> token -> Maybe ()
forall token. Eq token => token -> token -> Maybe ()
certain_token token
token)
parse_token' :: Eq token => (token -> Maybe t) -> String -> Parser' token t
parse_token' :: (token -> Maybe t) -> String -> Parser' token t
parse_token' token -> Maybe t
f String
expected =
do
Tokens' token
tokens <- State token -> Tokens' token
forall token. State token -> Tokens' token
state_tokens (State token -> Tokens' token)
-> Parser' token (State token) -> Parser' token (Tokens' token)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT
(State token)
(ExceptT (Parse_error' token) (Either Error))
(State token)
-> Parser' token (State token)
forall token t.
StateT
(State token) (ExceptT (Parse_error' token) (Either Error)) t
-> Parser' token t
Parser StateT
(State token)
(ExceptT (Parse_error' token) (Either Error))
(State token)
forall s (m :: * -> *). MonadState s m => m s
get
case (token -> Maybe t) -> Tokens' token -> Maybe (t, Tokens' token)
forall token t.
(token -> Maybe t) -> Tokens' token -> Maybe (t, Tokens' token)
take_token token -> Maybe t
f Tokens' token
tokens of
Maybe (t, Tokens' token)
Nothing -> String -> Parser' token t
forall token t. Eq token => String -> Parser' token t
match_error String
expected
Just (t
x, Tokens' token
tokens') ->
do
StateT
(State token) (ExceptT (Parse_error' token) (Either Error)) ()
-> Parser' token ()
forall token t.
StateT
(State token) (ExceptT (Parse_error' token) (Either Error)) t
-> Parser' token t
Parser ((State token -> State token)
-> StateT
(State token) (ExceptT (Parse_error' token) (Either Error)) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\State token
st -> State token
st {state_tokens :: Tokens' token
state_tokens = Tokens' token
tokens'}))
t -> Parser' token t
forall (m :: * -> *) a. Monad m => a -> m a
return t
x
write_maybe_token :: (token -> String) -> Maybe token -> String
write_maybe_token :: (token -> String) -> Maybe token -> String
write_maybe_token token -> String
write_token Maybe token
maybe_token =
case Maybe token
maybe_token of
Maybe token
Nothing -> String
"end of file"
Just token
token -> token -> String
write_token token
token
write_parse_error :: (token -> String) -> String -> Parse_error' token -> String
write_parse_error :: (token -> String) -> String -> Parse_error' token -> String
write_parse_error token -> String
write_token String
file_name Parse_error' token
err =
case Parse_error' token
err of
Filter_error Line_and_char
line_and_char String
err' -> String
err' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" at " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> Line_and_char -> String
write_file_name_and_line_and_char String
file_name Line_and_char
line_and_char String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"."
Match_error (Lookahead Line_and_char
line_and_char Set String
expected Maybe token
found) ->
(
String
"Parse error at " String -> ShowS
forall a. [a] -> [a] -> [a]
++
String -> Line_and_char -> String
write_file_name_and_line_and_char String
file_name Line_and_char
line_and_char String -> ShowS
forall a. [a] -> [a] -> [a]
++
String
". Expected [" String -> ShowS
forall a. [a] -> [a] -> [a]
++
String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " (Set String -> [String]
forall a. Set a -> [a]
elems Set String
expected) String -> ShowS
forall a. [a] -> [a] -> [a]
++
String
"], found " String -> ShowS
forall a. [a] -> [a] -> [a]
++
(token -> String) -> Maybe token -> String
forall token. (token -> String) -> Maybe token -> String
write_maybe_token token -> String
write_token Maybe token
found String -> ShowS
forall a. [a] -> [a] -> [a]
++
String
".")