module Burrito.Internal.TH
  ( expandTH,
    uriTemplate,
  )
where

import qualified Burrito.Internal.Expand as Expand
import qualified Burrito.Internal.Parse as Parse
import qualified Burrito.Internal.Type.Template as Template
import qualified Burrito.Internal.Type.Value as Value
import qualified Data.Bifunctor as Bifunctor
import qualified Data.Map as Map
import qualified Data.Text as Text
import qualified Data.Text.Lazy as LazyText
import qualified Data.Text.Lazy.Builder as Builder
import qualified Language.Haskell.TH.Quote as TH
import qualified Language.Haskell.TH.Syntax as TH

-- | This can be used together with the @TemplateHaskell@ language extension to
-- expand a URI template at compile time. This is slightly different from
-- 'Expand.expand' in that missing variables will throw an exception. This is
-- convenient because it allows you to verify that all of the variables have
-- been supplied at compile time.
--
-- >>> :set -XQuasiQuotes -XTemplateHaskell
-- >>> import Burrito
-- >>> $( expandTH [("foo", stringValue "bar")] [uriTemplate|l-{foo}-r|] )
-- "l-bar-r"
expandTH :: [(String, Value.Value)] -> Template.Template -> TH.Q TH.Exp
expandTH :: [(String, Value)] -> Template -> Q Exp
expandTH [(String, Value)]
xs Template
t = do
  let m :: Map Text Value
m = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
Bifunctor.first String -> Text
Text.pack) [(String, Value)]
xs
      f :: Text -> Either String (Maybe Value)
f Text
k =
        forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String
"missing variable: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Text
k) (forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just) forall a b. (a -> b) -> a -> b
$
          forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
k Map Text Value
m
  String
x <-
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall (m :: * -> *) a. MonadFail m => String -> m a
fail (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
LazyText.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
Builder.toLazyText) forall a b. (a -> b) -> a -> b
$
      forall (m :: * -> *).
Monad m =>
(Text -> m (Maybe Value)) -> Template -> m Builder
Expand.expandWith Text -> Either String (Maybe Value)
f Template
t
  forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
TH.lift String
x

-- | This can be used together with the @QuasiQuotes@ language extension to
-- parse a URI template at compile time. This is convenient because it allows
-- you to verify the validity of the template when you compile your file as
-- opposed to when you run it.
--
-- >>> :set -XQuasiQuotes
-- >>> import Burrito
-- >>> let template = [uriTemplate|http://example/search{?query}|]
-- >>> let values = [("query", stringValue "chorizo")]
-- >>> expand values template
-- "http://example/search?query=chorizo"
--
-- Note that you cannot use escape sequences in this quasi-quoter. For example,
-- this is invalid: @[uriTemplate|\\xa0|]@. You can however use percent encoded
-- triples as normal. So this is valid: @[uriTemplate|%c2%a0|]@.
uriTemplate :: TH.QuasiQuoter
uriTemplate :: QuasiQuoter
uriTemplate =
  TH.QuasiQuoter
    { quoteDec :: String -> Q [Dec]
TH.quoteDec = forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"cannot be used as a declaration",
      quoteExp :: String -> Q Exp
TH.quoteExp = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"invalid URI template") forall (m :: * -> *) a. (Quote m, Data a) => a -> m Exp
TH.liftData forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe Template
Parse.parse,
      quotePat :: String -> Q Pat
TH.quotePat = forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"cannot be used as a pattern",
      quoteType :: String -> Q Type
TH.quoteType = forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"cannot be used as a type"
    }