{-|
Module      : Toml.Parser.Utils
Description : Primitive operations used by the happy-generated parser
Copyright   : (c) Eric Mertens, 2023
License     : ISC
Maintainer  : emertens@gmail.com

This module contains all the primitives used by the Parser module.
By extracting it from the @.y@ file we minimize the amount of code
that has warnings disabled and get better editor support.

@since 1.3.0.0

-}
module Toml.Parser.Utils (
    Parser,
    runParser,
    pureP,
    thenP,
    asString,
    lexerP,
    errorP,

    -- * Lexer-state management
    push,
    pop,
    ) where

import Toml.Lexer (scanToken, Context(..))
import Toml.Lexer.Token (Token(TokBareKey, TokString))
import Toml.Located (Located)
import Toml.Pretty (prettyToken)

-- continuation passing implementation of a state monad with errors
newtype Parser r a = P {
    forall r a.
Parser r a
-> [Context]
-> Located String
-> ([Context] -> Located String -> a -> Either (Located String) r)
-> Either (Located String) r
getP ::
        [Context] -> Located String ->
        ([Context] -> Located String -> a -> Either (Located String) r) ->
        Either (Located String) r
    }

-- | Run the top-level parser
runParser :: Parser r r -> Context -> Located String -> Either (Located String) r
runParser :: forall r.
Parser r r
-> Context -> Located String -> Either (Located String) r
runParser (P [Context]
-> Located String
-> ([Context] -> Located String -> r -> Either (Located String) r)
-> Either (Located String) r
k) Context
ctx Located String
str = [Context]
-> Located String
-> ([Context] -> Located String -> r -> Either (Located String) r)
-> Either (Located String) r
k [Context
ctx] Located String
str \[Context]
_ Located String
_ r
r -> r -> Either (Located String) r
forall a b. b -> Either a b
Right r
r

-- | Bind implementation used in the happy-generated parser
thenP :: Parser r a -> (a -> Parser r b) -> Parser r b
thenP :: forall r a b. Parser r a -> (a -> Parser r b) -> Parser r b
thenP (P [Context]
-> Located String
-> ([Context] -> Located String -> a -> Either (Located String) r)
-> Either (Located String) r
m) a -> Parser r b
f = ([Context]
 -> Located String
 -> ([Context] -> Located String -> b -> Either (Located String) r)
 -> Either (Located String) r)
-> Parser r b
forall r a.
([Context]
 -> Located String
 -> ([Context] -> Located String -> a -> Either (Located String) r)
 -> Either (Located String) r)
