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

{-# LANGUAGE DerivingVia #-}

module Text.Interpolation.Nyan.Core.Internal.Base where

import Data.Monoid (Endo (..))
import Data.Text (Text)
import Language.Haskell.TH (ExpQ)

{- $setup

> import Data.Text
> import Data.Text.Lazy
-}


-- * Interpolation data

-- | Information about single piece that is to be interpolated.
data IntData = IntData
  { IntData -> Text
idMode :: Text
    -- ^ How to use the value in the braces.
    -- This is some text before the brances, usually one letter or nothing.
  , IntData -> Text
idCode :: Text
    -- ^ The inserted code. This is what appears in braces.
  } deriving stock (Int -> IntData -> ShowS
[IntData] -> ShowS
IntData -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IntData] -> ShowS
$cshowList :: [IntData] -> ShowS
show :: IntData -> String
$cshow :: IntData -> String
showsPrec :: Int -> IntData -> ShowS
$cshowsPrec :: Int -> IntData -> ShowS
Show, IntData -> IntData -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IntData -> IntData -> Bool
$c/= :: IntData -> IntData -> Bool
== :: IntData -> IntData -> Bool
$c== :: IntData -> IntData -> Bool
Eq)

-- | Piece of interpolation string.
data ParsedIntPiece
  = PipString Text
    -- ^ Mere text.
  | PipNewline Text
    -- ^ Some line feed.
    -- This must be preferred over 'PipString'.
  | PipLeadingWs Word
    -- ^ Whitespaces at the beginning of the line.
    -- This must be preferred over 'PipString'.
  | PipEmptyLine
    -- ^ Line without any text. The line feed is not included here.
    -- This must be preferred over 'PipLeadingWs'.
  | PipInt IntData
    -- ^ Interpolator piece.
  deriving stock (Int -> ParsedIntPiece -> ShowS
[ParsedIntPiece] -> ShowS
ParsedIntPiece -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ParsedIntPiece] -> ShowS
$cshowList :: [ParsedIntPiece] -> ShowS
show :: ParsedIntPiece -> String
$cshow :: ParsedIntPiece -> String
showsPrec :: Int -> ParsedIntPiece -> ShowS
$cshowsPrec :: Int -> ParsedIntPiece -> ShowS
Show, ParsedIntPiece -> ParsedIntPiece -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ParsedIntPiece -> ParsedIntPiece -> Bool
$c/= :: ParsedIntPiece -> ParsedIntPiece -> Bool
== :: ParsedIntPiece -> ParsedIntPiece -> Bool
$c== :: ParsedIntPiece -> ParsedIntPiece -> Bool
Eq)

type ParsedInterpolatedString = [ParsedIntPiece]

-- | Finalized piece of interpolation string.
data IntPiece
  = IpString Text
    -- ^ Mere text.
  | IpInt IntData
    -- ^ Interpolator piece.
  deriving stock (Int -> IntPiece -> ShowS
[IntPiece] -> ShowS
IntPiece -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IntPiece] -> ShowS
$cshowList :: [IntPiece] -> ShowS
show :: IntPiece -> String
$cshow :: IntPiece -> String
showsPrec :: Int -> IntPiece -> ShowS
$cshowsPrec :: Int -> IntPiece -> ShowS
Show, IntPiece -> IntPiece -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IntPiece -> IntPiece -> Bool
$c/= :: IntPiece -> IntPiece -> Bool
== :: IntPiece -> IntPiece -> Bool
$c== :: IntPiece -> IntPiece -> Bool
Eq)

type InterpolatedString = [IntPiece]

-- * Switches

-- | Return type of the interpolator.
data ReturnType
  = AnyFromBuilder
    -- ^ @FromBuilder a => a@
  | ConcreteText
    -- ^ 'Data.Text.Text'
  | ConcreteLText
    -- ^ 'Data.Text.Lazy.Text'
  | ConcreteBuilder
    -- ^ 'Data.Text.Lazy.Builder.Builder'
  deriving stock (Int -> ReturnType -> ShowS
[ReturnType] -> ShowS
ReturnType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ReturnType] -> ShowS
$cshowList :: [ReturnType] -> ShowS
show :: ReturnType -> String
$cshow :: ReturnType -> String
showsPrec :: Int -> ReturnType -> ShowS
$cshowsPrec :: Int -> ReturnType -> ShowS
Show, ReturnType -> ReturnType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ReturnType -> ReturnType -> Bool
$c/= :: ReturnType -> ReturnType -> Bool
== :: ReturnType -> ReturnType -> Bool
$c== :: ReturnType -> ReturnType -> Bool
Eq)

