-- SPDX-FileCopyrightText: 2022 Serokell <https://serokell.io/>
--
-- SPDX-License-Identifier: MPL-2.0

{-# LANGUAGE CPP #-}

-- | Contains full-fledged interpolator.
module Text.Interpolation.Nyan.Full
  ( fullHaskellValueInterpolator
  ) where

import Control.Monad (when)
import Data.Char (isSpace)
import qualified Data.Text as T
import Language.Haskell.Exts.Parser (ParseMode (extensions, parseFilename),
                                     ParseResult (ParseFailed, ParseOk), defaultParseMode,
                                     parseExpWithMode)
import Language.Haskell.Meta.Syntax.Translate (toExp)
import Language.Haskell.TH (extsEnabled)

#if MIN_VERSION_haskell_src_meta(0,8,9)
import Data.Maybe (mapMaybe)
import Language.Haskell.Exts.Extension (Extension (..), Language (..))
import Language.Haskell.Exts.Parser (baseLanguage)
import Language.Haskell.Meta.Extensions (fromExtension)
#endif

import Text.Interpolation.Nyan.Core

{- | Interpolates strings containing arbitrary Haskell expressions.

This is used in the interpolator provided by "Text.Interpolation.Nyan" module.

Known issues:

* If @haskell-src-meta@ prior to @0.8.9@ version is used, a default set of
  extensions for the given Haskell dialect (e.g. Haskell2010) is used
  for the interpolated values.
  With the modern version of @haskell-src-meta@, we do our best to be trasparent
  and pick the extensions enabled in the module where interpolator is called
  (some rare extensions may still be unsupported).

-}
fullHaskellValueInterpolator :: ValueInterpolator
fullHaskellValueInterpolator :: ValueInterpolator
fullHaskellValueInterpolator = (Text -> ExpQ) -> ValueInterpolator
ValueInterpolator ((Text -> ExpQ) -> ValueInterpolator)
-> (Text -> ExpQ) -> ValueInterpolator
forall a b. (a -> b) -> a -> b
$ \Text
txt -> do
  Bool -> Q () -> Q ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ((Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isSpace Text
txt) (Q () -> Q ()) -> Q () -> Q ()
forall a b. (a -> b) -> a -> b
$
    String -> Q ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Empty placeholder"
  [Extension]
enabledExtensions <- Q [Extension]
extsEnabled
  let parseMode :: ParseMode
parseMode = ParseMode
defaultParseMode
        { parseFilename :: String
parseFilename = String
"interpolator placeholder"
#if MIN_VERSION_haskell_src_meta(0,8,9)
        , baseLanguage :: Language
baseLanguage = Language
HaskellAllDisabled
#else
          -- use default language
#endif
        , extensions :: [Extension]
extensions = [Extension] -> [Extension]
providedExtensions [Extension]
enabledExtensions
        }
  case ParseMode -> String -> ParseResult (Exp SrcSpanInfo)
parseExpWithMode ParseMode
parseMode (Text -> String
T.unpack Text
txt) of
    ParseFailed SrcLoc
_loc String
e -> String -> ExpQ
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
e
    ParseOk Exp SrcSpanInfo
res        -> Exp -> ExpQ
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp SrcSpanInfo -> Exp
forall a. ToExp a => a -> Exp
toExp Exp SrcSpanInfo
res)
  where
    providedExtensions :: [Extension] -> [Extension]
providedExtensions =
#if MIN_VERSION_haskell_src_meta(0,8,9)
      (KnownExtension -> Extension) -> [KnownExtension] -> [Extension]
forall a b. (a -> b) -> [a] -> [b]
map KnownExtension -> Extension
EnableExtension ([KnownExtension] -> [Extension])
-> ([Extension] -> [KnownExtension]) -> [Extension] -> [Extension]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Extension -> Maybe KnownExtension)
-> [Extension] -> [KnownExtension]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Extension -> Maybe KnownExtension
fromExtension
#else
      -- There is no easy way to do the conversion between template-haskell's
      -- and haskell-src-exts's Extension types, so using only language-default
      -- extensions (e.g. Haskell2010).
      --
      -- It may be tempting to hardcode some common extensions, but we better
      -- not do that, otherwise on @haskell-src-meta@ bump the user's code will
      -- start relying on the extensions enabled in the module and so may break,
      -- which would be extremly bad if occurs in a library.
      --
      -- Meanwhile, using all the language-default extensions seems safe,
      -- they all seem to be supported by relatively recent versions of
      -- @haskell-src-meta@. An issue will fire only if the user disabled
      -- some extension in the module, and this starts affecting the interpolator
      -- after the bump; let's treat that as a non-caught timely bug in the
      -- user's code.
      \_enabledExts -> []
#endif