module Text.RawString.QQ (r, rQ)
where
import Language.Haskell.TH
import Language.Haskell.TH.Quote
r :: QuasiQuoter
r :: QuasiQuoter
r = QuasiQuoter {
quoteExp :: String -> Q Exp
quoteExp = Exp -> Q Exp
forall a. a -> Q a
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp -> Q Exp) -> (String -> Exp) -> String -> Q Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lit -> Exp
LitE (Lit -> Exp) -> (String -> Lit) -> String -> Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Lit
StringL (String -> Lit) -> (String -> String) -> String -> Lit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
normaliseNewlines,
quotePat :: String -> Q Pat
quotePat = \String
_ -> String -> Q Pat
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"illegal raw string QuasiQuote \
\(allowed as expression only, used as a pattern)",
quoteType :: String -> Q Type
quoteType = \String
_ -> String -> Q Type
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"illegal raw string QuasiQuote \
\(allowed as expression only, used as a type)",
quoteDec :: String -> Q [Dec]
quoteDec = \String
_ -> String -> Q [Dec]
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"illegal raw string QuasiQuote \
\(allowed as expression only, used as a declaration)"
}
rQ :: QuasiQuoter
rQ :: QuasiQuoter
rQ = QuasiQuoter {
quoteExp :: String -> Q Exp
quoteExp = Exp -> Q Exp
forall a. a -> Q a
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp -> Q Exp) -> (String -> Exp) -> String -> Q Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lit -> Exp
LitE (Lit -> Exp) -> (String -> Lit) -> String -> Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Lit
StringL (String -> Lit) -> (String -> String) -> String -> Lit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
escape_rQ (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
normaliseNewlines,
quotePat :: String -> Q Pat
quotePat = \String
_ -> String -> Q Pat
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"illegal raw string QuasiQuote \
\(allowed as expression only, used as a pattern)",
quoteType :: String -> Q Type
quoteType = \String
_ -> String -> Q Type
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"illegal raw string QuasiQuote \
\(allowed as expression only, used as a type)",
quoteDec :: String -> Q [Dec]
quoteDec = \String
_ -> String -> Q [Dec]
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"illegal raw string QuasiQuote \
\(allowed as expression only, used as a declaration)"
}
escape_rQ :: String -> String
escape_rQ :: String -> String
escape_rQ [] = []
escape_rQ (Char
'|':Char
'~':String
xs) =
let (String
tildas, String
rest) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'~') String
xs
in case String
rest of
[] -> Char
'|'Char -> String -> String
forall a. a -> [a] -> [a]
:Char
'~'Char -> String -> String
forall a. a -> [a] -> [a]
:String
tildas
(Char
']':String
rs) -> Char
'|'Char -> String -> String
forall a. a -> [a] -> [a]
:String
tildas String -> String -> String
forall a. [a] -> [a] -> [a]
++ Char
']'Char -> String -> String
forall a. a -> [a] -> [a]
:String -> String
escape_rQ String
rs
String
rs -> Char
'|'Char -> String -> String
forall a. a -> [a] -> [a]
:Char
'~'Char -> String -> String
forall a. a -> [a] -> [a]
:String
tildas String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
escape_rQ String
rs
escape_rQ (Char
x:String
xs) = Char
x Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
escape_rQ String
xs
normaliseNewlines :: String -> String
normaliseNewlines :: String -> String
normaliseNewlines [] = []
normaliseNewlines (Char
'\r':Char
'\n':String
cs) = Char
'\n'Char -> String -> String
forall a. a -> [a] -> [a]
:String -> String
normaliseNewlines String
cs
normaliseNewlines (Char
c:String
cs) = Char
cChar -> String -> String
forall a. a -> [a] -> [a]
:String -> String
normaliseNewlines String
cs