Add a test module

This commit is contained in:
Eugen Wissner 2023-09-03 10:26:43 +02:00
parent c2b98ba395
commit 77c9a2ab54
Signed by: belka
GPG Key ID: A27FDC1E8EE902C0
7 changed files with 147 additions and 48 deletions

View File

@ -2,7 +2,8 @@ module Main
( main ( main
) where ) where
import qualified Data.Text.IO as Text.IO import Data.List.NonEmpty (NonEmpty(..))
import Control.Monad.IO.Class (MonadIO(..))
import Data.Maybe (fromMaybe) import Data.Maybe (fromMaybe)
import Options.Applicative (execParser) import Options.Applicative (execParser)
import SlackBuilder.CommandLine import SlackBuilder.CommandLine
@ -10,10 +11,80 @@ import SlackBuilder.Config
import SlackBuilder.Trans import SlackBuilder.Trans
import SlackBuilder.Updater import SlackBuilder.Updater
import qualified Toml import qualified Toml
import Data.Text (Text)
import qualified Data.Text as Text import qualified Data.Text as Text
import Control.Monad.Trans.Reader (ReaderT(..)) import qualified Data.Text.IO as Text.IO
import Control.Monad.Trans.Reader (ReaderT(..), asks)
import SlackBuilder.Download import SlackBuilder.Download
import Text.URI (mkURI) import qualified SlackBuilder.Package as Package
import Text.URI (mkURI, URI)
import Text.URI.QQ (uri)
import Data.Foldable (for_)
import qualified Text.URI as URI
import GHC.Records (HasField(..))
data Package = Package
{ latest :: Package.Updater
, category :: Text
, name :: Text
, homepage :: Maybe URI
, requires :: [Text]
}
autoUpdatable :: [Package]
autoUpdatable =
[ Package
{ latest =
let ghArguments = GhArguments{ owner = "universal-ctags", name = "ctags", transform = Nothing}
latest' = latestGitHub ghArguments pure
templateTail =
[ Package.StaticPlaceholder "/ctags-"
, Package.VersionPlaceholder
, Package.StaticPlaceholder ".tar.gz"
]
template = Package.DownloadTemplate
$ Package.StaticPlaceholder "https://github.com/universal-ctags/ctags/archive/" :| templateTail
in Package.Updater latest' template
, category = "development"
, name = "universal-ctags"
, homepage = Just [uri|https://ctags.io/|]
, requires = pure "%README%"
}
]
up2Date :: SlackBuilderT ()
up2Date = for_ autoUpdatable go
where
go package@Package{ latest = Package.Updater getLatest _ } =
getLatest >>= mapM_ (updatePackage package)
updatePackage :: Package -> Text -> SlackBuilderT ()
updatePackage Package{..} version = do
maintainer' <- SlackBuilderT $ asks maintainer
let packagePath = category <> "/" <> name
package' = Package.PackageInfo
{ version = version
, requires = requires
, path = Text.unpack packagePath
, homepage = maybe "" URI.render homepage
, maintainer = Package.Maintainer
{ name = getField @"name" maintainer'
, email = getField @"email" maintainer'
}
}
Package.Updater _ downloadTemplate = latest
uri' <- liftIO $ Package.renderDownloadWithVersion downloadTemplate version
let tarball = "slackbuilds/development/universal-ctags/ctags-#{version}.tar.gz"
checksum <- fromMaybe undefined <$> download uri' tarball
download' <- liftIO $ mkURI "https://download.dlackware.com/hosted-sources/universal-ctags/ctags-#{version}.tar.gz"
liftIO $ Text.IO.writeFile "slackbuilds/#{package.path}/#{package.name}.info"
$ Package.infoTemplate package' [Package.Download download' checksum False]
updateSlackBuildVersion packagePath version
uploadCommand (Text.pack tarball) "#{CONFIG[:remote_path]}/universal-ctags"
commit packagePath version
main :: IO () main :: IO ()
main = do main = do
@ -40,13 +111,14 @@ main = do
ArchiveCommand repo nameVersion tarball tagPrefix -> ArchiveCommand repo nameVersion tarball tagPrefix ->
cloneAndArchive repo nameVersion tarball tagPrefix >> pure Nothing cloneAndArchive repo nameVersion tarball tagPrefix >> pure Nothing
DownloadCommand url target DownloadCommand url target
| Just uri <- mkURI url -> fmap (Text.pack . show) | Just uri' <- mkURI url -> fmap (Text.pack . show)
<$> download uri target <$> download uri' target
| otherwise -> pure Nothing | otherwise -> pure Nothing
CloneCommand repo tarball tagPrefix -> fmap (Text.pack . show) CloneCommand repo tarball tagPrefix -> fmap (Text.pack . show)
<$> clone repo tarball tagPrefix <$> clone repo tarball tagPrefix
DownloadAndDeployCommand uri tarball -> fmap (Text.pack . show) DownloadAndDeployCommand uri' tarball -> fmap (Text.pack . show)
<$> downloadAndDeploy uri tarball <$> downloadAndDeploy uri' tarball
Up2DateCommand -> up2Date >> pure Nothing
chooseTransformFunction (Just "php") = phpTransform chooseTransformFunction (Just "php") = phpTransform
chooseTransformFunction (Just "rdiff-backup") = Text.stripPrefix "v" chooseTransformFunction (Just "rdiff-backup") = Text.stripPrefix "v"
chooseTransformFunction _ = stripPrefix "v" chooseTransformFunction _ = stripPrefix "v"

