{-# 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 =
  ([(Name, Match)] -> [(String, Value)])
-> [[(Name, Match)]] -> [[(String, Value)]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(Name, Match)] -> [(String, Value)]
finalize
    ([[(Name, Match)]] -> [[(String, Value)]])
-> (Template -> [[(Name, Match)]])
-> Template
-> [[(String, Value)]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([(Name, Match)], String) -> Maybe [(Name, Match)])
-> [([(Name, Match)], String)] -> [[(Name, Match)]]
forall a b. (a -> Maybe b) -> [a] -> [b]
Maybe.mapMaybe ([(Name, Match)] -> Maybe [(Name, Match)]
keepConsistent ([(Name, Match)] -> Maybe [(Name, Match)])
-> (([(Name, Match)], String) -> [(Name, Match)])
-> ([(Name, Match)], String)
-> Maybe [(Name, Match)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(Name, Match)], String) -> [(Name, Match)]
forall a b. (a, b) -> a
fst)
    ([([(Name, Match)], String)] -> [[(Name, Match)]])
-> (Template -> [([(Name, Match)], String)])
-> Template
-> [[(Name, Match)]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ReadP [(Name, Match)] -> String -> [([(Name, Match)], String)])
-> String -> ReadP [(Name, Match)] -> [([(Name, Match)], String)]
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReadP [(Name, Match)] -> String -> [([(Name, Match)], String)]
forall a. ReadP a -> ReadS a
ReadP.readP_to_S String
s
    (ReadP [(Name, Match)] -> [([(Name, Match)], String)])
-> (Template -> ReadP [(Name, Match)])
-> Template
-> [([(Name, Match)], String)]
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 = ((Name, Match) -> Maybe (String, Value))
-> [(Name, Match)] -> [(String, Value)]
forall a b. (a -> Maybe b) -> [a] -> [b]
Maybe.mapMaybe (((Name, Match) -> Maybe (String, Value))
 -> [(Name, Match)] -> [(String, Value)])
-> ((Name, Match) -> Maybe (String, Value))
-> [(Name, Match)]
-> [(String, Value)]
forall a b. (a -> b) -> a -> b
$ \(Name
n, Match
m) -> case Match
m of
  Match.Defined Text
v ->
    (String, Value) -> Maybe (String, Value)
forall a. a -> Maybe a
Just (Builder -> String
Render.builderToString (Builder -> String) -> Builder -> String
forall a b. (a -> b) -> a -> b
$ Name -> Builder
Render.name Name
n, Text -> Value
Value.String Text
v)
  Match.Prefix MaxLength
_ Text
v ->
    (String, Value) -> Maybe (String, Value)
forall a. a -> Maybe a
Just (Builder -> String
Render.builderToString (Builder -> String) -> Builder -> String
forall a b. (a -> b) -> a -> b
$ Name -> Builder
Render.name Name
n, Text -> Value
Value.String Text
v)
  Match
Match.Undefined -> Maybe (String, Value)
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
  [] -> [(Name, Match)] -> Maybe [(Name, Match)]
forall a. a -> Maybe a
Just [(Name, Match)]
xs
  (Name
k, Match
v) : [(Name, Match)]
ys -> do
    let ([(Name, Match)]
ts, [(Name, Match)]
fs) = ((Name, Match) -> Bool)
-> [(Name, Match)] -> ([(Name, Match)], [(Name, Match)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
List.partition ((Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
k) (Name -> Bool) -> ((Name, Match) -> Name) -> (Name, Match) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name, Match) -> Name
forall a b. (a, b) -> a
fst) [(Name, Match)]
ys
    Match
w <- Match -> [Match] -> Maybe Match
combine Match
v ([Match] -> Maybe Match) -> [Match] -> Maybe Match
forall a b. (a -> b) -> a -> b
$ ((Name, Match) -> Match) -> [(Name, Match)] -> [Match]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Name, Match) -> Match
forall a b. (a, b) -> b
snd [(Name, Match)]
ts
    ((Name
k, Match
w) (Name, Match) -> [(Name, Match)] -> [(Name, Match)]
forall a. a -> [a] -> [a]
:) ([(Name, Match)] -> [(Name, Match)])
-> Maybe [(Name, Match)] -> Maybe [(Name, Match)]
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
  [] -> Match -> Maybe Match
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 Text -> Text -> Bool
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 Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
u -> Match -> [Match] -> Maybe Match
combine Match
x [Match]
zs
      Match
