Interpolate.hs

-- |
-- Module      : Data.String.Interpolate
-- Description : Unicode-aware string interpolation that handles all textual types.
-- Copyright   : (c) William Yao, 2019-2020
-- License     : BSD-3
-- Maintainer  : williamyaoh@gmail.com
-- Stability   : experimental
-- Portability : POSIX
--
-- This module provides two quasiquoters, @i@ and @iii@, which:
--
-- * handle all of String\/Text\/ByteString, both strict and lazy
-- * can interpolate /into/ anything that implements `IsString'
-- * can interpolate anything that implements `Show'
-- * are Unicode aware
-- * are fast
-- * handle multiline strings
--
-- @i@ leaves newlines and whitespace intact as they are in the source code,
-- while @iii@ collapses newlines/whitespace into single spaces, stripping
-- leading/trailing whitespace as well.
--
-- As an example,
--
-- > {-# LANGUAGE OverloadedStrings #-}
-- >
-- > import Data.Text
-- > import Data.String.Interpolate ( i )
-- >
-- > λ> age = 33 :: Int
-- > λ> name = "Tatiana" :: Text
-- > λ> [i|{"name": "#{name}", "age": #{age}}|] :: String
-- > >>> "{\"name\": \"Tatiana\", \"age\": 33}"
-- >
-- > λ> [i|
-- > Name: #{name}
-- > Age: #{age}
-- > |] :: String
-- > >>> "\nName: Tatiana\nAge: 33\n"
--
-- See the README at <https://gitlab.com/williamyaoh/string-interpolate/blob/master/README.md>
-- for more details and examples.

{-# LANGUAGE TemplateHaskell #-}

module Data.String.Interpolate
  ( i, iii )
where

import Data.Proxy

import qualified Language.Haskell.Exts.Extension as Ext
import           Language.Haskell.Exts.Parser
  ( ParseMode(..), ParseResult(..), defaultParseMode, parseExpWithMode )
import           Language.Haskell.Meta           ( ToExp(..) )
import           Language.Haskell.TH
import           Language.Haskell.TH.Quote       ( QuasiQuoter(..) )

import Data.String.Interpolate.Conversion ( build, chompSpaces, finalize, interpolate, ofString )
import Data.String.Interpolate.Parse      ( InterpSegment(..), dosToUnix, parseInterpSegments )

i :: QuasiQuoter
i = QuasiQuoter
  { quoteExp = toExp . parseInterpSegments . dosToUnix
  , quotePat = err "pattern"
  , quoteType = err "type"
  , quoteDec = err "declaration"
  }
  where err name = error ("Data.String.Interpolate.i: This QuasiQuoter cannot be used as a " ++ name)

        toExp :: Either String [InterpSegment] -> Q Exp
        toExp parseResult = case parseResult of
          Left msg   -> fail $ "Data.String.Interpolate.i: " ++ msg
          Right segs -> emitBuildExp segs

        emitBuildExp :: [InterpSegment] -> Q Exp
        emitBuildExp segs = [|finalize Proxy $(go segs)|]
          where go [] = [|ofString Proxy ""|]
                go (Verbatim str : rest) =
                  [|build Proxy (ofString Proxy str) $(go rest)|]
                go (Expression expr : rest) =
                  [|build Proxy (interpolate Proxy $(reifyExpression expr)) $(go rest)|]

iii :: QuasiQuoter
iii = QuasiQuoter
  { quoteExp = toExp . parseInterpSegments . dosToUnix
  , quotePat = err "pattern"
  , quoteType = err "type"
  , quoteDec = err "declaration"
  }
  where err name = error ("Data.String.Interpolate.iii: This QuasiQuoter cannot be used as a " ++ name)

        toExp :: Either String [InterpSegment] -> Q Exp
        toExp parseResult = case parseResult of
          Left msg   -> fail $ "Data.String.Interpolate.iii: " ++ msg
          Right segs -> emitBuildExp segs

        emitBuildExp :: [InterpSegment] -> Q Exp
        emitBuildExp segs = [|chompSpaces (finalize Proxy $(go segs))|]
          where go [] = [|ofString Proxy ""|]
                go (Verbatim str : rest) =
                  [|build Proxy (ofString Proxy str) $(go rest)|]
                go (Expression expr : rest) =
                  [|build Proxy (interpolate Proxy $(reifyExpression expr)) $(go rest)|]

reifyExpression :: String -> Q Exp
reifyExpression s = do
  -- We want to explicitly use whatever extensions are enabled in current module
  exts      <- (fmap . fmap) (Ext.parseExtension . show) extsEnabled
  parseMode <- pure (defaultParseMode { extensions = exts })
  case parseExpWithMode parseMode s of
    ParseFailed _ err  -> fail $
      "Data.String.Interpolate.i: got error: '" ++ err ++ "' while parsing expression: " ++ s
    ParseOk e -> pure (toExp e)