View File

@ -30,6 +30,7 @@ data SlackBuilderCommand
| DownloadCommand Text String | DownloadCommand Text String
| CloneCommand Text Text Text | CloneCommand Text Text Text
| DownloadAndDeployCommand Text Text | DownloadAndDeployCommand Text Text
| Up2DateCommand
deriving (Eq, Show) deriving (Eq, Show)
data PackagistArguments = PackagistArguments data PackagistArguments = PackagistArguments
@ -75,6 +76,7 @@ slackBuilderCommand = subparser
<> command "download" (info downloadCommand mempty) <> command "download" (info downloadCommand mempty)
<> command "clone" (info cloneCommand mempty) <> command "clone" (info cloneCommand mempty)
<> command "deploy" (info deployCommand mempty) <> command "deploy" (info deployCommand mempty)
<> command "up2date" (info up2DateCommand mempty)
where where
slackBuildCommand = SlackBuildCommand slackBuildCommand = SlackBuildCommand
<$> argument str (metavar "PATH") <$> argument str (metavar "PATH")
@ -98,3 +100,4 @@ slackBuilderCommand = subparser
deployCommand = DownloadAndDeployCommand deployCommand = DownloadAndDeployCommand
<$> argument str (metavar "URI") <$> argument str (metavar "URI")
<*> argument str (metavar "TARBALL") <*> argument str (metavar "TARBALL")
up2DateCommand = pure Up2DateCommand

View File

@ -7,6 +7,7 @@ module SlackBuilder.Download
, hostedSources , hostedSources
, remoteFileExists , remoteFileExists
, updateSlackBuildVersion , updateSlackBuildVersion
, uploadCommand
) where ) where
import Data.ByteString (ByteString) import Data.ByteString (ByteString)

View File

@ -1,13 +1,15 @@
module SlackBuilder.Package module SlackBuilder.Package
( DownloadPlaceholder(..) ( DownloadPlaceholder(..)
, Download(..) , Download(..)
, DownloadTemplate(..)
, PackageInfo(..) , PackageInfo(..)
, Maintainer(..) , Maintainer(..)
, Updater(..) , Updater(..)
, infoTemplate , infoTemplate
, renderDownloadWithVersion
) where ) where
import Data.List.NonEmpty (NonEmpty) import Data.List.NonEmpty (NonEmpty(..))
import Data.Text (Text) import Data.Text (Text)
import qualified Data.Text as Text import qualified Data.Text as Text
import Text.URI (URI(..)) import Text.URI (URI(..))
@ -17,6 +19,7 @@ import GHC.Records (HasField(..))
import System.FilePath (takeBaseName) import System.FilePath (takeBaseName)
import Data.List (partition) import Data.List (partition)
import SlackBuilder.Trans import SlackBuilder.Trans
import Control.Monad.Catch (MonadThrow)
-- | Download URI with the MD5 checksum of the target. -- | Download URI with the MD5 checksum of the target.
data Download = Download data Download = Download
@ -60,8 +63,15 @@ instance Show DownloadTemplate
where where
show (DownloadTemplate components) = concatMap show components show (DownloadTemplate components) = concatMap show components
renderDownloadWithVersion :: MonadThrow m => DownloadTemplate -> Text -> m URI
renderDownloadWithVersion (DownloadTemplate components) version =
URI.mkURI $ foldr f "" components
where
f (StaticPlaceholder staticPlaceholder) accumulator = accumulator <> staticPlaceholder
f VersionPlaceholder accumulator = accumulator <> version
-- | Function used to get the latest version of a source. -- | Function used to get the latest version of a source.
newtype Updater = Updater (SlackBuilderT (Maybe Text)) data Updater = Updater (SlackBuilderT (Maybe Text)) DownloadTemplate
packageName :: PackageInfo -> Text packageName :: PackageInfo -> Text
packageName PackageInfo{ path } = Text.pack $ takeBaseName path packageName PackageInfo{ path } = Text.pack $ takeBaseName path

