Add a test module
This commit is contained in:
parent
c2b98ba395
commit
77c9a2ab54
86
app/Main.hs
86
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"
|
||||
|
@ -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
|
||||
|
@ -7,6 +7,7 @@ module SlackBuilder.Download
|
||||
, hostedSources
|
||||
, remoteFileExists
|
||||
, updateSlackBuildVersion
|
||||
, uploadCommand
|
||||
) where
|
||||
|
||||
import Data.ByteString (ByteString)
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
@ -32,6 +32,7 @@ executable slackbuilder
|
||||
NamedFieldPuns
|
||||
OverloadedStrings
|
||||
RecordWildCards
|
||||
QuasiQuotes
|
||||
TemplateHaskell
|
||||
TypeApplications
|
||||
build-depends:
|
||||
@ -40,6 +41,7 @@ executable slackbuilder
|
||||
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,
|
||||
@ -55,3 +57,13 @@ executable slackbuilder
|
||||
default-language: Haskell2010
|
||||
|
||||
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
1
tests/Spec.hs
Normal file
@ -0,0 +1 @@
|
||||
{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
|
Loading…
Reference in New Issue
Block a user