module Text.InterpolatedString.Perl6 (qq, qc, q, ShowQ(..)) where
import qualified Language.Haskell.TH as TH
import Language.Haskell.TH.Quote
import Language.Haskell.Meta.Parse
import Data.Char (isAlpha, isAlphaNum)
class Show a => ShowQ a where
showQ :: a -> String
instance ShowQ Char where
showQ = (:[])
instance ShowQ String where
showQ = id
instance (Show a) => ShowQ a where
showQ = show
data StringPart = Literal String | AntiQuote String deriving Show
unQC a [] = [Literal (reverse a)]
unQC a ('\\':x:xs) = unQC (x:a) xs
unQC a ('\\':[]) = unQC ('\\':a) []
unQC a ('}':xs) = AntiQuote (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
unQQ a [] = [Literal (reverse a)]
unQQ a ('\\':x:xs) = unQC (x:a) xs
unQQ a ('\\':[]) = unQC ('\\':a) []
unQQ a ('}':xs) = AntiQuote (reverse a) : parseQQ [] xs
unQQ a (x:xs) = unQC (x:a) xs
parseQQ a [] = [Literal (reverse a)]
parseQQ a ('\\':x:xs) = parseQQ (x:a) xs
parseQQ a ('\\':[]) = parseQQ ('\\':a) []
parseQQ a ('$':x:xs) | x == '_' || isAlpha x =
Literal (reverse a) : AntiQuote (x:pre) : parseQQ [] post
where
(pre, post) = span isIdent xs
parseQQ a ('{':xs) = Literal (reverse a) : unQC [] xs
parseQQ a (x:xs) = parseQQ (x:a) xs
isIdent '_' = True
isIdent '\'' = True
isIdent x = isAlphaNum x
makeExpr [] = [| "" |]
makeExpr ((Literal a):xs) = TH.appE [| (++) a |] $ makeExpr xs
makeExpr ((AntiQuote a):xs) = TH.appE [| (++) (showQ $(reify a)) |] $ makeExpr xs
reify s =
case parseExp s of
Left s -> TH.report True s >> [| "" |]
Right e -> return e
qq :: QuasiQuoter
qq = QuasiQuoter (makeExpr . parseQQ [] . filter (/= '\r'))
$ error "Cannot use qq as a pattern"
qc :: QuasiQuoter
qc = QuasiQuoter (makeExpr . parseQC [] . filter (/= '\r'))
$ error "Cannot use qc as a pattern"
q :: QuasiQuoter
q = QuasiQuoter ((\a -> [|a|]) . filter (/= '\r'))
$ error "Cannot use q as a pattern"