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

module Burrito.Internal.Expand where

import qualified Burrito.Internal.Render as Render
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.Value as Value
import qualified Burrito.Internal.Type.Variable as Variable
import qualified Control.Monad.Trans.Class as Trans
import qualified Control.Monad.Trans.State as State
import qualified Data.ByteString as ByteString
import qualified Data.Char as Char
import qualified Data.Functor.Identity as Identity
import qualified Data.List as List
import qualified Data.List.NonEmpty as NonEmpty
import qualified Data.Map as Map
import qualified Data.Maybe as Maybe
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text
import qualified Data.Text.Lazy as LazyText
import qualified Data.Text.Lazy.Builder as Builder

-- | Expands a template using the given values. Unlike parsing, expansion
-- always succeeds. If no value is given for a variable, it will simply not
-- appear in the output.
--
-- >>> expand [] <$> parse "valid-template"
-- Just "valid-template"
-- >>> expand [] <$> parse "template:{example}"
-- Just "template:"
-- >>> expand [("example", stringValue "true")] <$> parse "template:{example}"
-- Just "template:true"
expand :: [(String, Value.Value)] -> Template.Template -> String
expand :: [(String, Value)] -> Template -> String
expand [(String, Value)]
values =
  let m :: Map Text Value
m = (String -> Text) -> Map String Value -> Map Text Value
forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeys String -> Text
Text.pack (Map String Value -> Map Text Value)
-> Map String Value -> Map Text Value
forall a b. (a -> b) -> a -> b
$ [(String, Value)] -> Map String Value
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(String, Value)]
values
  in
    Builder -> String
Render.builderToString (Builder -> String) -> (Template -> Builder) -> Template -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity Builder -> Builder
forall a. Identity a -> a
Identity.runIdentity (Identity Builder -> Builder)
-> (Template -> Identity Builder) -> Template -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Identity (Maybe Value)) -> Template -> Identity Builder
forall (m :: * -> *).
Monad m =>
(Text -> m (Maybe Value)) -> Template -> m Builder
expandWith
      (Maybe Value -> Identity (Maybe Value)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Value -> Identity (Maybe Value))
-> (Text -> Maybe Value) -> Text -> Identity (Maybe Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Map Text Value -> Maybe Value)
-> Map Text Value -> Text -> Maybe Value
forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> Map Text Value -> Maybe Value
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Map Text Value
m)

-- | This is like @expand@ except that it gives you more control over how
-- variables are expanded. If you can, use @expand@. It's simpler.
--
-- Instead of passing in a static mapping form names to
-- values, you pass in a function that is used to look up values on the fly.
-- This can be useful if computing values takes a while or requires some impure
-- actions.
--
-- >>> expandWith (\ x -> [Nothing, Just . stringValue $ unpack x]) <$> parse "template:{example}"
-- Just ["template:","template:example"]
-- >>> let Just template = parse "user={USER}"
-- >>> expandWith (fmap (fmap stringValue) . lookupEnv . unpack) template
-- "user=taylor"
--
-- Note that as the RFC specifies, the given function will be called at most
-- once for each variable in the template.
--
-- >>> let Just template = parse "{a}{a}"
-- >>> expandWith (\ x -> do { putStrLn $ "-- expanding " <> show x; pure . Just $ Burrito.stringValue "A" }) template
-- -- expanding "a"
-- "AA"
expandWith
  :: Monad m
  => (Text.Text -> m (Maybe Value.Value))
  -> Template.Template
  -> m Builder.Builder
expandWith :: (Text -> m (Maybe Value)) -> Template -> m Builder
expandWith Text -> m (Maybe Value)
f = (StateT (Map Text (Maybe Value)) m Builder
 -> Map Text (Maybe Value) -> m Builder)
