{-# LANGUAGE ViewPatterns #-}

-- |
-- Module    : Aura.Pacman
-- Copyright : (c) Colin Woodbury, 2012 - 2020
-- License   : GPL3
-- Maintainer: Colin Woodbury <colin@fosskers.ca>
--
-- An interface to @pacman@.
-- Takes any pacman arguments and applies it to pacman through the shell.

module Aura.Pacman
  ( -- * Calling Pacman
    pacman
  , pacmanOutput, pacmanSuccess, pacmanLines
    -- * Paths
  , lockFile
  , pacmanConfFile
  , defaultLogFile
  , getCachePath
  , getLogFilePath
    -- * Pacman Config
  , getPacmanConf
  , getIgnoredPkgs, getIgnoredGroups
  , groupPackages
    -- * Misc.
  , versionInfo
  , verMsgPad
  ) where

import           Aura.Languages
import           Aura.Settings.External
import           Aura.Types
import           RIO hiding (some, try)
import qualified RIO.ByteString as BS
import qualified RIO.ByteString.Lazy as BL
import           RIO.FilePath
import           RIO.Lens (_2)
import           RIO.List.Partial ((!!))
import qualified RIO.Map as M
import qualified RIO.Set as S
import qualified RIO.Text as T
import           System.Process.Typed
import           Text.Megaparsec (parse)

---

-- | Default location of the pacman config file: \/etc\/pacman.conf
pacmanConfFile :: FilePath
pacmanConfFile :: FilePath
pacmanConfFile = FilePath
"/etc/pacman.conf"

-- | Default location of the pacman log flie: \/var\/log\/pacman.log
defaultLogFile :: FilePath
defaultLogFile :: FilePath
defaultLogFile = FilePath
"/var/log/pacman.log"

-- | Default location of the pacman database lock file: \/var\/lib\/pacman\/db.lck
lockFile :: FilePath
lockFile :: FilePath
lockFile = FilePath
"/var/lib/pacman/db.lck"

-- | Given a filepath to the pacman config, try to parse its contents.
getPacmanConf :: FilePath -> IO (Either Failure Config)
getPacmanConf :: FilePath -> IO (Either Failure Config)
getPacmanConf FilePath
fp = do
  Text
file <- ByteString -> Text
decodeUtf8Lenient (ByteString -> Text) -> IO ByteString -> IO Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO ByteString
forall (m :: * -> *). MonadIO m => FilePath -> m ByteString
BS.readFile FilePath
fp
  Either Failure Config -> IO (Either Failure Config)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Failure Config -> IO (Either Failure Config))
-> (Either (ParseErrorBundle Text Void) Config
    -> Either Failure Config)
-> Either (ParseErrorBundle Text Void) Config
-> IO (Either Failure Config)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ParseErrorBundle Text Void -> Failure)
-> Either (ParseErrorBundle Text Void) Config
-> Either Failure Config
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Failure -> ParseErrorBundle Text Void -> Failure
forall a b. a -> b -> a
const (FailMsg -> Failure
Failure (FailMsg -> Failure) -> FailMsg -> Failure
forall a b. (a -> b) -> a -> b
$ (Language -> Doc AnsiStyle) -> FailMsg
FailMsg Language -> Doc AnsiStyle
confParsing_1)) (Either (ParseErrorBundle Text Void) Config
 -> IO (Either Failure Config))
-> Either (ParseErrorBundle Text Void) Config
-> IO (Either Failure Config)
forall a b. (a -> b) -> a -> b
$ Parsec Void Text Config
-> FilePath -> Text -> Either (ParseErrorBundle Text Void) Config
forall e s a.
Parsec e s a -> FilePath -> s -> Either (ParseErrorBundle s e) a
parse Parsec Void Text Config
config FilePath
"pacman config" Text
file

-- | Fetches the @IgnorePkg@ entry from the config, if it's there.
getIgnoredPkgs :: Config -> Set PkgName
getIgnoredPkgs :: Config -> Set PkgName
getIgnoredPkgs (Config Map Text [Text]
c) = Set PkgName
-> ([Text] -> Set PkgName) -> Maybe [Text] -> Set PkgName
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Set PkgName
forall a. Set a
S.empty ([PkgName] -> Set PkgName
forall a. Ord a => [a] -> Set a
S.fromList ([PkgName] -> Set PkgName)
-> ([Text] -> [PkgName]) -> [Text] -> Set PkgName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> PkgName) -> [Text] -> [PkgName]
forall a b. (a -> b) -> [a] -> [b]
map Text -> PkgName
PkgName) (Maybe [Text] -> Set PkgName) -> Maybe [Text] -> Set PkgName
forall a b. (a -> b) -> a -> b
$ Text -> Map Text [Text] -> Maybe [Text]
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
"IgnorePkg" Map Text [Text]
c

