{-# LANGUAGE TemplateHaskell #-}
module Data.String.Interpolate (
-- * String interpolation done right
-- |
-- The examples in this module use `QuasiQuotes`.  Make sure to enable the
-- corresponding language extension.
--
-- >>> :set -XQuasiQuotes
-- >>> import 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)

-- |
-- A `QuasiQuoter` for string interpolation.  Expression enclosed within
-- @#{...}@ are interpolated, the result has to be in the `Show` class.
--
-- It interpolates strings
--
-- >>> let name = "Marvin"
-- >>> putStrLn [i|name: #{name}|]
-- name: Marvin
--
-- or integers
--
-- >>> let age = 23
-- >>> putStrLn [i|age: #{age}|]
-- age: 23
--
-- or arbitrary Haskell expressions
--
-- >>> let profession = "\955-scientist"
-- >>> putStrLn [i|profession: #{unwords [name, "the", profession]}|]
-- profession: Marvin the λ-scientist
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
      [] -> []