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

{- | Core of the @nyan-interpolation@ library.

Use it to define your own variation of the interpolator,
customizing the default switches and other parameters to your preferences.

@
int :: QuasiQuoter
int = mkInt defaultInterpolatorOptions
  { defaultSwitchesOptions = recommendedDefaultSwitchesOptions
    { defSpacesTrimming = Just True
    }
  }
@

-}
module Text.Interpolation.Nyan.Core
  ( -- * Interpolator
    mkInt
    -- * Interpolator options
  , InterpolatorOptions
  , defaultInterpolatorOptions
    -- ** Field accessors for interpolator options
  , defaultSwitchesOptions
  , valueInterpolator
  , invisibleCharsPreview
    -- * Default switches options
  , DefaultSwitchesOptions
  , basicDefaultSwitchesOptions
  , recommendedDefaultSwitchesOptions
    -- ** Field accessors for default switches options
  , defSpacesTrimming
  , defIndentationStripping
  , defLeadingNewlineStripping
  , defTrailingSpacesStripping
  , defReducedNewlines
  , defReturnType
  , defMonadic

    -- * Value interpolators
  , ValueInterpolator (..)
  , simpleValueInterpolator
  , tickedValueInterpolator

    -- * Adjusting preview
  , InvisibleCharsPreview (..)
  , simpleInvisibleCharsPreview

    -- * Rendering modes
  , RMode (..)

    -- * Re-exports
  , TH.QuasiQuoter
  ) where

import qualified Data.Text as T
import qualified Language.Haskell.TH.Quote as TH

import Text.Interpolation.Nyan.Core.Internal.Base
import Text.Interpolation.Nyan.Core.Internal.Parser
import Text.Interpolation.Nyan.Core.Internal.Processor
import Text.Interpolation.Nyan.Core.Internal.RMode
import Text.Interpolation.Nyan.Core.Internal.Splice

-- | Construct an interpolator.
--
-- Usually you pass some options here that you consider canonical and use
-- the resulting interolator throughout your project.
mkInt :: InterpolatorOptions -> TH.QuasiQuoter
mkInt :: InterpolatorOptions -> QuasiQuoter
mkInt InterpolatorOptions
iopts = TH.QuasiQuoter
  { quoteExp :: String -> Q Exp
TH.quoteExp = \String
s -> do
      (SwitchesOptions
sopts, ParsedInterpolatedString
sint) <-
        forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
        DefaultSwitchesOptions
-> Text
-> Either String (SwitchesOptions, ParsedInterpolatedString)
parseIntString (InterpolatorOptions -> DefaultSwitchesOptions
defaultSwitchesOptions InterpolatorOptions
iopts) (Text -> Text
useUnixLineEndings forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
s)
      let sint' :: InterpolatedString
sint' = SwitchesOptions -> ParsedInterpolatedString -> InterpolatedString
processIntString SwitchesOptions
sopts ParsedInterpolatedString
sint
      InterpolatorOptions
-> (SwitchesOptions, InterpolatedString) -> Q Exp
intSplice InterpolatorOptions
iopts (SwitchesOptions
sopts, InterpolatedString
sint')
  , quotePat :: String -> Q Pat
TH.quotePat = \String
_ ->
      forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Cannot interpolate at pattern position"
  , quoteType :: String -> Q Type
TH.quoteType = \String
_ ->
      forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Cannot interpolate at type position"
  , quoteDec :: String -> Q [Dec]
TH.quoteDec = \String
_ ->
      forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Cannot interpolate at declaration position"
  }
  where
    -- as in https://github.com/serokell/nyan-interpolation/issues/21,
    -- we should use LF line endings even when source file has CRLF
    useUnixLineEndings :: T.Text -> T.Text
    useUnixLineEndings :: Text -> Text
useUnixLineEndings = Text -> Text -> Text -> Text
T.replace Text
"\r\n" Text
"\n"

-- | The most interpolator options.
--
-- * Tries to keep the text as much unchanged as possible.
-- * Interpolates only variables.
defaultInterpolatorOptions :: InterpolatorOptions
defaultInterpolatorOptions :: InterpolatorOptions
defaultInterpolatorOptions = InterpolatorOptions
  { defaultSwitchesOptions :: DefaultSwitchesOptions
defaultSwitchesOptions = DefaultSwitchesOptions
basicDefaultSwitchesOptions
  , valueInterpolator :: ValueInterpolator
valueInterpolator = ValueInterpolator
simpleValueInterpolator
  , invisibleCharsPreview :: InvisibleCharsPreview
invisibleCharsPreview = InvisibleCharsPreview
simpleInvisibleCharsPreview
  }