-- | Requested preview level.
data PreviewLevel
  = PreviewNone
    -- ^ Do nothing special.
  | PreviewExact
    -- ^ Print the resulting text as-is (without substitutions).
  | PreviewInvisible
    -- ^ Print the text, replacing invisible characters with special symbols.
  deriving stock (Int -> PreviewLevel -> ShowS
[PreviewLevel] -> ShowS
PreviewLevel -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PreviewLevel] -> ShowS
$cshowList :: [PreviewLevel] -> ShowS
show :: PreviewLevel -> String
$cshow :: PreviewLevel -> String
showsPrec :: Int -> PreviewLevel -> ShowS
$cshowsPrec :: Int -> PreviewLevel -> ShowS
Show, PreviewLevel -> PreviewLevel -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PreviewLevel -> PreviewLevel -> Bool
$c/= :: PreviewLevel -> PreviewLevel -> Bool
== :: PreviewLevel -> PreviewLevel -> Bool
$c== :: PreviewLevel -> PreviewLevel -> Bool
Eq, Int -> PreviewLevel
PreviewLevel -> Int
PreviewLevel -> [PreviewLevel]
PreviewLevel -> PreviewLevel
PreviewLevel -> PreviewLevel -> [PreviewLevel]
PreviewLevel -> PreviewLevel -> PreviewLevel -> [PreviewLevel]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: PreviewLevel -> PreviewLevel -> PreviewLevel -> [PreviewLevel]
$cenumFromThenTo :: PreviewLevel -> PreviewLevel -> PreviewLevel -> [PreviewLevel]
enumFromTo :: PreviewLevel -> PreviewLevel -> [PreviewLevel]
$cenumFromTo :: PreviewLevel -> PreviewLevel -> [PreviewLevel]
enumFromThen :: PreviewLevel -> PreviewLevel -> [PreviewLevel]
$cenumFromThen :: PreviewLevel -> PreviewLevel -> [PreviewLevel]
enumFrom :: PreviewLevel -> [PreviewLevel]
$cenumFrom :: PreviewLevel -> [PreviewLevel]
fromEnum :: PreviewLevel -> Int
$cfromEnum :: PreviewLevel -> Int
toEnum :: Int -> PreviewLevel
$ctoEnum :: Int -> PreviewLevel
pred :: PreviewLevel -> PreviewLevel
$cpred :: PreviewLevel -> PreviewLevel
succ :: PreviewLevel -> PreviewLevel
$csucc :: PreviewLevel -> PreviewLevel
Enum, PreviewLevel
forall a. a -> a -> Bounded a
maxBound :: PreviewLevel
$cmaxBound :: PreviewLevel
minBound :: PreviewLevel
$cminBound :: PreviewLevel
Bounded)

-- | All switches options.
data SwitchesOptions = SwitchesOptions
  { SwitchesOptions -> Bool
spacesTrimming          :: Bool
  , SwitchesOptions -> Bool
indentationStripping    :: Bool
  , SwitchesOptions -> Bool
leadingNewlineStripping :: Bool
  , SwitchesOptions -> Bool
trailingSpacesStripping :: Bool
  , SwitchesOptions -> ReturnType
returnType              :: ReturnType
  , SwitchesOptions -> Bool
reducedNewlines         :: Bool
  , SwitchesOptions -> Bool
monadic                 :: Bool
  , SwitchesOptions -> PreviewLevel
previewLevel            :: PreviewLevel
  } deriving stock (Int -> SwitchesOptions -> ShowS
[SwitchesOptions] -> ShowS
SwitchesOptions -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SwitchesOptions] -> ShowS
$cshowList :: [SwitchesOptions] -> ShowS
show :: SwitchesOptions -> String
$cshow :: SwitchesOptions -> String
showsPrec :: Int -> SwitchesOptions -> ShowS
$cshowsPrec :: Int -> SwitchesOptions -> ShowS
Show, SwitchesOptions -> SwitchesOptions -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SwitchesOptions -> SwitchesOptions -> Bool
$c/= :: SwitchesOptions -> SwitchesOptions -> Bool
== :: SwitchesOptions -> SwitchesOptions -> Bool
$c== :: SwitchesOptions -> SwitchesOptions -> Bool
Eq)