-> Map Text (Maybe Value)
-> StateT (Map Text (Maybe Value)) m Builder
-> m Builder
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT (Map Text (Maybe Value)) m Builder
-> Map Text (Maybe Value) -> m Builder
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
State.evalStateT Map Text (Maybe Value)
forall k a. Map k a
Map.empty (StateT (Map Text (Maybe Value)) m Builder -> m Builder)
-> (Template -> StateT (Map Text (Maybe Value)) m Builder)
-> Template
-> m Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name -> CacheT m (Maybe Value))
-> Template -> StateT (Map Text (Maybe Value)) m Builder
forall (m :: * -> *).
Monad m =>
(Name -> CacheT m (Maybe Value)) -> Template -> CacheT m Builder
template ((Text -> m (Maybe Value)) -> Name -> CacheT m (Maybe Value)
forall (m :: * -> *).
Monad m =>
(Text -> m (Maybe Value)) -> Name -> CacheT m (Maybe Value)
cached Text -> m (Maybe Value)
f)

type CacheT = State.StateT (Map.Map Text.Text (Maybe Value.Value))

cached
  :: Monad m
  => (Text.Text -> m (Maybe Value.Value))
  -> Name.Name
  -> CacheT m (Maybe Value.Value)
cached :: (Text -> m (Maybe Value)) -> Name -> CacheT m (Maybe Value)
cached Text -> m (Maybe Value)
f Name
x = do
  let key :: Text
key = Text -> Text
LazyText.toStrict (Text -> Text) -> (Builder -> Text) -> Builder -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
Builder.toLazyText (Builder -> Text) -> Builder -> Text
forall a b. (a -> b) -> a -> b
$ Name -> Builder
name Name
x
  Map Text (Maybe Value)
cache <- StateT (Map Text (Maybe Value)) m (Map Text (Maybe Value))
forall (m :: * -> *) s. Monad m => StateT s m s
State.get
  case Text -> Map Text (Maybe Value) -> Maybe (Maybe Value)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
key Map Text (Maybe Value)
cache of
    Just Maybe Value
result -> Maybe Value -> CacheT m (Maybe Value)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Value
result
    Maybe (Maybe Value)
Nothing -> do
      Maybe Value
result <- m (Maybe Value) -> CacheT m (Maybe Value)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Trans.lift (m (Maybe Value) -> CacheT m (Maybe Value))
-> m (Maybe Value) -> CacheT m (Maybe Value)
forall a b. (a -> b) -> a -> b
$ Text -> m (Maybe Value)
f Text
key
      (Map Text (Maybe Value) -> Map Text (Maybe Value))
-> StateT (Map Text (Maybe Value)) m ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
State.modify ((Map Text (Maybe Value) -> Map Text (Maybe Value))
 -> StateT (Map Text (Maybe Value)) m ())
-> (Map Text (Maybe Value) -> Map Text (Maybe Value))
-> StateT (Map Text (Maybe Value)) m ()
forall a b. (a -> b) -> a -> b
$ Text
-> Maybe Value -> Map Text (Maybe Value) -> Map Text (Maybe Value)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Text
key Maybe Value
result
      Maybe Value -> CacheT m (Maybe Value)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Value
result

template
  :: Monad m
  => (Name.Name -> CacheT m (Maybe Value.Value))
  -> Template.Template
  -> CacheT m Builder.Builder
template :: (Name -> CacheT m (Maybe Value)) -> Template -> CacheT m Builder
template Name -> CacheT m (Maybe Value)
f = ([Builder] -> Builder)
-> StateT (Map Text (Maybe Value)) m [Builder] -> CacheT m Builder
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat (StateT (Map Text (Maybe Value)) m [Builder] -> CacheT m Builder)
-> (Template -> StateT (Map Text (Maybe Value)) m [Builder])
-> Template
-> CacheT m Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Token -> CacheT m Builder)
-> [Token] -> StateT (Map Text (Maybe Value)) m [Builder]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((Name -> CacheT m (Maybe Value)) -> Token -> CacheT m Builder
forall (m :: * -> *).
Monad m =>
(Name -> CacheT m (Maybe Value)) -> Token -> CacheT m Builder
token Name -> CacheT m (Maybe Value)
f) ([Token] -> StateT (Map Text (Maybe Value)) m [Builder])
-> (Template -> [Token])
-> Template
-> StateT (Map Text (Maybe Value)) m [Builder]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Template -> [Token]
Template.tokens

