{-# LANGUAGE ViewPatterns #-}
module Aura.Pacman
(
pacman
, pacmanOutput, pacmanSuccess, pacmanLines
, lockFile
, pacmanConfFile
, defaultLogFile
, getCachePath
, getLogFilePath
, Config(..), config
, getPacmanConf
, getIgnoredPkgs, getIgnoredGroups
, groupPackages
, versionInfo
, verMsgPad
) where
import Aura.Languages
import Aura.Types
import Data.Bifunctor (first)
import Lens.Micro (_2)
import RIO hiding (first, some, try)
import qualified RIO.ByteString as BS
import qualified RIO.ByteString.Lazy as BL
import RIO.FilePath
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 hiding (single)
import Text.Megaparsec.Char
import qualified Text.Megaparsec.Char.Lexer as L
newtype Config = Config (Map Text [Text]) deriving (Show)
config :: Parsec Void Text Config
config = Config . M.fromList . rights <$> (garbage *> some (fmap Right (try pair) <|> fmap Left single) <* eof)
single :: Parsec Void Text ()
single = L.lexeme garbage . void $ manyTill letterChar newline
pair :: Parsec Void Text (Text, [Text])
pair = L.lexeme garbage $ do
n <- takeWhile1P Nothing (/= ' ')
space
void $ char '='
space
rest <- T.words <$> takeWhile1P Nothing (/= '\n')
pure (n, rest)
garbage :: Parsec Void Text ()
garbage = L.space space1 (L.skipLineComment "#") (L.skipBlockComment "[" "]")
pacmanConfFile :: FilePath
pacmanConfFile = "/etc/pacman.conf"
defaultLogFile :: FilePath
defaultLogFile = "/var/log/pacman.log"
lockFile :: FilePath
lockFile = "/var/lib/pacman/db.lck"
getPacmanConf :: FilePath -> IO (Either Failure Config)
getPacmanConf fp = do
file <- decodeUtf8Lenient <$> BS.readFile fp
pure . first (const (Failure confParsing_1)) $ parse config "pacman config" file
getIgnoredPkgs :: Config -> Set PkgName
getIgnoredPkgs (Config c) = maybe S.empty (S.fromList . map PkgName) $ M.lookup "IgnorePkg" c
getIgnoredGroups :: Config -> Set PkgGroup
getIgnoredGroups (Config c) = maybe S.empty (S.fromList . map PkgGroup) $ M.lookup "IgnoreGroup" c
groupPackages :: NonEmpty PkgGroup -> IO (Set PkgName)
groupPackages igs = fmap (f . decodeUtf8Lenient) . pacmanOutput $ "-Qg" : asFlag igs
where
f :: Text -> Set PkgName
f = S.fromList . map (PkgName . (!! 1) . T.words) . T.lines
getCachePath :: Config -> Maybe FilePath
getCachePath (Config c) = do
fp <- T.unpack <$> (M.lookup "CacheDir" c >>= listToMaybe)
bool Nothing (Just fp) $ isAbsolute fp
getLogFilePath :: Config -> Maybe FilePath
getLogFilePath (Config c) = do
fp <- T.unpack <$> (M.lookup "LogFile" c >>= listToMaybe)
bool Nothing (Just fp) $ isAbsolute fp
pacmanProc :: [String] -> ProcessConfig () () ()
pacmanProc args = setEnv [("LC_ALL", "C")] $ proc "pacman" args
pacman :: [Text] -> IO ()
pacman (map T.unpack -> args) = do
ec <- runProcess $ pacmanProc args
unless (ec == ExitSuccess) $ throwM (Failure pacmanFailure_1)
pacmanSuccess :: [T.Text] -> IO Bool
pacmanSuccess = fmap (== ExitSuccess) . runProcess . setStderr closed . setStdout closed . pacmanProc . map T.unpack
pacmanOutput :: [Text] -> IO ByteString
pacmanOutput = fmap (^. _2 . to BL.toStrict) . readProcess . pacmanProc . map T.unpack
pacmanLines :: [Text] -> IO [Text]
pacmanLines s = T.lines . decodeUtf8Lenient <$> pacmanOutput s
versionInfo :: IO [Text]
versionInfo = map (T.drop verMsgPad) <$> pacmanLines ["-V"]
verMsgPad :: Int
verMsgPad = 23