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

module Burrito.Internal.Match where

import qualified Burrito.Internal.Expand as Expand
import qualified Burrito.Internal.Render as Render
import qualified Burrito.Internal.Type.Case as Case
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.Literal as Literal
import qualified Burrito.Internal.Type.Match as Match
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.Value as Value
import qualified Burrito.Internal.Type.Variable as Variable
import qualified Control.Monad as Monad
import qualified Data.ByteString as ByteString
import qualified Data.Char as Char
import qualified Data.List as List
import qualified Data.List.NonEmpty as NonEmpty
import qualified Data.Maybe as Maybe
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text
import qualified Text.ParserCombinators.ReadP as ReadP

-- | Matches a string against a template. This is essentially the opposite of
-- @expand@.
--
-- Since there isn't always one unique match, this function returns all the
-- possibilities. It's up to you to select the one that makes the most sense,
-- or to simply grab the first one if you don't care.
--
-- >>> match "" <$> parse "no-match"
-- Just []
-- >>> match "no-variables" <$> parse "no-variables"
-- Just [[]]
-- >>> match "1-match" <$> parse "{one}-match"
-- Just [[("one",String "1")]]
--
-- Be warned that the number of possible matches can grow quickly if your
-- template has variables next to each other without any separators.
--
-- >>> let Just template = parse "{a}{b}"
-- >>> mapM_ print $ match "ab" template
-- [("a",String "a"),("b",String "b")]
-- [("a",String "ab"),("b",String "")]
-- [("a",String "ab")]
-- [("a",String ""),("b",String "ab")]
-- [("b",String "ab")]
--
-- Matching supports everything /except/ explode modifiers (@{a*}@), list
-- values, and dictionary values.
match :: String -> Template.Template -> [[(String, Value.Value)]]
match :: String -> Template -> [[(String, Value)]]
match String
s =
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(Name, Match)] -> [(String, Value)]
finalize
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> Maybe b) -> [a] -> [b]
Maybe.mapMaybe ([(Name, Match)] -> Maybe [(Name, Match)]
keepConsistent forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. ReadP a -> ReadS a
ReadP.readP_to_S String
s
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. Template -> ReadP [(Name, Match)]
template

finalize :: [(Name.Name, Match.Match)] -> [(String, Value.Value)]
finalize :: [(Name, Match)] -> [(String, Value)]
finalize = forall a b. (a -> Maybe b) -> [a] -> [b]
Maybe.mapMaybe forall a b. (a -> b) -> a -> b
$ \(Name
n, Match
m) -> case Match
m of
  Match.Defined Text
v ->
    forall a. a -> Maybe a
Just (Builder -> String
Render.builderToString forall a b. (a -> b) -> a -> b
$ Name -> Builder
Render.name Name
n, Text -> Value
Value.String Text
v)
  Match.Prefix MaxLength
_ Text
v ->
    forall a. a -> Maybe a
Just (Builder -> String
Render.builderToString forall a b. (a -> b) -> a -> b
$ Name -> Builder
Render.name Name
n, Text -> Value
Value.String Text
v)
  Match
Match.Undefined -> forall a. Maybe a
Nothing

keepConsistent ::
  [(Name.Name, Match.Match)] -> Maybe [(Name.Name, Match.Match)]
keepConsistent :: [(Name, Match)] -> Maybe [(Name, Match)]
keepConsistent [(Name, Match)]
xs = case [(Name, Match)]
xs of
  [] -> forall a. a -> Maybe a
Just [(Name, Match)]
xs
  (Name
k, Match
v) : [(Name, Match)]
ys -> do
    let ([(Name, Match)]
ts, [(Name, Match)]
fs) = forall a. (a -> Bool) -> [a] -> ([a], [a])
List.partition ((forall a. Eq a => a -> a -> Bool
== Name
k) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [(Name, Match)]
ys
    Match
w <- Match -> [Match] -> Maybe Match
combine Match
v forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd [(Name, Match)]
ts
    ((Name
k, Match
w) forall a. a -> [a] -> [a]
:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Name, Match)] -> Maybe [(Name, Match)]
keepConsistent [(Name, Match)]
fs

combine :: Match.Match -> [Match.Match] -> Maybe Match.Match
combine :: Match -> [Match] -> Maybe Match
combine Match
x [Match]
ys = case [Match]
ys of
  [] -> forall a. a -> Maybe a
Just Match
x
  Match
y : [Match]
zs -> case Match
x of
    Match.Defined Text
t -> case Match
y of
      Match.Defined Text
u | Text
t forall a. Eq a => a -> a -> Bool
== Text
u -> Match -> [Match] -> Maybe Match
combine Match
x [Match]
zs
      Match.Prefix MaxLength
m Text
u | Int -> Text -> Text
Text.take (MaxLength -> Int
MaxLength.count MaxLength
m) Text
t forall a. Eq a => a -> a -> Bool
== Text
u -> Match -> [Match] -> Maybe Match
combine Match
x [Match]
zs
      Match
_ -> forall a. Maybe a
Nothing
    Match.Prefix MaxLength
n Text
t -> case Match
y of
      Match.Defined Text
u | Text
t forall a. Eq a => a -> a -> Bool
== Int -> Text -> Text
Text.take (MaxLength -> Int
MaxLength.count MaxLength
n) Text
u -> Match -> [Match] -> Maybe Match
combine Match
y [Match]
zs
      Match.Prefix MaxLength
m Text
u
        | let c :: Int
c = MaxLength -> Int
MaxLength.count (forall a. Ord a => a -> a -> a
min MaxLength
n MaxLength
m) in Int -> Text -> Text
Text.take Int
c Text
t forall a. Eq a => a -> a -> Bool
== Int -> Text -> Text
Text.take Int
c Text
u ->
            Match -> [Match] -> Maybe Match
combine (if MaxLength
m forall a. Ord a => a -> a -> Bool
> MaxLength
n then Match
y else Match
x) [Match]
zs
      Match
_ -> forall a. Maybe a
Nothing
    Match
Match.Undefined -> case Match
y of
      Match
Match.Undefined -> Match -> [Match] -> Maybe Match
combine Match
x [Match]
zs
      Match
_ -> forall a. Maybe a
Nothing

template :: Template.Template -> ReadP.ReadP [(Name.Name, Match.Match)]
template :: Template -> ReadP [(Name, Match)]
template Template
x = do
  [(Name, Match)]
xs <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Token -> ReadP [(Name, Match)]
token forall a b. (a -> b) -> a -> b
$ Template -> [Token]
Template.tokens Template
x
  ReadP ()
ReadP.eof
  forall (f :: * -> *) a. Applicative f => a -> f a
pure [(Name, Match)]
xs

token :: Token.Token -> ReadP.ReadP [(Name.Name, Match.Match)]
token :: Token -> ReadP [(Name, Match)]
token Token
x = case Token
x of
  Token.Expression Expression
y -> Expression -> ReadP [(Name, Match)]
expression Expression
y
  Token.Literal Literal
y -> [] forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Literal -> ReadP ()
literal Literal
y

expression :: Expression.Expression -> ReadP.ReadP [(Name.Name, Match.Match)]
expression :: Expression -> ReadP [(Name, Match)]
expression Expression
x = Operator -> NonEmpty Variable -> ReadP [(Name, Match)]
variables (Expression -> Operator
Expression.operator Expression
x) (Expression -> NonEmpty Variable
Expression.variables Expression
x)

variables ::
  Operator.Operator ->
  NonEmpty.NonEmpty Variable.Variable ->
  ReadP.ReadP [(Name.Name, Match.Match)]
variables :: Operator -> NonEmpty Variable -> ReadP [(Name, Match)]
variables Operator
op NonEmpty Variable
vs = case Operator
op of
  Operator
Operator.Ampersand -> NonEmpty Variable
-> Maybe Char
-> Char
-> (Variable -> ReadP [(Name, Match)])
-> ReadP [(Name, Match)]
vars NonEmpty Variable
vs (forall a. a -> Maybe a
Just Char
'&') Char
'&' Variable -> ReadP [(Name, Match)]
varEq
  Operator
Operator.FullStop -> NonEmpty Variable
-> Maybe Char
-> Char
-> (Variable -> ReadP [(Name, Match)])
-> ReadP [(Name, Match)]
vars NonEmpty Variable
vs (forall a. a -> Maybe a
Just Char
'.') Char
'.' forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Variable -> ReadP [(Name, Match)]
variable Char -> Bool
Expand.isUnreserved
  Operator
Operator.None -> NonEmpty Variable
-> Maybe Char
-> Char
-> (Variable -> ReadP [(Name, Match)])
-> ReadP [(Name, Match)]
vars NonEmpty Variable
vs forall a. Maybe a
Nothing Char
',' forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Variable -> ReadP [(Name, Match)]
variable Char -> Bool
Expand.isUnreserved
  Operator
Operator.NumberSign -> NonEmpty Variable
-> Maybe Char
-> Char
-> (Variable -> ReadP [(Name, Match)])
-> ReadP [(Name, Match)]
vars NonEmpty Variable
vs (forall a. a -> Maybe a
Just Char
'#') Char
',' forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Variable -> ReadP [(Name, Match)]
variable Char -> Bool
Expand.isAllowed
  Operator
Operator.PlusSign -> NonEmpty Variable
-> Maybe Char
-> Char
-> (Variable -> ReadP [(Name, Match)])
-> ReadP [(Name, Match)]
vars NonEmpty Variable
vs forall a. Maybe a
Nothing Char
',' forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Variable -> ReadP [(Name, Match)]
variable Char -> Bool
Expand.isAllowed
  Operator
Operator.QuestionMark -> NonEmpty Variable
-> Maybe Char
-> Char
-> (Variable -> ReadP [(Name, Match)])
-> ReadP [(Name, Match)]
vars NonEmpty Variable
vs (forall a. a -> Maybe a
Just Char
'?') Char
'&' Variable -> ReadP [(Name, Match)]
varEq
  Operator
Operator.Semicolon -> NonEmpty Variable
-> Maybe Char
-> Char
-> (Variable -> ReadP [(Name, Match)])
-> ReadP [(Name, Match)]
vars NonEmpty Variable
vs (forall a. a -> Maybe a
Just Char
';') Char
';' forall a b. (a -> b) -> a -> b
$ \Variable
v -> do
    let n :: Name
n = Variable -> Name
Variable.name Variable
v
    Name -> ReadP ()
name Name
n
    forall a. a -> ReadP a -> ReadP a
ReadP.option [(Name
n, Text -> Match
Match.Defined Text
Text.empty)] forall a b. (a -> b) -> a -> b
$ do
      Char -> ReadP ()
char_ Char
'='
      (Char -> Bool) -> Variable -> ReadP [(Name, Match)]
variable Char -> Bool
Expand.isUnreserved Variable
v
  Operator
Operator.Solidus -> NonEmpty Variable
-> Maybe Char
-> Char
-> (Variable -> ReadP [(Name, Match)])
-> ReadP [(Name, Match)]
vars NonEmpty Variable
vs (forall a. a -> Maybe a
Just Char
'/') Char
'/' forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Variable -> ReadP [(Name, Match)]
variable Char -> Bool
Expand.isUnreserved

vars ::
  NonEmpty.NonEmpty Variable.Variable ->
  Maybe Char ->
  Char ->
  (Variable.Variable -> ReadP.ReadP [(Name.Name, Match.Match)]) ->
  ReadP.ReadP [(Name.Name, Match.Match)]
vars :: NonEmpty Variable
-> Maybe Char
-> Char
-> (Variable -> ReadP [(Name, Match)])
-> ReadP [(Name, Match)]
vars NonEmpty Variable
vs Maybe Char
m Char
c Variable -> ReadP [(Name, Match)]
f = do
  let ctx :: ReadP [(Name, Match)] -> ReadP [(Name, Match)]
ctx = case Maybe Char
m of
        Maybe Char
Nothing -> forall a. a -> a
id
        Just Char
o -> \ReadP [(Name, Match)]
p -> forall a. a -> ReadP a -> ReadP a
ReadP.option (Variable -> (Name, Match)
undef forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. NonEmpty a -> [a]
NonEmpty.toList NonEmpty Variable
vs) forall a b. (a -> b) -> a -> b
$ do
          Char -> ReadP ()
char_ Char
o
          [(Name, Match)]
xs <- ReadP [(Name, Match)]
p
          forall (f :: * -> *). Alternative f => Bool -> f ()
Monad.guard forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Name, Match) -> Bool
isUndefined [(Name, Match)]
xs
          forall (f :: * -> *) a. Applicative f => a -> f a
