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

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

import Control.Monad (guard)
import Data.Functor (($>))
import Data.Maybe (mapMaybe)
import qualified Data.Text as T
import qualified Data.Vector as V
import Text.Interpolation.Nyan.Core.Internal.Base

-- | Applies the transformations like spaces stripping.
processIntString :: SwitchesOptions -> ParsedInterpolatedString -> InterpolatedString
processIntString :: SwitchesOptions -> ParsedInterpolatedString -> InterpolatedString
processIntString SwitchesOptions
sopts ParsedInterpolatedString
istr = ParsedInterpolatedString
istr
  forall {b} {c}. b -> (b -> c) -> c
& forall a. [a] -> Vector a
V.fromList
  forall {b} {c}. b -> (b -> c) -> c
& do if SwitchesOptions -> Bool
leadingNewlineStripping SwitchesOptions
sopts then Vector ParsedIntPiece -> Vector ParsedIntPiece
stripLeadingNewline else forall a. a -> a
id
  forall {b} {c}. b -> (b -> c) -> c
& do if SwitchesOptions -> Bool
trailingSpacesStripping SwitchesOptions
sopts then Vector ParsedIntPiece -> Vector ParsedIntPiece
stripTrailingLeadingWs else forall a. a -> a
id
  forall {b} {c}. b -> (b -> c) -> c
& do if SwitchesOptions -> Bool
indentationStripping SwitchesOptions
sopts then Vector ParsedIntPiece -> Vector ParsedIntPiece
stripCommonIndentation else forall a. a -> a
id
  forall {b} {c}. b -> (b -> c) -> c
& forall a. Vector a -> [a]
V.toList
  forall {b} {c}. b -> (b -> c) -> c
& do if SwitchesOptions -> Bool
reducedNewlines SwitchesOptions
sopts then ParsedInterpolatedString -> ParsedInterpolatedString
reduceNewlines else forall a. a -> a
id
  forall {b} {c}. b -> (b -> c) -> c
& forall a. [a] -> Vector a
V.fromList
  forall {b} {c}. b -> (b -> c) -> c
& do if SwitchesOptions -> Bool
spacesTrimming SwitchesOptions
sopts then Vector ParsedIntPiece -> Vector ParsedIntPiece
trimLeftSpaces forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector ParsedIntPiece -> Vector ParsedIntPiece
trimRightSpaces else forall a. a -> a
id
  forall {b} {c}. b -> (b -> c) -> c
& forall a. Vector a -> [a]
V.toList
    -- We don't need the information about trailing whitespaces anymore
  forall {b} {c}. b -> (b -> c) -> c
& ParsedInterpolatedString -> InterpolatedString
unfoldWsData
    -- Glue strings, as the previous stage put texts and whitespaces separately
  forall {b} {c}. b -> (b -> c) -> c
& InterpolatedString -> InterpolatedString
glueStrings
  where
    & :: b -> (b -> c) -> c
(&) = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. (a -> b) -> a -> b
($)

    stripLeadingNewline :: Vector ParsedIntPiece -> Vector ParsedIntPiece