token
  :: Monad m
  => (Name.Name -> CacheT m (Maybe Value.Value))
  -> Token.Token
  -> CacheT m Builder.Builder
token :: (Name -> CacheT m (Maybe Value)) -> Token -> CacheT m Builder
token Name -> CacheT m (Maybe Value)
f Token
x = case Token
x of
  Token.Expression Expression
y -> (Name -> CacheT m (Maybe Value)) -> Expression -> CacheT m Builder
forall (m :: * -> *).
Monad m =>
(Name -> CacheT m (Maybe Value)) -> Expression -> CacheT m Builder
expression Name -> CacheT m (Maybe Value)
f Expression
y
  Token.Literal Literal
y -> Builder -> CacheT m Builder
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Builder -> CacheT m Builder) -> Builder -> CacheT m Builder
forall a b. (a -> b) -> a -> b
$ Literal -> Builder
literal Literal
y

expression
  :: Monad m
  => (Name.Name -> CacheT m (Maybe Value.Value))
  -> Expression.Expression
  -> CacheT m Builder.Builder
expression :: (Name -> CacheT m (Maybe Value)) -> Expression -> CacheT m Builder
expression Name -> CacheT m (Maybe Value)
f Expression
ex =
  let op :: Operator
op = Expression -> Operator
Expression.operator Expression
ex
  in
    ([Maybe Builder] -> Builder)
-> StateT (Map Text (Maybe Value)) m [Maybe Builder]
-> CacheT m Builder
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
      ([Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat
      ([Builder] -> Builder)
-> ([Maybe Builder] -> [Builder]) -> [Maybe Builder] -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\[Builder]
xs -> if [Builder] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Builder]
xs then [Builder]
xs else Operator -> Builder
prefix Operator
op Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
: [Builder]
xs)
      ([Builder] -> [Builder])
-> ([Maybe Builder] -> [Builder]) -> [Maybe Builder] -> [Builder]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
List.intersperse (Operator -> Builder
separator Operator
op)
      ([Builder] -> [Builder])
-> ([Maybe Builder] -> [Builder]) -> [Maybe Builder] -> [Builder]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe Builder] -> [Builder]
forall a. [Maybe a] -> [a]
Maybe.catMaybes
      )
    (StateT (Map Text (Maybe Value)) m [Maybe Builder]
 -> CacheT m Builder)
-> (NonEmpty Variable
    -> StateT (Map Text (Maybe Value)) m [Maybe Builder])
-> NonEmpty Variable
-> CacheT m Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Variable -> StateT (Map Text (Maybe Value)) m (Maybe Builder))
-> [Variable] -> StateT (Map Text (Maybe Value)) m [Maybe Builder]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((Name -> CacheT m (Maybe Value))
-> Operator
-> Variable
-> StateT (Map Text (Maybe Value)) m (Maybe Builder)
forall (m :: * -> *).
Monad m =>
(Name -> CacheT m (Maybe Value))
-> Operator -> Variable -> CacheT m (Maybe Builder)
variable Name -> CacheT m (Maybe Value)
f Operator
op)
    ([Variable] -> StateT (Map Text (Maybe Value)) m [Maybe Builder])
-> (NonEmpty Variable -> [Variable])
-> NonEmpty Variable
-> StateT (Map Text (Maybe Value)) m [Maybe Builder]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty Variable -> [Variable]
forall a. NonEmpty a -> [a]
NonEmpty.toList
    (NonEmpty Variable -> CacheT m Builder)
-> NonEmpty Variable -> CacheT m Builder
forall a b. (a -> b) -> a -> b
$ Expression -> NonEmpty Variable
Expression.variables Expression
ex

