module Main ( main ) where import Data.List.NonEmpty (NonEmpty(..)) import qualified Data.List.NonEmpty as NonEmpty import Control.Monad.IO.Class (MonadIO(..)) import Data.Maybe (fromJust, fromMaybe) import Options.Applicative (execParser) import SlackBuilder.CommandLine import SlackBuilder.Config import SlackBuilder.Trans import SlackBuilder.Updater import qualified Toml import qualified Data.ByteString as ByteString import Data.Text (Text) import qualified Data.Text as Text import qualified Data.Text.IO as Text.IO import Control.Monad.Trans.Reader (ReaderT(..), asks) import SlackBuilder.Download 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 ((), (<.>)) import SlackBuilder.Info import Text.Megaparsec (parse, errorBundlePretty) data Package = Package { latest :: Package.Updater , category :: Text , name :: Text , homepage :: Maybe URI , requires :: [Text] , reupload :: Bool } autoUpdatable :: [Package] autoUpdatable = [ Package { latest = let ghArguments = GhArguments{ owner = "universal-ctags", name = "ctags", transform = Nothing} latest' = latestGitHub ghArguments pure templateTail = [ Package.VersionPlaceholder , 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%" , reupload = True } , Package { latest = let packagistArguments = PackagistArguments{ vendor = "composer", name = "composer" } latest' = latestPackagist packagistArguments template = Package.DownloadTemplate $ Package.StaticPlaceholder "https://getcomposer.org/download/" :| [Package.VersionPlaceholder, Package.StaticPlaceholder "/composer.phar"] in Package.Updater latest' template , category = "development" , name = "composer" , homepage = Just [uri|https://getcomposer.org/|] , requires = mempty , reupload = False } , Package { latest = let ghArguments = GhArguments { owner = "jitsi" , name = "jitsi-meet-electron" , transform = Nothing } latest' = latestGitHub ghArguments $ Text.stripPrefix "v" template = Package.DownloadTemplate $ Package.StaticPlaceholder "https://github.com/jitsi/jitsi-meet-electron/releases/download/v" :| Package.VersionPlaceholder : [Package.StaticPlaceholder "/jitsi-meet-x86_64.AppImage"] in Package.Updater latest' template , category = "network" , name = "jitsi-meet-desktop" , homepage = Just [uri|https://jitsi.org/|] , requires = mempty , reupload = False } , Package { latest = let ghArguments = GhArguments { owner = "php" , name = "php-src" , transform = Nothing } checkVersion x | Text.isPrefixOf "php-8.2." x = Text.stripPrefix "php-" x | otherwise = Nothing latest' = latestGitHub ghArguments checkVersion template = Package.DownloadTemplate $ Package.StaticPlaceholder "https://www.php.net/distributions/php-" :| Package.VersionPlaceholder : [Package.StaticPlaceholder ".tar.xz"] in Package.Updater latest' template , category = "development" , name = "php82" , homepage = Just [uri|https://www.php.net/|] , requires = ["postgresql"] , reupload = False } ] up2Date :: SlackBuilderT () up2Date = for_ autoUpdatable go where go package = getAndLogLatest package >>= mapM_ (updatePackageIfRequired package) getAndLogLatest Package{ latest = Package.Updater getLatest _, name } = liftIO (putStrLn $ Text.unpack name <> ": Retreiving the latest version.") >> getLatest updatePackageIfRequired :: Package -> Text -> SlackBuilderT () updatePackageIfRequired package@Package{..} version = do let packagePath = Text.unpack category Text.unpack name (Text.unpack name <.> "info") repository' <- SlackBuilderT $ asks repository infoContents <- liftIO $ ByteString.readFile $ repository' packagePath case parse parseInfoFile packagePath infoContents of Right _parsedInfoFile -> updatePackage package version Left errorBundle -> liftIO $ putStr $ errorBundlePretty errorBundle updatePackage :: Package -> Text -> SlackBuilderT () updatePackage Package{..} version = do maintainer' <- SlackBuilderT $ asks $ getField @"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 repository' <- SlackBuilderT $ asks repository uri' <- liftIO $ Package.renderDownloadWithVersion downloadTemplate version let downloadFileName = URI.unRText $ NonEmpty.last $ snd $ fromJust $ URI.uriPath uri' relativeTarball = packagePath <> "/" <> downloadFileName tarball = repository' Text.unpack relativeTarball liftIO $ putStrLn $ "Downloading " <> Text.unpack (URI.render uri') <> " to " <> tarball <> "." checksum <- fromJust <$> download uri' tarball download' <- handleReupload uri' relativeTarball downloadFileName let infoFilePath = repository' Text.unpack packagePath (Text.unpack name <.> "info") liftIO $ Text.IO.writeFile infoFilePath $ Package.infoTemplate package' [Package.Download download' checksum False] updateSlackBuildVersion packagePath version commit packagePath version where handleReupload uri' relativeTarball downloadFileName | reupload = liftIO (putStrLn $ "Upload the source tarball " <> Text.unpack relativeTarball) >> uploadCommand relativeTarball ("/" <> name) >> liftIO (mkURI $ "https://download.dlackware.com/hosted-sources/" <> name <> "/" <> downloadFileName) | otherwise = pure uri' main :: IO () main = do programCommand <- execParser slackBuilderParser settings <- Toml.decodeFile settingsCodec "config/config.toml" latestVersion <- flip runReaderT settings $ runSlackBuilderT $ executeCommand programCommand Text.IO.putStrLn $ fromMaybe "" latestVersion where executeCommand = \case 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 DownloadCommand url 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 Up2DateCommand -> up2Date >> pure Nothing chooseTransformFunction (Just "php") = phpTransform chooseTransformFunction (Just "rdiff-backup") = Text.stripPrefix "v" chooseTransformFunction _ = stripPrefix "v" stripPrefix prefix string = Just $ fromMaybe string $ Text.stripPrefix prefix string phpTransform version | (majorPrefix, _patchVersion) <- Text.breakOnEnd "." version , majorPrefix == "php-8.2." = Just $ Text.drop (Text.length "php-") version | otherwise = Nothing