-- |
--
-- Module      : Network.URI.Template.Internal.Parse
-- Copyright   : (c) 2025 Patrick Brisbin
-- License     : AGPL-3
-- Maintainer  : pbrisbin@gmail.com
-- Stability   : experimental
-- Portability : POSIX
module Network.URI.Template.Internal.Parse
  ( -- * Parsing
    Parser
  , parse
  , parseOpt

    -- * Errors
  , ParseError
  , errorBundlePretty

    -- * Re-exports
  , module Text.Megaparsec
  , module Text.Megaparsec.Char

    -- * Extensions
  , quoted
  , restOfLine
  ) where

import Prelude

import Control.Monad (void)
import Data.Text (Text, pack)
import Data.Void (Void)
import Text.Megaparsec hiding (ParseError, errorBundlePretty, parse)
import Text.Megaparsec qualified as Megaparsec
import Text.Megaparsec.Char

type Parser = Parsec Void Text

type ParseError = ParseErrorBundle Text Void

errorBundlePretty :: ParseError -> String
errorBundlePretty :: ParseError -> String
errorBundlePretty = ParseError -> String
forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> String
Megaparsec.errorBundlePretty

parse :: Parser a -> Text -> Either ParseError a
parse :: forall a. Parser a -> Text -> Either ParseError a
parse Parser a
p = Parser a -> String -> Text -> Either ParseError a
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
Megaparsec.parse Parser a
p String
"<uri>"

parseOpt :: Parser a -> String -> Either String a
parseOpt :: forall a. Parser a -> String -> Either String a
parseOpt Parser a
p String
s = case Parser a -> String -> Text -> Either ParseError a
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
Megaparsec.parse Parser a
p String
"<input>" (Text -> Either ParseError a) -> Text -> Either ParseError a
forall a b. (a -> b) -> a -> b
$ String -> Text
pack String
s of
  Left ParseError
err ->
    String -> Either String a
forall a b. a -> Either a b
Left
      (String -> Either String a) -> String -> Either String a
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines
        [ String
"Unable to parse option"
        , String
"input: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
s
        , String
"error:"
        , ParseError -> String
forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> String
Megaparsec.errorBundlePretty ParseError
err
        ]
  Right a
a -> a -> Either String a
forall a b. b -> Either a b
Right a
a

-- | NOTE: doesn't handle escaping
quoted :: Parser Text
quoted :: Parser Text
quoted = String -> Text
pack (String -> Text)
-> ParsecT Void Text Identity String -> Parser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'"' ParsecT Void Text Identity Char
-> ParsecT Void Text Identity String
-> ParsecT Void Text Identity String
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity String
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
manyTill ParsecT Void Text Identity Char
ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'"'))

restOfLine :: Parser Text
restOfLine :: Parser Text
restOfLine = String -> Text
pack (String -> Text)
-> ParsecT Void Text Identity String -> Parser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity ()
-> ParsecT Void Text Identity String
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
manyTill ParsecT Void Text Identity Char
ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle (ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead (ParsecT Void Text Identity () -> ParsecT Void Text Identity ())
-> ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall a b. (a -> b) -> a -> b
$ ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Tokens s)
eol ParsecT Void Text Identity ()
-> ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void Text Identity ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof)