{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE RecordWildCards #-}
-- |
-- This module gives you a way of easily constructing QuasiQuoters for literals
-- of any type @a@ for which you can write a parsing function @String -> Either
-- String a@.
--
module QQLiterals (qqLiteral, QuasiQuoter) where

import Language.Haskell.TH (varE, Name)
import Language.Haskell.TH.Quote (QuasiQuoter(..))

-- |
-- The qqLiteral function takes two arguments. The first is a function which
-- parses values of the type we’re interested in, which should return a 'Right'
-- value in case of success, or a 'Left' value with an error message in case of
-- failure. The second is a 'Name', which must refer to the same function
-- passed as the first argument. It is recommended to use Template Haskell
-- quoting to provide the second argument; see below.
--
-- The resulting 'QuasiQuoter' applies the quoted string to the parsing
-- function at compile time, and if parsing succeeds, an expression equivalent
-- to @fromRight (parse str)@ is spliced into the program. If parsing fails,
-- this causes an error at compile time.
--
-- As long as the parsing function isn't lying about being pure, this should
-- always be safe, in that it should never result in an error at runtime.
--
-- For example, suppose we wanted to be able to define literals for the @URI@
-- type in @network-uri@. The function @parseURI@ from @network-uri@ has
-- type @String -> Maybe URI@, so we first need to define an 'Either' version:
--
-- @
-- eitherParseURI :: String -> Either String URI
-- eitherParseURI str =
--   maybe (Left ("Failed to parse URI: " ++ str)) Right (parseURI str)
-- @
--
-- We can then use the 'qqLiteral' function to create our 'QuasiQuoter'. Note
-- that we use a single-quote character to quote @eitherParseURI@ in order to
-- provide the 'Name' argument; this will require the @TemplateHaskell@
-- extension to be enabled.
--
-- @
-- uri :: QuasiQuoter
-- uri = qqLiteral eitherParseURI 'eitherParseURI
-- @
--
-- And it can be used as follows:
--
-- @
-- exampleDotCom :: URI
-- exampleDotCom = [uri|http:\/\/example.com\/lol|]
-- @
--
qqLiteral :: (String -> Either String a) -> Name -> QuasiQuoter
qqLiteral :: (String -> Either String a) -> Name -> QuasiQuoter
qqLiteral String -> Either String a
parse Name
parseFn = QuasiQuoter :: (String -> Q Exp)
-> (String -> Q Pat)
-> (String -> Q Type)
-> (String -> Q [Dec])
-> QuasiQuoter
QuasiQuoter {String -> Q [Dec]
String -> Q Exp
String -> Q Pat
String -> Q Type
forall p a. p -> Q a
quoteExp :: String -> Q Exp
quotePat :: String -> Q Pat
quoteDec :: String -> Q [Dec]
quoteType :: String -> Q Type
quoteDec :: forall p a. p -> Q a
quoteType :: forall p a. p -> Q a
quotePat :: forall p a. p -> Q a
quoteExp :: String -> Q Exp
..}
  where
  quoteExp :: String -> Q Exp
quoteExp String
str =
    case String -> Either String a
parse String
str of
      Right a
_ -> [| case $(varE parseFn) str of { Right x -> x; Left x -> error ("can't happen: " ++ show x)} |]
      Left String
err -> String -> Q Exp
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
err

  quotePat :: p -> Q a
quotePat  = String -> p -> Q a
forall (m :: * -> *) p a. MonadFail m => String -> p -> m a
unsupported String
"pattern"
  quoteType :: p -> Q a
quoteType = String -> p -> Q a
forall (m :: * -> *) p a. MonadFail m => String -> p -> m a
unsupported String
"type"
  quoteDec :: p -> Q a
quoteDec  = String -> p -> Q a
forall (m :: * -> *) p a. MonadFail m => String -> p -> m a
unsupported String
"declaration"

  unsupported :: String -> p -> m a
unsupported String
context p
_ = String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m a) -> String -> m a
forall a b. (a -> b) -> a -> b
$
    String
"Unsupported operation: this QuasiQuoter can not be used in a " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
context String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" context."