separator :: Operator.Operator -> Builder.Builder
separator :: Operator -> Builder
separator Operator
op = Char -> Builder
Builder.singleton (Char -> Builder) -> Char -> Builder
forall a b. (a -> b) -> a -> b
$ case Operator
op of
  Operator
Operator.Ampersand -> Char
'&'
  Operator
Operator.FullStop -> Char
'.'
  Operator
Operator.None -> Char
','
  Operator
Operator.NumberSign -> Char
','
  Operator
Operator.PlusSign -> Char
','
  Operator
Operator.QuestionMark -> Char
'&'
  Operator
Operator.Semicolon -> Char
';'
  Operator
Operator.Solidus -> Char
'/'

prefix :: Operator.Operator -> Builder.Builder
prefix :: Operator -> Builder
prefix Operator
op = case Operator
op of
  Operator
Operator.Ampersand -> Char -> Builder
Builder.singleton Char
'&'
  Operator
Operator.FullStop -> Char -> Builder
Builder.singleton Char
'.'
  Operator
Operator.None -> Builder
forall a. Monoid a => a
mempty
  Operator
Operator.NumberSign -> Char -> Builder
Builder.singleton Char
'#'
  Operator
Operator.PlusSign -> Builder
forall a. Monoid a => a
mempty
  Operator
Operator.QuestionMark -> Char -> Builder
Builder.singleton Char
'?'
  Operator
Operator.Semicolon -> Char -> Builder
Builder.singleton Char
';'
  Operator
Operator.Solidus -> Char -> Builder
Builder.singleton Char
'/'

variable
  :: Monad m
  => (Name.Name -> CacheT m (Maybe Value.Value))
  -> Operator.Operator
  -> Variable.Variable
  -> CacheT m (Maybe Builder.Builder)
variable :: (Name -> CacheT m (Maybe Value))
-> Operator -> Variable -> CacheT m (Maybe Builder)
variable Name -> CacheT m (Maybe Value)
f Operator
op Variable
var = do
  Maybe Value
res <- Name -> CacheT m (Maybe Value)
f (Name -> CacheT m (Maybe Value)) -> Name -> CacheT m (Maybe Value)
forall a b. (a -> b) -> a -> b
$ Variable -> Name
Variable.name Variable
var
  Maybe Builder -> CacheT m (Maybe Builder)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Builder -> CacheT m (Maybe Builder))
-> Maybe Builder -> CacheT m (Maybe Builder)
forall a b. (a -> b) -> a -> b
$ case Maybe Value
res of
    Maybe Value
Nothing -> Maybe Builder
forall a. Maybe a
Nothing
    Just Value
val -> Operator -> Variable -> Value -> Maybe Builder
value Operator
op Variable
var Value
val

value
  :: Operator.Operator
  -> Variable.Variable
  -> Value.Value
  -> Maybe Builder.Builder
value :: Operator -> Variable -> Value -> Maybe Builder
value Operator
op Variable
var Value
val = case Value
val of
  Value.Dictionary Map Text Text
xs -> Operator -> Variable -> [(Text, Text)] -> Maybe Builder
dictionaryValue Operator
op Variable
var ([(Text, Text)] -> Maybe Builder)
-> [(Text, Text)] -> Maybe Builder
forall a b. (a -> b) -> a -> b
$ Map Text Text -> [(Text, Text)]
forall k a. Map k a -> [(k, a)]
Map.toAscList Map Text Text
xs
  Value.List [Text]
xs -> Operator -> Variable -> [Text] -> Maybe Builder
listValue Operator
op Variable
var [Text]
xs
  Value.String Text
x -> Builder -> Maybe Builder
forall a. a -> Maybe a
Just (Builder -> Maybe Builder) -> Builder -> Maybe Builder
forall a b. (a -> b) -> a -> b
$ Operator -> Variable -> Text -> Builder
stringValue Operator
op Variable
var Text
x

