slackbuilder/app/Main.hs

141 lines
5.4 KiB
Haskell
Raw Normal View History

module Main
( main
) where
2023-09-03 10:26:43 +02:00
import Data.List.NonEmpty (NonEmpty(..))
import Control.Monad.IO.Class (MonadIO(..))
import Data.Maybe (fromMaybe)
import Options.Applicative (execParser)
import SlackBuilder.CommandLine
2023-08-09 20:59:42 +02:00
import SlackBuilder.Config
2023-08-15 10:33:19 +02:00
import SlackBuilder.Trans
import SlackBuilder.Updater
2023-08-09 20:59:42 +02:00
import qualified Toml
2023-09-03 10:26:43 +02:00
import Data.Text (Text)
2023-08-09 20:59:42 +02:00
import qualified Data.Text as Text
2023-09-03 10:26:43 +02:00
import qualified Data.Text.IO as Text.IO
import Control.Monad.Trans.Reader (ReaderT(..), asks)
2023-08-15 10:33:19 +02:00
import SlackBuilder.Download
2023-09-03 10:26:43 +02:00
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(..))
import System.FilePath ((</>), (<.>))
2023-09-03 10:26:43 +02:00
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
$ Text.replace "#{version}" version
"https://download.dlackware.com/hosted-sources/universal-ctags/ctags-#{version}.tar.gz"
repository' <- SlackBuilderT $ asks repository
let infoFilePath = repository' </> Text.unpack packagePath
</> (Text.unpack name <.> "info")
2023-09-03 10:26:43 +02:00
liftIO $ Text.IO.writeFile infoFilePath
2023-09-03 10:26:43 +02:00
$ Package.infoTemplate package' [Package.Download download' checksum False]
updateSlackBuildVersion packagePath version
remotePath' <- SlackBuilderT $ asks remotePath
uploadCommand (Text.pack tarball) $ remotePath' <> "/universal-ctags"
2023-09-03 10:26:43 +02:00
commit packagePath version
main :: IO ()
main = do
programCommand <- execParser slackBuilderParser
2023-08-09 20:59:42 +02:00
settings <- Toml.decodeFile settingsCodec "config/config.toml"
2023-08-15 10:33:19 +02:00
latestVersion <- flip runReaderT settings
$ runSlackBuilderT
$ executeCommand programCommand
Text.IO.putStrLn $ fromMaybe "" latestVersion
2023-08-09 20:59:42 +02:00
where
2023-08-15 10:33:19 +02:00
executeCommand = \case
PackagistCommand packagistArguments ->
latestPackagist packagistArguments
TextCommand textArguments -> latestText textArguments
GhCommand ghArguments@GhArguments{ transform }
-> latestGitHub ghArguments $ chooseTransformFunction transform
SlackBuildCommand packagePath version ->
updateSlackBuildVersion packagePath version >> pure Nothing
CommitCommand packagePath version ->
commit packagePath version >> pure Nothing
ExistsCommand urlPath -> pure . Text.pack . show
<$> remoteFileExists urlPath
ArchiveCommand repo nameVersion tarball tagPrefix ->
cloneAndArchive repo nameVersion tarball tagPrefix >> pure Nothing
2023-08-25 10:30:24 +02:00
DownloadCommand url target
2023-09-03 10:26:43 +02:00
| Just uri' <- mkURI url -> fmap (Text.pack . show)
<$> download uri' target
2023-08-25 10:30:24 +02:00
| otherwise -> pure Nothing
CloneCommand repo tarball tagPrefix -> fmap (Text.pack . show)
<$> clone repo tarball tagPrefix
2023-09-03 10:26:43 +02:00
DownloadAndDeployCommand uri' tarball -> fmap (Text.pack . show)
<$> downloadAndDeploy uri' tarball
Up2DateCommand -> up2Date >> pure Nothing
2023-08-10 12:47:43 +02:00
chooseTransformFunction (Just "php") = phpTransform
chooseTransformFunction (Just "rdiff-backup") = Text.stripPrefix "v"
chooseTransformFunction _ = stripPrefix "v"
2023-08-09 20:59:42 +02:00
stripPrefix prefix string = Just
$ fromMaybe string
$ Text.stripPrefix prefix string
2023-08-10 12:47:43 +02:00
phpTransform version
2023-08-21 13:38:20 +02:00
| (majorPrefix, _patchVersion) <- Text.breakOnEnd "." version
2023-08-10 12:47:43 +02:00
, majorPrefix == "php-8.2." = Just $ Text.drop (Text.length "php-") version
| otherwise = Nothing