pure [(Name, Match)]
xs
  ReadP [(Name, Match)] -> ReadP [(Name, Match)]
ctx forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char
-> (Variable -> ReadP [(Name, Match)])
-> [Variable]
-> ReadP [(Name, Match)]
vars' Char
c Variable -> ReadP [(Name, Match)]
f forall a b. (a -> b) -> a -> b
$ forall a. NonEmpty a -> [a]
NonEmpty.toList NonEmpty Variable
vs

isUndefined :: (Name.Name, Match.Match) -> Bool
isUndefined :: (Name, Match) -> Bool
isUndefined = (forall a. Eq a => a -> a -> Bool
== Match
Match.Undefined) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd

vars' ::
  Char ->
  (Variable.Variable -> ReadP.ReadP [(Name.Name, Match.Match)]) ->
  [Variable.Variable] ->
  ReadP.ReadP [(Name.Name, Match.Match)]
vars' :: Char
-> (Variable -> ReadP [(Name, Match)])
-> [Variable]
-> ReadP [(Name, Match)]
vars' Char
c Variable -> ReadP [(Name, Match)]
f [Variable]
vs = case [Variable]
vs of
  [] -> forall (f :: * -> *) a. Applicative f => a -> f a
pure []
  Variable
v : [Variable]
ws ->
    let this :: ReadP [(Name, Match)]