stripLeadingNewline Vector ParsedIntPiece
ps = case forall a. Vector a -> Maybe (a, Vector a)
V.uncons Vector ParsedIntPiece
ps of
      Just (PipNewline Text
_, Vector ParsedIntPiece
ps') -> Vector ParsedIntPiece
ps'
      Maybe (ParsedIntPiece, Vector ParsedIntPiece)
_                        -> Vector ParsedIntPiece
ps

    stripTrailingLeadingWs :: Vector ParsedIntPiece -> Vector ParsedIntPiece
stripTrailingLeadingWs Vector ParsedIntPiece
ps = case forall a. Vector a -> Maybe (Vector a, a)
V.unsnoc Vector ParsedIntPiece
ps of
      Just (Vector ParsedIntPiece
ps', PipLeadingWs Word
_) -> Vector ParsedIntPiece
ps'
      Maybe (Vector ParsedIntPiece, ParsedIntPiece)
_                          -> Vector ParsedIntPiece
ps

    trimSpacesInPiece :: (Text -> Text) -> ParsedIntPiece -> Maybe ParsedIntPiece
trimSpacesInPiece Text -> Text
trimText = \case
      PipNewline Text
_ -> forall a. Maybe a
Nothing
      PipLeadingWs Word
_ -> forall a. Maybe a
Nothing
      ParsedIntPiece
PipEmptyLine -> forall a. Maybe a
Nothing
      PipString Text
s ->
        let s' :: Text
s' = Text -> Text
trimText Text
s
        in if Text -> Bool
T.null Text
s' then forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just (Text -> ParsedIntPiece
PipString Text
s')
      p :: ParsedIntPiece
p@PipInt{} -> forall a. a -> Maybe a
Just ParsedIntPiece
p

    trimLeftSpaces :: Vector ParsedIntPiece -> Vector ParsedIntPiece
trimLeftSpaces Vector ParsedIntPiece
ps = case forall a. Vector a -> Maybe (a, Vector a)
V.uncons Vector ParsedIntPiece
ps of
      Maybe (ParsedIntPiece, Vector ParsedIntPiece)
Nothing -> forall a. Monoid a => a
mempty
      Just (ParsedIntPiece
p, Vector ParsedIntPiece
ps') -> case (Text -> Text) -> ParsedIntPiece -> Maybe ParsedIntPiece
trimSpacesInPiece Text -> Text
T.stripStart ParsedIntPiece
p of
        Maybe ParsedIntPiece
Nothing -> Vector ParsedIntPiece -> Vector ParsedIntPiece
trimLeftSpaces Vector ParsedIntPiece
ps'
        Just ParsedIntPiece
p' -> forall a. a -> Vector a -> Vector a
V.cons ParsedIntPiece
p' Vector ParsedIntPiece
ps'

    trimRightSpaces :: Vector ParsedIntPiece -> Vector ParsedIntPiece
trimRightSpaces Vector ParsedIntPiece
ps = case forall a. Vector a -> Maybe (Vector a, a)
V.unsnoc Vector ParsedIntPiece
ps of
      Maybe (Vector ParsedIntPiece, ParsedIntPiece)
Nothing -> forall a. Monoid a => a
mempty
      Just (Vector ParsedIntPiece
ps', ParsedIntPiece
p) -> case (Text -> Text) -> ParsedIntPiece -> Maybe ParsedIntPiece
trimSpacesInPiece Text -> Text
T.stripEnd ParsedIntPiece
p of
        Maybe ParsedIntPiece
Nothing -> Vector ParsedIntPiece -> Vector ParsedIntPiece
trimRightSpaces Vector ParsedIntPiece
ps'
        Just ParsedIntPiece
p' -> forall a. Vector a -> a -> Vector a
V.snoc Vector ParsedIntPiece
ps' ParsedIntPiece
p'

    stripCommonIndentation :: Vector ParsedIntPiece -> Vector ParsedIntPiece
stripCommonIndentation Vector ParsedIntPiece
ps =
      let
        interestingIndent :: ParsedIntPiece -> Maybe Word
interestingIndent ParsedIntPiece
piece = do
          PipLeadingWs Word
ws <- forall (f :: * -> *) a. Applicative f => a -> f a
pure ParsedIntPiece
piece
            -- Lines without payload will likely be completely empty
            -- which is forced by trailing newline stripping
            -- So a line with 0 leading spaces won't not affect anything
          forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Word
ws forall a. Eq a => a -> a -> Bool
/= Word
0)
          forall a. a -> Maybe a
Just Word
ws
        minIndent :: Word
minIndent = case forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ParsedIntPiece -> Maybe Word
interestingIndent (forall a. Vector a -> [a]
V.toList Vector ParsedIntPiece
ps) of
          []  -> forall a. HasCallStack => [Char] -> a
error [Char]
"min indent requested unnecessarily"
          [Word]
res -> forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [Word]
res
      in forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. (a -> Maybe b) -> Vector a -> Vector b
V.mapMaybe Vector ParsedIntPiece
ps \case
        PipLeadingWs Word
ws ->
          forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Word
ws forall a. Ord a => a -> a -> Bool
> Word
minIndent) forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Word -> ParsedIntPiece
PipLeadingWs (Word
ws forall a. Num a => a -> a -> a
- Word
minIndent)
        ParsedIntPiece
other -> forall a. a -> Maybe a
Just ParsedIntPiece
other

    reduceNewlines :: ParsedInterpolatedString -> ParsedInterpolatedString
reduceNewlines = \case
        -- The initial case is special - we just want to remove the leading newline
        PipNewline{} : ParsedInterpolatedString
l -> ParsedInterpolatedString -> ParsedInterpolatedString
skipNext ParsedInterpolatedString
l
        ParsedIntPiece
p : ParsedInterpolatedString
l            -> ParsedIntPiece
p forall a. a -> [a] -> [a]
: ParsedInterpolatedString -> ParsedInterpolatedString
reduceNext ParsedInterpolatedString
l
        []               -> []
      where
        -- Reduce the next encountered newline
        reduceNext :: ParsedInterpolatedString -> ParsedInterpolatedString
