mega-sdist 0.3.2 → 0.3.3
raw patch · 3 files changed
+29/−20 lines, 3 filesdep +rio-orphans
Dependencies added: rio-orphans
Files
- ChangeLog.md +4/−0
- mega-sdist.cabal +4/−4
- mega-sdist.hs +21/−16
ChangeLog.md view
@@ -1,3 +1,7 @@+## 0.3.3++* Support for new Stack 1.8 console output+ ## 0.3.2 * Switch to rio and LTS 11
mega-sdist.cabal view
@@ -1,11 +1,11 @@--- This file has been generated from package.yaml by hpack version 0.21.2.+-- This file has been generated from package.yaml by hpack version 0.28.2. -- -- see: https://github.com/sol/hpack ----- hash: 407ba429efdb65a7f336e889a0aeccf043f834c4c3c040efca8216c42587a55e+-- hash: afc2ed4fe6e6a2099f0044f7966a1f908f3db8ba91dce47907e608dcdc3a1860 name: mega-sdist-version: 0.3.2+version: 0.3.3 synopsis: Handles uploading to Hackage from mega repos description: Please see the description on Github at <https://github.com/snoyberg/mega-sdist#readme> category: Distribution@@ -17,7 +17,6 @@ license-file: LICENSE build-type: Simple cabal-version: >= 1.10- extra-source-files: ChangeLog.md README.md@@ -36,6 +35,7 @@ , http-conduit >=2.3 , optparse-simple , rio+ , rio-orphans , tar-conduit >=0.2.1 , yaml other-modules:
mega-sdist.hs view
@@ -4,6 +4,7 @@ {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TemplateHaskell #-} import RIO+import RIO.Orphans import Conduit import RIO.Directory import RIO.FilePath@@ -29,11 +30,14 @@ data App = App { appLogFunc :: !LogFunc , appProcessContext :: !ProcessContext+ , appResourceMap :: !ResourceMap } instance HasLogFunc App where logFuncL = lens appLogFunc (\x y -> x { appLogFunc = y }) instance HasProcessContext App where processContextL = lens appProcessContext (\x y -> x { appProcessContext = y })+instance HasResourceMap App where+ resourceMapL = lens appResourceMap (\x y -> x { appResourceMap = y }) getUrlHackage :: MonadIO m => Package -> m Request getUrlHackage (Package _fp (PackageName a) (Version b)) =@@ -88,10 +92,11 @@ lo <- logOptionsHandle stdout verbose pc <- mkDefaultProcessContext- withLogFunc lo $ \lf -> do+ withLogFunc lo $ \lf -> withResourceMap $ \rm -> do let app = App { appLogFunc = lf , appProcessContext = pc+ , appResourceMap = rm } runRIO app $ main2 args @@ -114,15 +119,15 @@ createDirectoryIfMissing True "tarballs" tarballs <- forM dirs $ \dir -> do- output <- proc "stack" ["sdist", dir] readProcessStderr_+ output <- proc "stack" ["--no-terminal", "sdist", dir] readProcessStderr_ case decodeUtf8' $ BL.toStrict output of Left e -> error $ "Invalid non-UTF8 output: " ++ show e- Right text -> case reverse $ map T.unpack $ T.words text of+ Right text -> case fmap T.unpack $ filter (".tar.gz" `T.isSuffixOf`) $ T.words text of fp:_ -> do let dest = "tarballs" </> takeFileName fp renameFile fp dest return dest- [] -> error $ "Unexpected 'stack sdist' output in dir: " ++ dir+ [] -> error $ "Unexpected 'stack sdist' output in dir: " ++ dir ++ "\n\n" ++ T.unpack text m <- Map.unionsWith mappend <$> mapM (go getDiffs) tarballs @@ -151,7 +156,7 @@ let ident = T.unpack $ mconcat [name, "-", version] msg = "Release: " <> ident in proc "git" ["tag", "-s", ident, "-m", msg] $ \pc -> do- logInfo $ displayShow pc+ logInfo $ display pc runProcess_ pc Just s -> do logInfo "\nThe following packages require a version bump:"@@ -185,33 +190,33 @@ then handleFile else do reqH <- getUrlHackage package- runResourceT $ httpSink reqH $ \resH -> do+ httpSink reqH $ \resH -> do case () of () | getResponseStatusCode resH `elem` [403, 404] -> do mdiff <- if getDiffs then do- mlatest <- getLatestVersion (packageName package)+ mlatest <- lift $ getLatestVersion $ packageName package case mlatest of Nothing -> return Nothing Just (latest, latestv) -> do- (isDiff, mdiff) <- lift $ lift $ compareTGZ getDiffs (packageName package) latest latestv fp (packageVersion package)+ (isDiff, mdiff) <- lift $ compareTGZ getDiffs (packageName package) latest latestv fp (packageVersion package) return $ if isDiff then mdiff else Nothing else return Nothing return (DoesNotExist, mdiff) | getResponseStatusCode resH == 403 -> return (DoesNotExist, Nothing) | getResponseStatusCode resH == 200 -> do- liftIO $ createDirectoryIfMissing True $ takeDirectory localFileHackage+ createDirectoryIfMissing True $ takeDirectory localFileHackage sinkFileCautious localFileHackage- lift $ lift handleFile+ lift handleFile | otherwise -> error $ "Invalid status code: " ++ show (getResponseStatus resH) return $ Map.singleton status $ Map.singleton package mdiff -- | Get the filepath for the latest version of a package from -- Hackage, if it exists at all.-getLatestVersion :: MonadIO m => PackageName -> m (Maybe (FilePath, Version))-getLatestVersion name = liftIO $ do+getLatestVersion :: PackageName -> RIO App (Maybe (FilePath, Version))+getLatestVersion name = do stack <- getAppUserDataDirectory "stack" let indexTar = stack </> "indices" </> "Hackage" </> "00-index.tar" mversion <- runConduitRes@@ -225,10 +230,10 @@ let p = Package "" name $ toTextVersion version fp <- getHackageFile p req <- getUrlHackage p- runResourceT $ httpSink req $ \res ->+ httpSink req $ \res -> if getResponseStatusCode res == 200 then do- liftIO $ createDirectoryIfMissing True $ takeDirectory fp+ createDirectoryIfMissing True $ takeDirectory fp sinkFileCautious fp return $ Just (fp, toTextVersion version) else error $ "Could not download from Hackage: " ++ show p@@ -278,7 +283,7 @@ logInfo $ display name <> "-" <> display version getHackageFile :: MonadIO m => Package -> m FilePath-getHackageFile (Package _fp (PackageName a') (Version b')) = liftIO $ do+getHackageFile (Package _fp (PackageName a') (Version b')) = do stack <- getAppUserDataDirectory "stack" return $ stack </> "indices" </> "Hackage" </> "packages" </> a </> b </> concat [a, "-", b, ".tar.gz"]@@ -338,7 +343,7 @@ "Error opening tarball: " <> fromString fp <> ", " <>- displayShow e+ display e return mempty addEntry header