{-# LANGUAGE FlexibleContexts #-}
{-# OPTIONS_GHC -Wno-missing-export-lists #-}

module Burrito.Internal.Parse where

import qualified Burrito.Internal.Type.Character as Character
import qualified Burrito.Internal.Type.Digit as Digit
import qualified Burrito.Internal.Type.Expression as Expression
import qualified Burrito.Internal.Type.Field as Field
import qualified Burrito.Internal.Type.Literal as Literal
import qualified Burrito.Internal.Type.MaxLength as MaxLength
import qualified Burrito.Internal.Type.Modifier as Modifier
import qualified Burrito.Internal.Type.Name as Name
import qualified Burrito.Internal.Type.Operator as Operator
import qualified Burrito.Internal.Type.Template as Template
import qualified Burrito.Internal.Type.Token as Token
import qualified Burrito.Internal.Type.Variable as Variable
import qualified Data.Char as Char
import qualified Data.Ix as Ix
import qualified Data.List.NonEmpty as NonEmpty
import qualified Text.Parsec as Parsec
import qualified Text.Read as Read

-- | Attempts to parse a string as a URI template. If parsing fails, this will
-- return @Nothing@. Otherwise it will return @Just@ the parsed template.
--
-- Parsing will usually succeed, but it can fail if the input string contains
-- characters that are not valid in IRIs (like @^@) or if the input string
-- contains an invalid template expression (like @{!}@). To include characters
-- that aren't valid in IRIs, percent encode them (like @%5E@).
--
-- >>> parse "invalid template"
-- Nothing
-- >>> parse "valid-template"
-- Just (Template ...)
parse :: String -> Maybe Template.Template
parse :: String -> Maybe Template
parse = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
Parsec.parse forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Template
template String
""

template :: (Parsec.Stream s m Char) => Parsec.ParsecT s u m Template.Template
template :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Template
template = [Token] -> Template
Template.Template forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
Parsec.many forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Token
token forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
Parsec.eof

token :: (Parsec.Stream s m Char) => Parsec.ParsecT s u m Token.Token
token :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Token
token = forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
choice (Expression -> Token
Token.Expression forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m Expression
expression) (Literal -> Token
Token.Literal forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Literal
literal)

choice ::
  Parsec.ParsecT s u m a -> Parsec.ParsecT s u m a -> Parsec.ParsecT s u m a
choice :: forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
choice = forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
(Parsec.<|>)

expression ::
  (Parsec.Stream s m Char) => Parsec.ParsecT s u m Expression.Expression
expression :: forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m Expression
expression =
  forall s (m :: * -> *) t u open close a.
Stream s m t =>
ParsecT s u m open
-> ParsecT s u m close -> ParsecT s u m a -> ParsecT s u m a
Parsec.between (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
Parsec.char Char
'{') (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
Parsec.char Char
'}') forall a b. (a -> b) -> a -> b
$
    Operator -> NonEmpty Variable -> Expression
Expression.Expression
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Operator
operator
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall s u (m :: * -> *) a x.
ParsecT s u m a -> ParsecT s u m x -> ParsecT s u m (NonEmpty a)
sepBy1 forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Variable
variable (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
Parsec.char Char
',')

operator :: (Parsec.Stream s m Char) => Parsec.ParsecT s u m Operator.Operator
operator :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Operator
operator =
  forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
Parsec.option Operator
Operator.None forall a b. (a -> b) -> a -> b
$
    forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
Parsec.choice
      [ Operator
Operator.Ampersand forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
Parsec.char Char
'&',
        Operator
Operator.FullStop forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
Parsec.char Char
'.',
        Operator
Operator.NumberSign forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
Parsec.char Char
'#',
        Operator
Operator.PlusSign forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
Parsec.char Char
'+',
        Operator
Operator.QuestionMark forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
Parsec.char Char
'?',
        Operator
Operator.Semicolon forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
Parsec.char Char
';',
        Operator
Operator.Solidus forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
Parsec.char Char
'/'
      ]

sepBy1 ::
  Parsec.ParsecT s u m a ->
  Parsec.ParsecT s u m x ->
  Parsec.ParsecT s u m (NonEmpty.NonEmpty a)
sepBy1 :: forall s u (m :: * -> *) a x.
ParsecT s u m a -> ParsecT s u m x -> ParsecT s u m (NonEmpty a)
sepBy1 ParsecT s u m a
p ParsecT s u m x
s = forall a. a -> [a] -> NonEmpty a
(NonEmpty.:|) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT s u m a
p forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
Parsec.many (ParsecT s u m x
s forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT s u m a
p)

variable :: (Parsec.Stream s m Char) => Parsec.ParsecT s u m Variable.Variable
variable :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Variable
variable = Name -> Modifier -> Variable
Variable.Variable forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Name
name forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Modifier
modifier

name :: (Parsec.Stream s m Char) => Parsec.ParsecT s u m Name.Name
name :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Name
name = NonEmpty Field -> Name
Name.Name forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s u (m :: * -> *) a x.
ParsecT s u m a -> ParsecT s u m x -> ParsecT s u m (NonEmpty a)
sepBy1 forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Field
field (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
Parsec.char Char
'.')

field :: (Parsec.Stream s m Char) => Parsec.ParsecT s u m Field.Field
field :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Field
field = NonEmpty (Character Field) -> Field
Field.Field forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m (NonEmpty a)
nonEmpty forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m (Character Field)
fieldCharacter

nonEmpty ::
  Parsec.ParsecT s u m a -> Parsec.ParsecT s u m (NonEmpty.NonEmpty a)
nonEmpty :: forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m (NonEmpty a)
nonEmpty ParsecT s u m a
p = forall a. a -> [a] -> NonEmpty a
(NonEmpty.:|) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT s u m a
p forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
Parsec.many ParsecT s u m a
p

fieldCharacter ::
  (Parsec.Stream s m Char) =>
  Parsec.ParsecT s u m (Character.Character Field.Field)
fieldCharacter :: forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m (Character Field)
fieldCharacter = forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
choice forall s (m :: * -> *) u tag.
Stream s m Char =>
ParsecT s u m (Character tag)
encodedCharacter (forall s (m :: * -> *) u tag.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m (Character tag)
unencodedCharacter Char -> Bool
isFieldCharacter)

encodedCharacter ::
  (Parsec.Stream s m Char) => Parsec.ParsecT s u m (Character.Character tag)
encodedCharacter :: forall s (m :: * -> *) u tag.
Stream s m Char =>
ParsecT s u m (Character tag)
encodedCharacter = forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
Parsec.char Char
'%' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall tag. Digit -> Digit -> Character tag
Character.Encoded forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Digit
digit forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Digit
digit

digit :: (Parsec.Stream s m Char) => Parsec.ParsecT s u m Digit.Digit
digit :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Digit
digit = do
  Char
x <- forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
Parsec.satisfy Char -> Bool
Char.isHexDigit
  forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"invalid Digit") forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Char -> Maybe Digit
Digit.fromChar Char
x

unencodedCharacter ::
  (Parsec.Stream s m Char) =>
  (Char -> Bool) ->
  Parsec.ParsecT s u m (Character.Character tag)
unencodedCharacter :: forall s (m :: * -> *) u tag.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m (Character tag)
unencodedCharacter = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall tag. Char -> Character tag
Character.Unencoded forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
Parsec.satisfy

isFieldCharacter :: Char -> Bool
isFieldCharacter :: Char -> Bool
isFieldCharacter Char
x = case Char
x of
  Char
'_' -> Bool
True
  Char
_ -> Char -> Bool
Char.isAsciiUpper Char
x Bool -> Bool -> Bool
|| Char -> Bool
Char.isAsciiLower Char
x Bool -> Bool -> Bool
|| Char -> Bool
Char.isDigit Char
x

modifier :: (Parsec.Stream s m Char) => Parsec.ParsecT s u m Modifier.Modifier
modifier :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Modifier
modifier =
  forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
Parsec.option Modifier
Modifier.None forall a b. (a -> b) -> a -> b
$
    forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
Parsec.choice
      [ Modifier
Modifier.Asterisk forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
Parsec.char Char
'*',
        forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
Parsec.char Char
':' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MaxLength -> Modifier
Modifier.Colon forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m MaxLength
maxLength
      ]

maxLength ::
  (Parsec.Stream s m Char) => Parsec.ParsecT s u m MaxLength.MaxLength
maxLength :: forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m MaxLength
maxLength = do
  Char
x <- forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
Parsec.satisfy forall a b. (a -> b) -> a -> b
$ forall a. Ix a => (a, a) -> a -> Bool
Ix.inRange (Char
'1', Char
'9')
  String
xs <- forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
Parsec.many forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
Parsec.satisfy Char -> Bool
Char.isDigit
  Int
n <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"invalid MaxLength") forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Read a => String -> Maybe a
Read.readMaybe forall a b. (a -> b) -> a -> b
$ Char
x forall a. a -> [a] -> [a]
: String
xs
  if Int -> Bool
