mega-sdist 0.3.0.3 → 0.3.0.4
raw patch · 3 files changed
+87/−41 lines, 3 files
Files
- ChangeLog.md +5/−0
- mega-sdist.cabal +44/−31
- mega-sdist.hs +38/−10
ChangeLog.md view
@@ -1,3 +1,8 @@+## 0.3.0.4++* Warning cleanup+* Colorize diffs+ ## 0.3.0.3 * Diffs against previous versions
mega-sdist.cabal view
@@ -1,34 +1,47 @@-Name: mega-sdist-Version: 0.3.0.3-Synopsis: Handles uploading to Hackage from mega repos-Description: See README.md-Homepage: https://github.com/snoyberg/mega-sdist-License: MIT-License-file: LICENSE-Author: Michael Snoyman-Maintainer: michael@snoyman.com-Category: Distribution-Build-type: Simple-Cabal-version: >=1.8-extra-source-files: README.md ChangeLog.md+-- This file has been generated from package.yaml by hpack version 0.20.0.+--+-- see: https://github.com/sol/hpack+--+-- hash: 2563f862ebfe95c1677871684a68b2b6e9ad380b37504e43d4df5a90efb9b749 -Executable mega-sdist- Main-is: mega-sdist.hs- other-modules: Paths_mega_sdist- Build-depends: base >= 4 && < 5- , classy-prelude-conduit >= 1.2- , conduit-extra- , http-conduit >= 2.2.3- , tar-conduit- , directory- , filepath- , typed-process- , yaml- , optparse-simple- , temporary- , bytestring- , text+name: mega-sdist+version: 0.3.0.4+synopsis: Handles uploading to Hackage from mega repos+description: See README.md+category: Distribution+homepage: https://github.com/snoyberg/mega-sdist#readme+bug-reports: https://github.com/snoyberg/mega-sdist/issues+author: Michael Snoyman+maintainer: michael@snoyman.com+license: MIT+license-file: LICENSE+build-type: Simple+cabal-version: >= 1.10 +extra-source-files:+ ChangeLog.md+ README.md+ source-repository head- type: git- location: https://github.com/snoyberg/mega-sdist.git+ type: git+ location: https://github.com/snoyberg/mega-sdist++executable mega-sdist+ main-is: mega-sdist.hs+ build-depends:+ base >=4 && <5+ , bytestring+ , classy-prelude-conduit >=1.2+ , conduit-extra+ , directory+ , filepath+ , http-conduit >=2.2.3+ , optparse-simple+ , tar-conduit+ , temporary+ , text+ , typed-process+ , yaml+ other-modules:+ Paths_mega_sdist+ default-language: Haskell2010
mega-sdist.hs view
@@ -12,8 +12,9 @@ import System.FilePath import Data.Conduit.Binary (sinkFileCautious) import Data.Yaml (Value (..), decodeEither')-import Options.Applicative.Simple-import Paths_mega_sdist (version)+import Options.Applicative.Simple hiding (header, value)+import qualified Paths_mega_sdist as Paths (version)+import System.IO (hIsTerminalDevice) import System.IO.Temp (withSystemTempDirectory) import qualified Data.ByteString.Lazy as L import Data.Semigroup (Max (..), Option (..))@@ -49,7 +50,7 @@ main :: IO () main = do (Args {..}, ()) <- simpleOptions- $(simpleVersion version)+ $(simpleVersion Paths.version) "Check Haskell cabal package versions in a mega-repo" "Determines if the code present in this repo is the most current with Hackage" (Args@@ -101,13 +102,15 @@ mapM_ sayPackage $ keys s mapM_ (removeFile . packageFile) $ keys s + toColor <- hIsTerminalDevice stdout+ case lookup DoesNotExist m of Nothing -> return () Just s -> do say "\nThe following new packages exist locally:" forM_ (mapToList s) $ \(name, mdiff) -> do sayPackage name- forM_ mdiff (L.hPut stdout)+ sayDiff toColor mdiff case lookup NeedsVersionBump m of Nothing -> do@@ -123,8 +126,12 @@ say "\nThe following packages require a version bump:" forM_ (mapToList s) $ \(name, mdiff) -> do sayPackage name- forM_ mdiff (L.hPut stdout)+ sayDiff toColor mdiff +sayDiff :: Bool -- ^ use color?+ -> Maybe Diff -> IO ()+sayDiff toColor = mapM_ $ L.hPut stdout . (if toColor then colorize else id)+ data Status = DoesNotExist | NoChanges | NeedsVersionBump deriving (Show, Eq, Ord) @@ -145,8 +152,8 @@ if localFileExists then handleFile else do- reqH <- getUrlHackage package- runResourceT $ httpSink reqH $ \resH -> do+ reqH <- getUrlHackage package+ runResourceT $ httpSink reqH $ \resH -> do case () of () | getResponseStatusCode resH `elem` [403, 404] -> do@@ -174,9 +181,9 @@ getLatestVersion :: MonadIO m => PackageName -> m (Maybe (FilePath, Version)) getLatestVersion name = liftIO $ do stack <- getAppUserDataDirectory "stack"- let index = stack </> "indices" </> "Hackage" </> "00-index.tar"+ let indexTar = stack </> "indices" </> "Hackage" </> "00-index.tar" mversion <- runConduitRes- $ sourceFile index+ $ sourceFile indexTar .| untar .| withEntries yield .| foldMapC (parseVersionNumber name)@@ -276,7 +283,7 @@ , unpack (unVersion v) ] (_, out, _) <- readProcess $ setWorkingDir diff $ proc "diff"- [ "-r"+ [ "-ru" , "old" </> toNV av , "new" </> toNV bv ]@@ -306,3 +313,24 @@ lbs <- sinkLazy yield $ asMap $ singletonMap (headerFilePath header) lbs | otherwise = return ()++colorize :: LByteString -> LByteString+colorize =+ intercalate "\n" . map colorLine . L.split 10+ where+ colorLine :: LByteString -> LByteString+ colorLine l =+ case (toEnum . fromEnum) <$> headMay l of+ Just '-' -> add "31" l+ Just '+' -> add "32" l+ Just '@' -> add "34" l+ _ -> l++ add :: LByteString -> LByteString -> LByteString+ add color l = concat+ [ "\x1b["+ , color+ , "m"+ , l+ , "\x1b[0m"+ ]