Accept up2date package parameter

2023-12-11 08:14:55 +01:00
parent e9504fb8e5
commit 6a063b2cc4
7 changed files with 29 additions and 135 deletions
--- a/lib/SlackBuilder/Info.hs
+++ b/lib/SlackBuilder/Info.hs
@@ -2,8 +2,6 @@ module SlackBuilder.Info
    ( PackageInfo(..)
    , generate
    , parseInfoFile
-    , update
-    , updateDownloadVersion
    ) where

 import Control.Applicative (Alternative(..))
@@ -12,7 +10,6 @@ import qualified Data.ByteArray as ByteArray
 import Data.ByteString (ByteString)
 import qualified Data.ByteString as ByteString
 import qualified Data.ByteString.Char8 as Char8
-import qualified Data.List.NonEmpty as NonEmpty
 import Data.Maybe (mapMaybe)
 import Data.Text (Text)
 import qualified Data.Text as Text
@@ -27,17 +24,15 @@ import Numeric (readHex, showHex)
 import Text.Megaparsec (Parsec, count, eof, takeWhile1P)
 import Text.Megaparsec.Byte (space, string, hexDigitChar)
 import Text.URI
-    ( Authority(..)
-    , URI(..)
-    , mkPathPiece
+    ( URI(..)
    , parserBs
    , render
-    , unRText
    )
 import qualified Data.Word8 as Word8

 type GenParser = Parsec Void ByteString

+-- | Data used to generate an .info file.
 data PackageInfo = PackageInfo
    { pkgname :: String
    , version :: Text
@@ -108,60 +103,6 @@ parseInfoFile = PackageInfo
        *> packageName
        <* "\"\n"

-updateDownloadVersion :: PackageInfo -> Text -> Maybe String -> [URI]
-updateDownloadVersion package toVersion gnomeVersion
-    = updateDownload (version package) toVersion gnomeVersion
-    <$> downloads package
-
-updateDownload :: Text -> Text -> Maybe String -> URI -> URI
-updateDownload fromVersion toVersion gnomeVersion
-    = updateCoreVersion fromVersion toVersion gnomeVersion
-    . updatePackageVersion fromVersion toVersion gnomeVersion
-
-updatePackageVersion :: Text -> Text -> Maybe String -> URI -> URI
-updatePackageVersion fromVersion toVersion _gnomeVersion download = download
-    { uriPath = uriPath download >>= traverse (traverse updatePathPiece)
-    }
-  where
-    updatePathPiece = mkPathPiece
-        . Text.replace fromMajor toMajor
-        . Text.replace fromVersion toVersion
-        . unRText
-    fromMajor = major fromVersion
-    toMajor = major toVersion
-
-major :: Text -> Text
-major = Text.intercalate "." . take 2 . Text.splitOn "."
-
-updateCoreVersion :: Text -> Text -> Maybe String -> URI -> URI
-updateCoreVersion _fromVersion _toVersion (Just gnomeVersion) download
-    | Just (False, pathPieces) <- uriPath download
-    , (beforeCore, afterCore) <- NonEmpty.break (comparePathPiece "core") pathPieces
-    , _ : _ : _ : sources : afterSources <- afterCore
-    , comparePathPiece "sources" sources && not (null afterSources)
-    , Right Authority{..} <- uriAuthority download
-    , ".gnome.org" `Text.isSuffixOf` unRText authHost
-    , Nothing <- authPort =
-        download { uriPath = buildPath beforeCore afterSources }
-  where
-    comparePathPiece this that = Just that == mkPathPiece this
-    buildPath beforeCore afterSources = do
-        core <- mkPathPiece "core"
-        let textGnomeVersion = Text.pack gnomeVersion
-        minorGnomeVersion <- mkPathPiece $ major textGnomeVersion
-        patchGnomeVersion <- mkPathPiece textGnomeVersion
-        sources <- mkPathPiece "sources"
-        let afterCore = core : minorGnomeVersion : patchGnomeVersion : sources : afterSources
-        (False,) <$> NonEmpty.nonEmpty (beforeCore ++ afterCore)
-updateCoreVersion _ _ _ download = download            
-
-update :: PackageInfo -> Text -> [URI] -> [Digest MD5] -> PackageInfo
-update old toVersion downloads' checksums' = old
-    { version = toVersion
-    , downloads = downloads'
-    , checksums = checksums'
-    }
-
 generate :: PackageInfo -> Text
 generate pkg = Lazy.Text.toStrict $ Text.Builder.toLazyText builder
  where
--- a/lib/SlackBuilder/Package.hs
+++ b/lib/SlackBuilder/Package.hs
@@ -3,7 +3,6 @@ module SlackBuilder.Package
    , Download(..)
    , DownloadTemplate(..)
    , Package(..)
-    , PackageInfo(..)
    , Maintainer(..)
    , Updater(..)
    , renderDownloadWithVersion
@@ -34,15 +33,6 @@ data Download = Download
    , is64 :: Bool
    } deriving (Eq, Show)

-- | Data used to generate an .info file.
-data PackageInfo = PackageInfo
-    { path :: FilePath
-    , version :: Text
-    , homepage :: Text
-    , requires :: [Text]
-    , maintainer :: Maintainer
-    } deriving (Eq, Show)
-
 -- | Package maintainer information.
 data Maintainer = Maintainer
    { name :: Text
--- a/lib/SlackBuilder/Trans.hs
+++ b/lib/SlackBuilder/Trans.hs
@@ -1,11 +1,19 @@
 module SlackBuilder.Trans
-    ( SlackBuilderT(..)
+    ( SlackBuilderException(..)
+    , SlackBuilderT(..)
    ) where

 import Control.Monad.Trans.Reader (ReaderT(..))
+import Data.Text (Text)
 import SlackBuilder.Config
 import Control.Monad.IO.Class (MonadIO(..))
 import Control.Monad.Catch (MonadCatch(..), MonadThrow(..))
+import Control.Exception (Exception(..))
+
+newtype SlackBuilderException = UpdaterNotFound Text
+    deriving Show
+
+instance Exception SlackBuilderException

 newtype SlackBuilderT a = SlackBuilderT
    { runSlackBuilderT :: ReaderT Settings IO a
--- a/slackbuilder.cabal
+++ b/slackbuilder.cabal
@@ -22,6 +22,7 @@ common dependencies
    containers ^>= 0.6,
    cryptonite >= 0.30,
    directory ^>= 1.3.8,
+    exceptions >= 0.10,
    filepath ^>= 1.4.2,
    megaparsec ^>= 9.5,
    modern-uri ^>= 0.3.6,
@@ -58,7 +59,6 @@ library
  hs-source-dirs: lib
  build-depends:
    conduit ^>= 1.3.5,
-    exceptions >= 0.10,
    http-client ^>= 0.7

  ghc-options: -Wall
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -6,6 +6,7 @@ import Data.Char (isNumber)
 import Control.Applicative (Applicative(liftA2))
 import Data.List.NonEmpty (NonEmpty(..))
 import qualified Data.List.NonEmpty as NonEmpty
+import Control.Monad.Catch (MonadThrow(..))
 import Control.Monad.IO.Class (MonadIO(..))
 import Data.Maybe (fromJust)
 import qualified Data.Map as Map
@@ -250,8 +251,13 @@ autoUpdatable =
        }
    ]

-up2Date :: SlackBuilderT ()
-up2Date = for_ autoUpdatable go
+up2Date :: Maybe Text -> SlackBuilderT ()
+up2Date = \case
+    Nothing -> for_ autoUpdatable go
+    Just packageName
+        | Just foundPackage <- find ((packageName ==) . getField @"name") autoUpdatable ->
+            go foundPackage
+        | otherwise -> throwM $ UpdaterNotFound packageName
  where
    go package = getAndLogLatest package
        >>= mapM_ (updatePackageIfRequired package)
@@ -427,10 +433,10 @@ main = do
    maybe (pure ()) Text.IO.putStrLn latestVersion
  where
    executeCommand = \case
-        CategoryCommand _packageName -> do
+        CategoryCommand -> do
            repository' <- SlackBuilderT $ asks repository
            categories <- liftIO $ findCategory repository'
            liftIO $ print $ splitFileName . makeRelative repository' <$> categories
            pure Nothing
        CheckCommand -> check >> pure Nothing
-        Up2DateCommand -> up2Date >> pure Nothing
+        Up2DateCommand packageName -> up2Date packageName >> pure Nothing
--- a/src/SlackBuilder/CommandLine.hs
+++ b/src/SlackBuilder/CommandLine.hs
@@ -16,13 +16,14 @@ import Options.Applicative
    , info
    , fullDesc
    , subparser
-    , command,
+    , command
+    , optional
    )

 data SlackBuilderCommand
-    = CategoryCommand Text
+    = CategoryCommand
    | CheckCommand
-    | Up2DateCommand
+    | Up2DateCommand (Maybe Text)

 data PackagistArguments = PackagistArguments
    { vendor :: Text
@@ -49,7 +50,7 @@ slackBuilderCommand = subparser
    <> command "check" (info checkCommand mempty)
    <> command "up2date" (info up2DateCommand mempty)
  where
-    categoryCommand = CategoryCommand
-        <$> argument str (metavar "PKGNAM")
+    categoryCommand = pure CategoryCommand
    checkCommand = pure CheckCommand
-    up2DateCommand = pure Up2DateCommand
+    up2DateCommand = Up2DateCommand
+        <$> optional (argument str (metavar "PKGNAM"))
--- a/tests/SlackBuilder/InfoSpec.hs
+++ b/tests/SlackBuilder/InfoSpec.hs
@@ -100,55 +100,3 @@ spec = do
                given = PackageInfo
                    "pkgnam" "1.2.3" "homepage" downloads' checksumSample [] [] [] "Z" "test@example.com"
             in generate given `shouldBe` Text.decodeUtf8 infoDownload1
-
-    describe "updateDownloadVersion" $ do
-        it "replaces the version" $
-            let downloads' = maybeToList
-                    $ mkURI "https://dlackware.com/download-1.2.3.tar.gz"
-                testPackage = PackageInfo
-                    "pkgnam" "1.2.3" "homepage" downloads' checksumSample [] [] [] "Z" "test@example.com"
-                expected = maybeToList
-                    $ mkURI "https://dlackware.com/download-2.3.4.tar.gz"
-                actual = updateDownloadVersion testPackage "2.3.4" Nothing
-             in actual `shouldBe` expected
-
-        it "updates the major version" $
-            let downloads' = maybeToList
-                    $ mkURI "https://dlackware.com/1.2/download.tar.gz"
-                testPackage = PackageInfo
-                    "pkgnam" "1.2.3" "homepage" downloads' checksumSample [] [] [] "Z" "test@example.com"
-                expected = maybeToList
-                    $ mkURI "https://dlackware.com/2.3/download.tar.gz"
-                actual = updateDownloadVersion testPackage "2.3.4" Nothing
-             in actual `shouldBe` expected
-
-        it "updates gnome version" $
-            let downloads' = maybeToList
-                    $ mkURI "https://download.gnome.org/core/3.36/3.36.0/sources/gnome-calendar-3.36.0.tar.xz"
-                testPackage = PackageInfo "gnome-calendar" "3.36.0" "https://wiki.gnome.org/Core/Calendar"
-                    downloads' checksumSample [] [] [] "Z" "test@example.com"
-                expected = maybeToList
-                    $ mkURI "https://download.gnome.org/core/3.36/3.36.4/sources/gnome-calendar-3.36.2.tar.xz"
-                actual = updateDownloadVersion testPackage "3.36.2" $ Just "3.36.4"
-             in actual `shouldBe` expected
-
-        it "updates versions without a patch number" $
-            let downloads' = maybeToList
-                    $ mkURI "https://dlackware.com/gnome-contacts-3.36.tar.xz"
-                testPackage = PackageInfo
-                    "gnome-contacts" "3.36" "homepage" downloads' checksumSample [] [] [] "Z" "test@example.com"
-                expected = maybeToList
-                    $ mkURI "https://dlackware.com/gnome-contacts-3.36.2.tar.xz"
-                actual = updateDownloadVersion testPackage "3.36.2" Nothing
-             in actual `shouldBe` expected
-
-    describe "update" $
-        it "replaces the version" $
-            let downloads' = maybeToList
-                    $ mkURI "https://dlackware.com/1.2/download.tar.gz"
-                testPackage = PackageInfo
-                    "pkgnam" "1.2.3" "homepage" downloads' checksumSample [] [] [] "Z" "test@example.com"
-                expected = PackageInfo
-                    "pkgnam" "2.3.4" "homepage" downloads' checksumSample [] [] [] "Z" "test@example.com"
-                given = update testPackage "2.3.4" downloads' checksumSample
-             in given `shouldBe` expected