-> Parser r a
P \[Context]
ctx Located String
str [Context] -> Located String -> b -> Either (Located String) r
k -> [Context]
-> Located String
-> ([Context] -> Located String -> a -> Either (Located String) r)
-> Either (Located String) r
m [Context]
ctx Located String
str \[Context]
ctx' Located String
str' a
x -> Parser r b
-> [Context]
-> Located String
-> ([Context] -> Located String -> b -> Either (Located String) r)
-> Either (Located String) r
forall r a.
Parser r a
-> [Context]
-> Located String
-> ([Context] -> Located String -> a -> Either (Located String) r)
-> Either (Located String) r
getP (a -> Parser r b
f a
x) [Context]
ctx' Located String
str' [Context] -> Located String -> b -> Either (Located String) r
k
{-# Inline thenP #-}

-- | Return implementation used in the happy-generated parser
pureP :: a -> Parser r a
pureP :: forall a r. a -> Parser r a
pureP a
x = ([Context]
 -> Located String
 -> ([Context] -> Located String -> a -> Either (Located String) r)
 -> Either (Located String) r)
-> Parser r a
forall r a.
([Context]
 -> Located String
 -> ([Context] -> Located String -> a -> Either (Located String) r)
 -> Either (Located String) r)
-> Parser r a
P \[Context]
ctx Located String
str [Context] -> Located String -> a -> Either (Located String) r
k -> [Context] -> Located String -> a -> Either (Located String) r
k [Context]
ctx Located String
str a
x
{-# Inline pureP #-}

-- | Add a new context to the lexer context stack
push :: Context -> Parser r ()
push :: forall r. Context -> Parser r ()
push Context
x = ([Context]
 -> Located String
 -> ([Context] -> Located String -> () -> Either (Located String) r)
 -> Either (Located String) r)
-> Parser r ()
forall r a.
([Context]
 -> Located String
 -> ([Context] -> Located String -> a -> Either (Located String) r)
 -> Either (Located String) r)
-> Parser r a
P \[Context]
st Located String
str [Context] -> Located String -> () -> Either (Located String) r
k -> [Context] -> Located String -> () -> Either (Located String) r
k (Context
x Context -> [Context] -> [Context]
forall a. a -> [a] -> [a]
: [Context]
st) Located String
str ()
{-# Inline push #-}

-- | Pop the top context off the lexer context stack. It is a program
-- error to pop without first pushing.
pop :: Parser r ()
pop :: forall r. Parser r ()
pop = ([Context]
 -> Located String
 -> ([Context] -> Located String -> () -> Either (Located String) r)
 -> Either (Located String) r)
-> Parser r ()
forall r a.
([Context]
 -> Located String
 -> ([Context] -> Located String -> a -> Either (Located String) r)
 -> Either (Located String) r)
-> Parser r a
P \[Context]
ctx Located String
str [Context] -> Located String -> () -> Either (Located String) r
k ->
    case [Context]
ctx of
        []       -> String -> Either (Located String) r
forall a. HasCallStack => String -> a
error String
"Toml.Parser.Utils.pop: PANIC! malformed production in parser"
        Context
_ : [Context]
ctx' -> [Context] -> Located String -> () -> Either (Located String) r
k [Context]
ctx' Located String
str ()
{-# Inline pop #-}

-- | Operation the parser generator uses when it reaches an unexpected token.
errorP :: Located Token -> Parser r a
errorP :: forall r a. Located Token -> Parser r a
errorP Located Token
e = ([Context]
 -> Located String
 -> ([Context] -> Located String -> a -> Either (Located String) r)
 -> Either (Located String) r)
-> Parser r a
forall r a.
([Context]
 -> Located String
 -> ([Context] -> Located String -> a -> Either (Located String) r)
 -> Either (Located String) r)
-> Parser r a
P \[Context]
_ Located String
_ [Context] -> Located String -> a -> Either (Located String) r
_ -> Located String -> Either (Located String) r
forall a b. a -> Either a b
Left ((Token -> String) -> Located Token -> Located String
forall a b. (a -> b) -> Located a -> Located b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Token
t -> String
"parse error: unexpected " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Token -> String
prettyToken Token
t) Located Token
e)

-- | Operation the parser generator uses to request the next token.
lexerP :: (Located Token -> Parser r a) -> Parser r a
lexerP :: forall r a. (Located Token -> Parser r a) -> Parser r a
lexerP Located Token -> Parser r a
f = ([Context]
 -> Located String
 -> ([Context] -> Located String -> a -> Either (Located String) r)
 -> Either (Located String) r)
-> Parser r a
forall r a.
([Context]
 -> Located String
 -> ([Context] -> Located String -> a -> Either (Located String) r)
 -> Either (Located String) r)
-> Parser r a
P \[Context]
st Located String
str [Context] -> Located String -> a -> Either (Located String) r
k ->
    case Context
-> Located String
-> Either (Located String) (Located Token, Located String)
scanToken ([Context] -> Context
forall a. HasCallStack => [a] -> a
head [Context]
st) Located String
str of
        Left Located String
le -> Located String -> Either (Located String) r
forall a b. a -> Either a b
Left ((String
"lexical error: " String -> String -> String
forall a. [a] -> [a] -> [a]
++) (String -> String) -> Located String -> Located String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Located String
le)
        Right (Located Token
t, Located String
str') -> Parser r a
-> [Context]
-> Located String
-> ([Context] -> Located String -> a -> Either (Located String) r)
-> Either (Located String) r
forall r a.
Parser r a
-> [Context]
-> Located String
-> ([Context] -> Located String -> a -> Either (Located String) r)
-> Either (Located String) r
getP (Located Token -> Parser r a
f Located Token
t) [Context]
st Located String
str' [Context] -> Located String -> a -> Either (Located String) r
k
{-# Inline lexerP #-}

-- | Extract the string content of a bare-key or a quoted string.
asString :: Token -> String
asString :: Token -> String
asString (TokString String
x) = String
x
asString (TokBareKey String
x) = String
x
asString Token
_ = String -> String
forall a. HasCallStack => String -> a
error String
"simpleKeyLexeme: panic"
{-# Inline asString #-}