{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE MonoLocalBinds #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeApplications #-} {- Copyright 2012 - 2020 Colin Woodbury This file is part of Aura. Aura is free s oftwar e:youcanredist ributeitand/ormodify itunderthetermsoftheGN UGeneralPublicLicenseasp ublishedbytheFreeSoftw areFoundation,either ver sio n3o fth eLicense,or(atyou ropti on)an ylate rvers ion.Auraisdistr ibutedi nthehop ethatit willbeu seful,butWITHOUTA NYWAR RANTY ;with outev entheimpliedwarranty ofM ERC HAN TAB ILITYorFITNESSFORAPART ICULARPURPOSE.SeetheGNUG eneralPublicLicensefor moredetails.Youshoul dhavereceiveda copyof the GNU General Public License along with Aura. If not, see . -} module Main ( main ) where import Aura.Colour (dtot) import Aura.Commands.A as A import Aura.Commands.B as B import Aura.Commands.C as C import Aura.Commands.L as L import Aura.Commands.O as O import Aura.Core import Aura.Languages import Aura.Logo import Aura.Packages.AUR (aurRepo) import Aura.Packages.Repository (pacmanRepo) import Aura.Pacman import Aura.Settings import Aura.Types import Aura.Utils (putTextLn) import Data.Bifunctor (first) import qualified Data.Set.NonEmpty as NES import Data.Text.Prettyprint.Doc import Data.Text.Prettyprint.Doc.Render.Terminal import Flags import Options.Applicative (execParser) import RIO hiding (first) import Settings import System.Path (toFilePath) import System.Process.Typed (proc, runProcess) import Text.Pretty.Simple (pPrintNoColor) --- #ifndef CURRENT_PACKAGE_VERSION #define CURRENT_PACKAGE_VERSION "UNKNOWN" #endif auraVersion :: Text auraVersion = CURRENT_PACKAGE_VERSION main :: IO () main = do options <- execParser opts esettings <- getSettings options repos <- (<>) <$> pacmanRepo <*> aurRepo case esettings of Left err -> putTextLn . dtot . ($ English) $ failure err Right ss -> execute ss repos options >>= exit ss execute :: Settings -> Repository -> Program -> IO (Either (Doc AnsiStyle) ()) execute ss r p = first f <$> try (runRIO (Env r ss) . execOpts $ _operation p) where f (Failure fl) = fl $ langOf ss exit :: Settings -> Either (Doc AnsiStyle) () -> IO a exit ss (Left e) = scold ss e *> exitFailure exit _ (Right _) = exitSuccess execOpts :: Either (PacmanOp, Set MiscOp) AuraOp -> RIO Env () execOpts ops = do ss <- asks settings when (shared ss Debug) $ do liftIO . pPrintNoColor $ ops liftIO . pPrintNoColor $ buildConfigOf ss liftIO . pPrintNoColor $ commonConfigOf ss let p (ps, ms) = liftIO . pacman $ asFlag ps ++ foldMap asFlag ms ++ asFlag (commonConfigOf ss) ++ bool [] ["--quiet"] (switch ss LowVerbosity) case ops of Left o@(Sync (Left sops) _, _) | any isUpgrade sops -> sudo (liftIO $ B.saveState ss) *> p o Left o -> p o Right (AurSync o _) -> case o of Right ps -> bool (trueRoot . sudo) id (switch ss DryRun) $ A.install ps Left (AurDeps ps) -> A.displayPkgDeps ps Left (AurInfo ps) -> A.aurPkgInfo ps Left (AurPkgbuild ps) -> A.displayPkgbuild ps Left (AurSearch s) -> A.aurPkgSearch s Left (AurUpgrade ps) -> bool (trueRoot . sudo) id (switch ss DryRun) $ A.upgradeAURPkgs ps Left (AurJson ps) -> A.aurJson ps Right (Backup o) -> case o of Nothing -> sudo . liftIO $ B.saveState ss Just (BackupClean n) -> sudo . liftIO $ B.cleanStates ss n Just BackupRestore -> sudo B.restoreState Just BackupList -> liftIO B.listStates Right (Cache o) -> case o of Right ps -> sudo $ C.downgradePackages ps Left (CacheSearch s) -> C.searchCache s Left (CacheClean n) -> sudo $ C.cleanCache n Left CacheCleanNotSaved -> sudo C.cleanNotSaved Left (CacheBackup pth) -> sudo $ C.backupCache pth Right (Log o) -> case o of Nothing -> L.viewLogFile Just (LogInfo ps) -> L.logInfoOnPkg ps Just (LogSearch s) -> asks settings >>= liftIO . flip L.searchLogFile s Right (Orphans o) -> case o of Nothing -> liftIO O.displayOrphans Just OrphanAbandon -> sudo $ liftIO orphans >>= traverse_ removePkgs . NES.nonEmptySet Just (OrphanAdopt ps) -> O.adoptPkg ps Right Version -> liftIO $ versionInfo >>= animateVersionMsg ss auraVersion Right Languages -> displayOutputLanguages Right ViewConf -> viewConfFile isUpgrade :: SyncOp -> Bool isUpgrade (SyncUpgrade _) = True isUpgrade _ = False displayOutputLanguages :: RIO Env () displayOutputLanguages = do ss <- asks settings liftIO . notify ss . displayOutputLanguages_1 $ langOf ss liftIO $ traverse_ (putTextLn . tshow) [English ..] viewConfFile :: RIO Env () viewConfFile = do pth <- asks (either id id . configPathOf . commonConfigOf . settings) liftIO . void . runProcess @IO $ proc "less" [toFilePath pth]