{-# LANGUAGE TemplateHaskell, TypeSynonymInstances, FlexibleInstances, UndecidableInstances, MultiParamTypeClasses #-} -- | QuasiQuoter for interpolated strings using Perl 6 syntax. -- -- The 'q' form does one thing and does it well: It contains a multi-line string with -- no interpolation at all: -- -- @ -- {-\# LANGUAGE QuasiQuotes, ExtendedDefaultRules #-} -- import Text.InterpolatedString.QQ2 (q) -- foo :: String -- 'Text', 'ByteString' etc also works -- foo = [q| -- -- Well here is a -- multi-line string! -- -- |] -- @ -- -- Any instance of the 'IsString' class is permitted. -- -- The 'qc' form interpolates curly braces: expressions inside #{} will be -- directly interpolated if it's a 'Char', 'String', 'Text' or 'ByteString', or -- it will have 'show' called if it is not. -- -- Escaping of '{' is done with backslash. -- -- For interpolating numeric expressions without an explicit type signature, -- use the ExtendedDefaultRules lanuage pragma, as shown below: -- -- @ -- {-\# LANGUAGE QuasiQuotes, ExtendedDefaultRules #-} -- import Text.InterpolatedString.QQ2 (qc) -- bar :: String -- bar = [qc| Well #{\"hello\" ++ \" there\"} #{6 * 7} |] -- @ -- -- bar will have the value \" Well hello there 42 \". -- -- If you want control over how 'show' works on your types, define a custom -- 'ShowQ' instance: -- -- For example, this instance allows you to display interpolated lists of strings as -- a sequence of words, removing those pesky brackets, quotes, and escape sequences. -- -- @ -- {-\# LANGUAGE FlexibleInstances #-} -- import Text.InterpolatedString.QQ2 (qc, ShowQ(..)) -- instance ShowQ [String] where -- showQ = unwords -- @ -- -- 'qc' permits output to any types with both 'IsString' and 'Monoid' -- instances. -- -- @ -- {-# LANGUAGE QuasiQuotes, OverloadedStrings #-} -- import Text.InterpolatedString.QQ2 (qc) -- import Data.Text (Text) -- import Data.ByteString.Char8 (ByteString) -- qux :: ByteString -- qux = [qc| This will convert #{\"Text\" :: Text} to #{\"ByteString\" :: ByteString} |] -- @ module Text.InterpolatedString.QQ2 (qc, q, ShowQ(..)) where import Data.ByteString.Char8 as Strict (ByteString, unpack) import Data.ByteString.Lazy.Char8 as Lazy (ByteString, unpack) import Data.Monoid (Monoid(..)) import Data.Text as T (Text, unpack) import Data.Text.Lazy as LazyT(Text, unpack) import GHC.Exts (IsString(..)) import Language.Haskell.Meta.Parse import qualified Language.Haskell.TH as TH import Language.Haskell.TH.Quote -- |A class for types that use special interpolation rules. -- Instances of 'ShowQ' that are also instances of 'IsString' should obey the -- following law: -- -- @ -- fromString (showQ s) == s -- @ -- -- because this library relies on this fact to optimize -- away needless string conversions. class ShowQ a where showQ :: a -> String instance ShowQ Char where showQ = (:[]) instance ShowQ String where showQ = id instance ShowQ Strict.ByteString where showQ = Strict.unpack instance ShowQ Lazy.ByteString where showQ = Lazy.unpack instance ShowQ T.Text where showQ = T.unpack instance ShowQ LazyT.Text where showQ = LazyT.unpack instance {-# OVERLAPPABLE #-} Show a => ShowQ a where showQ = show -- todo: this should really be rewritten into RULES pragmas, but so far -- I can't convince GHC to let the rules fire. class QQ a string where toQQ :: a -> string instance {-# INCOHERENT #-} IsString s => QQ s s where toQQ = id instance {-# INCOHERENT #-} (ShowQ a, IsString s) => QQ a s where toQQ = fromString . showQ data StringPart = Literal String | AntiQuote String deriving Show unQC :: [Char] -> [Char] -> [StringPart] 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 :: [Char] -> [Char] -> [StringPart] parseQC a [] = [Literal (reverse a)] parseQC a ('\\':'\\':xs) = parseQC ('\\':a) xs parseQC a ('\\':'#':xs) = parseQC ('#':a) xs parseQC a ('\\':[]) = parseQC ('\\':a) [] parseQC a ('#':'{':xs) = Literal (reverse a) : unQC [] xs parseQC a (x:xs) = parseQC (x:a) xs makeExpr :: [StringPart] -> TH.Q TH.Exp makeExpr [] = [| mempty |] makeExpr ((Literal a):xs) = TH.appE [| mappend (fromString a) |] $ makeExpr xs makeExpr ((AntiQuote a):xs) = TH.appE [| mappend (toQQ $(reify a)) |] $ makeExpr xs reify :: String -> TH.Q TH.Exp reify s = case parseExp s of Left s' -> TH.reportError s' >> [| mempty |] Right e -> return e -- | QuasiQuoter for interpolating '{expr}' into a string literal. The pattern portion is undefined. qc :: QuasiQuoter qc = QuasiQuoter (makeExpr . parseQC [] . filter (/= '\r')) (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. The pattern portion is undefined. q :: QuasiQuoter q = QuasiQuoter ((\a -> [|fromString a|]) . filter (/= '\r')) (error "Cannot use q as a pattern") (error "Cannot use q as a type") (error "Cannot use q as a dec")