{-# 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
    { 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
forall (m :: * -> *). Quote m => m Exp -> m Exp -> m 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
forall (m :: * -> *). Quote m => [m Exp] -> m 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
forall (m :: * -> *). Quote m => m Exp -> m Exp -> m 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
forall (m :: * -> *). Quote m => Name -> m 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
forall (m :: * -> *). Quote m => Lit -> m 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