{- This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0. If a copy of the MPL was not distributed with this file, You can obtain one at https://mozilla.org/MPL/2.0/. -} module Main ( main ) where import Data.Char (isNumber) import Control.Monad.Catch (MonadThrow(..), handle) import Control.Monad.IO.Class (MonadIO(..)) import qualified Data.Map as Map import Options.Applicative (execParser) import SlackBuilder.CommandLine import SlackBuilder.Config import SlackBuilder.Trans import SlackBuilder.LatestVersionCheck import SlackBuilder.Update import qualified Toml import Data.Text (Text) import qualified Data.Text as Text import qualified Data.Text.IO as Text import Control.Monad.Trans.Reader (ReaderT(..), asks) import SlackBuilder.Package (PackageDescription(..)) import qualified SlackBuilder.Package as Package import Text.URI.QQ (uri) import Data.Foldable (find, traverse_) import GHC.Records (HasField(..)) import System.Process (CmdSpec(..)) import System.Console.ANSI ( setSGR , SGR(..) , ColorIntensity(..) , Color(..) , ConsoleLayer(..) ) import Data.Maybe (fromJust) autoUpdatable :: [PackageSettings] -> [PackageDescription] autoUpdatable packageSettings = [ PackageDescription { latest = let ghArguments = uncurry PackageOwner $ fromJust $ getField @"github" setting setting = fromJust $ find ((== "universal-ctags") . getField @"name") packageSettings template = Package.DownloadTemplate $ getField @"template" setting in Package.Updater { detectLatest = latestGitHub ghArguments "(v)\\." , getVersion = reuploadWithTemplate template [] , is64 = getField @"is64" setting } , name = "universal-ctags" , downloaders = mempty } , PackageDescription { latest = let packagistArguments = uncurry PackageOwner $ fromJust $ getField @"packagist" setting setting = fromJust $ find ((== "composer") . getField @"name") packageSettings template = Package.DownloadTemplate $ getField @"template" setting in Package.Updater { detectLatest = latestPackagist packagistArguments , getVersion = downloadWithTemplate template , is64 = getField @"is64" setting } , name = "composer" , downloaders = mempty } , PackageDescription { latest = let ghArguments = uncurry PackageOwner $ fromJust $ getField @"github" setting setting = fromJust $ find ((== "jitsi-meet-desktop") . getField @"name") packageSettings template = Package.DownloadTemplate $ getField @"template" setting in Package.Updater { detectLatest = latestGitHub ghArguments "(v)*" , getVersion = downloadWithTemplate template , is64 = getField @"is64" setting } , name = "jitsi-meet-desktop" , downloaders = mempty } , PackageDescription { latest = let ghArguments = uncurry PackageOwner $ fromJust $ getField @"github" setting setting = fromJust $ find ((== "php82") . getField @"name") packageSettings template = Package.DownloadTemplate $ getField @"template" setting in Package.Updater { detectLatest = latestGitHub ghArguments "(php-)8.2.\\d" , getVersion = downloadWithTemplate template , is64 = getField @"is64" setting } , name = "php82" , downloaders = mempty } , PackageDescription { latest = let ghArguments = uncurry PackageOwner $ fromJust $ getField @"github" setting setting = fromJust $ find ((== "kitty") . getField @"name") packageSettings template = Package.DownloadTemplate $ getField @"template" setting in Package.Updater { detectLatest = latestGitHub ghArguments "(v)\\." , getVersion = reuploadWithTemplate template [RawCommand "go" ["mod", "vendor"]] , is64 = getField @"is64" setting } , name = "kitty" , downloaders = mempty } , PackageDescription { latest = let ghArguments = uncurry PackageOwner $ fromJust $ getField @"github" setting setting = fromJust $ find ((== "rdiff-backup") . getField @"name") packageSettings template = Package.DownloadTemplate $ getField @"template" setting in Package.Updater { detectLatest = latestGitHub ghArguments "(v)\\." , getVersion = reuploadWithTemplate template [] , is64 = getField @"is64" setting } , name = "rdiff-backup" , downloaders = mempty } , PackageDescription { latest = let needle = "Linux—" textArguments = TextArguments { textURL = fromJust $ getField @"text" setting , versionPicker = Text.takeWhile (liftA2 (||) (== '.') isNumber) . Text.drop (Text.length needle) . snd . Text.breakOn needle } setting = fromJust $ find ((== "webex") . getField @"name") packageSettings template = Package.DownloadTemplate $ getField @"template" setting in Package.Updater { detectLatest = latestText textArguments , getVersion = downloadWithTemplate template , is64 = getField @"is64" setting } , name = "webex" , downloaders = mempty } , PackageDescription { latest = let ghArguments = uncurry PackageOwner $ fromJust $ getField @"github" setting setting = fromJust $ find ((== "librsync") . getField @"name") packageSettings template = Package.DownloadTemplate $ getField @"template" setting in Package.Updater { detectLatest = latestGitHub ghArguments "(v)\\." , getVersion = reuploadWithTemplate template [] , is64 = getField @"is64" setting } , name = "librsync" , downloaders = mempty } , PackageDescription { latest = let textArguments = TextArguments { textURL = fromJust $ getField @"text" setting , versionPicker = Text.strip } setting = fromJust $ find ((== "dmd") . getField @"name") packageSettings template = Package.DownloadTemplate $ getField @"template" setting in Package.Updater { detectLatest = latestText textArguments , getVersion = downloadWithTemplate template , is64 = getField @"is64" setting } , name = "dmd" , downloaders = mempty } , PackageDescription { latest = let textArguments = TextArguments { textURL = fromJust $ getField @"text" setting , versionPicker = Text.strip } setting = fromJust $ find ((== "d-tools") . getField @"name") packageSettings template = Package.DownloadTemplate $ getField @"template" setting in Package.Updater { detectLatest = latestText textArguments , getVersion = reuploadWithTemplate template [] , is64 = getField @"is64" setting } , name = "d-tools" , downloaders = let dubArguments = PackageOwner{ owner = "dlang", name = "dub" } dscannerArguments = PackageOwner{ owner = "dlang-community", name = "D-Scanner" } dcdArguments = PackageOwner{ owner = "dlang-community", name = "DCD" } latestDub = Package.Updater { detectLatest = latestGitHub dubArguments "(v)\\." , getVersion = reuploadWithTemplate dubTemplate [] , is64 = False } latestDscanner = Package.Updater { detectLatest = latestGitHub dscannerArguments "(v)\\." , getVersion = cloneFromGit dscannerURI "v" , is64 = False } dcdURI = [uri|https://github.com/dlang-community/DCD.git|] latestDcd = Package.Updater { detectLatest = latestGitHub dcdArguments "(v)\\." , getVersion = cloneFromGit dcdURI "v" , is64 = False } dubTemplate = Package.DownloadTemplate "https://codeload.github.com/dlang/dub/tar.gz/v{version}" dscannerURI = [uri|https://github.com/dlang-community/D-Scanner.git|] in Map.fromList [ ("DUB", latestDub) , ("DSCANNER", latestDscanner) , ("DCD", latestDcd) ] } , PackageDescription { latest = let ghArguments = uncurry PackageOwner $ fromJust $ getField @"github" setting setting = fromJust $ find ((== "simde") . getField @"name") packageSettings template = Package.DownloadTemplate $ getField @"template" setting in Package.Updater { detectLatest = latestGitHub ghArguments "(v)\\." , getVersion = downloadWithTemplate template , is64 = getField @"is64" setting } , name = "simde" , downloaders = mempty } , PackageDescription { latest = let ghArguments = uncurry PackageOwner $ fromJust $ getField @"github" setting setting = fromJust $ find ((== "nginx") . getField @"name") packageSettings template = Package.DownloadTemplate $ getField @"template" setting in Package.Updater { detectLatest = latestGitHub ghArguments "(release-)\\d.[02468].\\d" , getVersion = downloadWithTemplate template , is64 = getField @"is64" setting } , name = "nginx" , downloaders = mempty } ] up2Date :: Maybe Text -> SlackBuilderT () up2Date selectedPackage = do packages' <- SlackBuilderT $ asks (getField @"packages") case selectedPackage of Nothing -> traverse_ (handle handleException . go) $ autoUpdatable packages' Just packageName | Just foundPackage <- find ((packageName ==) . getField @"name") (autoUpdatable packages') -> go foundPackage | otherwise -> throwM $ UpdaterNotFound packageName where go package = getAndLogLatest package >>= mapM_ updatePackageIfRequired >> liftIO (putStrLn "") check :: SlackBuilderT () check = SlackBuilderT (asks (getField @"packages")) >>= traverse_ (handle handleException . go) . autoUpdatable where go package = getAndLogLatest package >>= mapM_ checkUpdateAvailability >> liftIO (putStrLn "") main :: IO () main = execParser slackBuilderParser >>= handle handleException . withCommandLine where withCommandLine programCommand = do settingsResult <- Toml.decodeFileEither settingsCodec configurationFile case settingsResult of Right settings -> flip runReaderT settings $ runSlackBuilderT $ executeCommand programCommand Left settingsErrors -> setSGR [SetColor Foreground Dull Red] >> putStrLn (configurationFile <> " parsing failed.") >> setSGR [Reset] >> Text.putStr (Toml.prettyTomlDecodeErrors settingsErrors) configurationFile = "config/config.toml" executeCommand = \case CheckCommand -> check Up2DateCommand packageName -> up2Date packageName