isMaxLength Int
n
    then forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Int -> MaxLength
MaxLength.MaxLength Int
n
    else forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"invalid MaxLength"

isMaxLength :: Int -> Bool
isMaxLength :: Int -> Bool
isMaxLength = forall a. Ix a => (a, a) -> a -> Bool
Ix.inRange (Int
1, Int
9999)

literal :: (Parsec.Stream s m Char) => Parsec.ParsecT s u m Literal.Literal
literal :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Literal
literal = NonEmpty (Character Literal) -> Literal
Literal.Literal forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m (NonEmpty a)
nonEmpty forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m (Character Literal)
literalCharacter

literalCharacter ::
  (Parsec.Stream s m Char) =>
  Parsec.ParsecT s u m (Character.Character Literal.Literal)
literalCharacter :: forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m (Character Literal)
literalCharacter =
  forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
choice forall s (m :: * -> *) u tag.
Stream s m Char =>
ParsecT s u m (Character tag)
encodedCharacter (forall s (m :: * -> *) u tag.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m (Character tag)
unencodedCharacter Char -> Bool
isLiteralCharacter)

isLiteralCharacter :: Char -> Bool
isLiteralCharacter :: Char -> Bool
isLiteralCharacter Char
x = case Char
x of
  Char
' ' -> Bool
False
  Char
