Whitespace.hs

module Language.Fluent.Parser.Whitespace where

import Control.Monad (void)
import Control.Monad.Extra (ifM, whenM, whenMaybeM, (&&^))
import Data.Attoparsec.Extra
import Data.Attoparsec.Text (Parser, atEnd, peekChar, takeWhile)
import Data.Text (Text)
import Data.Text qualified as Text
import Language.Fluent.AST
import Prelude hiding (takeWhile)

-- | Consumes a line end: a line break or the end of the input.
expectLineEnd :: Parser ()
expectLineEnd =
    peekChar >>= \case
        Nothing -> pure ()
        Just '\n' -> advance
        Just '\r' -> ifM (secondIs '\n') (advance *> advance) notLineEnd
        _ -> notLineEnd
  where
    notLineEnd :: Parser ()
    notLineEnd = parseError "Expected token: end of line"

-- | Whether a line end is next.
atLineEnd :: Parser Bool
atLineEnd =
    peekChar >>= \case
        Nothing -> pure True
        Just '\n' -> pure True
        Just '\r' -> secondIs '\n'
        _ -> pure False

-- | Consumes a line break, and tells whether there was one. The end of the input is not one.
consumeNewline :: Parser Bool
consumeNewline =
    peekChar >>= \case
        Just '\n' -> True <$ advance
        Just '\r' -> secondIs '\n' &&^ (True <$ (advance *> advance))
        _ -> pure False

-- | Skips the spaces before the next character.
skipBlankInline :: Parser ()
skipBlankInline = void $ takeWhile (== ' ')

-- | Skips spaces and line breaks.
skipBlank :: Parser ()
skipBlank = skipBlankInline *> whenM consumeNewline skipBlank

-- | Skips lines of only spaces, and tells how many.
skipBlankBlock :: Parser Int
skipBlankBlock = length <$> whileJust (attemptMaybe blankLine)
  where
    blankLine = skipBlankInline *> whenMaybeM consumeNewline (pure ())

-- | Like 'skipBlankBlock', and skips spaces that end the input.
skipBlankBlockToEnd :: Parser Int
skipBlankBlockToEnd =
    skipBlankBlock <* attemptMaybe (skipBlankInline *> whenMaybeM atEnd (pure ()))

-- | Applies <https://projectfluent.org/fluent/guide/multiline multi-line rules>
-- to the raw pattern elements.
dedent :: [PatternElement] -> [PatternElement]
dedent elements =
    onLast (mapText $ Text.dropWhileEnd (`elem` blanks))
        . onFirst dropLeadingBreaks
        $ strip <$> elements
  where
    newlines = "\r\n" :: String
    blanks = " \r\n" :: String
    commonIndent :: Int
    commonIndent =
        minimum $
            maxBound
                : [indentWidth t | BlockText t <- elements]
                    <> [indent | Placeable (BlockPlaceable indent _) <- elements]
    indentWidth :: Text -> Int
    indentWidth = Text.length . Text.takeWhile (== ' ') . Text.dropWhile (`elem` newlines)
    strip :: PatternElement -> PatternElement
    strip (BlockText t) =
        let (ns, rest) = Text.span (`elem` newlines) t
         in BlockText (ns <> Text.drop commonIndent rest)
    strip e = e
    dropLeadingBreaks :: PatternElement -> PatternElement
    dropLeadingBreaks (BlockText t) = BlockText $ Text.dropWhile (`elem` newlines) t
    dropLeadingBreaks e = e
    mapText :: (Text -> Text) -> PatternElement -> PatternElement
    mapText f (InlineText t) = InlineText $ f t
    mapText f (BlockText t) = BlockText $ f t
    mapText _ e = e
    onFirst, onLast :: (a -> a) -> [a] -> [a]
    onFirst f (x : xs) = f x : xs
    onFirst _ [] = []
    onLast f = reverse . onFirst f . reverse