-- | Fetches the @IgnoreGroup@ entry from the config, if it's there.
getIgnoredGroups :: Config -> Set PkgGroup
getIgnoredGroups :: Config -> Set PkgGroup
getIgnoredGroups (Config Map Text [Text]
c) = Set PkgGroup
-> ([Text] -> Set PkgGroup) -> Maybe [Text] -> Set PkgGroup
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Set PkgGroup
forall a. Set a
S.empty ([PkgGroup] -> Set PkgGroup
forall a. Ord a => [a] -> Set a
S.fromList ([PkgGroup] -> Set PkgGroup)
-> ([Text] -> [PkgGroup]) -> [Text] -> Set PkgGroup
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> PkgGroup) -> [Text] -> [PkgGroup]
forall a b. (a -> b) -> [a] -> [b]
map Text -> PkgGroup
PkgGroup) (Maybe [Text] -> Set PkgGroup) -> Maybe [Text] -> Set PkgGroup
forall a b. (a -> b) -> a -> b
$ Text -> Map Text [Text] -> Maybe [Text]
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
"IgnoreGroup" Map Text [Text]
c

-- | Given a `Set` of package groups, yield all the packages they contain.
groupPackages :: Environment -> NonEmpty PkgGroup -> IO (Set PkgName)
groupPackages :: Environment -> NonEmpty PkgGroup -> IO (Set PkgName)
groupPackages Environment
env NonEmpty PkgGroup
igs = (ByteString -> Set PkgName) -> IO ByteString -> IO (Set PkgName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> Set PkgName
f (Text -> Set PkgName)
-> (ByteString -> Text) -> ByteString -> Set PkgName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
decodeUtf8Lenient) (IO ByteString -> IO (Set PkgName))
-> ([Text] -> IO ByteString) -> [Text] -> IO (Set PkgName)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Environment -> [Text] -> IO ByteString
pacmanOutput Environment
env ([Text] -> IO (Set PkgName)) -> [Text] -> IO (Set PkgName)
forall a b. (a -> b) -> a -> b
$ Text
"-Qg" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: NonEmpty PkgGroup -> [Text]
forall a. Flagable a => a -> [Text]
asFlag NonEmpty PkgGroup
igs
  where
    f :: Text -> Set PkgName
    f :: Text -> Set PkgName
f = [PkgName] -> Set PkgName
forall a. Ord a => [a] -> Set a
S.fromList ([PkgName] -> Set PkgName)
-> (Text -> [PkgName]) -> Text -> Set PkgName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> PkgName) -> [Text] -> [PkgName]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> PkgName
PkgName (Text -> PkgName) -> (Text -> Text) -> Text -> PkgName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Text] -> Int -> Text
forall a. [a] -> Int -> a
!! Int
1) ([Text] -> Text) -> (Text -> [Text]) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.words) ([Text] -> [PkgName]) -> (Text -> [Text]) -> Text -> [PkgName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.lines

-- | Fetches the @CacheDir@ entry from the config, if it's there.
getCachePath :: Config -> Maybe FilePath
getCachePath :: Config -> Maybe FilePath
getCachePath (Config Map Text [Text]
c) = do
  FilePath
fp <- Text -> FilePath
T.unpack (Text -> FilePath) -> Maybe Text -> Maybe FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Map Text [Text] -> Maybe [Text]
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
"CacheDir" Map Text [Text]
c Maybe [Text] -> ([Text] -> Maybe Text) -> Maybe Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Text] -> Maybe Text
forall a. [a] -> Maybe a
listToMaybe)
  Maybe FilePath -> Maybe FilePath -> Bool -> Maybe FilePath
forall a. a -> a -> Bool -> a
bool Maybe FilePath
forall a. Maybe a
Nothing (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
fp) (Bool -> Maybe FilePath) -> Bool -> Maybe FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> Bool
isAbsolute FilePath
fp

-- | Fetches the @LogFile@ entry from the config, if it's there.
getLogFilePath :: Config -> Maybe FilePath
getLogFilePath :: Config -> Maybe FilePath
getLogFilePath (Config Map Text [Text]
c) = do
  FilePath