-- | Default switches options set in the interpolator, those that are used
-- in @[int||...|]@.
--
-- When no default value for a switch is specified, this switch is left
-- mandatory for specifying in the interpolator.
data DefaultSwitchesOptions = DefaultSwitchesOptions
  { DefaultSwitchesOptions -> Maybe Bool
defSpacesTrimming          :: Maybe Bool
  , DefaultSwitchesOptions -> Maybe Bool
defIndentationStripping    :: Maybe Bool
  , DefaultSwitchesOptions -> Maybe Bool
defLeadingNewlineStripping :: Maybe Bool
  , DefaultSwitchesOptions -> Maybe Bool
defTrailingSpacesStripping :: Maybe Bool
  , DefaultSwitchesOptions -> Maybe Bool
defReducedNewlines         :: Maybe Bool
  , DefaultSwitchesOptions -> Maybe ReturnType
defReturnType              :: Maybe ReturnType
  , DefaultSwitchesOptions -> Maybe Bool
defMonadic                 :: Maybe Bool
  } deriving stock (Int -> DefaultSwitchesOptions -> ShowS
[DefaultSwitchesOptions] -> ShowS
DefaultSwitchesOptions -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DefaultSwitchesOptions] -> ShowS
$cshowList :: [DefaultSwitchesOptions] -> ShowS
show :: DefaultSwitchesOptions -> String
$cshow :: DefaultSwitchesOptions -> String
showsPrec :: Int -> DefaultSwitchesOptions -> ShowS
$cshowsPrec :: Int -> DefaultSwitchesOptions -> ShowS
Show)

-- | Default 'DefaultSwitchesOptions'.
--
-- This set of switches tries to leave the text as much unmodified as possible.
--
-- It does __not__ define default switches used by @Text.Interpolation.Nyan@
-- module, and you will likely want to enable at least some options here.
basicDefaultSwitchesOptions :: DefaultSwitchesOptions
basicDefaultSwitchesOptions :: DefaultSwitchesOptions
basicDefaultSwitchesOptions = DefaultSwitchesOptions
  { defSpacesTrimming :: Maybe Bool
defSpacesTrimming = forall a. a -> Maybe a
Just Bool
False
  , defIndentationStripping :: Maybe Bool
defIndentationStripping = forall a. a -> Maybe a
Just Bool
False
  , defLeadingNewlineStripping :: Maybe Bool
defLeadingNewlineStripping = forall a. a -> Maybe a
Just Bool
False
  , defTrailingSpacesStripping :: Maybe Bool
defTrailingSpacesStripping = forall a. a -> Maybe a
Just Bool
False
  , defReturnType :: Maybe ReturnType
defReturnType = forall a. a -> Maybe a
Just ReturnType
AnyFromBuilder
  , defReducedNewlines :: Maybe Bool
defReducedNewlines = forall a. a -> Maybe a
Just Bool
False
  , defMonadic :: Maybe Bool
defMonadic = forall a. a -> Maybe a
Just Bool
False
  }

