slackbuilder/src/Main.hs

{- 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 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.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.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 (getField @"version" setting)
                , getVersion = repackageWithTemplate (getField @"repackage" setting) 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 = repackageWithTemplate (getField @"repackage" setting) 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 (getField @"version" setting)
                , getVersion = repackageWithTemplate (getField @"repackage" setting) 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  (getField @"version" setting)
                , getVersion = repackageWithTemplate (getField @"repackage" setting) 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 (getField @"version" setting)
                , getVersion = repackageWithTemplate (getField @"repackage" setting) template
                , 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 (getField @"version" setting)
                , getVersion = repackageWithTemplate (getField @"repackage" setting) template
                , is64 = getField @"is64" setting
                }
        , name = "rdiff-backup"
        , downloaders = mempty
        }
    , PackageDescription
        { latest =
            let textArguments = uncurry TextArguments $ fromJust $ getField @"text" setting
                setting = fromJust $ find ((== "webex") . getField @"name") packageSettings
                template = Package.DownloadTemplate $ getField @"template" setting
             in Package.Updater
                { detectLatest = latestText textArguments (getField @"version" setting)
                , getVersion = repackageWithTemplate (getField @"repackage" setting) 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 (getField @"version" setting)
                , getVersion = repackageWithTemplate (getField @"repackage" setting) template
                , is64 = getField @"is64" setting
                }
        , name = "librsync"
        , downloaders = mempty
        }
    , PackageDescription
        { latest =
            let textArguments = uncurry TextArguments $ fromJust $ getField @"text" setting
                setting = fromJust $ find ((== "dmd") . getField @"name") packageSettings
                template = Package.DownloadTemplate $ getField @"template" setting
             in Package.Updater
                { detectLatest = latestText textArguments (getField @"version" setting)
                , getVersion = repackageWithTemplate (getField @"repackage" setting) template
                , is64 = getField @"is64" setting
                }
        , name = "dmd"
        , downloaders = mempty
        }
    , PackageDescription
        { latest =
            let textArguments = uncurry TextArguments $ fromJust $ getField @"text" setting
                setting = fromJust $ find ((== "d-tools") . getField @"name") packageSettings
                template = Package.DownloadTemplate $ getField @"template" setting
             in Package.Updater
                { detectLatest = latestText textArguments (getField @"version" setting)
                , getVersion = repackageWithTemplate (getField @"repackage" setting) 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 (getField @"version" setting)
                , getVersion = repackageWithTemplate (getField @"repackage" setting) 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 (getField @"version" setting)
                , getVersion = repackageWithTemplate (getField @"repackage" setting) 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