View File

@ -20,7 +20,7 @@ module SlackBuilder
package = Package.new 'development/dmd', version: version, package = Package.new 'development/dmd', version: version,
homepage: 'https://dlang.org' homepage: 'https://dlang.org'
write_info package, downloads: [Download.new(uri.to_s, checksum.hexdigest)] write_info package, downloads: [Download.new(uri.to_s, checksum)]
update_slackbuild_version 'development/dmd', package.version update_slackbuild_version 'development/dmd', package.version
commit 'development/dmd', version commit 'development/dmd', version

View File

@ -1,6 +1,6 @@
cabal-version: 2.4 cabal-version: 2.4
name: slackbuilder name: slackbuilder
version: 1.0.0.0 version: 1.0.0
synopsis: Slackware build scripts and configuration files. synopsis: Slackware build scripts and configuration files.
bug-reports: https://git.caraus.tech/OSS/slackbuilder/issues bug-reports: https://git.caraus.tech/OSS/slackbuilder/issues
@ -16,42 +16,54 @@ category: Build
extra-source-files: CHANGELOG.md extra-source-files: CHANGELOG.md
executable slackbuilder executable slackbuilder
main-is: Main.hs main-is: Main.hs
other-modules: other-modules:
SlackBuilder.CommandLine SlackBuilder.CommandLine
SlackBuilder.Config SlackBuilder.Config
SlackBuilder.Download SlackBuilder.Download
SlackBuilder.Package SlackBuilder.Package
SlackBuilder.Trans SlackBuilder.Trans
SlackBuilder.Updater SlackBuilder.Updater
default-extensions: default-extensions:
DataKinds DataKinds
DuplicateRecordFields DuplicateRecordFields
LambdaCase LambdaCase
NamedFieldPuns NamedFieldPuns
OverloadedStrings OverloadedStrings
RecordWildCards RecordWildCards
TemplateHaskell QuasiQuotes
TypeApplications TemplateHaskell
build-depends: TypeApplications
aeson ^>= 2.2.0, build-depends:
base ^>= 4.16.4.0, aeson ^>= 2.2.0,
bytestring ^>= 0.11.0, base ^>= 4.16.4.0,
conduit ^>= 1.3.5, bytestring ^>= 0.11.0,
cryptonite >= 0.30, conduit ^>= 1.3.5,
filepath ^>= 1.4.2, cryptonite >= 0.30,
http-client ^>= 0.7, exceptions >= 0.10,
modern-uri ^>= 0.3.6, filepath ^>= 1.4.2,
optparse-applicative ^>= 0.18.1, http-client ^>= 0.7,
process ^>= 1.6.17, modern-uri ^>= 0.3.6,
req ^>= 3.13, optparse-applicative ^>= 0.18.1,
text ^>= 2.0, process ^>= 1.6.17,
tomland ^>= 1.3.3, req ^>= 3.13,
transformers ^>= 0.5.6, text ^>= 2.0,
unordered-containers ^>= 0.2.19, tomland ^>= 1.3.3,
vector ^>= 0.13.0 transformers ^>= 0.5.6,
hs-source-dirs: app unordered-containers ^>= 0.2.19,
default-language: Haskell2010 vector ^>= 0.13.0
hs-source-dirs: app
default-language: Haskell2010
ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall
test-suite slackbuilder-test
type: exitcode-stdio-1.0
main-is: Spec.hs
hs-source-dirs:
tests
ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall
default-language: Haskell2010
build-depends:
hspec >= 2.10.9 && < 2.12

1
tests/Spec.hs Normal file
View File

@ -0,0 +1 @@
{-# OPTIONS_GHC -F -pgmF hspec-discover #-}