{-# LANGUAGE TemplateHaskell #-}
module Data.String.Interpolate (
i
) where
import Language.Haskell.TH.Quote (QuasiQuoter(..))
import Language.Haskell.Meta.Parse (parseExp)
import Data.String.Interpolate.Internal.Util
import Data.String.Interpolate.Parse
import Data.String.Interpolate.Compat (Q, Exp, appE, reportError)
i :: QuasiQuoter
i :: QuasiQuoter
i = QuasiQuoter :: (String -> Q Exp)
-> (String -> Q Pat)
-> (String -> Q Type)
-> (String -> Q [Dec])
-> QuasiQuoter
QuasiQuoter {
quoteExp :: String -> Q Exp
quoteExp = [Node] -> Q Exp
toExp ([Node] -> Q Exp) -> (String -> [Node]) -> String -> Q Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [Node]
parseNodes (String -> [Node]) -> (String -> String) -> String -> [Node]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
decodeNewlines
, quotePat :: String -> Q Pat
quotePat = String -> String -> Q Pat
forall a. String -> a
err "pattern"
, quoteType :: String -> Q Type
quoteType = String -> String -> Q Type
forall a. String -> a
err "type"
, quoteDec :: String -> Q [Dec]
quoteDec = String -> String -> Q [Dec]
forall a. String -> a
err "declaration"
}
where
err :: String -> a
err name :: String
name = String -> a
forall a. HasCallStack => String -> a
error ("Data.String.Interpolate.i: This QuasiQuoter can not be used as a " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ "!")
toExp:: [Node] -> Q Exp
toExp :: [Node] -> Q Exp
toExp nodes :: [Node]
nodes = case [Node]
nodes of
[] -> [|""|]
(x :: Node
x:xs :: [Node]
xs) -> Node -> Q Exp
f Node
x Q Exp -> Q Exp -> Q Exp
`appE` [Node] -> Q Exp
toExp [Node]
xs
where
f :: Node -> Q Exp
f (Literal s :: String
s) = [|showString s|]
f (Expression e :: String
e) = [|(showString . toString) $(reifyExpression e)|]
reifyExpression :: String -> Q Exp
reifyExpression :: String -> Q Exp
reifyExpression s :: String
s = case String -> Either String Exp
parseExp String
s of
Left _ -> do
String -> Q ()
reportError "Parse error in expression!"
[|""|]
Right e :: Exp
e -> Exp -> Q Exp
forall (m :: * -> *) a. Monad m => a -> m a
return Exp
e
decodeNewlines :: String -> String
decodeNewlines :: String -> String
decodeNewlines = String -> String
go
where
go :: String -> String
go xs :: String
xs = case String
xs of
'\r' : '\n' : ys :: String
ys -> '\n' Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
go String
ys
y :: Char
y : ys :: String
ys -> Char
y Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
go String
ys
[] -> []