_ -> Maybe Match
forall a. Maybe a
Nothing
    Match.Prefix MaxLength
n Text
t -> case Match
y of
      Match.Defined Text
u | Text
t Text -> Text -> Bool
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 (MaxLength -> MaxLength -> MaxLength
forall a. Ord a => a -> a -> a
min MaxLength
n MaxLength
m) in Int -> Text -> Text
Text.take Int
c Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Text -> Text
Text.take Int
c Text
u
        -> Match -> [Match] -> Maybe Match
combine (if MaxLength
m MaxLength -> MaxLength -> Bool
forall a. Ord a => a -> a -> Bool
> MaxLength
n then Match
y else Match
x) [Match]
zs
      Match
_ -> Maybe 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
_ -> Maybe 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 <- ([[(Name, Match)]] -> [(Name, Match)])
-> ReadP [[(Name, Match)]] -> ReadP [(Name, Match)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[(Name, Match)]] -> [(Name, Match)]
forall a. Monoid a => [a] -> a
mconcat (ReadP [[(Name, Match)]] -> ReadP [(Name, Match)])
-> ([Token] -> ReadP [[(Name, Match)]])
-> [Token]
-> ReadP [(Name, Match)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Token -> ReadP [(Name, Match)])
-> [Token] -> ReadP [[(Name, Match)]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Token -> ReadP [(Name, Match)]
token ([Token] -> ReadP [(Name, Match)])
-> [Token] -> ReadP [(Name, Match)]
forall a b. (a -> b) -> a -> b
$ Template -> [Token]
Template.tokens Template
x
  ReadP ()
ReadP.eof
  [(Name, Match)] -> ReadP [(Name, Match)]
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 -> [] [(Name, Match)] -> ReadP () -> ReadP [(Name, Match)]
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 (Char -> Maybe Char
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 (Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'.') Char
'.' ((Variable -> ReadP [(Name, Match)]) -> ReadP [(Name, Match)])
-> (Variable -> ReadP [(Name, Match)]) -> ReadP [(Name, Match)]
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 Maybe Char
forall a. Maybe a
Nothing Char
',' ((Variable -> ReadP [(Name, Match)]) -> ReadP [(Name, Match)])
-> (Variable -> ReadP [(Name, Match)]) -> ReadP [(Name, Match)]
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 (Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'#') Char
',' ((Variable -> ReadP [(Name, Match)]) -> ReadP [(Name, Match)])
-> (Variable -> ReadP [(Name, Match)]) -> ReadP [(Name, Match)]
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 Maybe Char
forall a. Maybe a
Nothing Char
',' ((Variable -> ReadP [(Name, Match)]) -> ReadP [(Name, Match)])
-> (Variable -> ReadP [(Name, Match)]) -> ReadP [(Name, Match)]
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 (Char -> Maybe Char
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 (Char -> Maybe Char
forall a. a -> Maybe a
Just Char
';') Char
';' ((Variable -> ReadP [(Name, Match)]) -> ReadP [(Name, Match)])
-> (Variable -> ReadP [(Name, Match)]) -> ReadP [(Name, Match)]
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
    [(Name, Match)] -> ReadP [(Name, Match)] -> ReadP [(Name, Match)]
forall a. a -> ReadP a -> ReadP a
ReadP.option [(Name
n, Text -> Match
Match.Defined Text
Text.empty)] (ReadP [(Name, Match)] -> ReadP [(Name, Match)])
-> ReadP [(Name, Match)] -> ReadP [(Name, Match)]
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 (Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'/') Char
'/' ((Variable -> ReadP [(Name, Match)]) -> ReadP [(Name, Match)])
-> (Variable -> ReadP [(Name, Match)]) -> ReadP [(Name, Match)]
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 -> ReadP [(Name, Match)] -> ReadP [(Name, Match)]
forall a. a -> a
id
      Just Char
o -> \ReadP [(Name, Match)]
p -> [(Name, Match)] -> ReadP [(Name, Match)] -> ReadP [(Name, Match)]
forall a. a -> ReadP a -> ReadP a
ReadP.option (Variable -> (Name, Match)
undef (Variable -> (Name, Match)) -> [Variable] -> [(Name, Match)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty Variable -> [Variable]
forall a. NonEmpty a -> [a]
NonEmpty.toList NonEmpty Variable
vs) (ReadP [(Name, Match)] -> ReadP [(Name, Match)])
-> ReadP [(Name, Match)] -> ReadP [(Name, Match)]
forall a b. (a -> b) -> a -> b
$ do
        Char -> ReadP ()
char_ Char
o
        [(Name, Match)]
xs <- ReadP [(Name, Match)]
p
        Bool -> ReadP ()
forall (f :: * -> *). Alternative f => Bool -> f ()
Monad.guard (Bool -> ReadP ()) -> (Bool -> Bool) -> Bool -> ReadP ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Bool
not (Bool -> ReadP ()) -> Bool -> ReadP ()
forall a b. (a -> b) -> a -> b
$ ((Name, Match) -> Bool) -> [(Name, Match)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Name, Match) -> Bool
isUndefined [(Name, Match)]
xs
        [(Name, Match)] -> ReadP [(Name, Match)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [(Name, Match)]
xs
  ReadP [(Name, Match)] -> ReadP [(Name, Match)]
ctx (ReadP [(Name, Match)] -> ReadP [(Name, Match)])
-> ([Variable] -> ReadP [(Name, Match)])
-> [Variable]
-> ReadP [(Name, Match)]
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 ([Variable] -> ReadP [(Name, Match)])
-> [Variable] -> ReadP [(Name, Match)]
forall a b. (a -> b) -> a -> b
$ NonEmpty Variable -> [Variable]
forall a. NonEmpty a -> [a]
NonEmpty.toList NonEmpty Variable
vs

isUndefined :: (Name.Name, Match.Match) -> Bool
isUndefined :: (Name, Match) -> Bool
isUndefined = (Match -> Match -> Bool
forall a. Eq a => a -> a -> Bool
== Match
Match.Undefined) (Match -> Bool)
-> ((Name, Match) -> Match) -> (Name, Match) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name, Match) -> Match
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
  [] -> [(Name, Match)] -> ReadP [(Name, Match)]
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 <- [(Name, Match)] -> ReadP [(Name, Match)] -> ReadP [(Name, Match)]
forall a. a -> ReadP a -> ReadP a
ReadP.option (Variable -> (Name, Match)
undef (Variable -> (Name, Match)) -> [Variable] -> [(Name, Match)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Variable]
ws) (ReadP [(Name, Match)] -> ReadP [(Name, Match)])
-> ReadP [(Name, Match)] -> ReadP [(Name, Match)]
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
        [(Name, Match)] -> ReadP [(Name, Match)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(Name, Match)] -> ReadP [(Name, Match)])
-> [(Name, Match)] -> ReadP [(Name, Match)]
forall a b. (a -> b) -> a -> b
$ [(Name, Match)]
x [(Name, Match)] -> [(Name, Match)] -> [(Name, Match)]
forall a. Semigroup a => a -> a -> a
<> [(Name, Match)]
xs
      that :: ReadP [(Name, Match)]
that = (Variable -> (Name, Match)
undef Variable
v (Name, Match) -> [(Name, Match)] -> [(Name, Match)]
forall a. a -> [a] -> [a]
:) ([(Name, Match)] -> [(Name, Match)])
-> ReadP [(Name, Match)] -> ReadP [(Name, Match)]
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 ReadP [(Name, Match)]
-> ReadP [(Name, Match)] -> ReadP [(Name, Match)]
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_ = ReadP Char -> ReadP ()
forall (f :: * -> *) a. Functor f => f a -> f ()
Monad.void (ReadP Char -> ReadP ())
-> (Char -> ReadP Char) -> Char -> ReadP ()
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 (Name -> ReadP ()) -> Name -> ReadP ()
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 = ReadP String -> ReadP ()
forall (f :: * -> *) a. Functor f => f a -> f ()
Monad.void (ReadP String -> ReadP ())
-> (Name -> ReadP String) -> Name -> ReadP ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ReadP String
ReadP.string (String -> ReadP String)
-> (Name -> String) -> Name -> ReadP String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> String
Render.builderToString (Builder -> String) -> (Name -> Builder) -> Name -> String
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 -> ReadP Match
forall a. ReadP a
ReadP.pfail
    Modifier
Modifier.None -> Text -> Match
Match.Defined (Text -> Match) -> ReadP Text -> ReadP Match
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 (Text -> Match) -> ReadP Text -> ReadP Match
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> ReadP Text
manyCharacters Char -> Bool
f
  [(Name, Match)] -> ReadP [(Name, Match)]
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 = (:) (Text -> [Text] -> [Text])
-> ReadP Text -> ReadP ([Text] -> [Text])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadP Text
someEncodedCharacters ReadP ([Text] -> [Text]) -> ReadP [Text] -> ReadP [Text]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Text] -> ReadP [Text] -> ReadP [Text]
forall a. a -> ReadP a -> ReadP a
ReadP.option [] ReadP [Text]
f2
    f2 :: ReadP [Text]
f2 = (:) (Text -> [Text] -> [Text])
-> ReadP Text -> ReadP ([Text] -> [Text])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> ReadP Text
someUnencodedCharacters Char -> Bool
f ReadP ([Text] -> [Text]) -> ReadP [Text] -> ReadP [Text]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Text] -> ReadP [Text] -> ReadP [Text]
forall a. a -> ReadP a -> ReadP a
ReadP.option [] ReadP [Text]
f1
  ([Text] -> Text) -> ReadP [Text] -> ReadP Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat (ReadP [Text] -> ReadP Text)
-> (ReadP [Text] -> ReadP [Text]) -> ReadP [Text] -> ReadP Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> ReadP [Text] -> ReadP [Text]
forall a. a -> ReadP a -> ReadP a
ReadP.option [] (ReadP [Text] -> ReadP Text) -> ReadP [Text] -> ReadP Text
forall a b. (a -> b) -> a -> b
$ ReadP [Text]
f1 ReadP [Text] -> ReadP [Text] -> ReadP [Text]
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 <- ReadP (Digit, Digit) -> ReadP (NonEmpty (Digit, Digit))
forall a. ReadP a -> ReadP (NonEmpty a)
some ReadP (Digit, Digit)
anEncodedCharacter
  (UnicodeException -> ReadP Text)
-> (Text -> ReadP Text)
-> Either UnicodeException Text
-> ReadP Text
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> ReadP Text
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> ReadP Text)
-> (UnicodeException -> String) -> UnicodeException -> ReadP Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnicodeException -> String
forall a. Show a => a -> String
show) Text -> ReadP Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    (Either UnicodeException Text -> ReadP Text)
-> ([(Digit, Digit)] -> Either UnicodeException Text)
-> [(Digit, Digit)]
-> ReadP Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either UnicodeException Text
Text.decodeUtf8'
    (ByteString -> Either UnicodeException Text)
