diff --git a/distribution-opensuse.cabal b/distribution-opensuse.cabal --- a/distribution-opensuse.cabal +++ b/distribution-opensuse.cabal @@ -1,5 +1,5 @@ name: distribution-opensuse -version: 1.0.0 +version: 1.1.0 synopsis: Types, functions, and tools to manipulate the openSUSE distribution description: Types, functions, and tools to manipulate the openSUSE distribution. license: BSD3 @@ -25,6 +25,7 @@ OpenSuse.Prelude.Parser OpenSuse.Prelude.PrettyPrinting OpenSuse.Prelude.PrettyPrinting.Orphans + OpenSuse.StripSpace OpenSuse.Types.ChangeLog OpenSuse.Types.EMailAddress OpenSuse.Types.Issue @@ -58,6 +59,16 @@ executable guess-changelog main-is: guess-changelog.hs build-depends: base, containers, distribution-opensuse, text, turtle + default-language: Haskell2010 + default-extensions: MonadFailDesugaring + ghc-options: -Wall -Wcompat -Wincomplete-uni-patterns -Wincomplete-record-updates + -Wredundant-constraints -threaded + +test-suite test-strip-space + type: exitcode-stdio-1.0 + main-is: test-strip-space.hs + hs-source-dirs: tests + build-depends: base, distribution-opensuse default-language: Haskell2010 default-extensions: MonadFailDesugaring ghc-options: -Wall -Wcompat -Wincomplete-uni-patterns -Wincomplete-record-updates diff --git a/guess-changelog.hs b/guess-changelog.hs --- a/guess-changelog.hs +++ b/guess-changelog.hs @@ -20,17 +20,16 @@ main :: IO () main = do - (oldDir,newDir) <- options "Guess the change log entry between two version of a package." parser + (oldDir,newDir) <- options "Guess the change log entry between two versions of a package." parser result <- guessChangeLog oldDir newDir case result of - Right txt -> Text.putStrLn txt - Left desc -> case desc of - NoChangeLogFiles -> eprintf "no change log files found\n" - UndocumentedUpdate p -> eprintf ("file "%fp%" has not changed between releases\n") p - NoCommonChangeLogFiles l r -> eprintf ("both directories have no files in common: "%fps%" vs. "%fps%"\n") l r - MoreThanOneChangeLogFile p -> eprintf ("too many changelog files: "%fps%"\n") p - UnmodifiedTopIsTooLarge p n -> eprintf (fp%" has more than 10 unmodified lines at top: "%d%"\n") p n - NotJustTopAdditions p -> eprintf (fp%" has more edits than just adding at the top\n") p + GuessedChangeLog _ txt -> Text.putStr txt + NoChangeLogFiles -> eprintf "no change log files found\n" + UndocumentedUpdate p -> eprintf ("file "%fp%" has not changed between releases\n") p + NoCommonChangeLogFiles l r -> eprintf ("both directories have no files in common: "%fps%" vs. "%fps%"\n") l r + MoreThanOneChangeLogFile p -> eprintf ("too many changelog files: "%fps%"\n") p + UnmodifiedTopIsTooLarge p n -> eprintf (fp%" has more than 10 unmodified lines at top: "%d%"\n") p n + NotJustTopAdditions p -> eprintf (fp%" has more edits than just adding at the top\n") p -- * Utility Functions diff --git a/src/OpenSuse/GuessChangeLog.hs b/src/OpenSuse/GuessChangeLog.hs --- a/src/OpenSuse/GuessChangeLog.hs +++ b/src/OpenSuse/GuessChangeLog.hs @@ -3,6 +3,8 @@ module OpenSuse.GuessChangeLog ( guessChangeLog, GuessedChangeLog(..) ) where +import OpenSuse.StripSpace + import qualified Control.Foldl as Fold import Control.Monad.Except import Data.Algorithm.Diff @@ -12,8 +14,11 @@ import Prelude hiding ( FilePath ) import Turtle hiding ( l, x ) -guessChangeLog :: FilePath -> FilePath -> IO (Either GuessedChangeLog Text) -guessChangeLog oldDir newDir = runExceptT $ do +guessChangeLog :: FilePath -> FilePath -> IO GuessedChangeLog +guessChangeLog oldDir = fmap (either id id) . guessChangeLog' oldDir + +guessChangeLog' :: FilePath -> FilePath -> IO (Either GuessedChangeLog GuessedChangeLog) +guessChangeLog' oldDir newDir = runExceptT $ do oldCLF <- Set.fromList <$> listShell (findChangeLogFiles oldDir) newCLF <- Set.fromList <$> listShell (findChangeLogFiles newDir) when (all null [oldCLF,newCLF]) (throwError NoChangeLogFiles) @@ -22,11 +27,8 @@ [] -> throwError (NoCommonChangeLogFiles oldCLF newCLF) [clf] -> return clf _ -> throwError (MoreThanOneChangeLogFile clf') - (oec,old) <- shellStrict (format ("git stripspace < "%fp) (oldDir clf)) empty - (nec,new) <- shellStrict (format ("git stripspace < "%fp) (newDir clf)) empty - unless (all (== ExitSuccess) [oec,nec]) $ - -- TODO: Throw a proper exception here, or even don't even rely on git-stripspace. - die (format ("git stripspace failed with "%w%"\n") oec) + old <- stripSpace <$> liftIO (readTextFile (oldDir clf)) + new <- stripSpace <$> liftIO (readTextFile (newDir clf)) let changes = cleanupEmptyLines (getDiff (Text.lines old) (Text.lines new)) (top,diff) = span inBoth changes (add,foot) = span inSecond diff @@ -34,9 +36,10 @@ when (all inBoth changes) (throwError (UndocumentedUpdate clf)) unless (length top < 10) (throwError (UnmodifiedTopIsTooLarge clf (fromIntegral (length top)))) unless topAddOnly (throwError (NotJustTopAdditions clf)) - return (Text.strip (Text.unlines (map unDiff add))) + return (GuessedChangeLog clf (stripSpace (Text.unlines (map unDiff add)))) -data GuessedChangeLog = NoChangeLogFiles +data GuessedChangeLog = GuessedChangeLog FilePath Text + | NoChangeLogFiles | UndocumentedUpdate FilePath | NoCommonChangeLogFiles (Set FilePath) (Set FilePath) | MoreThanOneChangeLogFile (Set FilePath) diff --git a/src/OpenSuse/StripSpace.hs b/src/OpenSuse/StripSpace.hs new file mode 100644 --- /dev/null +++ b/src/OpenSuse/StripSpace.hs @@ -0,0 +1,42 @@ +{-# 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.unlines + . normalizeEndOfText + . normalizeEmptyLines Skip + . map Text.stripEnd + . Text.lines + +data Mode = Skip | Keep + +normalizeEmptyLines :: Mode -> [Text] -> [Text] +normalizeEmptyLines _ [] = [] +normalizeEmptyLines Skip ("":ls) = normalizeEmptyLines Skip ls +normalizeEmptyLines Keep ("":ls) = "" : normalizeEmptyLines Skip ls +normalizeEmptyLines _ (l:ls) = l : normalizeEmptyLines Keep ls + +normalizeEndOfText :: [Text] -> [Text] +normalizeEndOfText = reverse . dropWhile Text.null . reverse diff --git a/tests/test-strip-space.hs b/tests/test-strip-space.hs new file mode 100644 --- /dev/null +++ b/tests/test-strip-space.hs @@ -0,0 +1,33 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +module Main where + +import OpenSuse.Prelude +import OpenSuse.StripSpace + +{-# INLINE (~~>) #-} +(~~>) :: String -> String -> (Text, Text) +(~~>) input result = (packText input, packText result) + +testCases :: [(Text, Text)] +testCases = + [ "para1\n\r\n\n para2 \n\r\r\n\n" ~~> "para1\n\n para2\n" + , "line1\nline2\r\nline3\n" ~~> "line1\nline2\nline3\n" + , "line1\nline2\n" ~~> "line1\nline2\n" + , "line1" ~~> "line1\n" + , "line 1 \r and still line 1" ~~> "line 1 \r and still line 1\n" + , "" ~~> "" + , "\n" ~~> "" + , " \n" ~~> "" + , " \n \n\n \n " ~~> "" + ] + +main :: IO () +main = + forM_ testCases $ \(inp,expct) -> do + let r = stripSpace inp + unless (r == expct) $ + fail (unwords [ "stripped version of", show inp + , "is", show r + , "not the expected", show expct + ])