Migrate composer updater

app/Main.hs

@@ -3,8 +3,9 @@ module Main
     ) where
 
 import Data.List.NonEmpty (NonEmpty(..))
+import qualified Data.List.NonEmpty as NonEmpty
 import Control.Monad.IO.Class (MonadIO(..))
-import Data.Maybe (fromMaybe)
+import Data.Maybe (fromJust, fromMaybe)
 import Options.Applicative (execParser)
 import SlackBuilder.CommandLine
 import SlackBuilder.Config
@@ -30,6 +31,7 @@ data Package = Package
     , name :: Text
     , homepage :: Maybe URI
     , requires :: [Text]
+    , reupload :: Bool
     }
 
 autoUpdatable :: [Package]
@@ -45,12 +47,28 @@ autoUpdatable =
                     , Package.StaticPlaceholder ".tar.gz"
                     ]
                 template = Package.DownloadTemplate
-                    $ Package.StaticPlaceholder "https://github.com/universal-ctags/ctags/archive/" :| templateTail
+                    $ Package.StaticPlaceholder "https://github.com/universal-ctags/ctags/archive/"
+                    :| templateTail
              in Package.Updater latest' template
         , category = "development"
         , name = "universal-ctags"
         , homepage = Just [uri|https://ctags.io/|]
         , requires = pure "%README%"
+        , reupload = True
+        }
+    , Package
+        { latest =
+            let packagistArguments = PackagistArguments{ vendor = "composer", name = "composer" }
+                latest' = latestPackagist packagistArguments
+                template = Package.DownloadTemplate
+                    $ Package.StaticPlaceholder "https://getcomposer.org/download/"
+                    :| [Package.VersionPlaceholder, Package.StaticPlaceholder "/composer.phar"]
+             in Package.Updater latest' template
+        , category = "development"
+        , name = "composer"
+        , homepage = Just [uri|https://getcomposer.org/|]
+        , requires = mempty
+        , reupload = False
         }
     ]
 
@@ -80,15 +98,14 @@ updatePackage Package{..} version = do
 
     repository' <- SlackBuilderT $ asks repository
     uri' <- liftIO $ Package.renderDownloadWithVersion downloadTemplate version
-    let relativeTarball = Text.replace "#{version}" version
-            "development/universal-ctags/ctags-#{version}.tar.gz"
+    let downloadFileName = URI.unRText
+            $ NonEmpty.last $ snd $ fromJust $ URI.uriPath uri'
+        relativeTarball = packagePath <> "/" <> downloadFileName
         tarball = repository' </> Text.unpack relativeTarball
     liftIO $ putStrLn
         $ "Downloading " <> Text.unpack (URI.render uri') <> " to " <> tarball <> "."
-    checksum <- fromMaybe undefined <$> download uri' tarball
-    download' <- liftIO $ mkURI
-        $ Text.replace "#{version}" version
-        "https://download.dlackware.com/hosted-sources/universal-ctags/ctags-#{version}.tar.gz"
+    checksum <- fromJust <$> download uri' tarball
+    download' <- handleReupload uri' relativeTarball downloadFileName
     let infoFilePath = repository' </> Text.unpack packagePath
             </> (Text.unpack name <.> "info")
 
@@ -96,11 +113,15 @@ updatePackage Package{..} version = do
         $ Package.infoTemplate package' [Package.Download download' checksum False]
     updateSlackBuildVersion packagePath version
 
-    liftIO $ putStrLn
-        $ "Upload the source tarball " <> Text.unpack relativeTarball
-    uploadCommand relativeTarball "/universal-ctags"
-
     commit packagePath version
+  where
+    handleReupload uri' relativeTarball downloadFileName
+        | reupload = 
+            liftIO (putStrLn $ "Upload the source tarball " <> Text.unpack relativeTarball)
+            >> uploadCommand relativeTarball ("/" <> name)
+            >> liftIO (mkURI $ "https://download.dlackware.com/hosted-sources/" <> name <> "/" <> downloadFileName)
+        | otherwise = pure uri'
+
 
 main :: IO ()
 main = do

lib/SlackBuilder/Trans.hs

@@ -5,6 +5,7 @@ module SlackBuilder.Trans
 import Control.Monad.Trans.Reader (ReaderT(..))
 import SlackBuilder.Config
 import Control.Monad.IO.Class (MonadIO(..))
+import Control.Monad.Catch (MonadCatch(..), MonadThrow(..))
 
 newtype SlackBuilderT a = SlackBuilderT
     { runSlackBuilderT :: ReaderT Settings IO a
@@ -27,3 +28,12 @@ instance Monad SlackBuilderT
 instance MonadIO SlackBuilderT
   where
     liftIO = SlackBuilderT . liftIO
+
+instance MonadThrow SlackBuilderT
+  where
+    throwM = SlackBuilderT . throwM
+
+instance MonadCatch SlackBuilderT
+  where
+    catch (SlackBuilderT action) handler =
+        SlackBuilderT $ catch action $ runSlackBuilderT . handler