dictionaryValue
  :: Operator.Operator
  -> Variable.Variable
  -> [(Text.Text, Text.Text)]
  -> Maybe Builder.Builder
dictionaryValue :: Operator -> Variable -> [(Text, Text)] -> Maybe Builder
dictionaryValue = (Operator -> Variable -> (Text, Text) -> [Builder])
-> Operator -> Variable -> [(Text, Text)] -> Maybe Builder
forall a.
(Operator -> Variable -> a -> [Builder])
-> Operator -> Variable -> [a] -> Maybe Builder
items ((Operator -> Variable -> (Text, Text) -> [Builder])
 -> Operator -> Variable -> [(Text, Text)] -> Maybe Builder)
-> (Operator -> Variable -> (Text, Text) -> [Builder])
-> Operator
-> Variable
-> [(Text, Text)]
-> Maybe Builder
forall a b. (a -> b) -> a -> b
$ \Operator
op Variable
var (Text
k, Text
v) ->
  let f :: Text -> Builder
f = Operator -> Modifier -> Text -> Builder
string Operator
op Modifier
Modifier.None
  in
    case Variable -> Modifier
Variable.modifier Variable
var of
      Modifier
Modifier.Asterisk -> [Text -> Builder
f Text
k Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
Builder.singleton Char
'=' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
f Text
v]
      Modifier
_ -> [Text -> Builder
f Text
k, Text -> Builder
f Text
v]

listValue
  :: Operator.Operator
  -> Variable.Variable
  -> [Text.Text]
  -> Maybe Builder.Builder
listValue :: Operator -> Variable -> [Text] -> Maybe Builder
listValue = (Operator -> Variable -> Text -> [Builder])
-> Operator -> Variable -> [Text] -> Maybe Builder
forall a.
(Operator -> Variable -> a -> [Builder])
-> Operator -> Variable -> [a] -> Maybe Builder
items ((Operator -> Variable -> Text -> [Builder])
 -> Operator -> Variable -> [Text] -> Maybe Builder)
-> (Operator -> Variable -> Text -> [Builder])
-> Operator
-> Variable
-> [Text]
-> Maybe Builder
forall a b. (a -> b) -> a -> b
$ \Operator
op Variable
var -> Builder -> [Builder]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Builder -> [Builder]) -> (Text -> Builder) -> Text -> [Builder]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Operator -> Variable -> Text -> Builder
stringValue
  (case Variable -> Modifier
Variable.modifier Variable
var of
    Modifier
Modifier.Asterisk -> Operator
op
    Modifier
_ -> Operator
Operator.None
  )
  Variable
var { modifier :: Modifier
Variable.modifier = Modifier
Modifier.None }

items
  :: (Operator.Operator -> Variable.Variable -> a -> [Builder.Builder])
  -> Operator.Operator
  -> Variable.Variable
  -> [a]
  -> Maybe Builder.Builder
items :: (Operator -> Variable -> a -> [Builder])
-> Operator -> Variable -> [a] -> Maybe Builder
items Operator -> Variable -> a -> [Builder]
f Operator
op Variable
var [a]
xs =
  let
    md :: Modifier
md = Variable -> Modifier
Variable.modifier Variable
var
    sep :: Builder
sep = case Modifier
md of
      Modifier
Modifier.Asterisk -> Operator -> Builder
separator Operator
op
      Modifier
_ -> Char -> Builder
Builder.singleton Char
','
    p :: Bool
p = case Modifier
md of
      Modifier
Modifier.Asterisk -> Bool
False
      Modifier
_ -> case Operator
op of
        Operator
Operator.Ampersand -> Bool
True
        Operator
Operator.QuestionMark -> Bool
True
        Operator
Operator.Semicolon -> Bool
True
        Operator
