-- SPDX-FileCopyrightText: 2021 Oxhead Alpha
-- SPDX-License-Identifier: LicenseRef-MIT-OA

-- | Lorentz template-haskell and quasiquote utilities.
module Lorentz.Util.TH
  ( entrypointDoc
  , errorDoc
  , errorDocArg
  , typeDoc
  ) where

import Prelude hiding (lift)

import Data.Text (strip, stripPrefix, stripSuffix)
import Language.Haskell.TH (Dec, Q, TypeQ, appT, conT, litE, litT, mkName, strTyLit, stringL)
import Language.Haskell.TH.Quote (QuasiQuoter(..))
import Language.Haskell.TH.Syntax (lift)
import Text.ParserCombinators.ReadP (choice, readP_to_S, skipSpaces, string)
import Text.Read.Lex (Lexeme(..), lex)

import Lorentz.Doc
import Lorentz.Entrypoints
import Lorentz.Errors

-- | QuasiQuote that helps generating @ParameterHasEntrypoints@ instance.
--
-- Usage:
--
-- @
-- [entrypointDoc| Parameter \<parameter-type> \<optional-root-annotation> |]
-- [entrypointDoc| Parameter plain |]
-- [entrypointDoc| Parameter plain "root"|]
-- @
--
-- See this [tutorial](https://indigo-lang.gitlab.io/contract-docs/) which
-- includes this quasiquote.
--
entrypointDoc :: QuasiQuoter
entrypointDoc :: QuasiQuoter
entrypointDoc = QuasiQuoter :: (String -> Q Exp)
-> (String -> Q Pat)
-> (String -> Q Type)
-> (String -> Q [Dec])
-> QuasiQuoter
QuasiQuoter
  { quoteExp :: String -> Q Exp
quoteExp  = Q Exp -> String -> Q Exp
forall a b. a -> b -> a
const (Q Exp -> String -> Q Exp) -> Q Exp -> String -> Q Exp
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Q Exp
forall (m :: * -> *) a. MonadFail m => Text -> Text -> m a
failQQType Text
qqName Text
"expression"
  , quotePat :: String -> Q Pat
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
$ Text -> Text -> Q Pat
forall (m :: * -> *) a. MonadFail m => Text -> Text -> m a
failQQType Text
qqName Text
"pattern"
  , quoteType :: String -> Q Type
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
$ Text -> Text -> Q Type
forall (m :: * -> *) a. MonadFail m => Text -> Text -> m a
failQQType Text
qqName Text
"type"
  , quoteDec :: String -> Q [Dec]
quoteDec  = String -> Q [Dec]
go
  }
  where
    qqName :: Text
qqName = Text
"entrypointDoc"

    go :: String -> Q [Dec]
    go :: String -> Q [Dec]
go String
input =
      let
        mkEpdWithRoot :: Text -> Text -> TypeQ
        mkEpdWithRoot :: Text -> Text -> Q Type
mkEpdWithRoot Text
epd Text
r =
          Q Type -> Q Type -> Q Type
forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
appT (Q Type -> Q Type -> Q Type
forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
appT (Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
conT (Name -> Q Type) -> Name -> Q Type
forall a b. (a -> b) -> a -> b
$ String -> Name
mkName String
"EpdWithRoot") (Q TyLit -> Q Type
forall (m :: * -> *). Quote m => m TyLit -> m Type
litT (Q TyLit -> Q Type) -> Q TyLit -> Q Type
forall a b. (a -> b) -> a -> b
$ String -> Q TyLit
forall (m :: * -> *). Quote m => String -> m TyLit
strTyLit (String -> Q TyLit) -> String -> Q TyLit
forall a b. (a -> b) -> a -> b
$ Text -> String
forall a. ToString a => a -> String
toString (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Text -> Text
stripQuote Text
r))
               (Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
conT (Name -> Q Type) -> Name -> Q Type
forall a b. (a -> b) -> a -> b
$ String -> Name
mkName (Text -> String
forall a. ToString a => a -> String
toString Text
epd))
        extract :: [Text] -> Either Text (Text, TypeQ)
        extract :: [Text] -> Either Text (Text, Q Type)
extract [Text]
a =
          case [Text]
a of
            [Text
x, Text
"plain"] -> (Text, Q Type) -> Either Text (Text, Q Type)
forall a b. b -> Either a b
Right (Text
x, Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
conT (Name -> Q Type) -> Name -> Q Type
forall a b. (a -> b) -> a -> b
$ String -> Name
mkName (String -> Name) -> String -> Name
forall a b. (a -> b) -> a -> b
$ String
"EpdPlain")
            [Text
x, Text
"delegate"] -> (Text, Q Type) -> Either Text (Text, Q Type)
forall a b. b -> Either a b
Right (Text
x, Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
conT (Name -> Q Type) -> Name -> Q Type
forall a b. (a -> b) -> a -> b
$ String -> Name
mkName (String -> Name) -> String -> Name
forall a b. (a -> b) -> a -> b
$ String
"EpdDelegate")
            [Text
x, Text
"recursive"] -> (Text, Q Type) -> Either Text (Text, Q Type)
forall a b. b -> Either a b
Right (Text
x, Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
conT (Name -> Q Type) -> Name -> Q Type
forall a b. (a -> b) -> a -> b
$ String -> Name
mkName (String -> Name) -> String -> Name
forall a b. (a -> b) -> a -> b
$ String
"EpdRecursive")
            [Text
x, Text
"none"] -> (Text, Q Type) -> Either Text (Text, Q Type)
forall a b. b -> Either a b
Right (Text
x, Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
conT (Name -> Q Type) -> Name -> Q Type
forall a b. (a -> b) -> a -> b
$ String -> Name
mkName (String -> Name) -> String -> Name
forall a b. (a -> b) -> a -> b
$ String
"EpdNone")
            [Text
x, Text
"plain", Text
r] -> (Text, Q Type) -> Either Text (Text, Q Type)
forall a b. b -> Either a b
Right (Text
x, Text -> Text -> Q Type
mkEpdWithRoot Text
"EpdPlain" Text
r)
            [Text
x, Text
"delegate", Text
r] -> (Text, Q Type) -> Either Text (Text, Q Type)
forall a b. b -> Either a b
Right (Text
x, Text -> Text -> Q Type
mkEpdWithRoot Text
"EpdDelegate" Text
r)
            [Text
x, Text
"recursive", Text
r] -> (Text, Q Type) -> Either Text (Text, Q Type)
forall a b. b -> Either a b
Right (Text
x, Text -> Text -> Q Type
mkEpdWithRoot Text
"EpdRecursive" Text
r)
            [Text]
i -> Text -> Either Text (Text, Q Type)
forall a b. a -> Either a b
Left (Text -> Either Text (Text, Q Type))
-> Text -> Either Text (Text, Q Type)
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
unlines
              [ Text
"Invalid arguments."
              , Text
"      Expected arguments to be in the format of:"
              , Text
"        - [" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
qqName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"| Parameter <parameter-type> <optional-root-annotation> |]"
              , Text
"      Examples:"
              , Text
"        - [" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
qqName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"| Parameter plain |]"
              , Text
"        - [" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
qqName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"| Parameter recursive |]"
              , Text
"        - [" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
qqName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"| Parameter plain \"root\" |]"
              , Text
"      But instead got: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
unwords [Text]
i
              ]
      in case  [Text] -> Either Text (Text, Q Type)
extract ([Text] -> Either Text (Text, Q Type))
-> [Text] -> Either Text (Text, Q Type)
forall a b. (a -> b) -> a -> b
$ Text -> [Text]
words (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. ToText a => a -> Text
toText String
input of
            Right (Text
param, Q Type
paramValue) -> [d|
              instance ParameterHasEntrypoints $(conT $ mkName $ toString param) where
                type ParameterEntrypointsDerivation $(conT $ mkName $ toString param) = $(paramValue)
              |]
            Left Text
err -> Text -> Text -> Q [Dec]
forall (m :: * -> *) a. MonadFail m => Text -> Text -> m a
failQQ Text
qqName Text
err

-- | QuasiQuote that helps generating @CustomErrorHasDoc@ instance.
--
-- Usage:
--
-- @
-- [errorDoc| \<error-name> \<error-type> \<error-description> |]
-- [errorDoc| "errorName" exception "Error description" |]
-- @
--
-- This is equivalent to 'errorDocArg' with @()@ specified as error argument type.
--
errorDoc :: QuasiQuoter
errorDoc :: QuasiQuoter
errorDoc = QuasiQuoter :: (String -> Q Exp)
-> (String -> Q Pat)
-> (String -> Q Type)
-> (String -> Q [Dec])
-> QuasiQuoter
QuasiQuoter
  { quoteExp :: String -> Q Exp
quoteExp  = Q Exp -> String -> Q Exp
forall a b. a -> b -> a
const (Q Exp -> String -> Q Exp) -> Q Exp -> String -> Q Exp
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Q Exp
forall (m :: * -> *) a. MonadFail m => Text -> Text -> m a
failQQType Text
qqName Text
"expression"
  , quotePat :: String -> Q Pat
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
$ Text -> Text -> Q Pat
forall (m :: * -> *) a. MonadFail m => Text -> Text -> m a
failQQType Text
qqName Text
"pattern"
  , quoteType :: String -> Q Type
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
$ Text -> Text -> Q Type
forall (m :: * -> *) a. MonadFail m => Text -> Text -> m a
failQQType Text
qqName Text
"type"
  , quoteDec :: String -> Q [Dec]
quoteDec  = QuasiQuoter -> String -> Q [Dec]
quoteDec QuasiQuoter
errorDocArg (String -> Q [Dec]) -> (String -> String) -> String -> Q [Dec]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" ()")
  }
  where
    qqName :: Text
qqName = Text
"errorDoc"

{-# DEPRECATED errorDoc "errorDoc is deprecated, use errorDocArg with () argument instead" #-}

-- | QuasiQuote that helps generating @CustomErrorHasDoc@ instance.
--
-- Usage:
--
-- @
-- [errorDocArg| \<error-name> \<error-type> \<error-description> [\<error-arg-type>] |]
-- [errorDocArg| "errorName" exception "Error description" |]
-- [errorDocArg| "errorName" contract-internal "Error description" () |]
-- [errorDocArg| "errorName" bad-argument "Error description" Integer |]
-- @
--
-- The default argument type is 'NoErrorArg'. Only a type name can be used,
-- if you need complex type, define a type synonym.
--
-- See this [tutorial](https://indigo-lang.gitlab.io/contract-docs/) which
-- includes this quasiquote.
--
errorDocArg :: QuasiQuoter
errorDocArg :: QuasiQuoter
errorDocArg = QuasiQuoter :: (String -> Q Exp)
-> (String -> Q Pat)
-> (String -> Q Type)
-> (String -> Q [Dec])
-> QuasiQuoter
QuasiQuoter
  { quoteExp :: String -> Q Exp
quoteExp  = Q Exp -> String -> Q Exp
forall a b. a -> b -> a
const (Q Exp -> String -> Q Exp) -> Q Exp -> String -> Q Exp
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Q Exp
forall (m :: * -> *) a. MonadFail m => Text -> Text -> m a
failQQType Text
qqName Text
"expression"
  , quotePat :: String -> Q Pat
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
$ Text -> Text -> Q Pat
forall (m :: * -> *) a. MonadFail m => Text -> Text -> m a
failQQType Text
qqName Text
"pattern"
  , quoteType :: String -> Q Type
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
$ Text -> Text -> Q Type
forall (m :: * -> *) a. MonadFail m => Text -> Text -> m a
failQQType Text
qqName Text
"type"
  , quoteDec :: String -> Q [Dec]
quoteDec  = String -> Q [Dec]
go
  }
  where
    qqName :: Text
qqName = Text
"errorDocArg"

    errMsg :: String -> Text
errMsg String
i = [Text] -> Text
unlines
      [ Text
"Invalid arguments."
      , Text
"      Expected arguments to be in the format of:"
      , Text
"        - [" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
qqName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"| <error-name> <error-type> <error-description> [<error-argument>] |]"
      , Text
"      Examples:"
      , Text
"        - [" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
qqName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"| \"errorName\" exception \"Error description\" |]"
      , Text
"        - [" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
qqName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"| \"myError\" bad-argument \"An error happened\" () |]"
      , Text
"      But instead got: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a. IsString a => String -> a
fromString String
i
      ]

    go :: String -> Q [Dec]
    go :: String -> Q [Dec]
go String
input =
      let
        parser :: ReadP (String, ErrorClass, String)
parser = do
          ReadP ()
skipSpaces
          String String
errorName <- ReadP Lexeme
lex
          ReadP ()
skipSpaces
          ErrorClass
errorClass <- [ReadP ErrorClass] -> ReadP ErrorClass
forall a. [ReadP a] -> ReadP a
choice
            [ String -> ReadP String
string String
"exception"         ReadP String -> ErrorClass -> ReadP ErrorClass
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ErrorClass
ErrClassActionException
            , String -> ReadP String
string String
"bad-argument"      ReadP String -> ErrorClass -> ReadP ErrorClass
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ErrorClass
ErrClassBadArgument
            , String -> ReadP String
string String
"contract-internal" ReadP String -> ErrorClass -> ReadP ErrorClass
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ErrorClass
ErrClassContractInternal
            , String -> ReadP String
string String
"unknown"           ReadP String -> ErrorClass -> ReadP ErrorClass
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ErrorClass
ErrClassUnknown
            ]
          ReadP ()
skipSpaces
          String String
errorDesc <- ReadP Lexeme
lex
          ReadP ()
skipSpaces
          pure (String
errorName, ErrorClass
errorClass, String
errorDesc)
        extract :: String -> Either Text ((String, ErrorClass, String), String)
        extract :: String -> Either Text ((String, ErrorClass, String), String)
extract String
i = ReadP (String, ErrorClass, String)
-> ReadS (String, ErrorClass, String)
forall a. ReadP a -> ReadS a
readP_to_S ReadP (String, ErrorClass, String)
parser String
i [((String, ErrorClass, String), String)]
-> ([((String, ErrorClass, String), String)]
    -> Either Text ((String, ErrorClass, String), String))
-> Either Text ((String, ErrorClass, String), String)
forall a b. a -> (a -> b) -> b
& \case
          [((String, ErrorClass, String)
res, String
type_)] -> ((String, ErrorClass, String), String)
-> Either Text ((String, ErrorClass, String), String)
forall a b. b -> Either a b
Right ((String, ErrorClass, String)
res, Text -> String
forall a. ToString a => a -> String
toString (Text -> String) -> (Text -> Text) -> Text -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
strip (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString String
type_)
          [((String, ErrorClass, String), String)]
_ -> Text -> Either Text ((String, ErrorClass, String), String)
forall a b. a -> Either a b
Left (Text -> Either Text ((String, ErrorClass, String), String))
-> Text -> Either Text ((String, ErrorClass, String), String)
forall a b. (a -> b) -> a -> b
$ String -> Text
errMsg String
i
      in case  String -> Either Text ((String, ErrorClass, String), String)
extract String
input of
            Right ((String
errorName, ErrorClass
errorClassVal, String
errorDesc), String
errorArg) -> do
              let errorArgType :: Q Type
errorArgType = case String
errorArg of
                    [] -> [t|NoErrorArg|]
                    String
_ -> Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
conT (Name -> Q Type) -> Name -> Q Type
forall a b. (a -> b) -> a -> b
$ String -> Name
mkName String
errorArg
              [d|
                type instance ErrorArg $(litT . strTyLit $ toString $ errorName) = $errorArgType
                instance CustomErrorHasDoc $(litT . strTyLit $ toString $ errorName) where
                  customErrClass = $(lift errorClassVal)
                  customErrDocMdCause = $(litE $ stringL $ toString $ errorDesc)
                |]
            Left Text
err -> Text -> Text -> Q [Dec]
forall (m :: * -> *) a. MonadFail m => Text -> Text -> m a
failQQ Text
qqName Text
err

-- | QuasiQuote that helps generating @TypeHasDoc@ instance.
--
-- Usage:
--
-- @
-- [typeDoc| \<type> \<description> |]
-- [typeDoc| Storage "This is storage description"  |]
-- @
--
-- See this [tutorial](https://indigo-lang.gitlab.io/contract-docs/) which
-- includes this quasiquote.
--
typeDoc :: QuasiQuoter
typeDoc :: QuasiQuoter
typeDoc = QuasiQuoter :: (String -> Q Exp)
-> (String -> Q Pat)
-> (String -> Q Type)
-> (String -> Q [Dec])
-> QuasiQuoter
QuasiQuoter
  { quoteExp :: String -> Q Exp
quoteExp  = Q Exp -> String -> Q Exp
forall a b. a -> b -> a
const (Q Exp -> String -> Q Exp) -> Q Exp -> String -> Q Exp
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Q Exp
forall (m :: * -> *) a. MonadFail m => Text -> Text -> m a
failQQType Text
qqName Text
"expression"
  , quotePat :: String -> Q Pat
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
$ Text -> Text -> Q Pat
forall (m :: * -> *) a. MonadFail m => Text -> Text -> m a
failQQType Text
qqName Text
"pattern"
  , quoteType :: String -> Q Type
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
$ Text -> Text -> Q Type
forall (m :: * -> *) a. MonadFail m => Text -> Text -> m a
failQQType Text
qqName Text
"type"
  , quoteDec :: String -> Q [Dec]
quoteDec  = String -> Q [Dec]
go
  }
  where
    qqName :: Text
qqName = Text
"typeDoc"

    go :: String -> Q [Dec]
    go :: String -> Q [Dec]
go String
input =
      case Text -> [Text]
words (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. ToText a => a -> Text
toText (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
input of
        (Text
param:[Text]
value) ->
          [d|
          instance TypeHasDoc $(conT $ mkName $ toString $ param) where
            typeDocMdDescription = $(litE $ stringL $ toString $ stripQuote $ unwords value)
          |]
        [Text]
i ->
          Text -> Text -> Q [Dec]
forall (m :: * -> *) a. MonadFail m => Text -> Text -> m a
failQQ Text
qqName (Text -> Q [Dec]) -> Text -> Q [Dec]
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
unlines
            [ Text
"Invalid arguments."
            , Text
"      Expected arguments to be in the format of:"
            , Text
"        - [" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
qqName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"| <type> <description> |]"
            , Text
"      Example:"
            , Text
"        - [" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
qqName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"| Storage \"This is storage description\" |]"
            , Text
"      But instead got: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
unwords [Text]
i
            ]

--------------------------------------------------
-- Helper
--------------------------------------------------

failQQ :: MonadFail m => Text -> Text -> m a
failQQ :: forall (m :: * -> *) a. MonadFail m => Text -> Text -> m a
failQQ Text
qq Text
errTxt =
  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
"Lorentz.Util.TH." String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a. ToString a => a -> String
toString (Text
qq Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
errTxt)

failQQType :: MonadFail m => Text -> Text -> m a
failQQType :: forall (m :: * -> *) a. MonadFail m => Text -> Text -> m a
failQQType Text
qq Text
typeTxt = Text -> Text -> m a
forall (m :: * -> *) a. MonadFail m => Text -> Text -> m a
failQQ Text
qq (Text -> m a) -> Text -> m a
forall a b. (a -> b) -> a -> b
$ Text
"This QuasiQuoter cannot be used as a " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
typeTxt

stripQuote :: Text -> Text
stripQuote :: Text -> Text
stripQuote Text
txt =
  let
    h :: Text
h = Text -> Text -> Maybe Text
stripPrefix Text
"\"" Text
txt Maybe Text -> Text -> Text
forall a. Maybe a -> a -> a
?: Text
txt
    g :: Text
g = Text -> Text -> Maybe Text
stripSuffix Text
"\"" Text
h Maybe Text -> Text -> Text
forall a. Maybe a -> a -> a
?: Text
h
  in Text
g