{-|
Module      : Toml.Syntax.ParserUtils
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.

-}
module Toml.Syntax.ParserUtils (
    Parser,
    runParser,
    pureP,
    thenP,
    asString,
    asMlString,
    asBareKey,
    asInteger,
    asBool,
    asFloat,
    asOffsetDateTime,
    asLocalDate,
    asLocalTime,
    asLocalDateTime,
    locVal,

    lexerP,
    errorP,

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

import Data.Text (Text)
import Data.Time
import Data.List.NonEmpty (NonEmpty((:|)))
import Data.List.NonEmpty qualified as NonEmpty
import Toml.Pretty (prettyToken)
import Toml.Syntax.Lexer (scanToken, Context(..))
import Toml.Syntax.Position (Located(..), Position)
import Toml.Syntax.Token (Token(..))

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

-- | Run the top-level parser
runParser :: Parser r r -> Context -> Located Text -> Either (Located String) r
runParser :: forall r.
Parser r r -> Context -> Located Text -> Either (Located String) r
runParser (P NonEmpty Context
-> Located Text
-> (NonEmpty Context
    -> Located Text -> r -> Either (Located String) r)
-> Either (Located String) r
k) Context
ctx Located Text
str = NonEmpty Context
-> Located Text
-> (NonEmpty Context
    -> Located Text -> r -> Either (Located String) r)
-> Either (Located String) r
k (Context
ctx Context -> [Context] -> NonEmpty Context
forall a. a -> [a] -> NonEmpty a
:| []) Located Text
str \NonEmpty Context
_ Located Text
_ 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 NonEmpty Context
-> Located Text
-> (NonEmpty Context
    -> Located Text -> a -> Either (Located String) r)
-> Either (Located String) r
m) a -> Parser r b
f = (NonEmpty Context
 -> Located Text
 -> (NonEmpty Context
     -> Located Text -> b -> Either (Located String) r)
 -> Either (Located String) r)
-> Parser r b
forall r a.
(NonEmpty Context
 -> Located Text
 -> (NonEmpty Context
     -> Located Text -> a -> Either (Located String) r)
 -> Either (Located String) r)
-> Parser r a
P \NonEmpty Context
ctx Located Text
str NonEmpty Context -> Located Text -> b -> Either (Located String) r
k -> NonEmpty Context
-> Located Text
-> (NonEmpty Context
    -> Located Text -> a -> Either (Located String) r)
-> Either (Located String) r
m NonEmpty Context
ctx Located Text
str \NonEmpty Context
ctx' Located Text
str' a
x -> Parser r b
-> NonEmpty Context
-> Located Text
-> (NonEmpty Context
    -> Located Text -> b -> Either (Located String) r)
-> Either (Located String) r
forall r a.
Parser r a
-> NonEmpty Context
-> Located Text
-> (NonEmpty Context
    -> Located Text -> a -> Either (Located String) r)
-> Either (Located String) r
getP (a -> Parser r b
f a
x) NonEmpty Context
ctx' Located Text
str' NonEmpty Context -> Located Text -> 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 = (NonEmpty Context
 -> Located Text
 -> (NonEmpty Context
     -> Located Text -> a -> Either (Located String) r)
 -> Either (Located String) r)
-> Parser r a
forall r a.
(NonEmpty Context
 -> Located Text
 -> (NonEmpty Context
     -> Located Text -> a -> Either (Located String) r)
 -> Either (Located String) r)
-> Parser r a
P \NonEmpty Context
ctx Located Text
str NonEmpty Context -> Located Text -> a -> Either (Located String) r
k -> NonEmpty Context -> Located Text -> a -> Either (Located String) r
k NonEmpty Context
ctx Located Text
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 = (NonEmpty Context
 -> Located Text
 -> (NonEmpty Context
     -> Located Text -> () -> Either (Located String) r)
 -> Either (Located String) r)
-> Parser r ()
forall r a.
(NonEmpty Context
 -> Located Text
 -> (NonEmpty Context
     -> Located Text -> a -> Either (Located String) r)
 -> Either (Located String) r)
-> Parser r a
P \NonEmpty Context
st Located Text
str NonEmpty Context -> Located Text -> () -> Either (Located String) r
k -> NonEmpty Context -> Located Text -> () -> Either (Located String) r
k (Context -> NonEmpty Context -> NonEmpty Context
forall a. a -> NonEmpty a -> NonEmpty a
NonEmpty.cons Context
x NonEmpty Context
st) Located Text
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 = (NonEmpty Context
 -> Located Text
 -> (NonEmpty Context
     -> Located Text -> () -> Either (Located String) r)
 -> Either (Located String) r)
-> Parser r ()
forall r a.
(NonEmpty Context
 -> Located Text
 -> (NonEmpty Context
     -> Located Text -> a -> Either (Located String) r)
 -> Either (Located String) r)
-> Parser r a
P \NonEmpty Context
ctx Located Text
str NonEmpty Context -> Located Text -> () -> Either (Located String) r
k ->
    case (Context, Maybe (NonEmpty Context)) -> Maybe (NonEmpty Context)
forall a b. (a, b) -> b
snd (NonEmpty Context -> (Context, Maybe (NonEmpty Context))
forall a. NonEmpty a -> (a, Maybe (NonEmpty a))
NonEmpty.uncons NonEmpty Context
ctx) of
        Maybe (NonEmpty Context)
