{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}

module OpenSuse.StripSpace ( stripSpace ) where

import OpenSuse.Prelude

import qualified Data.Text as Text

-- | A (quite possibly inefficient) re-implementation of @git stripspace@. This
-- function normalizes a 'Text' buffer to conform to the following rules:
--
-- * All trailing white space is stripped.
--
-- * Empty lines at the beginning or at the end of the buffer are stripped.
--
-- * Consecutive empty lines between paragraphs are collapsed into one.
--
-- * @\\r\\n@ line endings are normalized into @\\n@.
--
-- * If the buffer is not empty, then its last line is terminated by @\\n@.
--
-- * If the buffer is empty (i.e. it contains only white space), then it comes
--   out as the empty string.

stripSpace :: Text -> Text
stripSpace :: Text -> Text
stripSpace = [Text] -> Text
Text.unlines
           ([Text] -> Text) -> (Text -> [Text]) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> [Text]
normalizeEndOfText
           ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mode -> [Text] -> [Text]
normalizeEmptyLines Mode
Skip
           ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
Text.stripEnd
           ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
Text.lines

data Mode = Skip | Keep

normalizeEmptyLines :: Mode -> [Text] -> [Text]
normalizeEmptyLines :: Mode -> [Text] -> [Text]
normalizeEmptyLines  Mode
_     []    = []
normalizeEmptyLines Mode
Skip (Text
"":[Text]
ls) = Mode -> [Text] -> [Text]
normalizeEmptyLines Mode
Skip [Text]
ls
normalizeEmptyLines Mode
Keep (Text
"":[Text]
ls) = Text
"" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Mode -> [Text] -> [Text]
normalizeEmptyLines Mode
Skip [Text]
ls
normalizeEmptyLines Mode
_    (Text
l:[Text]
ls)  = Text
l  Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Mode -> [Text] -> [Text]
normalizeEmptyLines Mode
Keep [Text]
ls

normalizeEndOfText :: [Text] -> [Text]
normalizeEndOfText :: [Text] -> [Text]
normalizeEndOfText = [Text] -> [Text]
forall a. [a] -> [a]
reverse ([Text] -> [Text]) -> ([Text] -> [Text]) -> [Text] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Text -> Bool
Text.null ([Text] -> [Text]) -> ([Text] -> [Text]) -> [Text] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> [Text]
forall a. [a] -> [a]
reverse