    {-# LANGUAGE RankNTypes #-}
    {-# LANGUAGE TemplateHaskell #-}

    -- |
    -- Module      :  Text.URI.QQ
    -- Copyright   :  © 2017–present Mark Karpov
    -- License     :  BSD 3 clause
    --
    -- Maintainer  :  Mark Karpov <markkarpov92@gmail.com>
    -- Stability   :  experimental
    -- Portability :  portable
    --
    -- Quasi-quoters for compile-time construction of URIs and refined text
    -- values.
    --
    -- All of the quasi-quoters in this module can be used in an expression
    -- context. With the @ViewPatterns@ language extension enabled, they may
    -- also be used in a pattern context (since /0.3.2.0/).
    module Text.URI.QQ
      ( uri,
        scheme,
        host,
        username,
        password,
        pathPiece,
        queryKey,
        queryValue,
        fragment,
      )
    where

    import Control.Exception (Exception (..), SomeException)
    import Data.Text (Text)
    import qualified Data.Text as T
    import Language.Haskell.TH.Lib (appE, viewP)
    import Language.Haskell.TH.Quote (QuasiQuoter (..))
    import Language.Haskell.TH.Syntax (Lift (..))
    import Text.URI.Parser.Text
    import Text.URI.Types

    -- | Construct a 'URI' value at compile time.
    uri :: QuasiQuoter
    uri :: QuasiQuoter
    uri = (Text -> Either SomeException URI) -> QuasiQuoter
    forall a.
    (Eq a, Lift a) =>
    (Text -> Either SomeException a) -> QuasiQuoter
    liftToQQ Text -> Either SomeException URI
    forall (m :: * -> *). MonadThrow m => Text -> m URI
    mkURI

    -- | Construct a @'RText' 'Scheme'@ value at compile time.
    scheme :: QuasiQuoter
    scheme :: QuasiQuoter
    scheme = (Text -> Either SomeException (RText 'Scheme)) -> QuasiQuoter
    forall a.
    (Eq a, Lift a) =>
    (Text -> Either SomeException a) -> QuasiQuoter
    liftToQQ Text -> Either SomeException (RText 'Scheme)
    forall (m :: * -> *). MonadThrow m => Text -> m (RText 'Scheme)
    mkScheme

    -- | Construct a @'RText' 'Host'@ value at compile time.
    host :: QuasiQuoter
    host :: QuasiQuoter
    host = (Text -> Either SomeException (RText 'Host)) -> QuasiQuoter
    forall a.
    (Eq a, Lift a) =>
    (Text -> Either SomeException a) -> QuasiQuoter
    liftToQQ Text -> Either SomeException (RText 'Host)
    forall (m :: * -> *). MonadThrow m => Text -> m (RText 'Host)
    mkHost

    -- | Construct a @'RText' 'Username'@ value at compile time.
    username :: QuasiQuoter
    username :: QuasiQuoter
    username = (Text -> Either SomeException (RText 'Username)) -> QuasiQuoter
    forall a.
    (Eq a, Lift a) =>
    (Text -> Either SomeException a) -> QuasiQuoter
    liftToQQ Text -> Either SomeException (RText 'Username)
    forall (m :: * -> *). MonadThrow m => Text -> m (RText 'Username)
    mkUsername

    -- | Construct a @'RText' 'Password'@ value at compile time.
    password :: QuasiQuoter
    password :: QuasiQuoter
    password = (Text -> Either SomeException (RText 'Password)) -> QuasiQuoter
    forall a.
    (Eq a, Lift a) =>
    (Text -> Either SomeException a) -> QuasiQuoter
    liftToQQ Text -> Either SomeException (RText 'Password)
    forall (m :: * -> *). MonadThrow m => Text -> m (RText 'Password)
    mkPassword

    -- | Construct a @'RText' 'PathPiece'@ value at compile time.
    pathPiece :: QuasiQuoter
    pathPiece :: QuasiQuoter
    pathPiece = (Text -> Either SomeException (RText 'PathPiece)) -> QuasiQuoter
    forall a.
    (Eq a, Lift a) =>
    (Text -> Either SomeException a) -> QuasiQuoter
    liftToQQ Text -> Either SomeException (RText 'PathPiece)
    forall (m :: * -> *). MonadThrow m => Text -> m (RText 'PathPiece)
    mkPathPiece

    -- | Construct a @'RText' 'QueryKey'@ value at compile time.
    queryKey :: QuasiQuoter
    queryKey :: QuasiQuoter
    queryKey = (Text -> Either SomeException (RText 'QueryKey)) -> QuasiQuoter
    forall a.
    (Eq a, Lift a) =>
    (Text -> Either SomeException a) -> QuasiQuoter
    liftToQQ Text -> Either SomeException (RText 'QueryKey)
    forall (m :: * -> *). MonadThrow m => Text -> m (RText 'QueryKey)
    mkQueryKey

    -- | Construct a @'RText 'QueryValue'@ value at compile time.
    queryValue :: QuasiQuoter
    queryValue :: QuasiQuoter
    queryValue = (Text -> Either SomeException (RText 'QueryValue)) -> QuasiQuoter
    forall a.
    (Eq a, Lift a) =>
    (Text -> Either SomeException a) -> QuasiQuoter
    liftToQQ Text -> Either SomeException (RText 'QueryValue)
    forall (m :: * -> *). MonadThrow m => Text -> m (RText 'QueryValue)
    mkQueryValue

    -- | Construct a @'RText' 'Fragment'@ value at compile time.
    fragment :: QuasiQuoter
    fragment :: QuasiQuoter
    fragment = (Text -> Either SomeException (RText 'Fragment)) -> QuasiQuoter
    forall a.
    (Eq a, Lift a) =>
    (Text -> Either SomeException a) -> QuasiQuoter
    liftToQQ Text -> Either SomeException (RText 'Fragment)
    forall (m :: * -> *). MonadThrow m => Text -> m (RText 'Fragment)
    mkFragment

    ----------------------------------------------------------------------------
    -- Helpers

    -- | Lift a smart constructor for refined text into a 'QuasiQuoter'.
    --
    -- The 'Eq' constraint is technically unnecessary here, but the pattern
    -- generated by 'quotePat' will only work if the type has an 'Eq' instance.
    liftToQQ :: (Eq a, Lift a) => (Text -> Either SomeException a) -> QuasiQuoter
    liftToQQ :: forall a.
    (Eq a, Lift a) =>
    (Text -> Either SomeException a) -> QuasiQuoter
    liftToQQ Text -> Either SomeException a
    f =
      QuasiQuoter
        { quoteExp :: String -> Q Exp
    quoteExp = \String
    str ->
            case Text -> Either SomeException a
    f (String -> Text
    T.pack String
    str) of
              Left SomeException
    err -> String -> Q Exp
    forall a. String -> Q a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail (SomeException -> String
    forall e. Exception e => e -> String
    displayException SomeException
    err)
              Right a
    x -> a -> Q Exp
    forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
    forall (m :: * -> *). Quote m => a -> m Exp
    lift a
    x,
          quotePat :: String -> Q Pat
    quotePat = \String
    str ->
            case Text -> Either SomeException a
    f (String -> Text
    T.pack String
    str) of
              Left SomeException
    err -> String -> Q Pat
    forall a. String -> Q a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail (SomeException -> String
    forall e. Exception e => e -> String
    displayException SomeException
    err)
              Right a
    x -> Q Exp -> Q Exp -> Q Exp
    forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
    appE [|(==)|] (a -> Q Exp
    forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
    forall (m :: * -> *). Quote m => a -> m Exp
    lift a
    x) Q Exp -> Q Pat -> Q Pat
    forall (m :: * -> *). Quote m => m Exp -> m Pat -> m Pat
    `viewP` [p|True|],
          quoteType :: String -> Q Type
    quoteType = String -> String -> Q Type
    forall a. HasCallStack => String -> a
    error String
    "This usage is not supported",
          quoteDec :: String -> Q [Dec]
    quoteDec = String -> String -> Q [Dec]
    forall a. HasCallStack => String -> a
    error String
    "This usage is not supported"
        }