{-# LANGUAGE ExistentialQuantification, TemplateHaskell, QuasiQuotes, OverloadedStrings, FlexibleInstances, UndecidableInstances, IncoherentInstances #-}-- |-- A simple 'QuasiQuoter' for 'Text' strings. Note that to use 'embed' you need to use the OverloadedStrings extension.moduleText.QuasiText(embed,Chunk(..),getChunks)whereimportLanguage.Haskell.TH.QuoteimportLanguage.Haskell.TH.SyntaximportLanguage.Haskell.THimportLanguage.Haskell.Meta(parseExp)importData.Attoparsec.TextimportqualifiedData.TextasTimportData.Text(Text)importData.CharimportData.MonoidimportControl.ApplicativeinstanceLiftTextwherelift=litE.stringL.T.unpackdataChunk=TText-- ^ text|EText-- ^ expression|VText-- ^ valuederiving(Show,Eq)classTextishawheretoText::a->TextinstanceTextishTextwhere{-# INLINE toText #-}toTextx=xinstanceTextish[Char]where{-# INLINE toText #-}toTextx=T.packxinstanceShowa=>Textishawhere{-# INLINE toText #-}toTextx=T.pack(showx)-- | A simple 'QuasiQuoter' to interpolate 'Text' into other pieces of 'Text'. -- Expressions can be embedded using $(expr), and values can be interpolated -- with $name. Inside $( )s, if you have a string of ambiguous type, it will -- default to the Show instance for toText, which will escape unicode -- characters in the string, and add quotes around them.embed::QuasiQuoterembed=QuasiQuoter{quoteExp=\s->letchunks=flipmap(getChunks(T.packs))$\c->casecofTt->[|t|]Et->letRighte=parseExp(T.unpackt)inappE[|toText|](returne)Vt->appE[|toText|](global(mkName(T.unpackt)))inappE[|T.concat|](listEchunks)}-- | Create 'Chunk's without any TH.getChunks::Text->[Chunk]getChunksi=caseparseOnlyparser(T.stripi)ofRightm->m_->error"Unclosed parenthesis."whereparenthesis'('=Trueparenthesis')'=Trueparenthesis_=FalseparseExpression::Int->Parser[Text]parseExpressionlevel=doexpr<-takeTillparenthesisparen<-anyCharcaseparenof')'|level<=0->return[expr]|otherwise->donext<-parseExpression(level-1)return([expr,")"]++next)'('->donext<-parseExpression(level+1)return([expr,"("]++next)_->return[expr,T.singletonparen]parser::Parser[Chunk]parser=fmapconcat$flipmanyTill(endOfInput<|>endOfLine)$dotext<-takeTill(=='$')end<-atEndifendthenreturn[Ttext]elsedochar'$'next<-anyCharcasenextof-- opening an experssion'('->doexpr<-T.concat<$>parseExpression0return[Ttext,Eexpr]-- escaped '$' '$'->return[T(text<>"$")]-- value_->doname<-takeTill(not.isAlphaNum)return[Ttext,V(T.consnextname)]