├── Setup.hs ├── tests ├── TestRewrite.hs └── Test.hs ├── interpolatedstring-perl6.cabal ├── README ├── LICENSE └── src └── Text └── InterpolatedString └── Perl6.hs /Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | import System.Cmd(system) 3 | 4 | main = defaultMainWithHooks $ simpleUserHooks { testHook = runElfTests } 5 | 6 | runElfTests _ _ _ _ _ = system "runhaskell -i./src ./tests/Test.hs" >> return () 7 | 8 | -------------------------------------------------------------------------------- /tests/TestRewrite.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings, QuasiQuotes #-} 2 | module Main where 3 | import Text.InterpolatedString.Perl6 4 | import Test.HUnit 5 | import Data.ByteString.Char8 as BS(ByteString, pack) 6 | import Data.Text as T(Text, pack) 7 | 8 | 9 | -- the primary purpose of these tests is to ensure that 10 | -- the Text and ByteString rewrite rules are firing, to avoid 11 | -- needlessly converting string types 12 | testByteString = assertBool "" $ [$qc|{"a" :: ByteString} {"b" :: ByteString}|] 13 | == BS.pack ("a b") 14 | testText = assertBool "" $ [$qc|{"a" :: Text} {"b" :: Text}|] 15 | == T.pack ("a b") 16 | 17 | tests = TestList [TestLabel "ByteString Test" $ TestCase testByteString 18 | ,TestLabel "Text Test" $ TestCase testText 19 | ] 20 | 21 | main = runTestTT tests -------------------------------------------------------------------------------- /interpolatedstring-perl6.cabal: -------------------------------------------------------------------------------- 1 | Name: interpolatedstring-perl6 2 | Version: 1.0.1 3 | License: PublicDomain 4 | License-file: LICENSE 5 | Category: Data 6 | Author: Audrey Tang 7 | Copyright: Audrey Tang 8 | Maintainer: Audrey Tang 9 | Stability: stable 10 | Cabal-Version: >= 1.10 11 | Build-Type: Custom 12 | Synopsis: QuasiQuoter for Perl6-style multi-line interpolated strings 13 | Description: QuasiQuoter for Perl6-style multi-line interpolated strings with \"q\", \"qq\" and \"qc\" support. 14 | Data-Files: tests/Test.hs 15 | 16 | Source-Repository head 17 | type: git 18 | location: git://github.com/audreyt/interpolatedstring-perl6.git 19 | 20 | library 21 | default-extensions: TemplateHaskell, TypeSynonymInstances, FlexibleInstances, UndecidableInstances, OverlappingInstances 22 | default-language: Haskell2010 23 | build-depends: base > 4 && < 5, template-haskell >= 2.5, haskell-src-meta >= 0.3, text, bytestring 24 | hs-source-dirs: src 25 | exposed-modules: Text.InterpolatedString.Perl6 26 | 27 | custom-setup 28 | setup-depends: 29 | base >= 4 && < 5, 30 | Cabal >= 1.10, 31 | process 32 | -------------------------------------------------------------------------------- /tests/Test.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE QuasiQuotes, ExtendedDefaultRules #-} 2 | 3 | module Main where 4 | 5 | import Text.InterpolatedString.Perl6 6 | import Test.HUnit 7 | import GHC.Exts(fromString) 8 | import Data.ByteString.Char8 as BS(ByteString, pack) 9 | import Data.Text as T(Text, pack) 10 | 11 | data Foo = Foo Int String deriving Show 12 | 13 | t1 = "字元" 14 | 15 | testEmpty = assertBool "" ([$qc||] == "") 16 | testCharLiteral = assertBool "" ([$qc|{1+2}|] == "3") 17 | testString = assertBool "" ([$qc|a string {t1} is here|] == "a string 字元 is here") 18 | testVariable = assertBool "" ([$qq|a string {t1} $t1 {t1} $t1 is here|] == "a string 字元 字元 字元 字元 is here") 19 | testEscape = assertBool "" ([$qc|#\{}|] == "#{}" && [$qc|\{}|] == "{}") 20 | testComplex = assertBool "" ([$qc| 21 | \ok 22 | {Foo 4 "Great!" : [Foo 3 "Scott!"]} 23 | then 24 | |] == ("\n" ++ 25 | " \\ok\n" ++ 26 | "[Foo 4 \"Great!\",Foo 3 \"Scott!\"]\n" ++ 27 | " then\n")) 28 | testConvert = assertBool "" 29 | (([$qc|{fromString "a"::Text} {fromString "b"::ByteString}|] :: String) 30 | == "a b") 31 | 32 | tests = TestList 33 | [ TestLabel "Empty String" $ TestCase testEmpty 34 | , TestLabel "Character Literal" $ TestCase testCharLiteral 35 | , TestLabel "String Variable" $ TestCase testString 36 | , TestLabel "Dollar Variable" $ TestCase testVariable 37 | , TestLabel "Escape Sequences" $ TestCase testEscape 38 | , TestLabel "Complex Expression" $ TestCase testComplex 39 | , TestLabel "String Conversion" $ TestCase testConvert 40 | ] 41 | 42 | main = runTestTT tests 43 | 44 | -------------------------------------------------------------------------------- /README: -------------------------------------------------------------------------------- 1 | Text.InterpolatedString.Perl6 2 | 3 | QuasiQuoter for Perl6-style multi-line interpolated strings with "q", "qq" and "qc" support. 4 | 5 | Description 6 | 7 | QuasiQuoter for interpolated strings using Perl 6 syntax. 8 | 9 | The q form does one thing and does it well: It contains a multi-line string with 10 | no interpolation at all: 11 | 12 | {-# LANGUAGE QuasiQuotes, ExtendedDefaultRules #-} 13 | import Text.InterpolatedString.Perl6 (q) 14 | foo :: String -- Text, ByteString etc also works 15 | foo = [q| 16 | 17 | Well here is a 18 | multi-line string! 19 | 20 | |] 21 | 22 | Any instance of the IsString class is permitted. 23 | 24 | The qc form interpolates curly braces: expressions inside {} will be 25 | directly interpolated if it's a Char, String, Text or ByteString, or 26 | it will have show called if it is not. 27 | 28 | Escaping of '{' is done with backslash. 29 | 30 | For interpolating numeric expressions without an explicit type signature, 31 | use the ExtendedDefaultRules lanuage pragma, as shown below: 32 | 33 | {-# LANGUAGE QuasiQuotes, ExtendedDefaultRules #-} 34 | import Text.InterpolatedString.Perl6 (qc) 35 | bar :: String 36 | bar = [qc| Well {"hello" ++ " there"} {6 * 7} |] 37 | 38 | bar will have the value " Well hello there 42 ". 39 | 40 | If you want control over how show works on your types, define a custom 41 | ShowQ instance: 42 | 43 | For example, this instance allows you to display interpolated lists of strings as 44 | a sequence of words, removing those pesky brackets, quotes, and escape sequences. 45 | 46 | {-# LANGUAGE FlexibleInstances #-} 47 | import Text.InterpolatedString.Perl6 (qc, ShowQ(..)) 48 | instance ShowQ [String] where 49 | showQ = unwords 50 | 51 | The qq form adds to the qc form with a simple shorthand: '$foo' means '{foo}', 52 | namely interpolating a single variable into the string. 53 | 54 | {-# LANGUAGE QuasiQuotes, ExtendedDefaultRules #-} 55 | import Text.InterpolatedString.Perl6 (qq) 56 | baz :: String 57 | baz = [qc| Hello, $who |] 58 | where 59 | who = "World" 60 | 61 | Both qc and qq permit output to any types with both IsString and Monoid 62 | instances. 63 | 64 | {-# LANGUAGE QuasiQuotes, OverloadedStrings #-} 65 | import Text.InterpolatedString.Perl6 (qc) 66 | import Data.Text (Text) 67 | import Data.ByteString.Char8 (ByteString) 68 | qux :: ByteString 69 | qux = [qc| This will convert {"Text" :: Text} to {"ByteString" :: ByteString} |] 70 | 71 | The ability to define custom ShowQ instances is particularly powerful with 72 | cascading instances using qq. 73 | 74 | Below is a sample snippet from a script that converts Shape objects into 75 | AppleScript suitable for drawing in OmniGraffle: 76 | 77 | {-# LANGUAGE QuasiQuotes, ExtendedDefaultRules, NamedFieldPuns, RecordWildCards #-} 78 | import Text.InterpolatedString.Perl6 79 | 80 | 81 | data Shape = Shape 82 | { originX :: Int 83 | , originY :: Int 84 | , width :: Int 85 | , height :: Int 86 | , stroke :: Stroke 87 | , text :: Text 88 | } 89 | instance ShowQ Shape where 90 | showQ Shape{..} = [qq| 91 | make new shape at end of graphics with properties 92 | \{ $text, $stroke, $_size, $_origin } 93 | |] 94 | where 95 | _size = [qq|size: \{$width, $height}|] 96 | _origin = [qq|origin: \{$originX, $originY}|] 97 | 98 | data Stroke = StrokeWhite | StrokeNone 99 | instance ShowQ Stroke where 100 | showQ StrokeNone = "draws stroke:false" 101 | showQ StrokeWhite = "stroke color: {1, 1, 1}" 102 | 103 | data Text = Text 104 | { txt :: String 105 | , color :: Color 106 | } 107 | instance ShowQ Text where 108 | showQ Text{..} = [qq|text: \{ text: "$txt", $color, alignment: center } |] 109 | 110 | data Color = Color { red :: Float, green :: Float, blue :: Float } 111 | instance ShowQ Color where 112 | showQ Color{..} = [qq|color: {$red, $green, $blue}|] 113 | 114 | main :: IO () 115 | main = putStrLn [qq| 116 | tell application "OmniGraffle Professional 5" 117 | tell canvas of front window 118 | { makeShape ... } 119 | end tell 120 | end tell 121 | |] 122 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | CC0 1.0 Universal 2 | 3 | Statement of Purpose 4 | 5 | The laws of most jurisdictions throughout the world automatically confer 6 | exclusive Copyright and Related Rights (defined below) upon the creator and 7 | subsequent owner(s) (each and all, an "owner") of an original work of 8 | authorship and/or a database (each, a "Work"). 9 | 10 | Certain owners wish to permanently relinquish those rights to a Work for the 11 | purpose of contributing to a commons of creative, cultural and scientific 12 | works ("Commons") that the public can reliably and without fear of later 13 | claims of infringement build upon, modify, incorporate in other works, reuse 14 | and redistribute as freely as possible in any form whatsoever and for any 15 | purposes, including without limitation commercial purposes. These owners may 16 | contribute to the Commons to promote the ideal of a free culture and the 17 | further production of creative, cultural and scientific works, or to gain 18 | reputation or greater distribution for their Work in part through the use and 19 | efforts of others. 20 | 21 | For these and/or other purposes and motivations, and without any expectation 22 | of additional consideration or compensation, the person associating CC0 with a 23 | Work (the "Affirmer"), to the extent that he or she is an owner of Copyright 24 | and Related Rights in the Work, voluntarily elects to apply CC0 to the Work 25 | and publicly distribute the Work under its terms, with knowledge of his or her 26 | Copyright and Related Rights in the Work and the meaning and intended legal 27 | effect of CC0 on those rights. 28 | 29 | 1. Copyright and Related Rights. A Work made available under CC0 may be 30 | protected by copyright and related or neighboring rights ("Copyright and 31 | Related Rights"). Copyright and Related Rights include, but are not limited 32 | to, the following: 33 | 34 | i. the right to reproduce, adapt, distribute, perform, display, communicate, 35 | and translate a Work; 36 | 37 | ii. moral rights retained by the original author(s) and/or performer(s); 38 | 39 | iii. publicity and privacy rights pertaining to a person's image or likeness 40 | depicted in a Work; 41 | 42 | iv. rights protecting against unfair competition in regards to a Work, 43 | subject to the limitations in paragraph 4(a), below; 44 | 45 | v. rights protecting the extraction, dissemination, use and reuse of data in 46 | a Work; 47 | 48 | vi. database rights (such as those arising under Directive 96/9/EC of the 49 | European Parliament and of the Council of 11 March 1996 on the legal 50 | protection of databases, and under any national implementation thereof, 51 | including any amended or successor version of such directive); and 52 | 53 | vii. other similar, equivalent or corresponding rights throughout the world 54 | based on applicable law or treaty, and any national implementations thereof. 55 | 56 | 2. Waiver. To the greatest extent permitted by, but not in contravention of, 57 | applicable law, Affirmer hereby overtly, fully, permanently, irrevocably and 58 | unconditionally waives, abandons, and surrenders all of Affirmer's Copyright 59 | and Related Rights and associated claims and causes of action, whether now 60 | known or unknown (including existing as well as future claims and causes of 61 | action), in the Work (i) in all territories worldwide, (ii) for the maximum 62 | duration provided by applicable law or treaty (including future time 63 | extensions), (iii) in any current or future medium and for any number of 64 | copies, and (iv) for any purpose whatsoever, including without limitation 65 | commercial, advertising or promotional purposes (the "Waiver"). Affirmer makes 66 | the Waiver for the benefit of each member of the public at large and to the 67 | detriment of Affirmer's heirs and successors, fully intending that such Waiver 68 | shall not be subject to revocation, rescission, cancellation, termination, or 69 | any other legal or equitable action to disrupt the quiet enjoyment of the Work 70 | by the public as contemplated by Affirmer's express Statement of Purpose. 71 | 72 | 3. Public License Fallback. Should any part of the Waiver for any reason be 73 | judged legally invalid or ineffective under applicable law, then the Waiver 74 | shall be preserved to the maximum extent permitted taking into account 75 | Affirmer's express Statement of Purpose. In addition, to the extent the Waiver 76 | is so judged Affirmer hereby grants to each affected person a royalty-free, 77 | non transferable, non sublicensable, non exclusive, irrevocable and 78 | unconditional license to exercise Affirmer's Copyright and Related Rights in 79 | the Work (i) in all territories worldwide, (ii) for the maximum duration 80 | provided by applicable law or treaty (including future time extensions), (iii) 81 | in any current or future medium and for any number of copies, and (iv) for any 82 | purpose whatsoever, including without limitation commercial, advertising or 83 | promotional purposes (the "License"). The License shall be deemed effective as 84 | of the date CC0 was applied by Affirmer to the Work. Should any part of the 85 | License for any reason be judged legally invalid or ineffective under 86 | applicable law, such partial invalidity or ineffectiveness shall not 87 | invalidate the remainder of the License, and in such case Affirmer hereby 88 | affirms that he or she will not (i) exercise any of his or her remaining 89 | Copyright and Related Rights in the Work or (ii) assert any associated claims 90 | and causes of action with respect to the Work, in either case contrary to 91 | Affirmer's express Statement of Purpose. 92 | 93 | 4. Limitations and Disclaimers. 94 | 95 | a. No trademark or patent rights held by Affirmer are waived, abandoned, 96 | surrendered, licensed or otherwise affected by this document. 97 | 98 | b. Affirmer offers the Work as-is and makes no representations or warranties 99 | of any kind concerning the Work, express, implied, statutory or otherwise, 100 | including without limitation warranties of title, merchantability, fitness 101 | for a particular purpose, non infringement, or the absence of latent or 102 | other defects, accuracy, or the present or absence of errors, whether or not 103 | discoverable, all to the greatest extent permissible under applicable law. 104 | 105 | c. Affirmer disclaims responsibility for clearing rights of other persons 106 | that may apply to the Work or any use thereof, including without limitation 107 | any person's Copyright and Related Rights in the Work. Further, Affirmer 108 | disclaims responsibility for obtaining any necessary consents, permissions 109 | or other rights required for any use of the Work. 110 | 111 | d. Affirmer understands and acknowledges that Creative Commons is not a 112 | party to this document and has no duty or obligation with respect to this 113 | CC0 or use of the Work. 114 | 115 | For more information, please see 116 | 117 | 118 | -------------------------------------------------------------------------------- /src/Text/InterpolatedString/Perl6.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TemplateHaskell, TypeSynonymInstances, FlexibleInstances, 2 | UndecidableInstances, OverlappingInstances, MultiParamTypeClasses, 3 | IncoherentInstances 4 | #-} 5 | 6 | -- | QuasiQuoter for interpolated strings using Perl 6 syntax. 7 | -- 8 | -- The 'q' form does one thing and does it well: It contains a multi-line string with 9 | -- no interpolation at all: 10 | -- 11 | -- @ 12 | -- {-\# LANGUAGE QuasiQuotes, ExtendedDefaultRules #-} 13 | -- import Text.InterpolatedString.Perl6 (q) 14 | -- foo :: String -- 'Text', 'ByteString' etc also works 15 | -- foo = [q| 16 | -- 17 | -- Well here is a 18 | -- multi-line string! 19 | -- 20 | -- |] 21 | -- @ 22 | -- 23 | -- Any instance of the 'IsString' class is permitted. 24 | -- 25 | -- The 'qc' form interpolates curly braces: expressions inside {} will be 26 | -- directly interpolated if it's a 'Char', 'String', 'Text' or 'ByteString', or 27 | -- it will have 'show' called if it is not. 28 | -- 29 | -- Escaping of '{' is done with backslash. 30 | -- 31 | -- For interpolating numeric expressions without an explicit type signature, 32 | -- use the ExtendedDefaultRules lanuage pragma, as shown below: 33 | -- 34 | -- @ 35 | -- {-\# LANGUAGE QuasiQuotes, ExtendedDefaultRules #-} 36 | -- import Text.InterpolatedString.Perl6 (qc) 37 | -- bar :: String 38 | -- bar = [qc| Well {\"hello\" ++ \" there\"} {6 * 7} |] 39 | -- @ 40 | -- 41 | -- bar will have the value \" Well hello there 42 \". 42 | -- 43 | -- If you want control over how 'show' works on your types, define a custom 44 | -- 'ShowQ' instance: 45 | -- 46 | -- For example, this instance allows you to display interpolated lists of strings as 47 | -- a sequence of words, removing those pesky brackets, quotes, and escape sequences. 48 | -- 49 | -- @ 50 | -- {-\# LANGUAGE FlexibleInstances #-} 51 | -- import Text.InterpolatedString.Perl6 (qc, ShowQ(..)) 52 | -- instance ShowQ [String] where 53 | -- showQ = unwords 54 | -- @ 55 | -- 56 | -- The 'qq' form adds to the 'qc' form with a simple shorthand: '$foo' means '{foo}', 57 | -- namely interpolating a single variable into the string. 58 | -- 59 | -- @ 60 | -- {-\# LANGUAGE QuasiQuotes, ExtendedDefaultRules #-} 61 | -- import Text.InterpolatedString.Perl6 (qq) 62 | -- baz :: String 63 | -- baz = [qq| Hello, $who |] 64 | -- where 65 | -- who = \"World\" 66 | -- @ 67 | -- 68 | -- Both 'qc' and 'qq' permit output to any types with both 'IsString' and 'Monoid' 69 | -- instances. 70 | -- 71 | -- @ 72 | -- {-# LANGUAGE QuasiQuotes, OverloadedStrings #-} 73 | -- import Text.InterpolatedString.Perl6 (qc) 74 | -- import Data.Text (Text) 75 | -- import Data.ByteString.Char8 (ByteString) 76 | -- qux :: ByteString 77 | -- qux = [qc| This will convert {\"Text\" :: Text} to {\"ByteString\" :: ByteString} |] 78 | -- @ 79 | -- 80 | -- The ability to define custom 'ShowQ' instances is particularly powerful with 81 | -- cascading instances using 'qq'. 82 | -- 83 | -- Below is a sample snippet from a script that converts Shape objects into 84 | -- AppleScript suitable for drawing in OmniGraffle: 85 | -- 86 | -- @ 87 | -- {-\# LANGUAGE QuasiQuotes, ExtendedDefaultRules, NamedFieldPuns, RecordWildCards #-} 88 | -- import Text.InterpolatedString.Perl6 89 | -- @ 90 | -- 91 | -- @ 92 | -- data Shape = Shape 93 | -- { originX :: Int 94 | -- , originY :: Int 95 | -- , width :: Int 96 | -- , height :: Int 97 | -- , stroke :: Stroke 98 | -- , text :: Text 99 | -- } 100 | -- instance ShowQ Shape where 101 | -- showQ Shape{..} = [qq| 102 | -- make new shape at end of graphics with properties 103 | -- \\{ $text, $stroke, _size, $_origin } 104 | -- |] 105 | -- where 106 | -- _size = [qq|size: \{$width, $height}|] 107 | -- _origin = [qq|origin: \{$originX, $originY}|] 108 | -- @ 109 | -- 110 | -- @ 111 | -- data Stroke = StrokeWhite | StrokeNone 112 | -- instance ShowQ Stroke where 113 | -- showQ StrokeNone = \"draws stroke:false\" 114 | -- showQ StrokeWhite = \"stroke color: {1, 1, 1}\" 115 | -- @ 116 | -- 117 | -- @ 118 | -- data Text = Text 119 | -- { txt :: String 120 | -- , color :: Color 121 | -- } 122 | -- instance ShowQ Text where 123 | -- showQ Text{..} = [qq|text: \\{ text: \"$txt\", $color, alignment: center } |] 124 | -- @ 125 | -- 126 | -- @ 127 | -- data Color = Color { red :: Float, green :: Float, blue :: Float } 128 | -- instance ShowQ Color where 129 | -- showQ Color{..} = [qq|color: \{$red, $green, $blue}|] 130 | -- @ 131 | -- 132 | -- @ 133 | -- main :: IO () 134 | -- main = putStrLn [qq| 135 | -- tell application \"OmniGraffle Professional 5\" 136 | -- tell canvas of front window 137 | -- { makeShape ... } 138 | -- end tell 139 | -- end tell 140 | -- |] 141 | -- @ 142 | -- 143 | 144 | module Text.InterpolatedString.Perl6 (qq, qc, q, ShowQ(..)) where 145 | 146 | import qualified Language.Haskell.TH as TH 147 | import Language.Haskell.TH.Quote 148 | import Language.Haskell.Meta.Parse 149 | import GHC.Exts (IsString(..)) 150 | import Data.Monoid (Monoid(..)) 151 | import Data.ByteString.Char8 as Strict (ByteString, unpack) 152 | import Data.ByteString.Lazy.Char8 as Lazy (ByteString, unpack) 153 | import Data.Text as T (Text, unpack) 154 | import Data.Text.Lazy as LazyT(Text, unpack) 155 | import Data.Char (isAlpha, isAlphaNum) 156 | 157 | -- |A class for types that use special interpolation rules. 158 | -- Instances of 'ShowQ' that are also instances of 'IsString' should obey the 159 | -- following law: 160 | -- 161 | -- @ 162 | -- fromString (showQ s) == s 163 | -- @ 164 | -- 165 | -- because this library relies on this fact to optimize 166 | -- away needless string conversions. 167 | class ShowQ a where 168 | showQ :: a -> String 169 | 170 | instance ShowQ Char where 171 | showQ = (:[]) 172 | 173 | instance ShowQ String where 174 | showQ = id 175 | 176 | instance ShowQ Strict.ByteString where 177 | showQ = Strict.unpack 178 | 179 | instance ShowQ Lazy.ByteString where 180 | showQ = Lazy.unpack 181 | 182 | instance ShowQ T.Text where 183 | showQ = T.unpack 184 | 185 | instance ShowQ LazyT.Text where 186 | showQ = LazyT.unpack 187 | 188 | instance Show a => ShowQ a where 189 | showQ = show 190 | 191 | -- todo: this should really be rewritten into RULES pragmas, but so far 192 | -- I can't convince GHC to let the rules fire. 193 | class QQ a string where 194 | toQQ :: a -> string 195 | 196 | instance IsString s => QQ s s where 197 | toQQ = id 198 | 199 | instance (ShowQ a, IsString s) => QQ a s where 200 | toQQ = fromString . showQ 201 | 202 | data StringPart = Literal String | AntiQuote String deriving Show 203 | 204 | unQC a [] = [Literal (reverse a)] 205 | unQC a ('\\':x:xs) = unQC (x:a) xs 206 | unQC a ('\\':[]) = unQC ('\\':a) [] 207 | unQC a ('}':xs) = AntiQuote (reverse a) : parseQC [] xs 208 | unQC a (x:xs) = unQC (x:a) xs 209 | 210 | parseQC a [] = [Literal (reverse a)] 211 | parseQC a ('\\':'\\':xs) = parseQC ('\\':a) xs 212 | parseQC a ('\\':'{':xs) = parseQC ('{':a) xs 213 | parseQC a ('\\':[]) = parseQC ('\\':a) [] 214 | parseQC a ('{':xs) = Literal (reverse a) : unQC [] xs 215 | parseQC a (x:xs) = parseQC (x:a) xs 216 | 217 | unQQ a [] = [Literal (reverse a)] 218 | unQQ a ('\\':x:xs) = unQQ (x:a) xs 219 | unQQ a ('\\':[]) = unQQ ('\\':a) [] 220 | unQQ a ('}':xs) = AntiQuote (reverse a) : parseQQ [] xs 221 | unQQ a (x:xs) = unQQ (x:a) xs 222 | 223 | parseQQ a [] = [Literal (reverse a)] 224 | parseQQ a ('\\':x:xs) = parseQQ (x:a) xs 225 | parseQQ a ('\\':[]) = parseQQ ('\\':a) [] 226 | parseQQ a ('$':x:xs) | x == '_' || isAlpha x = 227 | Literal (reverse a) : AntiQuote (x:pre) : parseQQ [] post 228 | where 229 | (pre, post) = span isIdent xs 230 | parseQQ a ('{':xs) = Literal (reverse a) : unQQ [] xs 231 | parseQQ a (x:xs) = parseQQ (x:a) xs 232 | 233 | isIdent '_' = True 234 | isIdent '\'' = True 235 | isIdent x = isAlphaNum x 236 | 237 | makeExpr [] = [| mempty |] 238 | makeExpr ((Literal a):xs) = TH.appE [| mappend (fromString a) |] 239 | $ makeExpr xs 240 | makeExpr ((AntiQuote a):xs) = TH.appE [| mappend (toQQ $(reify a)) |] 241 | $ makeExpr xs 242 | 243 | reify s = 244 | case parseExp s of 245 | Left s -> TH.report True s >> [| mempty |] 246 | Right e -> return e 247 | 248 | -- | QuasiQuoter for interpolating '$var' and '{expr}' into a string literal. The pattern portion is undefined. 249 | qq :: QuasiQuoter 250 | qq = QuasiQuoter (makeExpr . parseQQ [] . filter (/= '\r')) 251 | (error "Cannot use qq as a pattern") 252 | (error "Cannot use qq as a type") 253 | (error "Cannot use qq as a dec") 254 | 255 | -- | QuasiQuoter for interpolating '{expr}' into a string literal. The pattern portion is undefined. 256 | qc :: QuasiQuoter 257 | qc = QuasiQuoter (makeExpr . parseQC [] . filter (/= '\r')) 258 | (error "Cannot use qc as a pattern") 259 | (error "Cannot use qc as a type") 260 | (error "Cannot use qc as a dec") 261 | 262 | -- | QuasiQuoter for a non-interpolating string literal. The pattern portion is undefined. 263 | q :: QuasiQuoter 264 | q = QuasiQuoter ((\a -> [|fromString a|]) . filter (/= '\r')) 265 | (error "Cannot use q as a pattern") 266 | (error "Cannot use q as a type") 267 | (error "Cannot use q as a dec") 268 | --------------------------------------------------------------------------------