fp <- Text -> FilePath
T.unpack (Text -> FilePath) -> Maybe Text -> Maybe FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Map Text [Text] -> Maybe [Text]
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
"LogFile" Map Text [Text]
c Maybe [Text] -> ([Text] -> Maybe Text) -> Maybe Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Text] -> Maybe Text
forall a. [a] -> Maybe a
listToMaybe)
  Maybe FilePath -> Maybe FilePath -> Bool -> Maybe FilePath
forall a. a -> a -> Bool -> a
bool Maybe FilePath
forall a. Maybe a
Nothing (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
fp) (Bool -> Maybe FilePath) -> Bool -> Maybe FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> Bool
isAbsolute FilePath
fp

----------
-- ACTIONS
----------

-- | Create a pacman process to run.
pacmanProc :: Environment -> [String] -> ProcessConfig () () ()
pacmanProc :: Environment -> [FilePath] -> ProcessConfig () () ()
pacmanProc Environment
env [FilePath]
args = [(FilePath, FilePath)]
-> ProcessConfig () () () -> ProcessConfig () () ()
forall stdin stdout stderr.
[(FilePath, FilePath)]
-> ProcessConfig stdin stdout stderr
-> ProcessConfig stdin stdout stderr
setEnv [(FilePath, FilePath)]
vars (ProcessConfig () () () -> ProcessConfig () () ())
-> ProcessConfig () () () -> ProcessConfig () () ()
forall a b. (a -> b) -> a -> b
$ FilePath -> [FilePath] -> ProcessConfig () () ()
proc FilePath
"pacman" [FilePath]
args
  where
    vars :: [(String, String)]
    vars :: [(FilePath, FilePath)]
vars = (FilePath
"LC_ALL", FilePath
"C") (FilePath, FilePath)
-> [(FilePath, FilePath)] -> [(FilePath, FilePath)]
forall a. a -> [a] -> [a]
: [(FilePath, FilePath)]
-> (Text -> [(FilePath, FilePath)])
-> Maybe Text
-> [(FilePath, FilePath)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Text
p -> [(FilePath
"PATH", Text -> FilePath
T.unpack Text
p)]) (Text -> Environment -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
"PATH" Environment
env)

-- | Run a pacman action that may fail.
pacman :: Environment -> [Text] -> IO ()
pacman :: Environment -> [Text] -> IO ()
pacman Environment
env ((Text -> FilePath) -> [Text] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map Text -> FilePath
T.unpack -> [FilePath]
args) = do
  ExitCode
ec <- ProcessConfig () () () -> IO ExitCode
forall (m :: * -> *) stdin stdout stderr.
MonadIO m =>
ProcessConfig stdin stdout stderr -> m ExitCode
runProcess (ProcessConfig () () () -> IO ExitCode)
-> ProcessConfig () () () -> IO ExitCode
forall a b. (a -> b) -> a -> b
$ Environment -> [FilePath] -> ProcessConfig () () ()
pacmanProc Environment
env [FilePath]
args
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ExitCode
ec ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
== ExitCode
ExitSuccess) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Failure -> IO ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM Failure
Silent

-- | Run some `pacman` process, but only care about whether it succeeded.
pacmanSuccess :: Environment -> [T.Text] -> IO Bool
pacmanSuccess :: Environment -> [Text] -> IO Bool
pacmanSuccess Environment
env [Text]
i = (ExitCode -> Bool) -> IO ExitCode -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
== ExitCode
ExitSuccess) (IO ExitCode -> IO Bool)
-> ([FilePath] -> IO ExitCode) -> [FilePath] -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProcessConfig () () () -> IO ExitCode
forall (m :: * -> *) stdin stdout stderr.
MonadIO m =>
ProcessConfig stdin stdout stderr -> m ExitCode
runProcess (ProcessConfig () () () -> IO ExitCode)
-> ([FilePath] -> ProcessConfig () () ())
-> [FilePath]
-> IO ExitCode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StreamSpec 'STOutput ()
-> ProcessConfig () () () -> ProcessConfig () () ()
forall stderr stdin stdout stderr0.
StreamSpec 'STOutput stderr
-> ProcessConfig stdin stdout stderr0
-> ProcessConfig stdin stdout stderr
setStderr StreamSpec 'STOutput ()
forall (anyStreamType :: StreamType). StreamSpec anyStreamType ()
closed (ProcessConfig () () () -> ProcessConfig () () ())
-> ([FilePath] -> ProcessConfig () () ())
-> [FilePath]
-> ProcessConfig () () ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StreamSpec 'STOutput ()
-> ProcessConfig () () () -> ProcessConfig () () ()
forall stdout stdin stdout0 stderr.
StreamSpec 'STOutput stdout
-> ProcessConfig stdin stdout0 stderr
-> ProcessConfig stdin stdout stderr
setStdout StreamSpec 'STOutput ()
forall (anyStreamType :: StreamType). StreamSpec anyStreamType ()
closed (ProcessConfig () () () -> ProcessConfig () () ())
-> ([FilePath] -> ProcessConfig () () ())
-> [FilePath]
-> ProcessConfig () () ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Environment -> [FilePath] -> ProcessConfig () () ()
pacmanProc Environment
env ([FilePath] -> IO Bool) -> [FilePath] -> IO Bool
forall a b. (a -> b) -> a -> b
$ (Text -> FilePath) -> [Text] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map Text -> FilePath
T.unpack [Text]
i