Nothing -> String -> Either (Located String) r
forall a. HasCallStack => String -> a
error String
"toml-parser: PANIC! malformed production in parser"
        Just NonEmpty Context
ctx' -> NonEmpty Context -> Located Text -> () -> Either (Located String) r
k NonEmpty Context
ctx' Located Text
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 = (NonEmpty Context
 -> Located Text
 -> (NonEmpty Context
     -> Located Text -> a -> Either (Located String) r)
 -> Either (Located String) r)
-> Parser r a
forall r a.
(NonEmpty Context
 -> Located Text
 -> (NonEmpty Context
     -> Located Text -> a -> Either (Located String) r)
 -> Either (Located String) r)
-> Parser r a
P \NonEmpty Context
_ Located Text
_ NonEmpty Context -> Located Text -> 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 = (NonEmpty Context
 -> Located Text
 -> (NonEmpty Context
     -> Located Text -> a -> Either (Located String) r)
 -> Either (Located String) r)
-> Parser r a
forall r a.
(NonEmpty Context
 -> Located Text
 -> (NonEmpty Context
     -> Located Text -> a -> Either (Located String) r)
 -> Either (Located String) r)
-> Parser r a
P \NonEmpty Context
st Located Text
str NonEmpty Context -> Located Text -> a -> Either (Located String) r
k ->
    case Context
-> Located Text
-> Either (Located String) (Located Token, Located Text)
scanToken (NonEmpty Context -> Context
forall a. NonEmpty a -> a
NonEmpty.head NonEmpty Context
st) Located Text
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 Text
str') -> Parser r a
-> NonEmpty Context
-> Located Text
-> (NonEmpty Context
    -> Located Text -> a -> Either (Located String) r)
-> Either (Located String) r
forall r a.
Parser r a
-> NonEmpty Context
-> Located Text
-> (NonEmpty Context
    -> Located Text -> a -> Either (Located String) r)
-> Either (Located String) r
getP (Located Token -> Parser r a
f Located Token
t) NonEmpty Context
st Located Text
str' NonEmpty Context -> Located Text -> a -> Either (Located String) r
k
{-# Inline lexerP #-}


asString :: Token -> Maybe Text
asString :: Token -> Maybe Text
asString =
    \case
        TokString Text
i -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
i
        Token
_ -> Maybe Text
forall a. Maybe a
Nothing

asBareKey :: Token -> Maybe Text
asBareKey :: Token -> Maybe Text
asBareKey =
    \case
        TokBareKey Text
i -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
i
        Token
_ -> Maybe Text
forall a. Maybe a
Nothing

asMlString :: Token -> Maybe Text
asMlString :: Token -> Maybe Text
asMlString =
    \case
        TokMlString Text
i -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
i
        Token
_ -> Maybe Text
forall a. Maybe a
Nothing


asInteger :: Token -> Maybe Integer
asInteger :: Token -> Maybe Integer
asInteger =
    \case
        TokInteger Integer
i -> Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
i
        Token
_ -> Maybe Integer
forall a. Maybe a
Nothing

asBool :: Token -> Maybe Bool
asBool :: Token -> Maybe Bool
asBool =
    \case
        Token
TokTrue -> Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True
        Token
TokFalse -> Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False
        Token
_ -> Maybe Bool
forall a. Maybe a
Nothing

asFloat :: Token -> Maybe Double
asFloat :: Token -> Maybe Double
asFloat =
    \case
        TokFloat Double
x -> Double -> Maybe Double
forall a. a -> Maybe a
Just Double
x
        Token
_ -> Maybe Double
forall a. Maybe a
Nothing

asOffsetDateTime :: Token -> Maybe ZonedTime
asOffsetDateTime :: Token -> Maybe ZonedTime
asOffsetDateTime =
    \case
        TokOffsetDateTime ZonedTime
x -> ZonedTime -> Maybe ZonedTime
forall a. a -> Maybe a
Just ZonedTime
x
        Token
_ -> Maybe ZonedTime
forall a. Maybe a
Nothing


asLocalDateTime :: Token -> Maybe LocalTime
asLocalDateTime :: Token -> Maybe LocalTime
asLocalDateTime =
    \case
        TokLocalDateTime LocalTime
x -> LocalTime -> Maybe LocalTime
forall a. a -> Maybe a
Just LocalTime
x
        Token
_ -> Maybe LocalTime
forall a. Maybe a
Nothing


asLocalDate :: Token -> Maybe Day
asLocalDate :: Token -> Maybe Day
asLocalDate =
    \case
        TokLocalDate Day
x -> Day -> Maybe Day
forall a. a -> Maybe a
Just Day
x
        Token
_ -> Maybe Day
forall a. Maybe a
Nothing

asLocalTime :: Token -> Maybe TimeOfDay
asLocalTime :: Token -> Maybe TimeOfDay
asLocalTime =
    \case
        TokLocalTime TimeOfDay
x -> TimeOfDay -> Maybe TimeOfDay
forall a. a -> Maybe a
Just TimeOfDay
x
        Token
_ -> Maybe TimeOfDay
forall a. Maybe a
Nothing

locVal :: (Position -> a -> b) -> Located a -> b
locVal :: forall a b. (Position -> a -> b) -> Located a -> b
locVal Position -> a -> b
f (Located Position
l a
x) = Position -> a -> b
f Position
l a
x