-> ([(Digit, Digit)] -> ByteString)
-> [(Digit, Digit)]
-> Either UnicodeException Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> ByteString
ByteString.pack
    ([Word8] -> ByteString)
-> ([(Digit, Digit)] -> [Word8]) -> [(Digit, Digit)] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Digit, Digit) -> Word8) -> [(Digit, Digit)] -> [Word8]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Digit -> Digit -> Word8) -> (Digit, Digit) -> Word8
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Digit -> Digit -> Word8
Digit.toWord8)
    ([(Digit, Digit)] -> ReadP Text) -> [(Digit, Digit)] -> ReadP Text
forall a b. (a -> b) -> a -> b
$ NonEmpty (Digit, Digit) -> [(Digit, Digit)]
forall a. NonEmpty a -> [a]
NonEmpty.toList NonEmpty (Digit, Digit)
xs

some :: ReadP.ReadP a -> ReadP.ReadP (NonEmpty.NonEmpty a)
some :: ReadP a -> ReadP (NonEmpty a)
some ReadP a
p = a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
(NonEmpty.:|) (a -> [a] -> NonEmpty a) -> ReadP a -> ReadP ([a] -> NonEmpty a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadP a
p ReadP ([a] -> NonEmpty a) -> ReadP [a] -> ReadP (NonEmpty a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReadP a -> ReadP [a]
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 <- ReadP Char -> ReadP (NonEmpty Char)
forall a. ReadP a -> ReadP (NonEmpty a)
some (ReadP Char -> ReadP (NonEmpty Char))
-> ReadP Char -> ReadP (NonEmpty Char)
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ReadP Char
ReadP.satisfy Char -> Bool
f
  Text -> ReadP Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> ReadP Text) -> (String -> Text) -> String -> ReadP Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack (String -> ReadP Text) -> String -> ReadP Text
forall a b. (a -> b) -> a -> b
$ NonEmpty Char -> String
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
'%'
  (,) (Digit -> Digit -> (Digit, Digit))
-> ReadP Digit -> ReadP (Digit -> (Digit, Digit))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadP Digit
aDigit ReadP (Digit -> (Digit, Digit))
-> ReadP Digit -> ReadP (Digit, Digit)
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
  ReadP Digit -> (Digit -> ReadP Digit) -> Maybe Digit -> ReadP Digit
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> ReadP Digit
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"invalid Digit") Digit -> ReadP Digit
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Digit -> ReadP Digit) -> Maybe Digit -> ReadP Digit
forall a b. (a -> b) -> a -> b
$ Char -> Maybe Digit
Digit.fromChar Char
x

