whitespace cleaning quasiquoter

QQ.hs

-- This is a modification of raw-strings-qq with whitespace cleanup features.

{- | Raw string literals, implemented using Template Haskell's quasiquotation
feature.
-}
module Util.QQ (
  w,
)
where

import Data.List.Extra
import Language.Haskell.TH
import Language.Haskell.TH.Quote
import Prelude

{-

A quasiquoter that cleans up whitespace and common indent.  Example:

x = [w|

        for(i=0;i<10;i++) {
          printf("Hello, world!\n");
        }

 |]

...gives...

x = "for(i=0;i<10;i++) {\n" <>
    "  printf(\"Hello, world!\\n\");\n" <>
    "}\n"

-}
w :: QuasiQuoter
w =
  QuasiQuoter
    { quoteExp = return . LitE . StringL . whiteSpaceSanitize
    , quotePat = \_ ->
        fail
          "illegal raw string QuasiQuote \
          \(allowed as expression only, used as a pattern)"
    , quoteType = \_ ->
        fail
          "illegal raw string QuasiQuote \
          \(allowed as expression only, used as a type)"
    , quoteDec = \_ ->
        fail
          "illegal raw string QuasiQuote \
          \(allowed as expression only, used as a declaration)"
    }

whiteSpaceSanitize :: String -> String
whiteSpaceSanitize s =
  let
    -- normalize newlines, remove trailing whitespace, remove leading and trailing empty lines
    ls = (dropWhile null . dropWhileEnd null) (trimEnd <$> lines (normaliseNewlines s))

    minIndent =
      ( minimum
          . map (length . takeWhile (== ' ')) -- count leading spaces
          . filter (not . null) -- ignore empty lines
      )
        ls
   in
    unlines (drop minIndent <$> ls)

normaliseNewlines :: String -> String
normaliseNewlines [] = []
normaliseNewlines ('\r' : '\n' : cs) = '\n' : normaliseNewlines cs
normaliseNewlines (c : cs) = c : normaliseNewlines cs