_ -> Bool
False
  in if [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
xs
    then Maybe Builder
forall a. Maybe a
Nothing
    else
      Builder -> Maybe Builder
forall a. a -> Maybe a
Just
      (Builder -> Maybe Builder)
-> ([Builder] -> Builder) -> [Builder] -> Maybe Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat
      ([Builder] -> Builder)
-> ([Builder] -> [Builder]) -> [Builder] -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (if Bool
p then (Bool -> Variable -> Builder
label Bool
True Variable
var Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
:) else [Builder] -> [Builder]
forall a. a -> a
id)
      ([Builder] -> [Builder])
-> ([Builder] -> [Builder]) -> [Builder] -> [Builder]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
List.intersperse Builder
sep
      ([Builder] -> Maybe Builder) -> [Builder] -> Maybe Builder
forall a b. (a -> b) -> a -> b
$ (a -> [Builder]) -> [a] -> [Builder]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Operator -> Variable -> a -> [Builder]
f Operator
op Variable
var) [a]
xs

label :: Bool -> Variable.Variable -> Builder.Builder
label :: Bool -> Variable -> Builder
label Bool
p Variable
v =
  Name -> Builder
name (Variable -> Name
Variable.name Variable
v) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> if Bool
p then Char -> Builder
Builder.singleton Char
'=' else Builder
forall a. Monoid a => a
mempty

name :: Name.Name -> Builder.Builder
name :: Name -> Builder
name =
  [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat
    ([Builder] -> Builder) -> (Name -> [Builder]) -> Name -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
List.intersperse (Char -> Builder
Builder.singleton Char
'.')
    ([Builder] -> [Builder])
-> (Name -> [Builder]) -> Name -> [Builder]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Field -> Builder) -> [Field] -> [Builder]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Field -> Builder
field
    ([Field] -> [Builder]) -> (Name -> [Field]) -> Name -> [Builder]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty Field -> [Field]
forall a. NonEmpty a -> [a]
NonEmpty.toList
    (NonEmpty Field -> [Field])
-> (Name -> NonEmpty Field) -> Name -> [Field]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> NonEmpty Field
Name.fields

field :: Field.Field -> Builder.Builder
field :: Field -> Builder
field = (Character Field -> Builder)
-> NonEmpty (Character Field) -> Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((Char -> Bool) -> Character Field -> Builder
forall tag. (Char -> Bool) -> Character tag -> Builder
character ((Char -> Bool) -> Character Field -> Builder)
-> (Char -> Bool) -> Character Field -> Builder
forall a b. (a -> b) -> a -> b
$ Bool -> Char -> Bool
forall a b. a -> b -> a
const Bool
True) (NonEmpty (Character Field) -> Builder)
-> (Field -> NonEmpty (Character Field)) -> Field -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Field -> NonEmpty (Character Field)
Field.characters

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

stringValue
  :: Operator.Operator -> Variable.Variable -> Text.Text -> Builder.Builder
stringValue :: Operator -> Variable -> Text -> Builder
stringValue Operator
op Variable
var Text
str =
  let
    pre :: Builder
pre = case Operator
op of
      Operator
Operator.Ampersand -> Bool -> Variable -> Builder
label Bool
True Variable
var
      Operator
Operator.QuestionMark -> Bool -> Variable -> Builder
label Bool
True Variable
var
      Operator
Operator.Semicolon -> Bool -> Variable -> Builder
label (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Text -> Bool
Text.null Text
str) Variable
var
      Operator
_ -> Builder
forall a. Monoid a => a
mempty
  in Builder
pre Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Operator -> Modifier -> Text -> Builder
string Operator
op (Variable -> Modifier
Variable.modifier Variable
var) Text
str

string
  :: Operator.Operator -> Modifier.Modifier -> Text.Text -> Builder.Builder
string :: Operator -> Modifier -> Text -> Builder
string Operator
op Modifier
md =
  let
    allowed :: Char -> Bool
allowed Char
x = case Operator
op of
      Operator
Operator.NumberSign -> Char -> Bool
isAllowed Char
x
      Operator
Operator.PlusSign -> Char -> Bool
isAllowed Char
x
      Operator
_ -> Char -> Bool
isUnreserved Char
x
    trim :: Text -> Text