reduceNext = \case
          PipNewline{} : ParsedIntPiece
p : ParsedInterpolatedString
l -> case ParsedIntPiece
p of
            -- Multiple newlines in a row are just reduced
            PipEmptyLine{} -> ParsedIntPiece
p forall a. a -> [a] -> [a]
: ParsedInterpolatedString -> ParsedInterpolatedString
skipNext ParsedInterpolatedString
l
            -- Otherwise we see two adjacent non-empty lines
            ParsedIntPiece
_              -> Text -> ParsedIntPiece
PipString Text
" " forall a. a -> [a] -> [a]
: ParsedInterpolatedString -> ParsedInterpolatedString
skipNext (ParsedIntPiece
p forall a. a -> [a] -> [a]
: ParsedInterpolatedString
l)
          [PipNewline{}] -> []
          ParsedIntPiece
p : ParsedInterpolatedString
l -> ParsedIntPiece
p forall a. a -> [a] -> [a]
: ParsedInterpolatedString -> ParsedInterpolatedString
reduceNext ParsedInterpolatedString
l
          [] -> []

        -- Skip all the next newlines as-is
        skipNext :: ParsedInterpolatedString -> ParsedInterpolatedString
skipNext = \case
          p :: ParsedIntPiece
p@PipNewline{} : ParsedInterpolatedString
l   -> ParsedIntPiece
p forall a. a -> [a] -> [a]
: ParsedInterpolatedString -> ParsedInterpolatedString
skipNext ParsedInterpolatedString
l
          p :: ParsedIntPiece
p@PipEmptyLine{} : ParsedInterpolatedString
l -> ParsedIntPiece
p forall a. a -> [a] -> [a]
: ParsedInterpolatedString -> ParsedInterpolatedString
skipNext ParsedInterpolatedString
l
          -- This case is questionable.
          -- Let's assume, that those who think that invisible spaces should not
          -- affect newlines reduction, also have trailing spaces cleanup in IDE.
          -- And there might be people who want special tuning and make
          -- invisible spaces to break the newlines sequence.
          p :: ParsedIntPiece
p@PipLeadingWs{} : ParsedInterpolatedString
l -> ParsedIntPiece
p forall a. a -> [a] -> [a]
: ParsedInterpolatedString -> ParsedInterpolatedString
skipNext ParsedInterpolatedString
l
          p :: ParsedIntPiece
p@PipString{} : ParsedInterpolatedString
l    -> ParsedIntPiece
p forall a. a -> [a] -> [a]
: ParsedInterpolatedString -> ParsedInterpolatedString
reduceNext ParsedInterpolatedString
l
          p :: ParsedIntPiece
p@PipInt{} : ParsedInterpolatedString
l       -> ParsedIntPiece
p forall a. a -> [a] -> [a]
: ParsedInterpolatedString -> ParsedInterpolatedString
reduceNext ParsedInterpolatedString
l
          []                   -> []

    unfoldWsData :: ParsedInterpolatedString -> InterpolatedString
    unfoldWsData :: ParsedInterpolatedString -> InterpolatedString
unfoldWsData = forall a b. (a -> b) -> [a] -> [b]
map \case
      PipString Text
s    -> Text -> IntPiece
IpString Text
s
      PipNewline Text
nl  -> Text -> IntPiece
IpString Text
nl
      PipLeadingWs Word
n -> Text -> IntPiece
IpString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a. Int -> a -> [a]
replicate (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
n) Text
" "
      ParsedIntPiece
PipEmptyLine   -> Text -> IntPiece
IpString forall a. Monoid a => a
mempty
      PipInt IntData
i       -> IntData -> IntPiece
IpInt IntData
i

    glueStrings :: InterpolatedString -> InterpolatedString
    glueStrings :: InterpolatedString -> InterpolatedString
glueStrings = \case
      []                             -> []
      IpString Text
s1 : IpString Text
s2 : InterpolatedString
ps -> InterpolatedString -> InterpolatedString
glueStrings (Text -> IntPiece
IpString (Text
s1 forall a. Semigroup a => a -> a -> a
<> Text
s2) forall a. a -> [a] -> [a]
: InterpolatedString
ps)
      IntPiece
p : InterpolatedString
ps                         -> IntPiece
p forall a. a -> [a] -> [a]
: InterpolatedString -> InterpolatedString
glueStrings InterpolatedString
ps