string sh-like interpolation based on audrey tang previous work

gistfile1.hs

{-# LANGUAGE TemplateHaskell, TypeSynonymInstances, FlexibleInstances #-}

module Text.InterpolatedString.Interp (qc, q) where

import qualified Language.Haskell.TH as TH
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C8
import Language.Haskell.TH.Quote

data StringPart = Literal String | Binding String deriving Show

class ShowQ a where
    showQ :: a -> String

instance ShowQ B.ByteString where
    showQ = C8.unpack

instance ShowQ String where
    showQ = id

instance ShowQ Integer where
    showQ = show


unQC a []          = [Literal (reverse a)]
unQC a ('\\':x:xs) = unQC (x:a) xs
unQC a ('\\':[])   = unQC ('\\':a) []
unQC a ('}':xs)    = Binding (reverse a) : parseQC [] xs
unQC a (x:xs)      = unQC (x:a) xs

parseQC a []           = [Literal (reverse a)]
parseQC a ('\\':x:xs)  = parseQC (x:a) xs
parseQC a ('\\':[])    = parseQC ('\\':a) []
parseQC a ('$':'{':xs) = Literal (reverse a) : unQC [] xs
parseQC a (x:xs)       = parseQC (x:a) xs

makeExpr [] = [| "" |]
makeExpr ((Literal a):xs)   = TH.appE [| (++) a |] $ makeExpr xs
makeExpr ((Binding a):xs)   = TH.appE [| (++) (showQ $ $(TH.varE $ TH.mkName a)) |] $ makeExpr xs

-- | QuasiQuoter for interpolating '${expr}' into a string literal.
qc :: QuasiQuoter
qc = QuasiQuoter (makeExpr . parseQC [])
                 (error "Cannot use qc as a pattern")
                 (error "Cannot use qc as a type")
                 (error "Cannot use qc as a dec")

-- | QuasiQuoter for a non-interpolating string literal.
q :: QuasiQuoter
q = QuasiQuoter ((\a -> [|a|]))
                 (error "Cannot use q as a pattern")
                 (error "Cannot use q as a type")
                 (error "Cannot use q as a dec")