this = do
          [(Name, Match)]
x <- Variable -> ReadP [(Name, Match)]
f Variable
v
          [(Name, Match)]
xs <- forall a. a -> ReadP a -> ReadP a
ReadP.option (Variable -> (Name, Match)
undef forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Variable]
ws) forall a b. (a -> b) -> a -> b
$ do
            Char -> ReadP ()
char_ Char
c
            Char
-> (Variable -> ReadP [(Name, Match)])
-> [Variable]
-> ReadP [(Name, Match)]
vars' Char
c Variable -> ReadP [(Name, Match)]
f [Variable]
ws
          forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ [(Name, Match)]
x forall a. Semigroup a => a -> a -> a
<> [(Name, Match)]
xs
        that :: ReadP [(Name, Match)]
that = (Variable -> (Name, Match)
undef Variable
v forall a. a -> [a] -> [a]
:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Char
-> (Variable -> ReadP [(Name, Match)])
-> [Variable]
-> ReadP [(Name, Match)]
vars' Char
c Variable -> ReadP [(Name, Match)]
f [Variable]
ws
     in ReadP [(Name, Match)]
this forall a. ReadP a -> ReadP a -> ReadP a
ReadP.+++ ReadP [(Name, Match)]
that

undef :: Variable.Variable -> (Name.Name, Match.Match)
undef :: Variable -> (Name, Match)
undef Variable
v = (Variable -> Name
Variable.name Variable
v, Match
Match.Undefined)

char_ :: Char -> ReadP.ReadP ()
char_ :: Char -> ReadP ()
char_ = forall (f :: * -> *) a. Functor f => f a -> f ()
Monad.void forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ReadP Char
ReadP.char

varEq :: Variable.Variable -> ReadP.ReadP [(Name.Name, Match.Match)]
varEq :: Variable -> ReadP [(Name, Match)]
varEq Variable
v = do
  Name -> ReadP ()
name forall a b. (a -> b) -> a -> b
$ Variable -> Name
Variable.name Variable
v
  Char -> ReadP ()
char_ Char
'='
  (Char -> Bool) -> Variable -> ReadP [(Name, Match)]
variable Char -> Bool
Expand.isUnreserved Variable
v

name :: Name.Name -> ReadP.ReadP ()
name :: Name -> ReadP ()
name = forall (f :: * -> *) a. Functor f => f a -> f ()
Monad.void forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ReadP String
ReadP.string forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> String
Render.builderToString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Builder
Render.name

variable ::
  (Char -> Bool) ->
  Variable.Variable ->
  ReadP.ReadP [(Name.Name, Match.Match)]
variable :: (Char -> Bool) -> Variable -> ReadP [(Name, Match)]
variable Char -> Bool
f Variable
x = do
  Match
v <- case Variable -> Modifier
Variable.modifier Variable
x of
    Modifier
Modifier.Asterisk -> forall a. ReadP a
ReadP.pfail
    Modifier
Modifier.None -> Text -> Match
Match.Defined forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> ReadP Text
manyCharacters Char -> Bool
f
    Modifier.Colon MaxLength
n -> MaxLength -> Text -> Match
Match.Prefix MaxLength
n forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> ReadP Text
manyCharacters Char -> Bool
f
  forall (f :: * -> *) a. Applicative f => a -> f a
pure [(Variable -> Name
Variable.name Variable
x, Match
v)]

manyCharacters :: (Char -> Bool) -> ReadP.ReadP Text.Text
manyCharacters :: (Char -> Bool) -> ReadP Text
manyCharacters Char -> Bool
f = do
  let f1 :: ReadP [Text]
f1 = (:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadP Text
someEncodedCharacters forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. a -> ReadP a -> ReadP a
ReadP.option [] ReadP [Text]
f2
      f2 :: ReadP [Text]
f2 = (:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> ReadP Text
someUnencodedCharacters Char -> Bool
f forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. a -> ReadP a -> ReadP a
ReadP.option [] ReadP [Text]
f1
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> ReadP a -> ReadP a
ReadP.option [] forall a b. (a -> b) -> a -> b
$ ReadP [Text]
f1 forall a. ReadP a -> ReadP a -> ReadP a
ReadP.<++ ReadP [Text]
f2

someEncodedCharacters :: ReadP.ReadP Text.Text
someEncodedCharacters :: ReadP Text
someEncodedCharacters = do
  NonEmpty (Digit, Digit)
xs <- forall a. ReadP a -> ReadP (NonEmpty a)
some ReadP (Digit, Digit)
anEncodedCharacter
  forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) forall (f :: * -> *) a. Applicative f => a -> f a
pure
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either UnicodeException Text
Text.decodeUtf8'
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> ByteString
ByteString.pack
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Digit -> Digit -> Word8
Digit.toWord8)
    forall a b. (a -> b) -> a -> b
$ forall a. NonEmpty a -> [a]
NonEmpty.toList NonEmpty (Digit, Digit)
xs

some :: ReadP.ReadP a -> ReadP.ReadP (NonEmpty.NonEmpty a)
some :: forall a. ReadP a -> ReadP (NonEmpty a)
some ReadP a
p = forall a. a -> [a] -> NonEmpty a
(NonEmpty.:|) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadP a
p forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. ReadP a -> ReadP [a]
ReadP.many ReadP a
p

someUnencodedCharacters :: (Char -> Bool) -> ReadP.ReadP Text.Text
someUnencodedCharacters :: (Char -> Bool) -> ReadP Text
someUnencodedCharacters Char -> Bool
f = do
  NonEmpty Char
xs <- forall a. ReadP a -> ReadP (NonEmpty a)
some forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ReadP Char
ReadP.satisfy Char -> Bool
f
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack forall a b. (a -> b) -> a -> b
$ forall a. NonEmpty a -> [a]
NonEmpty.toList NonEmpty Char
xs

anEncodedCharacter :: ReadP.ReadP (Digit.Digit, Digit.Digit)
anEncodedCharacter :: ReadP (Digit, Digit)
anEncodedCharacter = do
  Char -> ReadP ()
char_ Char
'%'
  (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadP Digit
aDigit forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReadP Digit
aDigit

aDigit :: ReadP.ReadP Digit.Digit
aDigit :: ReadP Digit
aDigit = do
  Char
x <- (Char -> Bool) -> ReadP Char
ReadP.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

literal :: Literal.Literal -> ReadP.ReadP ()
literal :: Literal -> ReadP ()
literal = forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Character Literal -> ReadP ()
literalCharacter forall b c a. (b -> c) -> (a -> b) -> a -> c
. Literal -> NonEmpty (Character Literal)
Literal.characters

literalCharacter :: Character.Character Literal.Literal -> ReadP.ReadP ()
literalCharacter :: Character Literal -> ReadP ()
literalCharacter = forall tag. (Char -> Bool) -> Character tag -> ReadP ()
character Char -> Bool
Expand.isAllowed

character :: (Char -> Bool) -> Character.Character tag -> ReadP.ReadP ()
character :: forall tag. (Char -> Bool) -> Character tag -> ReadP ()
character Char -> Bool
f Character tag
x = case Character tag
x of
  Character.Encoded Digit
y Digit
z -> Digit -> Digit -> ReadP ()
encodedCharacter Digit
y Digit
z
  Character.Unencoded Char
y -> (Char -> Bool) -> Char -> ReadP ()
unencodedCharacter Char -> Bool
f Char
y

encodedCharacter :: Digit.Digit -> Digit.Digit -> ReadP.ReadP ()
encodedCharacter :: Digit -> Digit -> ReadP ()
encodedCharacter Digit
x Digit
y = Char -> ReadP ()
char_ Char
'%' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Digit -> ReadP ()
digit Digit
x forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Digit -> ReadP ()
digit Digit
y

digit :: Digit.Digit -> ReadP.ReadP ()
digit :: Digit -> ReadP ()
digit Digit
x = Char -> ReadP ()
char_ forall a b. (a -> b) -> a -> b
$ case Digit
x of
  Digit
Digit.Ox0 -> Char
'0'
  Digit
Digit.Ox1 -> Char
'1'
  Digit
Digit.Ox2 -> Char
'2'
  Digit
Digit.Ox3 -> Char
'3'
  Digit
Digit.Ox4 -> Char
'4'
  Digit
Digit.Ox5 -> Char
'5'
  Digit
Digit.Ox6 -> Char
'6'
  Digit
Digit.Ox7 -> Char
'7'
  Digit
Digit.Ox8 -> Char
'8'
  Digit
Digit.Ox9 -> Char
'9'
  Digit.OxA Case
Case.Upper -> Char
'A'
  Digit.OxB Case
Case.Upper -> Char
'B'
  Digit.OxC Case
Case.Upper -> Char
'C'
  Digit.OxD Case
Case.Upper -> Char
'D'
  Digit.OxE Case
Case.Upper -> Char
'E'
  Digit.OxF Case
Case.Upper -> Char
'F'
  Digit.OxA Case
Case.Lower -> Char
'a'
  Digit.OxB Case
Case.Lower -> Char
'b'
  Digit.OxC Case
Case.Lower -> Char
'c'
  Digit.OxD Case
Case.Lower -> Char
'd'
  Digit.OxE Case
Case.Lower -> Char
'e'
  Digit.OxF Case
Case.Lower -> Char
'f'

unencodedCharacter :: (Char -> Bool) -> Char -> ReadP.ReadP ()
unencodedCharacter :: (Char -> Bool) -> Char -> ReadP ()
unencodedCharacter Char -> Bool
f Char
x =
  if Char -> Bool
f Char
x
    then Char -> ReadP ()
char_ Char
x
    else forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Digit -> Digit -> ReadP ()
encodedCharacter) forall a b. (a -> b) -> a -> b
$ Char -> [(Digit, Digit)]
Expand.encodeCharacter Char
x