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
processIntString :: SwitchesOptions -> ParsedInterpolatedString -> InterpolatedString
processIntString :: SwitchesOptions -> ParsedInterpolatedString -> InterpolatedString
processIntString SwitchesOptions
sopts ParsedInterpolatedString
istr = ParsedInterpolatedString
istr
ParsedInterpolatedString
-> (ParsedInterpolatedString -> Vector ParsedIntPiece)
-> Vector ParsedIntPiece
forall a c. a -> (a -> c) -> c
& ParsedInterpolatedString -> Vector ParsedIntPiece
forall a. [a] -> Vector a
V.fromList
Vector ParsedIntPiece
-> (Vector ParsedIntPiece -> Vector ParsedIntPiece)
-> Vector ParsedIntPiece
forall a c. a -> (a -> c) -> c
& do if SwitchesOptions -> Bool
leadingNewlineStripping SwitchesOptions
sopts then Vector ParsedIntPiece -> Vector ParsedIntPiece
stripLeadingNewline else Vector ParsedIntPiece -> Vector ParsedIntPiece
forall a. a -> a
id
Vector ParsedIntPiece
-> (Vector ParsedIntPiece -> Vector ParsedIntPiece)
-> Vector ParsedIntPiece
forall a c. a -> (a -> c) -> c
& do if SwitchesOptions -> Bool
trailingSpacesStripping SwitchesOptions
sopts then Vector ParsedIntPiece -> Vector ParsedIntPiece
stripTrailingLeadingWs else Vector ParsedIntPiece -> Vector ParsedIntPiece
forall a. a -> a
id
Vector ParsedIntPiece
-> (Vector ParsedIntPiece -> Vector ParsedIntPiece)
-> Vector ParsedIntPiece
forall a c. a -> (a -> c) -> c
& do if SwitchesOptions -> Bool
indentationStripping SwitchesOptions
sopts then Vector ParsedIntPiece -> Vector ParsedIntPiece
stripCommonIndentation else Vector ParsedIntPiece -> Vector ParsedIntPiece
forall a. a -> a
id
Vector ParsedIntPiece
-> (Vector ParsedIntPiece -> ParsedInterpolatedString)
-> ParsedInterpolatedString
forall a c. a -> (a -> c) -> c
& Vector ParsedIntPiece -> ParsedInterpolatedString
forall a. Vector a -> [a]
V.toList
ParsedInterpolatedString
-> (ParsedInterpolatedString -> ParsedInterpolatedString)
-> ParsedInterpolatedString
forall a c. a -> (a -> c) -> c
& do if SwitchesOptions -> Bool
reducedNewlines SwitchesOptions
sopts then ParsedInterpolatedString -> ParsedInterpolatedString
reduceNewlines else ParsedInterpolatedString -> ParsedInterpolatedString
forall a. a -> a
id
ParsedInterpolatedString
-> (ParsedInterpolatedString -> Vector ParsedIntPiece)
-> Vector ParsedIntPiece
forall a c. a -> (a -> c) -> c
& ParsedInterpolatedString -> Vector ParsedIntPiece
forall a. [a] -> Vector a
V.fromList
Vector ParsedIntPiece
-> (Vector ParsedIntPiece -> Vector ParsedIntPiece)
-> Vector ParsedIntPiece
forall a c. a -> (a -> c) -> c
& do if SwitchesOptions -> Bool
spacesTrimming SwitchesOptions
sopts then Vector ParsedIntPiece -> Vector ParsedIntPiece
trimLeftSpaces (Vector ParsedIntPiece -> Vector ParsedIntPiece)
-> (Vector ParsedIntPiece -> Vector ParsedIntPiece)
-> Vector ParsedIntPiece
-> Vector ParsedIntPiece
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector ParsedIntPiece -> Vector ParsedIntPiece
trimRightSpaces else Vector ParsedIntPiece -> Vector ParsedIntPiece
forall a. a -> a
id
Vector ParsedIntPiece
-> (Vector ParsedIntPiece -> ParsedInterpolatedString)
-> ParsedInterpolatedString
forall a c. a -> (a -> c) -> c
& Vector ParsedIntPiece -> ParsedInterpolatedString
forall a. Vector a -> [a]
V.toList
ParsedInterpolatedString
-> (ParsedInterpolatedString -> InterpolatedString)
-> InterpolatedString
forall a c. a -> (a -> c) -> c
& ParsedInterpolatedString -> InterpolatedString
unfoldWsData
InterpolatedString
-> (InterpolatedString -> InterpolatedString) -> InterpolatedString
forall a c. a -> (a -> c) -> c
& InterpolatedString -> InterpolatedString
glueStrings
where
& :: a -> (a -> c) -> c
(&) = ((a -> c) -> a -> c) -> a -> (a -> c) -> c
forall a b c. (a -> b -> c) -> b -> a -> c
flip (a -> c) -> a -> c
forall a b. (a -> b) -> a -> b
($)
stripLeadingNewline :: Vector ParsedIntPiece -> Vector ParsedIntPiece
stripLeadingNewline Vector ParsedIntPiece
ps = case Vector ParsedIntPiece
-> Maybe (ParsedIntPiece, Vector ParsedIntPiece)
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 Vector ParsedIntPiece
-> Maybe (Vector ParsedIntPiece, ParsedIntPiece)
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
_ -> Maybe ParsedIntPiece
forall a. Maybe a
Nothing
PipLeadingWs Word
_ -> Maybe ParsedIntPiece
forall a. Maybe a
Nothing
ParsedIntPiece
PipEmptyLine -> Maybe ParsedIntPiece
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 Maybe ParsedIntPiece
forall a. Maybe a
Nothing else ParsedIntPiece -> Maybe ParsedIntPiece
forall a. a -> Maybe a
Just (Text -> ParsedIntPiece
PipString Text
s')
p :: ParsedIntPiece
p@PipInt{} -> ParsedIntPiece -> Maybe ParsedIntPiece
forall a. a -> Maybe a
Just ParsedIntPiece
p
trimLeftSpaces :: Vector ParsedIntPiece -> Vector ParsedIntPiece
trimLeftSpaces Vector ParsedIntPiece
ps = case Vector ParsedIntPiece
-> Maybe (ParsedIntPiece, Vector ParsedIntPiece)
forall a. Vector a -> Maybe (a, Vector a)
V.uncons Vector ParsedIntPiece
ps of
Maybe (ParsedIntPiece, Vector ParsedIntPiece)
Nothing -> Vector ParsedIntPiece
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' -> ParsedIntPiece -> Vector ParsedIntPiece -> Vector ParsedIntPiece
forall a. a -> Vector a -> Vector a
V.cons ParsedIntPiece
p' Vector ParsedIntPiece
ps'
trimRightSpaces :: Vector ParsedIntPiece -> Vector ParsedIntPiece
trimRightSpaces Vector ParsedIntPiece
ps = case Vector ParsedIntPiece
-> Maybe (Vector ParsedIntPiece, ParsedIntPiece)
forall a. Vector a -> Maybe (Vector a, a)
V.unsnoc Vector ParsedIntPiece
ps of
Maybe (Vector ParsedIntPiece, ParsedIntPiece)
Nothing -> Vector ParsedIntPiece
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' -> Vector ParsedIntPiece -> ParsedIntPiece -> Vector ParsedIntPiece
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 <- ParsedIntPiece -> Maybe ParsedIntPiece
forall (f :: * -> *) a. Applicative f => a -> f a
pure ParsedIntPiece
piece
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Word
ws Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
/= Word
0)
Word -> Maybe Word
forall a. a -> Maybe a
Just Word
ws
minIndent :: Word
minIndent = case (ParsedIntPiece -> Maybe Word)
-> ParsedInterpolatedString -> [Word]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ParsedIntPiece -> Maybe Word
interestingIndent (Vector ParsedIntPiece -> ParsedInterpolatedString
forall a. Vector a -> [a]
V.toList Vector ParsedIntPiece
ps) of
[] -> [Char] -> Word
forall a. HasCallStack => [Char] -> a
error [Char]
"min indent requested unnecessarily"
[Word]
res -> [Word] -> Word
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [Word]
res
in ((ParsedIntPiece -> Maybe ParsedIntPiece)
-> Vector ParsedIntPiece -> Vector ParsedIntPiece)
-> Vector ParsedIntPiece
-> (ParsedIntPiece -> Maybe ParsedIntPiece)
-> Vector ParsedIntPiece
forall a b c. (a -> b -> c) -> b -> a -> c
flip (ParsedIntPiece -> Maybe ParsedIntPiece)
-> Vector ParsedIntPiece -> Vector ParsedIntPiece
forall a b. (a -> Maybe b) -> Vector a -> Vector b
V.mapMaybe Vector ParsedIntPiece
ps \case
PipLeadingWs Word
ws ->
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Word
ws Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
> Word
minIndent) Maybe () -> ParsedIntPiece -> Maybe ParsedIntPiece
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Word -> ParsedIntPiece
PipLeadingWs (Word
ws Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
minIndent)
ParsedIntPiece
other -> ParsedIntPiece -> Maybe ParsedIntPiece
forall a. a -> Maybe a
Just ParsedIntPiece
other
reduceNewlines :: ParsedInterpolatedString -> ParsedInterpolatedString
reduceNewlines = \case
PipNewline{} : ParsedInterpolatedString
l -> ParsedInterpolatedString -> ParsedInterpolatedString
skipNext ParsedInterpolatedString
l
ParsedIntPiece
p : ParsedInterpolatedString
l -> ParsedIntPiece
p ParsedIntPiece
-> ParsedInterpolatedString -> ParsedInterpolatedString
forall a. a -> [a] -> [a]
: ParsedInterpolatedString -> ParsedInterpolatedString
reduceNext ParsedInterpolatedString
l
[] -> []
where
reduceNext :: ParsedInterpolatedString -> ParsedInterpolatedString
reduceNext = \case
PipNewline{} : ParsedIntPiece
p : ParsedInterpolatedString
l -> case ParsedIntPiece
p of
PipEmptyLine{} -> ParsedIntPiece
p ParsedIntPiece
-> ParsedInterpolatedString -> ParsedInterpolatedString
forall a. a -> [a] -> [a]
: ParsedInterpolatedString -> ParsedInterpolatedString
skipNext ParsedInterpolatedString
l
ParsedIntPiece
_ -> Text -> ParsedIntPiece
PipString Text
" " ParsedIntPiece
-> ParsedInterpolatedString -> ParsedInterpolatedString
forall a. a -> [a] -> [a]
: ParsedInterpolatedString -> ParsedInterpolatedString
skipNext (ParsedIntPiece
p ParsedIntPiece
-> ParsedInterpolatedString -> ParsedInterpolatedString
forall a. a -> [a] -> [a]
: ParsedInterpolatedString
l)
[PipNewline{}] -> []
ParsedIntPiece
p : ParsedInterpolatedString
l -> ParsedIntPiece
p ParsedIntPiece
-> ParsedInterpolatedString -> ParsedInterpolatedString
forall a. a -> [a] -> [a]
: ParsedInterpolatedString -> ParsedInterpolatedString
reduceNext ParsedInterpolatedString
l
[] -> []
skipNext :: ParsedInterpolatedString -> ParsedInterpolatedString
skipNext = \case
p :: ParsedIntPiece
p@PipNewline{} : ParsedInterpolatedString
l -> ParsedIntPiece
p ParsedIntPiece
-> ParsedInterpolatedString -> ParsedInterpolatedString
forall a. a -> [a] -> [a]
: ParsedInterpolatedString -> ParsedInterpolatedString
skipNext ParsedInterpolatedString
l
p :: ParsedIntPiece
p@PipEmptyLine{} : ParsedInterpolatedString
l -> ParsedIntPiece
p ParsedIntPiece
-> ParsedInterpolatedString -> ParsedInterpolatedString
forall a. a -> [a] -> [a]
: ParsedInterpolatedString -> ParsedInterpolatedString
skipNext ParsedInterpolatedString
l
p :: ParsedIntPiece
p@PipLeadingWs{} : ParsedInterpolatedString
l -> ParsedIntPiece
p ParsedIntPiece
-> ParsedInterpolatedString -> ParsedInterpolatedString
forall a. a -> [a] -> [a]
: ParsedInterpolatedString -> ParsedInterpolatedString
skipNext ParsedInterpolatedString
l
p :: ParsedIntPiece
p@PipString{} : ParsedInterpolatedString
l -> ParsedIntPiece
p ParsedIntPiece
-> ParsedInterpolatedString -> ParsedInterpolatedString
forall a. a -> [a] -> [a]
: ParsedInterpolatedString -> ParsedInterpolatedString
reduceNext ParsedInterpolatedString
l
p :: ParsedIntPiece
p@PipInt{} : ParsedInterpolatedString
l -> ParsedIntPiece
p ParsedIntPiece
-> ParsedInterpolatedString -> ParsedInterpolatedString
forall a. a -> [a] -> [a]
: ParsedInterpolatedString -> ParsedInterpolatedString
reduceNext ParsedInterpolatedString
l
[] -> []
unfoldWsData :: ParsedInterpolatedString -> InterpolatedString
unfoldWsData :: ParsedInterpolatedString -> InterpolatedString
unfoldWsData = (ParsedIntPiece -> IntPiece)
-> ParsedInterpolatedString -> InterpolatedString
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 (Text -> IntPiece) -> ([Text] -> Text) -> [Text] -> IntPiece
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat ([Text] -> IntPiece) -> [Text] -> IntPiece
forall a b. (a -> b) -> a -> b
$ Int -> Text -> [Text]
forall a. Int -> a -> [a]
replicate (Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
n) Text
" "
ParsedIntPiece
PipEmptyLine -> Text -> IntPiece
IpString Text
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 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
s2) IntPiece -> InterpolatedString -> InterpolatedString
forall a. a -> [a] -> [a]
: InterpolatedString
ps)
IntPiece
p : InterpolatedString
ps -> IntPiece
p IntPiece -> InterpolatedString -> InterpolatedString
forall a. a -> [a] -> [a]
: InterpolatedString -> InterpolatedString
glueStrings InterpolatedString
ps