diff --git a/src/SlackBuilder/LatestVersionCheck.hs b/lib/SlackBuilder/LatestVersionCheck.hs similarity index 99% rename from src/SlackBuilder/LatestVersionCheck.hs rename to 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