distribution-opensuse 1.0.0 → 1.1.0

raw patch · 5 files changed

+107/−19 lines, 5 filesdep ~basePVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• distribution-opensuse.cabal +12/−1
• guess-changelog.hs +8/−9
• src/OpenSuse/GuessChangeLog.hs +12/−9
• src/OpenSuse/StripSpace.hs +42/−0
• tests/test-strip-space.hs +33/−0

@@ -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

@@ -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 

@@ -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)

@@ -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

@@ -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+                    ])