module Burrito.Internal.TH (uriTemplate) where

import qualified Burrito.Internal.Parse as Parse
import qualified Language.Haskell.TH.Quote as TH
import qualified Language.Haskell.TH.Syntax as TH

-- | 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 = QuasiQuoter :: (String -> Q Exp)
-> (String -> Q Pat)
-> (String -> Q Type)
-> (String -> Q [Dec])
-> QuasiQuoter
TH.QuasiQuoter
  { quoteDec :: String -> Q [Dec]
TH.quoteDec = Q [Dec] -> String -> Q [Dec]
forall a b. a -> b -> a
const (Q [Dec] -> String -> Q [Dec]) -> Q [Dec] -> String -> Q [Dec]
forall a b. (a -> b) -> a -> b
$ String -> Q [Dec]
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"cannot be used as a declaration"
  , quoteExp :: String -> Q Exp
TH.quoteExp = Q Exp -> (Template -> Q Exp) -> Maybe Template -> Q Exp
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Q Exp
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"invalid URI template") Template -> Q Exp
forall a. Data a => a -> Q Exp
TH.liftData (Maybe Template -> Q Exp)
-> (String -> Maybe Template) -> String -> Q Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe Template
Parse.parse
  , quotePat :: String -> Q Pat
TH.quotePat = Q Pat -> String -> Q Pat
forall a b. a -> b -> a
const (Q Pat -> String -> Q Pat) -> Q Pat -> String -> Q Pat
forall a b. (a -> b) -> a -> b
$ String -> Q Pat
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"cannot be used as a pattern"
  , quoteType :: String -> Q Type
TH.quoteType = Q Type -> String -> Q Type
forall a b. a -> b -> a
const (Q Type -> String -> Q Type) -> Q Type -> String -> Q Type
forall a b. (a -> b) -> a -> b
$ String -> Q Type
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"cannot be used as a type"
  }