bricks-0.0.0.1: test/Bricks/Test/QQ.hs

{-# LANGUAGE OverloadedStrings #-}

module Bricks.Test.QQ
  ( text
  ) where

-- Base
import Control.Arrow ((>>>))
import Data.Function (const)

-- Template Haskell
import Language.Haskell.TH
import Language.Haskell.TH.Quote

-- Text
import qualified Data.Text as Text

text :: QuasiQuoter
text =
  QuasiQuoter
    { quoteExp  = pure . LitE . StringL . stripMargin
    , quotePat  = err
    , quoteType = err
    , quoteDec  = err
    }
  where
    err = const . fail $ "illegal text QuasiQuote (allowed as expression only)"

stripMargin :: String -> String
stripMargin =
  Text.pack
  >>> Text.splitOn "\n"
  >>> fmap (\x ->
        let (a, b) = Text.breakOn "|" x
        in  if Text.all (== ' ') a && not (Text.null b)
            then Text.drop 1 b
            else x)
  >>> Text.intercalate "\n"
  >>> Text.unpack