summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorEugen Wissner <belka@caraus.de>2024-03-19 11:34:19 +0100
committerEugen Wissner <belka@caraus.de>2024-03-19 11:34:19 +0100
commitbc3ba48d851f4f46f0ab33547efa39fa1fb0414a (patch)
tree530c32bea8c2034da4506c461673a6b6205423c9
parent3d81917627188cdbd8809729ecde7e20e21a1a43 (diff)
downloadslackbuilder-bc3ba48d851f4f46f0ab33547efa39fa1fb0414a.tar.gz
Recognize + in sematnic tags
-rw-r--r--lib/SlackBuilder/LatestVersionCheck.hs (renamed from src/SlackBuilder/LatestVersionCheck.hs)2
-rw-r--r--slackbuilder.cabal12
-rw-r--r--src/Main.hs243
-rw-r--r--src/SlackBuilder/Update.hs262
-rw-r--r--tests/SlackBuilder/InfoSpec.hs4
-rw-r--r--tests/SlackBuilder/LatestVersionCheckSpec.hs24
-rw-r--r--tests/SlackBuilder/PackageSpec.hs4
7 files changed, 309 insertions, 242 deletions
diff --git a/src/SlackBuilder/LatestVersionCheck.hs b/lib/SlackBuilder/LatestVersionCheck.hs
index 233ea3c..5dae251 100644
--- a/src/SlackBuilder/LatestVersionCheck.hs
+++ b/lib/SlackBuilder/LatestVersionCheck.hs
@@ -59,7 +59,7 @@ stableTagTransform :: Text -> Maybe Text
stableTagTransform = Text.stripPrefix "v" >=> checkForStable
where
checkForStable tag
- | '-' `Text.elem` tag = Nothing
+ | Text.any (`elem` ['-', '+']) tag = Nothing
| otherwise = Just tag
-- * Packagist
diff --git a/slackbuilder.cabal b/slackbuilder.cabal
index c712acb..ca22590 100644
--- a/slackbuilder.cabal
+++ b/slackbuilder.cabal
@@ -17,6 +17,7 @@ extra-source-files: CHANGELOG.md
common dependencies
build-depends:
+ aeson ^>= 2.2.0,
base >= 4.16 && < 5,
bytestring ^>= 0.11.0,
conduit ^>= 1.3.5,
@@ -38,6 +39,8 @@ common dependencies
text ^>= 2.0,
tomland ^>= 1.3.3,
transformers ^>= 0.5.6,
+ unordered-containers ^>= 0.2.19,
+ vector ^>= 0.13.0,
word8 ^>= 0.1.3
default-language: Haskell2010
default-extensions:
@@ -59,6 +62,7 @@ library
SlackBuilder.Config
SlackBuilder.Download
SlackBuilder.Info
+ SlackBuilder.LatestVersionCheck
SlackBuilder.Package
SlackBuilder.Trans
hs-source-dirs: lib
@@ -70,14 +74,11 @@ executable slackbuilder
other-modules:
SlackBuilder.CommandLine
- SlackBuilder.LatestVersionCheck
+ SlackBuilder.Update
build-depends:
- aeson ^>= 2.2.0,
ansi-terminal ^>= 1.0,
optparse-applicative ^>= 0.18.1,
- slackbuilder,
- unordered-containers ^>= 0.2.19,
- vector ^>= 0.13.0
+ slackbuilder
hs-source-dirs: src
ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall
@@ -89,6 +90,7 @@ test-suite slackbuilder-test
other-modules:
SlackBuilder.InfoSpec
+ SlackBuilder.LatestVersionCheckSpec
SlackBuilder.PackageSpec
hs-source-dirs: tests
build-depends:
diff --git a/src/Main.hs b/src/Main.hs
index fb3a814..b51d4cd 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -7,66 +7,28 @@ module Main
) where
import Data.Char (isNumber)
-import Control.Applicative (Applicative(liftA2))
+import Control.Applicative (Applicative(..))
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, fromMaybe)
import qualified Data.Map as Map
import Options.Applicative (execParser)
import SlackBuilder.CommandLine
import SlackBuilder.Config
import SlackBuilder.Trans
import SlackBuilder.LatestVersionCheck
+import SlackBuilder.Update
import qualified Toml
-import qualified Data.ByteString as ByteString
import Data.Text (Text)
import qualified Data.Text as Text
import qualified Data.Text.IO as Text.IO
-import Control.Monad.Trans.Reader (ReaderT(..), asks)
-import SlackBuilder.Download
-import SlackBuilder.Package (PackageDescription(..), PackageUpdateData(..))
+import Control.Monad.Trans.Reader (ReaderT(..))
+import SlackBuilder.Package (PackageDescription(..))
import qualified SlackBuilder.Package as Package
-import Text.URI (URI(..), mkURI)
import Text.URI.QQ (uri)
-import Data.Foldable (Foldable(..), for_, find)
-import qualified Text.URI as URI
-import System.FilePath
- ( (</>)
- , (<.>)
- , dropExtension
- , takeBaseName
- , splitFileName
- , takeDirectory
- , takeFileName
- , dropTrailingPathSeparator
- )
-import SlackBuilder.Info
-import Text.Megaparsec (parse, errorBundlePretty)
+import Data.Foldable (for_, find)
import GHC.Records (HasField(..))
-import System.Process
- ( CmdSpec(..)
- , CreateProcess(..)
- , StdStream(..)
- , withCreateProcess
- , waitForProcess
- )
-import System.Console.ANSI
- ( setSGR
- , SGR(..)
- , ColorIntensity(..)
- , Color(..)
- , ConsoleLayer(..)
- )
-import System.Directory (listDirectory, doesDirectoryExist, withCurrentDirectory, removeDirectoryRecursive)
-import Control.Monad (filterM, void)
-import Data.List (isPrefixOf, isSuffixOf, partition)
-import Conduit (runConduitRes, (.|), yield)
-import Data.Functor ((<&>))
-import Data.Bifunctor (Bifunctor(..))
-import Data.Conduit.Tar (tarFilePath)
-import qualified Data.Conduit.Lzma as Lzma
+import System.Process (CmdSpec(..))
autoUpdatable :: [PackageDescription]
autoUpdatable =
@@ -180,7 +142,7 @@ autoUpdatable =
: Package.VersionPlaceholder
: [Package.StaticPlaceholder ".tar.gz"]
in Package.Updater
- { detectLatest = latestGitHub ghArguments $ Text.stripPrefix "v"
+ { detectLatest = latestGitHub ghArguments stableTagTransform
, getVersion = reuploadWithTemplate template []
, is64 = False
}
@@ -314,197 +276,6 @@ check = for_ autoUpdatable go
>>= mapM_ checkUpdateAvailability
>> liftIO (putStrLn "")
-getAndLogLatest :: PackageDescription -> SlackBuilderT (Maybe PackageUpdateData)
-getAndLogLatest description = do
- let PackageDescription{ latest = Package.Updater{ detectLatest }, name } = description
- liftIO (putStrLn $ Text.unpack name <> ": Retreiving the latest version.")
- detectedVersion <- detectLatest
- category <- fmap Text.pack
- <$> findCategory (Text.unpack name)
- pure $ PackageUpdateData description
- <$> category
- <*> detectedVersion
-
-checkUpdateAvailability :: PackageUpdateData -> SlackBuilderT (Maybe PackageInfo)
-checkUpdateAvailability PackageUpdateData{..} = do
- let name' = Text.unpack $ getField @"name" description
- packagePath = Text.unpack category </> name' </> (name' <.> "info")
- repository' <- SlackBuilderT $ asks repository
- infoContents <- liftIO $ ByteString.readFile $ repository' </> packagePath
-
- case parse parseInfoFile packagePath infoContents of
- Right parsedInfoFile
- | version == getField @"version" parsedInfoFile ->
- liftIO $ do
- setSGR [SetColor Foreground Dull Green]
- Text.IO.putStrLn
- $ getField @"name" description <> " is up to date (Version " <> version <> ")."
- setSGR [Reset]
- pure Nothing
- | otherwise ->
- liftIO $ do
- setSGR [SetColor Foreground Dull Yellow]
- Text.IO.putStr
- $ "A new version of "
- <> getField @"name" description
- <> " " <> getField @"version" parsedInfoFile
- <> " is available (" <> version <> ")."
- setSGR [Reset]
- putStrLn ""
- pure $ Just parsedInfoFile
- Left errorBundle -> liftIO (putStr $ errorBundlePretty errorBundle)
- >> pure Nothing
-
-updatePackageIfRequired :: PackageUpdateData -> SlackBuilderT ()
-updatePackageIfRequired updateData
- = checkUpdateAvailability updateData
- >>= mapM_ (updatePackage updateData)
-
-data DownloadUpdated = DownloadUpdated
- { result :: Package.Download
- , version :: Text
- , is64 :: Bool
- } deriving (Eq, Show)
-
-updateDownload :: Text -> Package.Updater -> SlackBuilderT DownloadUpdated
-updateDownload packagePath Package.Updater{..} = do
- latestDownloadVersion <- fromJust <$> detectLatest
- result <- getVersion packagePath latestDownloadVersion
- pure $ DownloadUpdated
- { result = result
- , version = latestDownloadVersion
- , is64 = is64
- }
-
-cloneFromGit :: URI -> Text -> Text -> Text -> SlackBuilderT Package.Download
-cloneFromGit repo tagPrefix packagePath version = do
- let downloadFileName = URI.unRText
- $ NonEmpty.last $ snd $ fromJust $ URI.uriPath repo
- relativeTarball = Text.unpack packagePath
- </> (dropExtension (Text.unpack downloadFileName) <> "-" <> Text.unpack version)
- (uri', checksum) <- cloneAndUpload (URI.render repo) relativeTarball tagPrefix
- pure $ Package.Download
- { md5sum = checksum
- , download = uri'
- }
-
-downloadWithTemplate :: Package.DownloadTemplate -> Text -> Text -> SlackBuilderT Package.Download
-downloadWithTemplate downloadTemplate packagePath version = do
- repository' <- SlackBuilderT $ asks repository
- uri' <- liftIO $ Package.renderDownloadWithVersion downloadTemplate version
- checksum <- download uri' $ repository' </> Text.unpack packagePath
- pure $ Package.Download uri' $ snd checksum
-
-reuploadWithTemplate :: Package.DownloadTemplate -> [CmdSpec] -> Text -> Text -> SlackBuilderT Package.Download
-reuploadWithTemplate downloadTemplate commands packagePath version = do
- repository' <- SlackBuilderT $ asks repository
- uri' <- liftIO $ Package.renderDownloadWithVersion downloadTemplate version
- let downloadFileName = Text.unpack
- $ URI.unRText
- $ NonEmpty.last $ snd $ fromJust $ URI.uriPath uri'
- packagePathRelativeToCurrent = repository' </> Text.unpack packagePath
-
- (relativeTarball', checksum) <- case commands of
- [] -> do
- (downloadedFileName, checksum) <- download uri' packagePathRelativeToCurrent
- pure (packagePathRelativeToCurrent </> downloadedFileName, checksum)
- _ -> do
- changedArchiveRootName <- extractRemote uri' packagePathRelativeToCurrent
- let relativeTarball = packagePathRelativeToCurrent
- </> fromMaybe downloadFileName changedArchiveRootName
- prepareSource relativeTarball
-
- download' <- handleReupload relativeTarball' downloadFileName
- pure $ Package.Download download' checksum
- where
- name' = Text.pack $ takeBaseName $ Text.unpack packagePath
- prepareSource tarballPath =
- liftIO (traverse (defaultCreateProcess tarballPath) commands)
- >> liftIO (tarCompress tarballPath)
- <* liftIO (removeDirectoryRecursive tarballPath)
- tarCompress tarballPath =
- let archiveBaseFilename = takeFileName tarballPath
- appendTarExtension = (<.> "tar.xz")
- in fmap (appendTarExtension tarballPath,)
- $ withCurrentDirectory (takeDirectory tarballPath)
- $ runConduitRes $ yield archiveBaseFilename
- .| void tarFilePath
- .| Lzma.compress Nothing
- .| sinkFileAndHash (appendTarExtension archiveBaseFilename)
- handleReupload relativeTarball downloadFileName = do
- downloadURL' <- SlackBuilderT $ asks downloadURL
-
- liftIO $ putStrLn $ "Upload the source tarball " <> relativeTarball
- uploadCommand relativeTarball ("/" <> name')
- liftIO $ mkURI $ downloadURL' <> "/" <> name' <> "/" <> Text.pack downloadFileName
- defaultCreateProcess cwd' cmdSpec
- = flip withCreateProcess (const . const . const waitForProcess)
- $ CreateProcess
- { use_process_jobs = False
- , std_out = Inherit
- , std_in = NoStream
- , std_err = Inherit
- , new_session = False
- , env = Nothing
- , detach_console = False
- , delegate_ctlc = False
- , cwd = Just cwd'
- , create_new_console = False
- , create_group = False
- , cmdspec = cmdSpec
- , close_fds = True
- , child_user = Nothing
- , child_group = Nothing
- }
-
-updatePackage :: PackageUpdateData -> PackageInfo -> SlackBuilderT ()
-updatePackage PackageUpdateData{..} info = do
- let packagePath = category <> "/" <> getField @"name" description
- latest' = getField @"latest" description
-
- repository' <- SlackBuilderT $ asks repository
- mainDownload <- (, getField @"is64" latest')
- <$> getField @"getVersion" latest' packagePath version
- moreDownloads <- traverse (updateDownload packagePath)
- $ getField @"downloaders" description
- let (downloads64, allDownloads) = partition snd
- $ mainDownload
- : (liftA2 (,) (getField @"result") (getField @"is64") <$> toList moreDownloads)
- let infoFilePath = repository' </> Text.unpack packagePath
- </> (Text.unpack (getField @"name" description) <.> "info")
- package' = info
- { version = version
- , downloads = getField @"download" . fst <$> allDownloads
- , checksums = getField @"md5sum" . fst <$> allDownloads
- , downloadX64 = getField @"download" . fst <$> downloads64
- , checksumX64 = getField @"md5sum" . fst <$> downloads64
- }
- liftIO $ Text.IO.writeFile infoFilePath $ generate package'
- updateSlackBuildVersion packagePath version
- $ getField @"version" <$> moreDownloads
-
- commit packagePath version
-
-findCategory :: FilePath -> SlackBuilderT (Maybe FilePath)
-findCategory packageName = do
- repository' <- SlackBuilderT $ asks repository
- go repository' [] "" <&> fmap fst . find ((packageName ==) . snd)
- where
- go currentDirectory found accumulatedDirectory = do
- let fullDirectory = currentDirectory </> accumulatedDirectory
- contents <- liftIO $ listDirectory fullDirectory
- case find (isSuffixOf ".info") contents of
- Just _ ->
- let result = first dropTrailingPathSeparator
- $ splitFileName accumulatedDirectory
- in pure $ result : found
- Nothing ->
- let accumulatedDirectories = (accumulatedDirectory </>)
- <$> filter (not . isPrefixOf ".") contents
- directoryFilter = liftIO . doesDirectoryExist
- . (currentDirectory </>)
- in filterM directoryFilter accumulatedDirectories
- >>= traverse (go currentDirectory found) <&> concat
main :: IO ()
main = do
diff --git a/src/SlackBuilder/Update.hs b/src/SlackBuilder/Update.hs
new file mode 100644
index 0000000..008b63d
--- /dev/null
+++ b/src/SlackBuilder/Update.hs
@@ -0,0 +1,262 @@
+{- This Source Code Form is subject to the terms of the Mozilla Public License,
+ v. 2.0. If a copy of the MPL was not distributed with this file, You can
+ obtain one at https://mozilla.org/MPL/2.0/. -}
+
+module SlackBuilder.Update
+ ( checkUpdateAvailability
+ , cloneFromGit
+ , downloadWithTemplate
+ , getAndLogLatest
+ , reuploadWithTemplate
+ , updatePackageIfRequired
+ ) where
+
+import Control.Applicative (Applicative(..))
+import Control.Monad.IO.Class (MonadIO(..))
+import Control.Monad.Trans.Reader (asks)
+import qualified Data.ByteString as ByteString
+import Data.Foldable (Foldable(..), find)
+import qualified Data.List.NonEmpty as NonEmpty
+import Data.Maybe (fromJust, fromMaybe)
+import Data.Text (Text)
+import qualified Data.Text as Text
+import qualified Data.Text.IO as Text.IO
+import GHC.Records (HasField(..))
+import System.FilePath
+ ( (</>)
+ , (<.>)
+ , dropExtension
+ , takeBaseName
+ , splitFileName
+ , takeDirectory
+ , takeFileName
+ , dropTrailingPathSeparator
+ )
+import System.Process
+ ( CmdSpec(..)
+ , CreateProcess(..)
+ , StdStream(..)
+ , withCreateProcess
+ , waitForProcess
+ )
+import SlackBuilder.Config
+import SlackBuilder.Download
+import SlackBuilder.Info
+import SlackBuilder.Package (PackageDescription(..), PackageUpdateData(..))
+import qualified SlackBuilder.Package as Package
+import SlackBuilder.Trans
+import Text.Megaparsec (parse, errorBundlePretty)
+import Text.URI (URI(..), mkURI)
+import qualified Text.URI as URI
+import System.Directory
+ ( listDirectory
+ , doesDirectoryExist
+ , withCurrentDirectory
+ , removeDirectoryRecursive
+ )
+import System.Console.ANSI
+ ( setSGR
+ , SGR(..)
+ , ColorIntensity(..)
+ , Color(..)
+ , ConsoleLayer(..)
+ )
+import Control.Monad (filterM, void)
+import Data.List (isPrefixOf, isSuffixOf, partition)
+import Conduit (runConduitRes, (.|), yield)
+import Data.Functor ((<&>))
+import Data.Bifunctor (Bifunctor(..))
+import Data.Conduit.Tar (tarFilePath)
+import qualified Data.Conduit.Lzma as Lzma
+
+getAndLogLatest :: PackageDescription -> SlackBuilderT (Maybe PackageUpdateData)
+getAndLogLatest description = do
+ let PackageDescription{ latest = Package.Updater{ detectLatest }, name } = description
+ liftIO (putStrLn $ Text.unpack name <> ": Retreiving the latest version.")
+ detectedVersion <- detectLatest
+ category <- fmap Text.pack
+ <$> findCategory (Text.unpack name)
+ pure $ PackageUpdateData description
+ <$> category
+ <*> detectedVersion
+
+checkUpdateAvailability :: PackageUpdateData -> SlackBuilderT (Maybe PackageInfo)
+checkUpdateAvailability PackageUpdateData{..} = do
+ let name' = Text.unpack $ getField @"name" description
+ packagePath = Text.unpack category </> name' </> (name' <.> "info")
+ repository' <- SlackBuilderT $ asks repository
+ infoContents <- liftIO $ ByteString.readFile $ repository' </> packagePath
+
+ case parse parseInfoFile packagePath infoContents of
+ Right parsedInfoFile
+ | version == getField @"version" parsedInfoFile ->
+ liftIO $ do
+ setSGR [SetColor Foreground Dull Green]
+ Text.IO.putStrLn
+ $ getField @"name" description <> " is up to date (Version " <> version <> ")."
+ setSGR [Reset]
+ pure Nothing
+ | otherwise ->
+ liftIO $ do
+ setSGR [SetColor Foreground Dull Yellow]
+ Text.IO.putStr
+ $ "A new version of "
+ <> getField @"name" description
+ <> " " <> getField @"version" parsedInfoFile
+ <> " is available (" <> version <> ")."
+ setSGR [Reset]
+ putStrLn ""
+ pure $ Just parsedInfoFile
+ Left errorBundle -> liftIO (putStr $ errorBundlePretty errorBundle)
+ >> pure Nothing
+
+updatePackageIfRequired :: PackageUpdateData -> SlackBuilderT ()
+updatePackageIfRequired updateData
+ = checkUpdateAvailability updateData
+ >>= mapM_ (updatePackage updateData)
+
+data DownloadUpdated = DownloadUpdated
+ { result :: Package.Download
+ , version :: Text
+ , is64 :: Bool
+ } deriving (Eq, Show)
+
+updateDownload :: Text -> Package.Updater -> SlackBuilderT DownloadUpdated
+updateDownload packagePath Package.Updater{..} = do
+ latestDownloadVersion <- fromJust <$> detectLatest
+ result <- getVersion packagePath latestDownloadVersion
+ pure $ DownloadUpdated
+ { result = result
+ , version = latestDownloadVersion
+ , is64 = is64
+ }
+
+cloneFromGit :: URI -> Text -> Text -> Text -> SlackBuilderT Package.Download
+cloneFromGit repo tagPrefix packagePath version = do
+ let downloadFileName = URI.unRText
+ $ NonEmpty.last $ snd $ fromJust $ URI.uriPath repo
+ relativeTarball = Text.unpack packagePath
+ </> (dropExtension (Text.unpack downloadFileName) <> "-" <> Text.unpack version)
+ (uri', checksum) <- cloneAndUpload (URI.render repo) relativeTarball tagPrefix
+ pure $ Package.Download
+ { md5sum = checksum
+ , download = uri'
+ }
+
+downloadWithTemplate :: Package.DownloadTemplate -> Text -> Text -> SlackBuilderT Package.Download
+downloadWithTemplate downloadTemplate packagePath version = do
+ repository' <- SlackBuilderT $ asks repository
+ uri' <- liftIO $ Package.renderDownloadWithVersion downloadTemplate version
+ checksum <- download uri' $ repository' </> Text.unpack packagePath
+ pure $ Package.Download uri' $ snd checksum
+
+reuploadWithTemplate :: Package.DownloadTemplate -> [CmdSpec] -> Text -> Text -> SlackBuilderT Package.Download
+reuploadWithTemplate downloadTemplate commands packagePath version = do
+ repository' <- SlackBuilderT $ asks repository
+ uri' <- liftIO $ Package.renderDownloadWithVersion downloadTemplate version
+ let downloadFileName = Text.unpack
+ $ URI.unRText
+ $ NonEmpty.last $ snd $ fromJust $ URI.uriPath uri'
+ packagePathRelativeToCurrent = repository' </> Text.unpack packagePath
+
+ (relativeTarball', checksum) <- case commands of
+ [] -> do
+ (downloadedFileName, checksum) <- download uri' packagePathRelativeToCurrent
+ pure (packagePathRelativeToCurrent </> downloadedFileName, checksum)
+ _ -> do
+ changedArchiveRootName <- extractRemote uri' packagePathRelativeToCurrent
+ let relativeTarball = packagePathRelativeToCurrent
+ </> fromMaybe downloadFileName changedArchiveRootName
+ prepareSource relativeTarball
+
+ download' <- handleReupload relativeTarball' downloadFileName
+ pure $ Package.Download download' checksum
+ where
+ name' = Text.pack $ takeBaseName $ Text.unpack packagePath
+ prepareSource tarballPath =
+ liftIO (traverse (defaultCreateProcess tarballPath) commands)
+ >> liftIO (tarCompress tarballPath)
+ <* liftIO (removeDirectoryRecursive tarballPath)
+ tarCompress tarballPath =
+ let archiveBaseFilename = takeFileName tarballPath
+ appendTarExtension = (<.> "tar.xz")
+ in fmap (appendTarExtension tarballPath,)
+ $ withCurrentDirectory (takeDirectory tarballPath)
+ $ runConduitRes $ yield archiveBaseFilename
+ .| void tarFilePath
+ .| Lzma.compress Nothing
+ .| sinkFileAndHash (appendTarExtension archiveBaseFilename)
+ handleReupload relativeTarball downloadFileName = do
+ downloadURL' <- SlackBuilderT $ asks downloadURL
+
+ liftIO $ putStrLn $ "Upload the source tarball " <> relativeTarball
+ uploadCommand relativeTarball ("/" <> name')
+ liftIO $ mkURI $ downloadURL' <> "/" <> name' <> "/" <> Text.pack downloadFileName
+ defaultCreateProcess cwd' cmdSpec
+ = flip withCreateProcess (const . const . const waitForProcess)
+ $ CreateProcess
+ { use_process_jobs = False
+ , std_out = Inherit
+ , std_in = NoStream
+ , std_err = Inherit
+ , new_session = False
+ , env = Nothing
+ , detach_console = False
+ , delegate_ctlc = False
+ , cwd = Just cwd'
+ , create_new_console = False
+ , create_group = False
+ , cmdspec = cmdSpec
+ , close_fds = True
+ , child_user = Nothing
+ , child_group = Nothing
+ }
+
+updatePackage :: PackageUpdateData -> PackageInfo -> SlackBuilderT ()
+updatePackage PackageUpdateData{..} info = do
+ let packagePath = category <> "/" <> getField @"name" description
+ latest' = getField @"latest" description
+
+ repository' <- SlackBuilderT $ asks repository
+ mainDownload <- (, getField @"is64" latest')
+ <$> getField @"getVersion" latest' packagePath version
+ moreDownloads <- traverse (updateDownload packagePath)
+ $ getField @"downloaders" description
+ let (downloads64, allDownloads) = partition snd
+ $ mainDownload
+ : (liftA2 (,) (getField @"result") (getField @"is64") <$> toList moreDownloads)
+ let infoFilePath = repository' </> Text.unpack packagePath
+ </> (Text.unpack (getField @"name" description) <.> "info")
+ package' = info
+ { version = version
+ , downloads = getField @"download" . fst <$> allDownloads
+ , checksums = getField @"md5sum" . fst <$> allDownloads
+ , downloadX64 = getField @"download" . fst <$> downloads64
+ , checksumX64 = getField @"md5sum" . fst <$> downloads64
+ }
+ liftIO $ Text.IO.writeFile infoFilePath $ generate package'
+ updateSlackBuildVersion packagePath version
+ $ getField @"version" <$> moreDownloads
+
+ commit packagePath version
+
+findCategory :: FilePath -> SlackBuilderT (Maybe FilePath)
+findCategory packageName = do
+ repository' <- SlackBuilderT $ asks repository
+ go repository' [] "" <&> fmap fst . find ((packageName ==) . snd)
+ where
+ go currentDirectory found accumulatedDirectory = do
+ let fullDirectory = currentDirectory </> accumulatedDirectory
+ contents <- liftIO $ listDirectory fullDirectory
+ case find (isSuffixOf ".info") contents of
+ Just _ ->
+ let result = first dropTrailingPathSeparator
+ $ splitFileName accumulatedDirectory
+ in pure $ result : found
+ Nothing ->
+ let accumulatedDirectories = (accumulatedDirectory </>)
+ <$> filter (not . isPrefixOf ".") contents
+ directoryFilter = liftIO . doesDirectoryExist
+ . (currentDirectory </>)
+ in filterM directoryFilter accumulatedDirectories
+ >>= traverse (go currentDirectory found) <&> concat
diff --git a/tests/SlackBuilder/InfoSpec.hs b/tests/SlackBuilder/InfoSpec.hs
index 301db54..c05aa3e 100644
--- a/tests/SlackBuilder/InfoSpec.hs
+++ b/tests/SlackBuilder/InfoSpec.hs
@@ -1,3 +1,7 @@
+{- This Source Code Form is subject to the terms of the Mozilla Public License,
+ v. 2.0. If a copy of the MPL was not distributed with this file, You can
+ obtain one at https://mozilla.org/MPL/2.0/. -}
+
module SlackBuilder.InfoSpec
( spec
) where
diff --git a/tests/SlackBuilder/LatestVersionCheckSpec.hs b/tests/SlackBuilder/LatestVersionCheckSpec.hs
new file mode 100644
index 0000000..fe92176
--- /dev/null
+++ b/tests/SlackBuilder/LatestVersionCheckSpec.hs
@@ -0,0 +1,24 @@
+{- This Source Code Form is subject to the terms of the Mozilla Public License,
+ v. 2.0. If a copy of the MPL was not distributed with this file, You can
+ obtain one at https://mozilla.org/MPL/2.0/. -}
+
+module SlackBuilder.LatestVersionCheckSpec
+ ( spec
+ ) where
+
+import SlackBuilder.LatestVersionCheck
+import Test.Hspec (Spec, describe, it, shouldBe)
+
+spec :: Spec
+spec = do
+ describe "stableTagTransform" $ do
+ it "excludes tags with +" $
+ let given = "v2.6.0+unreleased"
+ actual = stableTagTransform given
+ in actual `shouldBe` Nothing
+
+ it "recognizes a stable version" $
+ let given = "v2.6.0"
+ actual = stableTagTransform given
+ expected = Just "2.6.0"
+ in actual `shouldBe` expected
diff --git a/tests/SlackBuilder/PackageSpec.hs b/tests/SlackBuilder/PackageSpec.hs
index ffe6737..2a34c89 100644
--- a/tests/SlackBuilder/PackageSpec.hs
+++ b/tests/SlackBuilder/PackageSpec.hs
@@ -1,3 +1,7 @@
+{- This Source Code Form is subject to the terms of the Mozilla Public License,
+ v. 2.0. If a copy of the MPL was not distributed with this file, You can
+ obtain one at https://mozilla.org/MPL/2.0/. -}
+
module SlackBuilder.PackageSpec
( spec
) where