-- | A simple URL templating that enables interpolating environment variables
module Data.URL.Template
  ( URLTemplate,
    TemplateItem,
    Variable,
    printURLTemplate,
    mkPlainURLTemplate,
    parseURLTemplate,
    renderURLTemplate,
  )
where

import Data.Attoparsec.Combinator (lookAhead)
import Data.Attoparsec.Text
import Data.Environment qualified as Env
import Data.Text qualified as T
import Data.Text.Extended
import Hasura.Prelude
import Test.QuickCheck

newtype Variable = Variable {Variable -> Text
unVariable :: Text}
  deriving (Int -> Variable -> ShowS
[Variable] -> ShowS
Variable -> String
(Int -> Variable -> ShowS)
-> (Variable -> String) -> ([Variable] -> ShowS) -> Show Variable
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Variable] -> ShowS
$cshowList :: [Variable] -> ShowS
show :: Variable -> String
$cshow :: Variable -> String
showsPrec :: Int -> Variable -> ShowS
$cshowsPrec :: Int -> Variable -> ShowS
Show, Variable -> Variable -> Bool
(Variable -> Variable -> Bool)
-> (Variable -> Variable -> Bool) -> Eq Variable
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Variable -> Variable -> Bool
$c/= :: Variable -> Variable -> Bool
== :: Variable -> Variable -> Bool
$c== :: Variable -> Variable -> Bool
Eq, (forall x. Variable -> Rep Variable x)
-> (forall x. Rep Variable x -> Variable) -> Generic Variable
forall x. Rep Variable x -> Variable
forall x. Variable -> Rep Variable x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Variable x -> Variable
$cfrom :: forall x. Variable -> Rep Variable x
Generic, Int -> Variable -> Int
Variable -> Int
(Int -> Variable -> Int) -> (Variable -> Int) -> Hashable Variable
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: Variable -> Int
$chash :: Variable -> Int
hashWithSalt :: Int -> Variable -> Int
$chashWithSalt :: Int -> Variable -> Int
Hashable)

printVariable :: Variable -> Text
printVariable :: Variable -> Text
printVariable Variable
var = Text
"{{" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Variable -> Text
unVariable Variable
var Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"}}"

data TemplateItem
  = TIText !Text
  | TIVariable !Variable
  deriving (Int -> TemplateItem -> ShowS
[TemplateItem] -> ShowS
TemplateItem -> String
(Int -> TemplateItem -> ShowS)
-> (TemplateItem -> String)
-> ([TemplateItem] -> ShowS)
-> Show TemplateItem
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TemplateItem] -> ShowS
$cshowList :: [TemplateItem] -> ShowS
show :: TemplateItem -> String
$cshow :: TemplateItem -> String
showsPrec :: Int -> TemplateItem -> ShowS
$cshowsPrec :: Int -> TemplateItem -> ShowS
Show, TemplateItem -> TemplateItem -> Bool
(TemplateItem -> TemplateItem -> Bool)
-> (TemplateItem -> TemplateItem -> Bool) -> Eq TemplateItem
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TemplateItem -> TemplateItem -> Bool
$c/= :: TemplateItem -> TemplateItem -> Bool
== :: TemplateItem -> TemplateItem -> Bool
$c== :: TemplateItem -> TemplateItem -> Bool
Eq, (forall x. TemplateItem -> Rep TemplateItem x)
-> (forall x. Rep TemplateItem x -> TemplateItem)
-> Generic TemplateItem
forall x. Rep TemplateItem x -> TemplateItem
forall x. TemplateItem -> Rep TemplateItem x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TemplateItem x -> TemplateItem
$cfrom :: forall x. TemplateItem -> Rep TemplateItem x
Generic)

instance Hashable TemplateItem

printTemplateItem :: TemplateItem -> Text
printTemplateItem :: TemplateItem -> Text
printTemplateItem = \case
  TIText Text
t -> Text
t
  TIVariable Variable
v -> Variable -> Text
printVariable Variable
v

