Recognize + in sematnic tags

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

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,
+    slackbuilder
-    unordered-containers ^>= 0.2.19,
-    vector ^>= 0.13.0
   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:

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 Control.Monad.Trans.Reader (ReaderT(..))
-import SlackBuilder.Download
+import SlackBuilder.Package (PackageDescription(..))
-import SlackBuilder.Package (PackageDescription(..), PackageUpdateData(..))
 import qualified SlackBuilder.Package as Package
-import Text.URI (URI(..), mkURI)
 import Text.URI.QQ (uri)
-import Data.Foldable (Foldable(..), for_, find)
+import Data.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 GHC.Records (HasField(..))
-import System.Process
+import System.Process (CmdSpec(..))
-    ( 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
 
 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

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

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

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

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