    {-# 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           Language.Haskell.TH

    -- |
    -- 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 {
        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 String
    "pattern"
      , quoteType :: String -> Q Type
    quoteType = String -> String -> Q Type
    forall {a}. String -> a
    err String
    "type"
      , quoteDec :: String -> Q [Dec]
    quoteDec = String -> String -> Q [Dec]
    forall {a}. String -> a
    err String
    "declaration"
      }
      where
        err :: String -> a
    err String
    name = String -> a
    forall a. HasCallStack => String -> a
    error (String
    "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]
    ++ String
    "!")

        toExp :: [Node ()] -> Q Exp
        toExp :: [Node ()] -> Q Exp
    toExp [Node ()]
    input = do
          nodes <- (Node () -> Q (Node Name)) -> [Node ()] -> Q [Node Name]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM Node () -> Q (Node Name)
    generateName [Node ()]
    input
          e <- go nodes
          return $ foldr lambda e [name | Abstraction name <- nodes]
          where
            lambda :: Name -> Exp -> Exp
            lambda :: Name -> Exp -> Exp
    lambda Name
    name Exp
    e = [Pat] -> Exp -> Exp
    LamE [Name -> Pat
    VarP Name
    name] Exp
    e

            generateName :: Node () -> Q (Node Name)
            generateName :: Node () -> Q (Node Name)
    generateName (Abstraction ()) = Name -> Node Name
    forall a. a -> Node a
    Abstraction (Name -> Node Name) -> Q Name -> Q (Node Name)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> String -> Q Name
    forall (m :: * -> *). Quote m => String -> m Name
    newName String
    "x"
            generateName (Literal String
    s) = Node Name -> Q (Node Name)
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (String -> Node Name
    forall a. String -> Node a
    Literal String
    s)
            generateName (Expression String
    e) = Node Name -> Q (Node Name)
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (String -> Node Name
    forall a. String -> Node a
    Expression String
    e)

            go :: [Node Name] -> Q Exp
            go :: [Node Name] -> Q Exp
    go [Node Name]
    nodes = case [Node Name]
    nodes of
              [] -> [|""|]
              (Node Name
    x:[Node Name]
    xs) -> Node Name -> Q Exp
    eval Node Name
    x Q Exp -> Q Exp -> Q Exp
    forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
    `appE` [Node Name] -> Q Exp
    go [Node Name]
    xs
              where
                eval :: Node Name -> Q Exp
    eval (Literal String
    s) = [|showString s|]
                eval (Expression String
    e) = Q Exp -> Q Exp
    interpolate (String -> Q Exp
    reifyExpression String
    e)
                eval (Abstraction Name
    name) = Q Exp -> Q Exp
    interpolate (Q Exp -> Q Exp) -> Q Exp -> Q Exp
    forall a b. (a -> b) -> a -> b
    $ (Exp -> Q Exp
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Exp -> Q Exp) -> Exp -> Q Exp
    forall a b. (a -> b) -> a -> b
    $ Name -> Exp
    VarE Name
    name)

                interpolate :: Q Exp -> Q Exp
                interpolate :: Q Exp -> Q Exp
    interpolate Q Exp
    e = [|(showString . toString) $(Q Exp
    e)|]

                reifyExpression :: String -> Q Exp
                reifyExpression :: String -> Q Exp
    reifyExpression String
    s = case String -> Either String Exp
    parseExp String
    s of
                  Left String
    _ -> do
                    String -> Q Exp
    forall a. String -> Q a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail String
    "Parse error in expression!" :: Q Exp
                  Right Exp
    e -> Exp -> Q Exp
    forall a. a -> Q a
    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 String
    xs = case String
    xs of
          Char
    '\r' : Char
    '\n' : String
    ys -> Char
    '\n' Char -> String -> String
    forall a. a -> [a] -> [a]
    : String -> String
    go String
    ys
          Char
    y : String
    ys -> Char
    y Char -> String -> String
    forall a. a -> [a] -> [a]
    : String -> String
    go String
    ys
          [] -> []