-- | A String with environment variables enclosed in '{{' and '}}'
-- http://{{APP_HOST}}:{{APP_PORT}}/v1/api
newtype URLTemplate = URLTemplate {URLTemplate -> [TemplateItem]
unURLTemplate :: [TemplateItem]}
  deriving (Int -> URLTemplate -> ShowS
[URLTemplate] -> ShowS
URLTemplate -> String
(Int -> URLTemplate -> ShowS)
-> (URLTemplate -> String)
-> ([URLTemplate] -> ShowS)
-> Show URLTemplate
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [URLTemplate] -> ShowS
$cshowList :: [URLTemplate] -> ShowS
show :: URLTemplate -> String
$cshow :: URLTemplate -> String
showsPrec :: Int -> URLTemplate -> ShowS
$cshowsPrec :: Int -> URLTemplate -> ShowS
Show, URLTemplate -> URLTemplate -> Bool
(URLTemplate -> URLTemplate -> Bool)
-> (URLTemplate -> URLTemplate -> Bool) -> Eq URLTemplate
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: URLTemplate -> URLTemplate -> Bool
$c/= :: URLTemplate -> URLTemplate -> Bool
== :: URLTemplate -> URLTemplate -> Bool
$c== :: URLTemplate -> URLTemplate -> Bool
Eq, (forall x. URLTemplate -> Rep URLTemplate x)
-> (forall x. Rep URLTemplate x -> URLTemplate)
-> Generic URLTemplate
forall x. Rep URLTemplate x -> URLTemplate
forall x. URLTemplate -> Rep URLTemplate x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep URLTemplate x -> URLTemplate
$cfrom :: forall x. URLTemplate -> Rep URLTemplate x
Generic, Int -> URLTemplate -> Int
URLTemplate -> Int
(Int -> URLTemplate -> Int)
-> (URLTemplate -> Int) -> Hashable URLTemplate
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: URLTemplate -> Int
$chash :: URLTemplate -> Int
hashWithSalt :: Int -> URLTemplate -> Int
$chashWithSalt :: Int -> URLTemplate -> Int
Hashable)

printURLTemplate :: URLTemplate -> Text
printURLTemplate :: URLTemplate -> Text
printURLTemplate = [Text] -> Text
T.concat ([Text] -> Text) -> (URLTemplate -> [Text]) -> URLTemplate -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TemplateItem -> Text) -> [TemplateItem] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map TemplateItem -> Text
printTemplateItem ([TemplateItem] -> [Text])
-> (URLTemplate -> [TemplateItem]) -> URLTemplate -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. URLTemplate -> [TemplateItem]
unURLTemplate

mkPlainURLTemplate :: Text -> URLTemplate
mkPlainURLTemplate :: Text -> URLTemplate
mkPlainURLTemplate =
  [TemplateItem] -> URLTemplate
URLTemplate ([TemplateItem] -> URLTemplate)
-> (Text -> [TemplateItem]) -> Text -> URLTemplate
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TemplateItem -> [TemplateItem]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TemplateItem -> [TemplateItem])
-> (Text -> TemplateItem) -> Text -> [TemplateItem]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> TemplateItem
TIText

parseURLTemplate :: Text -> Either String URLTemplate
parseURLTemplate :: Text -> Either String URLTemplate
parseURLTemplate Text
t = Parser URLTemplate -> Text -> Either String URLTemplate
forall a. Parser a -> Text -> Either String a
parseOnly Parser URLTemplate
parseTemplate Text
t
  where
    parseTemplate :: Parser URLTemplate
    parseTemplate :: Parser URLTemplate
parseTemplate = do
      [TemplateItem]
items <- Parser Text TemplateItem -> Parser Text [TemplateItem]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser Text TemplateItem
parseTemplateItem
      TemplateItem
lastItem <- Text -> TemplateItem
TIText (Text -> TemplateItem)
-> Parser Text Text -> Parser Text TemplateItem
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text Text
takeText
      URLTemplate -> Parser URLTemplate
forall (f :: * -> *) a. Applicative f => a -> f a
pure (URLTemplate -> Parser URLTemplate)
-> URLTemplate -> Parser URLTemplate
forall a b. (a -> b) -> a -> b
$ [TemplateItem] -> URLTemplate
URLTemplate ([TemplateItem] -> URLTemplate) -> [TemplateItem] -> URLTemplate
forall a b. (a -> b) -> a -> b
$ [TemplateItem]
items [TemplateItem] -> [TemplateItem] -> [TemplateItem]
forall a. Semigroup a => a -> a -> a
<> [TemplateItem
lastItem]

    parseTemplateItem :: Parser TemplateItem
    parseTemplateItem :: Parser Text TemplateItem
parseTemplateItem =
      (Variable -> TemplateItem
TIVariable (Variable -> TemplateItem)
-> Parser Text Variable -> Parser Text TemplateItem
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text Variable
parseVariable)
        Parser Text TemplateItem
-> Parser Text TemplateItem -> Parser Text TemplateItem
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Text -> TemplateItem
TIText (Text -> TemplateItem)
-> (String -> Text) -> String -> TemplateItem
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> TemplateItem)
-> Parser Text String -> Parser Text TemplateItem
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text Char -> Parser Text Text -> Parser Text String
forall (f :: * -> *) a b. Alternative f => f a -> f b -> f [a]
manyTill Parser Text Char
anyChar (Parser Text Text -> Parser Text Text
forall i a. Parser i a -> Parser i a
lookAhead (Parser Text Text -> Parser Text Text)
-> Parser Text Text -> Parser Text Text
forall a b. (a -> b) -> a -> b
$ Text -> Parser Text Text
string Text
"{{"))

    parseVariable :: Parser Variable
    parseVariable :: Parser Text Variable