literal :: Literal.Literal -> ReadP.ReadP ()
literal :: Literal -> ReadP ()
literal = (Character Literal -> ReadP ())
-> NonEmpty (Character Literal) -> ReadP ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Character Literal -> ReadP ()
literalCharacter (NonEmpty (Character Literal) -> ReadP ())
-> (Literal -> NonEmpty (Character Literal)) -> Literal -> ReadP ()
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 = (Char -> Bool) -> Character Literal -> ReadP ()
forall tag. (Char -> Bool) -> Character tag -> ReadP ()
character Char -> Bool
Expand.isAllowed

character :: (Char -> Bool) -> Character.Character tag -> ReadP.ReadP ()
character :: (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
'%' ReadP () -> ReadP () -> ReadP ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Digit -> ReadP ()
digit Digit
x ReadP () -> ReadP () -> ReadP ()
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_ (Char -> ReadP ()) -> Char -> ReadP ()
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 ((Digit, Digit) -> ReadP ()) -> [(Digit, Digit)] -> ReadP ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((Digit -> Digit -> ReadP ()) -> (Digit, Digit) -> ReadP ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Digit -> Digit -> ReadP ()
encodedCharacter) ([(Digit, Digit)] -> ReadP ()) -> [(Digit, Digit)] -> ReadP ()
forall a b. (a -> b) -> a -> b
$ Char -> [(Digit, Digit)]
Expand.encodeCharacter Char
x