Recognize + in sematnic tags
All checks were successful
Build / audit (push) Successful in 14m54s
Build / test (push) Successful in 14m20s

This commit is contained in:
Eugen Wissner 2024-03-19 11:34:19 +01:00
parent 3d81917627
commit bc3ba48d85
Signed by: belka
GPG Key ID: A27FDC1E8EE902C0
7 changed files with 309 additions and 242 deletions

View File

@ -59,7 +59,7 @@ stableTagTransform :: Text -> Maybe Text
stableTagTransform = Text.stripPrefix "v" >=> checkForStable stableTagTransform = Text.stripPrefix "v" >=> checkForStable
where where
checkForStable tag checkForStable tag
| '-' `Text.elem` tag = Nothing | Text.any (`elem` ['-', '+']) tag = Nothing
| otherwise = Just tag | otherwise = Just tag
-- * Packagist -- * Packagist

View File

@ -17,6 +17,7 @@ extra-source-files: CHANGELOG.md
common dependencies common dependencies
build-depends: build-depends:
aeson ^>= 2.2.0,
base >= 4.16 && < 5, base >= 4.16 && < 5,
bytestring ^>= 0.11.0, bytestring ^>= 0.11.0,
conduit ^>= 1.3.5, conduit ^>= 1.3.5,
@ -38,6 +39,8 @@ common dependencies
text ^>= 2.0, text ^>= 2.0,
tomland ^>= 1.3.3, tomland ^>= 1.3.3,
transformers ^>= 0.5.6, transformers ^>= 0.5.6,
unordered-containers ^>= 0.2.19,
vector ^>= 0.13.0,
word8 ^>= 0.1.3 word8 ^>= 0.1.3
default-language: Haskell2010 default-language: Haskell2010
default-extensions: default-extensions:
@ -59,6 +62,7 @@ library
SlackBuilder.Config SlackBuilder.Config
SlackBuilder.Download SlackBuilder.Download
SlackBuilder.Info SlackBuilder.Info
SlackBuilder.LatestVersionCheck
SlackBuilder.Package SlackBuilder.Package
SlackBuilder.Trans SlackBuilder.Trans
hs-source-dirs: lib hs-source-dirs: lib
@ -70,14 +74,11 @@ executable slackbuilder
other-modules: other-modules:
SlackBuilder.CommandLine SlackBuilder.CommandLine
SlackBuilder.LatestVersionCheck SlackBuilder.Update
build-depends: build-depends:
aeson ^>= 2.2.0,
ansi-terminal ^>= 1.0, ansi-terminal ^>= 1.0,
optparse-applicative ^>= 0.18.1, optparse-applicative ^>= 0.18.1,
slackbuilder, slackbuilder
unordered-containers ^>= 0.2.19,
vector ^>= 0.13.0
hs-source-dirs: src hs-source-dirs: src
ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall
@ -89,6 +90,7 @@ test-suite slackbuilder-test
other-modules: other-modules:
SlackBuilder.InfoSpec SlackBuilder.InfoSpec
SlackBuilder.LatestVersionCheckSpec
SlackBuilder.PackageSpec SlackBuilder.PackageSpec
hs-source-dirs: tests hs-source-dirs: tests
build-depends: build-depends:

View File

@ -7,66 +7,28 @@ module Main
) where ) where
import Data.Char (isNumber) import Data.Char (isNumber)
import Control.Applicative (Applicative(liftA2)) import Control.Applicative (Applicative(..))
import Data.List.NonEmpty (NonEmpty(..)) import Data.List.NonEmpty (NonEmpty(..))
import qualified Data.List.NonEmpty as NonEmpty
import Control.Monad.Catch (MonadThrow(..)) import Control.Monad.Catch (MonadThrow(..))
import Control.Monad.IO.Class (MonadIO(..)) import Control.Monad.IO.Class (MonadIO(..))
import Data.Maybe (fromJust, fromMaybe)
import qualified Data.Map as Map import qualified Data.Map as Map
import Options.Applicative (execParser) import Options.Applicative (execParser)
import SlackBuilder.CommandLine import SlackBuilder.CommandLine
import SlackBuilder.Config import SlackBuilder.Config
import SlackBuilder.Trans import SlackBuilder.Trans
import SlackBuilder.LatestVersionCheck import SlackBuilder.LatestVersionCheck
import SlackBuilder.Update
import qualified Toml import qualified Toml
import qualified Data.ByteString as ByteString
import Data.Text (Text) import Data.Text (Text)
import qualified Data.Text as Text import qualified Data.Text as Text
import qualified Data.Text.IO as Text.IO 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 qualified SlackBuilder.Package as Package
import Text.URI (URI(..), mkURI)
import Text.URI.QQ (uri) 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 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 :: [PackageDescription]
autoUpdatable = autoUpdatable =
@ -180,7 +142,7 @@ autoUpdatable =
: Package.VersionPlaceholder : Package.VersionPlaceholder
: [Package.StaticPlaceholder ".tar.gz"] : [Package.StaticPlaceholder ".tar.gz"]
in Package.Updater in Package.Updater
{ detectLatest = latestGitHub ghArguments $ Text.stripPrefix "v" { detectLatest = latestGitHub ghArguments stableTagTransform
, getVersion = reuploadWithTemplate template [] , getVersion = reuploadWithTemplate template []
, is64 = False , is64 = False
} }
@ -314,197 +276,6 @@ check = for_ autoUpdatable go
>>= mapM_ checkUpdateAvailability >>= mapM_ checkUpdateAvailability
>> liftIO (putStrLn "") >> 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 :: IO ()
main = do main = do

262
src/SlackBuilder/Update.hs Normal file
View File

@ -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

View File

@ -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 module SlackBuilder.InfoSpec
( spec ( spec
) where ) where

View File

@ -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

View File

@ -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 module SlackBuilder.PackageSpec
( spec ( spec
) where ) where