{-# 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
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