Как я могу написать шаблон квази-квотер в Haskell?

Question

Я использую квази-кавычки для создания своих умно построенных типов данных во время компиляции. Это выглядит примерно так:

import qualified Data.Text as T
import Language.Haskell.TH.Quote (QuasiQuoter(..))
import Language.Haskell.TH (Q, Exp, Pat(..), Lit(..))
import Language.Haskell.TH.Syntax (Lift(..))
import qualified Language.Haskell.TH.Syntax as TH
import Instances.TH.Lift () -- th-lift-instances package

newtype NonEmptyText = NonEmptyText Text

textIsWhitespace :: Text -> Bool
textIsWhitespace = T.all (== ' ')

mkNonEmptyText :: Text -> Maybe NonEmptyText
mkNonEmptyText t = if textIsWhitespace t then Nothing else (Just (NonEmptyText t))

compileNonEmptyText :: QuasiQuoter
compileNonEmptyText = QuasiQuoter
  { quoteExp = compileNonEmptyText'
  , quotePat = error "NonEmptyText is not supported as a pattern"
  , quoteDec = error "NonEmptyText is not supported at top-level"
  , quoteType = error "NonEmptyText is not supported as a type"
  }
  where
    compileNonEmptyText' :: String -> Q Exp
    compileNonEmptyText' s = case mkNonEmptyText (pack s) of
      Nothing -> fail $ "Invalid NonEmptyText: " ++ s
      Just txt -> [| txt |]

(При необходимости я могу предоставить автономный рабочий пример - я только что вытащил этот пример из большой кодовой базы)

По сути, просто выводя Lift для моих новых типов я могу поместить тип данных в выражение квази-кавычка [| txt |] реализовать quoteExp,

Но у меня проблемы с quotePat, Если я сделаю, например:

Just txt -> [p| txt |]

Затем я получаю предупреждение о том, что первый текст не используется, а второй скрывает первый. Я уверен, что этот шаблон просто создает новое имя txt а не сращивание в объеме txt как выражение квазиквотер сделал, так как когда я делаю:

f :: NonEmptyText -> Bool
f [compileNonEmptyText|test|] = True
f _ = False

все соответствует первому утверждению.

Answer 1

Хорошо, я думаю, что у меня это есть. Начиная с базовой строки sЯ могу обернуть это в StringL а также LitP чтобы получить буквальную строку, которая из-за Text"s IsString экземпляр станет Text, Оттуда мне нужно применить NonEmptyText конструктор, использующий ConP:

compileNonEmptyTextPattern' :: String -> Q TH.Pat
compileNonEmptyTextPattern' s = case mkNonEmptyText (pack s) of
  Nothing -> fail $ "Invalid NonEmptyText: " ++ s
  Just (NonEmptyText txt) -> pure $ ConP 'NonEmptyText [(LitP (StringL (T.unpack txt)))]

К сожалению, это гораздо более многословно, чем версия выражения! Интересно, может ли быть класс типов для Q Pat лайк Lift для Q Exp?