From 77c9a2ab54b697f37e21b76c1fd82fc42dc4792e Mon Sep 17 00:00:00 2001 From: Eugen Wissner Date: Sun, 3 Sep 2023 10:26:43 +0200 Subject: [PATCH] Add a test module --- app/Main.hs | 86 +++++++++++++++++++++++++++++--- app/SlackBuilder/CommandLine.hs | 3 ++ app/SlackBuilder/Download.hs | 1 + app/SlackBuilder/Package.hs | 14 +++++- rakelib/dmd_tools.rake | 2 +- slackbuilder.cabal | 88 +++++++++++++++++++-------------- tests/Spec.hs | 1 + 7 files changed, 147 insertions(+), 48 deletions(-) create mode 100644 tests/Spec.hs diff --git a/app/Main.hs b/app/Main.hs index 76c985f..51681b5 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -2,7 +2,8 @@ module Main ( main ) 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 Options.Applicative (execParser) import SlackBuilder.CommandLine @@ -10,10 +11,80 @@ import SlackBuilder.Config import SlackBuilder.Trans import SlackBuilder.Updater import qualified Toml +import Data.Text (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 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 = do @@ -40,13 +111,14 @@ main = do ArchiveCommand repo nameVersion tarball tagPrefix -> cloneAndArchive repo nameVersion tarball tagPrefix >> pure Nothing DownloadCommand url target - | Just uri <- mkURI url -> fmap (Text.pack . show) - <$> download uri target + | Just uri' <- mkURI url -> fmap (Text.pack . show) + <$> download uri' target | otherwise -> pure Nothing CloneCommand repo tarball tagPrefix -> fmap (Text.pack . show) <$> clone repo tarball tagPrefix - DownloadAndDeployCommand uri tarball -> fmap (Text.pack . show) - <$> downloadAndDeploy uri tarball + DownloadAndDeployCommand uri' tarball -> fmap (Text.pack . show) + <$> downloadAndDeploy uri' tarball + Up2DateCommand -> up2Date >> pure Nothing chooseTransformFunction (Just "php") = phpTransform chooseTransformFunction (Just "rdiff-backup") = Text.stripPrefix "v" chooseTransformFunction _ = stripPrefix "v" diff --git a/app/SlackBuilder/CommandLine.hs b/app/SlackBuilder/CommandLine.hs index 23bf840..48881e2 100644 --- a/app/SlackBuilder/CommandLine.hs +++ b/app/SlackBuilder/CommandLine.hs @@ -30,6 +30,7 @@ data SlackBuilderCommand | DownloadCommand Text String | CloneCommand Text Text Text | DownloadAndDeployCommand Text Text + | Up2DateCommand deriving (Eq, Show) data PackagistArguments = PackagistArguments @@ -75,6 +76,7 @@ slackBuilderCommand = subparser <> command "download" (info downloadCommand mempty) <> command "clone" (info cloneCommand mempty) <> command "deploy" (info deployCommand mempty) + <> command "up2date" (info up2DateCommand mempty) where slackBuildCommand = SlackBuildCommand <$> argument str (metavar "PATH") @@ -98,3 +100,4 @@ slackBuilderCommand = subparser deployCommand = DownloadAndDeployCommand <$> argument str (metavar "URI") <*> argument str (metavar "TARBALL") + up2DateCommand = pure Up2DateCommand diff --git a/app/SlackBuilder/Download.hs b/app/SlackBuilder/Download.hs index 2201c25..5d4cb8d 100644 --- a/app/SlackBuilder/Download.hs +++ b/app/SlackBuilder/Download.hs @@ -7,6 +7,7 @@ module SlackBuilder.Download , hostedSources , remoteFileExists , updateSlackBuildVersion + , uploadCommand ) where import Data.ByteString (ByteString) diff --git a/app/SlackBuilder/Package.hs b/app/SlackBuilder/Package.hs index cc07cc5..cc3ea42 100644 --- a/app/SlackBuilder/Package.hs +++ b/app/SlackBuilder/Package.hs @@ -1,13 +1,15 @@ module SlackBuilder.Package ( DownloadPlaceholder(..) , Download(..) + , DownloadTemplate(..) , PackageInfo(..) , Maintainer(..) , Updater(..) , infoTemplate + , renderDownloadWithVersion ) where -import Data.List.NonEmpty (NonEmpty) +import Data.List.NonEmpty (NonEmpty(..)) import Data.Text (Text) import qualified Data.Text as Text import Text.URI (URI(..)) @@ -17,6 +19,7 @@ import GHC.Records (HasField(..)) import System.FilePath (takeBaseName) import Data.List (partition) import SlackBuilder.Trans +import Control.Monad.Catch (MonadThrow) -- | Download URI with the MD5 checksum of the target. data Download = Download @@ -60,8 +63,15 @@ instance Show DownloadTemplate where 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. -newtype Updater = Updater (SlackBuilderT (Maybe Text)) +data Updater = Updater (SlackBuilderT (Maybe Text)) DownloadTemplate packageName :: PackageInfo -> Text packageName PackageInfo{ path } = Text.pack $ takeBaseName path diff --git a/rakelib/dmd_tools.rake b/rakelib/dmd_tools.rake index d0d54a3..118bfae 100644 --- a/rakelib/dmd_tools.rake +++ b/rakelib/dmd_tools.rake @@ -20,7 +20,7 @@ module SlackBuilder package = Package.new 'development/dmd', version: version, 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 commit 'development/dmd', version diff --git a/slackbuilder.cabal b/slackbuilder.cabal index ddf3135..6244a58 100644 --- a/slackbuilder.cabal +++ b/slackbuilder.cabal @@ -1,6 +1,6 @@ cabal-version: 2.4 name: slackbuilder -version: 1.0.0.0 +version: 1.0.0 synopsis: Slackware build scripts and configuration files. bug-reports: https://git.caraus.tech/OSS/slackbuilder/issues @@ -16,42 +16,54 @@ category: Build extra-source-files: CHANGELOG.md executable slackbuilder - main-is: Main.hs + main-is: Main.hs - other-modules: - SlackBuilder.CommandLine - SlackBuilder.Config - SlackBuilder.Download - SlackBuilder.Package - SlackBuilder.Trans - SlackBuilder.Updater - default-extensions: - DataKinds - DuplicateRecordFields - LambdaCase - NamedFieldPuns - OverloadedStrings - RecordWildCards - TemplateHaskell - TypeApplications - build-depends: - aeson ^>= 2.2.0, - base ^>= 4.16.4.0, - bytestring ^>= 0.11.0, - conduit ^>= 1.3.5, - cryptonite >= 0.30, - filepath ^>= 1.4.2, - http-client ^>= 0.7, - modern-uri ^>= 0.3.6, - optparse-applicative ^>= 0.18.1, - process ^>= 1.6.17, - req ^>= 3.13, - text ^>= 2.0, - tomland ^>= 1.3.3, - transformers ^>= 0.5.6, - unordered-containers ^>= 0.2.19, - vector ^>= 0.13.0 - hs-source-dirs: app - default-language: Haskell2010 + other-modules: + SlackBuilder.CommandLine + SlackBuilder.Config + SlackBuilder.Download + SlackBuilder.Package + SlackBuilder.Trans + SlackBuilder.Updater + default-extensions: + DataKinds + DuplicateRecordFields + LambdaCase + NamedFieldPuns + OverloadedStrings + RecordWildCards + QuasiQuotes + TemplateHaskell + TypeApplications + build-depends: + aeson ^>= 2.2.0, + base ^>= 4.16.4.0, + bytestring ^>= 0.11.0, + conduit ^>= 1.3.5, + cryptonite >= 0.30, + exceptions >= 0.10, + filepath ^>= 1.4.2, + http-client ^>= 0.7, + modern-uri ^>= 0.3.6, + optparse-applicative ^>= 0.18.1, + process ^>= 1.6.17, + req ^>= 3.13, + text ^>= 2.0, + tomland ^>= 1.3.3, + transformers ^>= 0.5.6, + unordered-containers ^>= 0.2.19, + 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 diff --git a/tests/Spec.hs b/tests/Spec.hs new file mode 100644 index 0000000..a824f8c --- /dev/null +++ b/tests/Spec.hs @@ -0,0 +1 @@ +{-# OPTIONS_GHC -F -pgmF hspec-discover #-}