{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TemplateHaskellQuotes #-}

module Web.HttpApiData.QQ (
  url,
) where

import Data.String (fromString)
import qualified Data.Text as Text
import Language.Haskell.TH
import Language.Haskell.TH.Quote (QuasiQuoter (..))
import Web.HttpApiData (toUrlPiece)

import Web.HttpApiData.QQ.Parser

{- |
A quasiquoter to build a URL by interpolating values via ToHttpApiData.
The resulting value can be any IsString type.

Currently only supports single variable names being interpolated, not
arbitrary Haskell expressions.

Usage:

>>> [url|/foo/#{fooId}/bar|]
-}
url :: QuasiQuoter
url :: QuasiQuoter
url =
  QuasiQuoter :: (String -> Q Exp)
-> (String -> Q Pat)
-> (String -> Q Type)
-> (String -> Q [Dec])
-> QuasiQuoter
QuasiQuoter
    { quoteExp :: String -> Q Exp
quoteExp = [ParsedUrlPiece] -> Q Exp
toExpQ ([ParsedUrlPiece] -> Q Exp)
-> (String -> [ParsedUrlPiece]) -> String -> Q Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> [ParsedUrlPiece])
-> ([ParsedUrlPiece] -> [ParsedUrlPiece])
-> Either String [ParsedUrlPiece]
-> [ParsedUrlPiece]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> [ParsedUrlPiece]
forall a. HasCallStack => String -> a
error [ParsedUrlPiece] -> [ParsedUrlPiece]
forall a. a -> a
id (Either String [ParsedUrlPiece] -> [ParsedUrlPiece])
-> (String -> Either String [ParsedUrlPiece])
-> String
-> [ParsedUrlPiece]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either String [ParsedUrlPiece]
parseUrlPieces
    , quotePat :: String -> Q Pat
quotePat = String -> String -> Q Pat
forall a. HasCallStack => String -> a
error String
"'url' quasiquoter cannot be used as a pattern"
    , quoteType :: String -> Q Type
quoteType = String -> String -> Q Type
forall a. HasCallStack => String -> a
error String
"'url' quasiquoter cannot be used as a type"
    , quoteDec :: String -> Q [Dec]
quoteDec = String -> String -> Q [Dec]
forall a. HasCallStack => String -> a
error String
"'url' quasiquoter cannot be used as a declaration"
    }
  where
    -- convert parsed URL pieces into the ExpQ to inject
    toExpQ :: [ParsedUrlPiece] -> Q Exp
toExpQ = Q Exp -> Q Exp -> Q Exp
appE [|fromString . concat|] (Q Exp -> Q Exp)
-> ([ParsedUrlPiece] -> Q Exp) -> [ParsedUrlPiece] -> Q Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Q Exp] -> Q Exp
listE ([Q Exp] -> Q Exp)
-> ([ParsedUrlPiece] -> [Q Exp]) -> [ParsedUrlPiece] -> Q Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ParsedUrlPiece -> Q Exp) -> [ParsedUrlPiece] -> [Q Exp]
forall a b. (a -> b) -> [a] -> [b]
map ParsedUrlPiece -> Q Exp
urlPieceToExpQ
    urlPieceToExpQ :: ParsedUrlPiece -> Q Exp
urlPieceToExpQ = \case
      InterpolatedName String
name -> Q Exp -> Q Exp -> Q Exp
appE [|Text.unpack . toUrlPiece|] (Q Exp -> Q Exp) -> (String -> Q Exp) -> String -> Q Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Q Exp
varE (Name -> Q Exp) -> (String -> Name) -> String -> Q Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Name
mkName (String -> Q Exp) -> String -> Q Exp
forall a b. (a -> b) -> a -> b
$ String
name
      RawString String
s -> Lit -> Q Exp
litE (Lit -> Q Exp) -> (String -> Lit) -> String -> Q Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Lit
stringL (String -> Q Exp) -> String -> Q Exp
forall a b. (a -> b) -> a -> b
$ String
s