{- 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 as Text import qualified Data.Text.IO as Text import Control.Monad.Trans.Reader (ReaderT(..), asks) import SlackBuilder.Package (PackageDescription(..), renderTextWithVersion) import qualified SlackBuilder.Package as Package import Data.Foldable (find, traverse_) import GHC.Records (HasField(..)) import System.Console.ANSI ( setSGR , SGR(..) , ColorIntensity(..) , Color(..) , ConsoleLayer(..) ) import Data.Maybe (mapMaybe) import qualified Text.URI as URI import System.Directory (listDirectory) import qualified Data.HashMap.Strict as HashMap import SlackBuilder.Info (readInfoFile) autoUpdatable :: [PackageSettings] -> [PackageDescription] autoUpdatable = mapMaybe go where go PackageSettings{ downloader = setting, downloaders } = do latest' <- packageUpdaterFromSettings setting pure $ PackageDescription { latest = latest' , name = getField @"name" setting , downloaders = Map.fromList $ mapMaybe forDownloader downloaders } forDownloader downloaderSettings@DownloaderSettings{ name } = (name,) <$> packageUpdaterFromSettings downloaderSettings packageUpdaterFromSettings :: DownloaderSettings -> Maybe Package.Updater packageUpdaterFromSettings DownloaderSettings{..} = do getVersion' <- getVersionSettings detectLatest' <- detectLatestSettings Just Package.Updater { detectLatest = detectLatest' , getVersion = getVersion' , is64 = is64 } where detectLatestSettings | Just githubSettings <- github = let ghArguments = uncurry PackageOwner githubSettings in Just $ latestGitHub ghArguments version | Just packagistSettings <- packagist = let packagistArguments = uncurry PackageOwner packagistSettings in Just $ latestPackagist packagistArguments | Just textSettings <- text = let textArguments = uncurry TextArguments textSettings in Just $ latestText textArguments version | otherwise = Nothing getVersionSettings | Just template' <- template = Just $ repackageWithTemplate repackage $ Package.DownloadTemplate template' | Just CloneSettings{..} <- clone = flip cloneFromGit (renderTextWithVersion tagTemplate version) <$> URI.mkURI remote | otherwise = Nothing 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 "") installed :: SlackBuilderT () installed = do listing <- listRepository database <- foldr createDataBase HashMap.empty . mapMaybe createEntry <$> liftIO (listDirectory "/var/lib/pkgtools/packages") traverse_ findInfo $ HashMap.intersectionWith (,) database listing where findInfo (installed'@Package.DataBaseEntry{ name }, fromRepository) = do _ <- readInfoFile fromRepository name liftIO $ print installed' createDataBase entry@Package.DataBaseEntry{ name } = HashMap.insert name entry createEntry filename = createEntryFromChunks $ Text.split (== '-') $ Text.reverse $ Text.pack filename createEntryFromChunks (build : arch : version : name) = Just Package.DataBaseEntry { arch = Text.reverse arch , build = Text.reverse build , version = Text.reverse version , name = Text.reverse (Text.intercalate "-" name) } createEntryFromChunks _ = Nothing 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 InstalledCommand -> installed