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
|
( 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"
|
||||||
|
@ -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
|
||||||
|
@ -7,6 +7,7 @@ module SlackBuilder.Download
|
|||||||
, hostedSources
|
, hostedSources
|
||||||
, remoteFileExists
|
, remoteFileExists
|
||||||
, updateSlackBuildVersion
|
, updateSlackBuildVersion
|
||||||
|
, uploadCommand
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Data.ByteString (ByteString)
|
import Data.ByteString (ByteString)
|
||||||
|
@ -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
|
||||||
|
@ -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
|
||||||
|
@ -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
|
||||||
@ -32,6 +32,7 @@ executable slackbuilder
|
|||||||
NamedFieldPuns
|
NamedFieldPuns
|
||||||
OverloadedStrings
|
OverloadedStrings
|
||||||
RecordWildCards
|
RecordWildCards
|
||||||
|
QuasiQuotes
|
||||||
TemplateHaskell
|
TemplateHaskell
|
||||||
TypeApplications
|
TypeApplications
|
||||||
build-depends:
|
build-depends:
|
||||||
@ -40,6 +41,7 @@ executable slackbuilder
|
|||||||
bytestring ^>= 0.11.0,
|
bytestring ^>= 0.11.0,
|
||||||
conduit ^>= 1.3.5,
|
conduit ^>= 1.3.5,
|
||||||
cryptonite >= 0.30,
|
cryptonite >= 0.30,
|
||||||
|
exceptions >= 0.10,
|
||||||
filepath ^>= 1.4.2,
|
filepath ^>= 1.4.2,
|
||||||
http-client ^>= 0.7,
|
http-client ^>= 0.7,
|
||||||
modern-uri ^>= 0.3.6,
|
modern-uri ^>= 0.3.6,
|
||||||
@ -55,3 +57,13 @@ executable slackbuilder
|
|||||||
default-language: Haskell2010
|
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
1
tests/Spec.hs
Normal file
@ -0,0 +1 @@
|
|||||||
|
{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
|
Loading…
Reference in New Issue
Block a user