parseVariable =
      Text -> Parser Text Text
string Text
"{{" Parser Text Text -> Parser Text Variable -> Parser Text Variable
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Text -> Variable
Variable (Text -> Variable) -> (String -> Text) -> String -> Variable
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Variable) -> Parser Text String -> Parser Text Variable
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text Char -> Parser Text Text -> Parser Text String
forall (f :: * -> *) a b. Alternative f => f a -> f b -> f [a]
manyTill Parser Text Char
anyChar (Text -> Parser Text Text
string Text
"}}"))

renderURLTemplate :: Env.Environment -> URLTemplate -> Either String Text
renderURLTemplate :: Environment -> URLTemplate -> Either String Text
renderURLTemplate Environment
env URLTemplate
template =
  case [Text]
errorVariables of
    [] -> Text -> Either String Text
forall a b. b -> Either a b
Right (Text -> Either String Text) -> Text -> Either String Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ [Either Text Text] -> [Text]
forall a b. [Either a b] -> [b]
rights [Either Text Text]
eitherResults
    [Text]
_ ->
      String -> Either String Text
forall a b. a -> Either a b
Left (String -> Either String Text) -> String -> Either String Text
forall a b. (a -> b) -> a -> b
$
        Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$
          Text
"Value for environment variables not found: "
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
forall t (f :: * -> *). (ToTxt t, Foldable f) => f t -> Text
commaSeparated [Text]
errorVariables
  where
    eitherResults :: [Either Text Text]
eitherResults = (TemplateItem -> Either Text Text)
-> [TemplateItem] -> [Either Text Text]
forall a b. (a -> b) -> [a] -> [b]
map TemplateItem -> Either Text Text
renderTemplateItem ([TemplateItem] -> [Either Text Text])
-> [TemplateItem] -> [Either Text Text]
forall a b. (a -> b) -> a -> b
$ URLTemplate -> [TemplateItem]
unURLTemplate URLTemplate
template
    errorVariables :: [Text]
errorVariables = [Either Text Text] -> [Text]
forall a b. [Either a b] -> [a]
lefts [Either Text Text]
eitherResults
    renderTemplateItem :: TemplateItem -> Either Text Text
renderTemplateItem = \case
      TIText Text
t -> Text -> Either Text Text
forall a b. b -> Either a b
Right Text
t
      TIVariable (Variable Text
var) ->
        let maybeEnvValue :: Maybe String
maybeEnvValue = Environment -> String -> Maybe String
Env.lookupEnv Environment
env (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
var
         in case Maybe String
maybeEnvValue of
              Maybe String
Nothing -> Text -> Either Text Text
forall a b. a -> Either a b
Left Text
var
              Just String
value -> Text -> Either Text Text
forall a b. b -> Either a b
Right (Text -> Either Text Text) -> Text -> Either Text Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
value

-- QuickCheck generators
instance Arbitrary Variable where
  arbitrary :: Gen Variable
arbitrary = Text -> Variable
Variable (Text -> Variable) -> (String -> Text) -> String -> Variable
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Variable) -> Gen String -> Gen Variable
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Char -> Gen String
forall a. Gen a -> Gen [a]
listOf1 (String -> Gen Char
forall a. [a] -> Gen a
elements (String -> Gen Char) -> String -> Gen Char
forall a b. (a -> b) -> a -> b
$ String
alphaNumerics String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" -_")

instance Arbitrary URLTemplate where
  arbitrary :: Gen URLTemplate
arbitrary = [TemplateItem] -> URLTemplate
URLTemplate ([TemplateItem] -> URLTemplate)
-> Gen [TemplateItem] -> Gen URLTemplate
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen TemplateItem -> Gen [TemplateItem]
forall a. Gen a -> Gen [a]
listOf ([Gen TemplateItem] -> Gen TemplateItem
forall a. [Gen a] -> Gen a
oneof [Gen TemplateItem
genText, Gen TemplateItem
genVariable])
    where
      genText :: Gen TemplateItem
genText = Text -> TemplateItem
TIText (Text -> TemplateItem)
-> (String -> Text) -> String -> TemplateItem
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> TemplateItem) -> Gen String -> Gen TemplateItem
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Char -> Gen String
forall a. Gen a -> Gen [a]
listOf1 (String -> Gen Char
forall a. [a] -> Gen a
elements (String -> Gen Char) -> String -> Gen Char
forall a b. (a -> b) -> a -> b
$ String
alphaNumerics String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" ://")
      genVariable :: Gen TemplateItem
genVariable = Variable -> TemplateItem
TIVariable (Variable -> TemplateItem) -> Gen Variable -> Gen TemplateItem
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Variable
forall a. Arbitrary a => Gen a
arbitrary