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