'"' -> Bool
False
  Char
'\'' -> Bool
False
  Char
'%' -> Bool
False
  Char
'<' -> Bool
False
  Char
'>' -> Bool
False
  Char
'\\' -> Bool
False
  Char
'^' -> Bool
False
  Char
'`' -> Bool
False
  Char
'{' -> Bool
False
  Char
'|' -> Bool
False
  Char
'}' -> Bool
False
  Char
_ ->
    forall a. Ix a => (a, a) -> a -> Bool
Ix.inRange (Char
'\x20', Char
'\x7e') Char
x
      Bool -> Bool -> Bool
|| forall a. Ix a => (a, a) -> a -> Bool
Ix.inRange (Char
'\xa0', Char
'\xd7ff') Char
x
      Bool -> Bool -> Bool
|| forall a. Ix a => (a, a) -> a -> Bool
Ix.inRange (Char
'\xe000', Char
'\xf8ff') Char
x
      Bool -> Bool -> Bool
|| forall a. Ix a => (a, a) -> a -> Bool
Ix.inRange (Char
'\xf900', Char
'\xfdcf') Char
x
      Bool -> Bool -> Bool
|| forall a. Ix a => (a, a) -> a -> Bool
Ix.inRange (Char
'\xfdf0', Char
'\xffef') Char
x
      Bool -> Bool -> Bool
|| forall a. Ix a => (a, a) -> a -> Bool
Ix.inRange (Char
'\x10000', Char
'\x1fffd') Char
x
      Bool -> Bool -> Bool
|| forall a. Ix a => (a, a) -> a -> Bool
Ix.inRange (Char
'\x20000', Char
'\x2fffd') Char
x
      Bool -> Bool -> Bool
|| forall a. Ix a => (a, a) -> a -> Bool
Ix.inRange (Char
'\x30000', Char
'\x3fffd') Char
x
      Bool -> Bool -> Bool
|| forall a. Ix a => (a, a) -> a -> Bool
Ix.inRange (Char
'\x40000', Char
'\x4fffd') Char
x
      Bool -> Bool -> Bool
|| forall a. Ix a => (a, a) -> a -> Bool
Ix.inRange (Char
'\x50000', Char
'\x5fffd') Char
x
      Bool -> Bool -> Bool
|| forall a. Ix a => (a, a) -> a -> Bool
Ix.inRange (Char
'\x60000', Char
'\x6fffd') Char
x
      Bool -> Bool -> Bool
|| forall a. Ix a => (a, a) -> a -> Bool
Ix.inRange (Char
'\x70000', Char
'\x7fffd') Char
x
      Bool -> Bool -> Bool
|| forall a. Ix a => (a, a) -> a -> Bool
Ix.inRange (Char
'\x80000', Char
'\x8fffd') Char
x
      Bool -> Bool -> Bool
|| forall a. Ix a => (a, a) -> a -> Bool
Ix.inRange (Char
'\x90000', Char
'\x9fffd') Char
x
      Bool -> Bool -> Bool
|| forall a. Ix a => (a, a) -> a -> Bool
Ix.inRange (Char
'\xa0000', Char
'\xafffd') Char
x
      Bool -> Bool -> Bool
|| forall a. Ix a => (a, a) -> a -> Bool
Ix.inRange (Char
'\xb0000', Char
'\xbfffd') Char
x
      Bool -> Bool -> Bool
|| forall a. Ix a => (a, a) -> a -> Bool
Ix.inRange (Char
'\xc0000', Char
'\xcfffd') Char
x
      Bool -> Bool -> Bool
|| forall a. Ix a => (a, a) -> a -> Bool
Ix.inRange (Char
'\xd0000', Char
'\xdfffd') Char
x
      Bool -> Bool -> Bool
|| forall a. Ix a => (a, a) -> a -> Bool
Ix.inRange (Char
'\xe1000', Char
'\xefffd') Char
x
      Bool -> Bool -> Bool
|| forall a. Ix a => (a, a) -> a -> Bool
Ix.inRange (Char
'\xf0000', Char
'\xffffd') Char
x
      Bool -> Bool -> Bool
|| forall a. Ix a => (a, a) -> a -> Bool
Ix.inRange (Char
'\x100000', Char
'\x10fffd') Char
x