-- | Runs pacman silently and returns only the stdout.
pacmanOutput :: Environment -> [Text] -> IO ByteString
pacmanOutput :: Environment -> [Text] -> IO ByteString
pacmanOutput Environment
env [Text]
i =
  ((ExitCode, ByteString, ByteString) -> ByteString)
-> IO (ExitCode, ByteString, ByteString) -> IO ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((ExitCode, ByteString, ByteString)
-> Getting ByteString (ExitCode, ByteString, ByteString) ByteString
-> ByteString
forall s a. s -> Getting a s a -> a
^. (ByteString -> Const ByteString ByteString)
-> (ExitCode, ByteString, ByteString)
-> Const ByteString (ExitCode, ByteString, ByteString)
forall s t a b. Field2 s t a b => Lens s t a b
_2 ((ByteString -> Const ByteString ByteString)
 -> (ExitCode, ByteString, ByteString)
 -> Const ByteString (ExitCode, ByteString, ByteString))
-> ((ByteString -> Const ByteString ByteString)
    -> ByteString -> Const ByteString ByteString)
-> Getting ByteString (ExitCode, ByteString, ByteString) ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> ByteString) -> SimpleGetter ByteString ByteString
forall s a. (s -> a) -> SimpleGetter s a
to ByteString -> ByteString
BL.toStrict) (IO (ExitCode, ByteString, ByteString) -> IO ByteString)
-> ([FilePath] -> IO (ExitCode, ByteString, ByteString))
-> [FilePath]
-> IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProcessConfig () () () -> IO (ExitCode, ByteString, ByteString)
forall (m :: * -> *) stdin stdoutIgnored stderrIgnored.
MonadIO m =>
ProcessConfig stdin stdoutIgnored stderrIgnored
-> m (ExitCode, ByteString, ByteString)
readProcess (ProcessConfig () () () -> IO (ExitCode, ByteString, ByteString))
-> ([FilePath] -> ProcessConfig () () ())
-> [FilePath]
-> IO (ExitCode, ByteString, ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Environment -> [FilePath] -> ProcessConfig () () ()
pacmanProc Environment
env ([FilePath] -> IO ByteString) -> [FilePath] -> IO ByteString
forall a b. (a -> b) -> a -> b
$ (Text -> FilePath) -> [Text] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map Text -> FilePath
T.unpack [Text]
i

-- | Runs pacman silently and returns the stdout as UTF8-decoded `Text` lines.
pacmanLines :: Environment -> [Text] -> IO [Text]
pacmanLines :: Environment -> [Text] -> IO [Text]
pacmanLines Environment
env [Text]
s = Text -> [Text]
T.lines (Text -> [Text]) -> (ByteString -> Text) -> ByteString -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
decodeUtf8Lenient (ByteString -> [Text]) -> IO ByteString -> IO [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Environment -> [Text] -> IO ByteString
pacmanOutput Environment
env [Text]
s

-- | Yields the lines given by `pacman -V` with the pacman image stripped.
versionInfo :: Environment -> IO [Text]
versionInfo :: Environment -> IO [Text]
versionInfo Environment
env = (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Text -> Text
T.drop Int
verMsgPad) ([Text] -> [Text]) -> IO [Text] -> IO [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Environment -> [Text] -> IO [Text]
pacmanLines Environment
env [Text
"-V"]

-- | The amount of whitespace before text in the lines given by `pacman -V`
verMsgPad :: Int
verMsgPad :: Int
verMsgPad = Int
23