-- | 'DefaultSwitchesOptions' used in the @Text.Interpolation.Nyan@ module
-- in the default interpolator.
recommendedDefaultSwitchesOptions :: DefaultSwitchesOptions
recommendedDefaultSwitchesOptions :: DefaultSwitchesOptions
recommendedDefaultSwitchesOptions = DefaultSwitchesOptions
  { defSpacesTrimming :: Maybe Bool
defSpacesTrimming = forall a. a -> Maybe a
Just Bool
False
  , defIndentationStripping :: Maybe Bool
defIndentationStripping = forall a. a -> Maybe a
Just Bool
True
  , defLeadingNewlineStripping :: Maybe Bool
defLeadingNewlineStripping = forall a. a -> Maybe a
Just Bool
True
  , defTrailingSpacesStripping :: Maybe Bool
defTrailingSpacesStripping = forall a. a -> Maybe a
Just Bool
True
  , defReturnType :: Maybe ReturnType
defReturnType = forall a. a -> Maybe a
Just ReturnType
AnyFromBuilder
  , defReducedNewlines :: Maybe Bool
defReducedNewlines = forall a. a -> Maybe a
Just Bool
False
  , defMonadic :: Maybe Bool
defMonadic = forall a. a -> Maybe a
Just Bool
False
  }

-- | How to expand values in @#{}@ into Haskell AST.
newtype ValueInterpolator = ValueInterpolator
  { ValueInterpolator -> Text -> ExpQ
runValueInterpolator :: Text -> ExpQ
  }

-- | Transformation that describes how to mark the invisible characters.
--
-- Use 'Monoid' instance to sequence multiple such transformations.
newtype InvisibleCharsPreview = InvisibleCharsPreview
  { InvisibleCharsPreview -> ShowS
replaceInvisibleChars :: String -> String
  } deriving NonEmpty InvisibleCharsPreview -> InvisibleCharsPreview
InvisibleCharsPreview
-> InvisibleCharsPreview -> InvisibleCharsPreview
forall b.
Integral b =>
b -> InvisibleCharsPreview -> InvisibleCharsPreview
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: forall b.
Integral b =>
b -> InvisibleCharsPreview -> InvisibleCharsPreview
$cstimes :: forall b.
Integral b =>
b -> InvisibleCharsPreview -> InvisibleCharsPreview
sconcat :: NonEmpty InvisibleCharsPreview -> InvisibleCharsPreview
$csconcat :: NonEmpty InvisibleCharsPreview -> InvisibleCharsPreview
<> :: InvisibleCharsPreview
-> InvisibleCharsPreview -> InvisibleCharsPreview
$c<> :: InvisibleCharsPreview
-> InvisibleCharsPreview -> InvisibleCharsPreview
Semigroup via (Endo String)
    deriving Semigroup InvisibleCharsPreview
InvisibleCharsPreview
[InvisibleCharsPreview] -> InvisibleCharsPreview
InvisibleCharsPreview
-> InvisibleCharsPreview -> InvisibleCharsPreview
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [InvisibleCharsPreview] -> InvisibleCharsPreview
$cmconcat :: [InvisibleCharsPreview] -> InvisibleCharsPreview
mappend :: InvisibleCharsPreview
-> InvisibleCharsPreview -> InvisibleCharsPreview
$cmappend :: InvisibleCharsPreview
-> InvisibleCharsPreview -> InvisibleCharsPreview
mempty :: InvisibleCharsPreview
$cmempty :: InvisibleCharsPreview
Monoid via (Endo String)

-- | Options set when creating an interpolator.
data InterpolatorOptions = InterpolatorOptions
  { InterpolatorOptions -> DefaultSwitchesOptions
defaultSwitchesOptions :: DefaultSwitchesOptions
    -- ^ Default switches options.

  , InterpolatorOptions -> ValueInterpolator
valueInterpolator      :: ValueInterpolator
    -- ^ Expands text in @#{}@ into AST.
    --
    -- We have to leave this changeable because there is no "perfect" expander.
    -- Using the most appropriate one would require relying on @haskell-src-exts@
    -- package which is quite a heavy-weight dependency.
    -- Some users would prefer a simpler solution which would only allow
    -- variables in @#{}@.
    --
    -- Interpreting the passed text in tricky ways is valid.
    -- For instance, for specialized interpolators @#{var}@
    -- could be expanded to @local'var@, @view varLens@, or more complex
    -- Haskell code.

  , InterpolatorOptions -> InvisibleCharsPreview
invisibleCharsPreview  :: InvisibleCharsPreview
    -- ^ In case, when the switches are set to preview the resulting text
    -- with invisibles being marked specially (@!!@), how to update the pieces
    -- of text.
  }