trim = case Modifier
md of
      Modifier.Colon MaxLength
ml -> Int -> Text -> Text
Text.take (Int -> Text -> Text) -> Int -> Text -> Text
forall a b. (a -> b) -> a -> b
$ MaxLength -> Int
MaxLength.count MaxLength
ml
      Modifier
_ -> Text -> Text
forall a. a -> a
id
  in (Char -> Builder) -> String -> Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((Char -> Bool) -> Char -> Builder
unencodedCharacter Char -> Bool
allowed) (String -> Builder) -> (Text -> String) -> Text -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Text.unpack (Text -> String) -> (Text -> Text) -> Text -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
trim

isAllowed :: Char -> Bool
isAllowed :: Char -> Bool
isAllowed Char
x = Char -> Bool
isUnreserved Char
x Bool -> Bool -> Bool
|| Char -> Bool
isReserved Char
x

isUnreserved :: Char -> Bool
isUnreserved :: Char -> Bool
isUnreserved Char
x = case Char
x of
  Char
'-' -> Bool
True
  Char
'.' -> Bool
True
  Char
'_' -> Bool
True
  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

isReserved :: Char -> Bool
isReserved :: Char -> Bool
isReserved Char
x = case Char
x of
  Char
'!' -> Bool
True
  Char
'$' -> Bool
True
  Char
'&' -> Bool
True
  Char
'\'' -> Bool
True
  Char
'(' -> Bool
True
  Char
')' -> Bool
True
  Char
'*' -> Bool
True
  Char
'+' -> Bool
True
  Char
',' -> Bool
True
  Char
';' -> Bool
True
  Char
'=' -> Bool
True
  Char
':' -> Bool
True
  Char
'/' -> Bool
True
  Char
'?' -> Bool
True
  Char
'#' -> Bool
True
  Char
'[' -> Bool
True
  Char
']' -> Bool
True
  Char
'@' -> Bool
True
  Char
_ -> Bool
False

unencodedCharacter :: (Char -> Bool) -> Char -> Builder.Builder
unencodedCharacter :: (Char -> Bool) -> Char -> Builder
unencodedCharacter Char -> Bool
f Char
x = if Char -> Bool
f Char
x
  then Char -> Builder
Builder.singleton Char
x
  else ((Digit, Digit) -> Builder) -> [(Digit, Digit)] -> Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((Digit -> Digit -> Builder) -> (Digit, Digit) -> Builder
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Digit -> Digit -> Builder
Render.encodedCharacter) ([(Digit, Digit)] -> Builder) -> [(Digit, Digit)] -> Builder
forall a b. (a -> b) -> a -> b
$ Char -> [(Digit, Digit)]
encodeCharacter Char
x

encodeCharacter :: Char -> [(Digit.Digit, Digit.Digit)]
encodeCharacter :: Char -> [(Digit, Digit)]
encodeCharacter =
  (Word8 -> (Digit, Digit)) -> [Word8] -> [(Digit, Digit)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word8 -> (Digit, Digit)
Digit.fromWord8 ([Word8] -> [(Digit, Digit)])
-> (Char -> [Word8]) -> Char -> [(Digit, Digit)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Word8]
ByteString.unpack (ByteString -> [Word8]) -> (Char -> ByteString) -> Char -> [Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
Text.encodeUtf8 (Text -> ByteString) -> (Char -> Text) -> Char -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Text
Text.singleton

literal :: Literal.Literal -> Builder.Builder
literal :: Literal -> Builder
literal = (Character Literal -> Builder)
-> NonEmpty (Character Literal) -> Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((Char -> Bool) -> Character Literal -> Builder
forall tag. (Char -> Bool) -> Character tag -> Builder
character Char -> Bool
isAllowed) (NonEmpty (Character Literal) -> Builder)
-> (Literal -> NonEmpty (Character Literal)) -> Literal -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Literal -> NonEmpty (Character Literal)
Literal.characters