{-# LANGUAGE MultiWayIf, OverloadedStrings #-}
{-# LANGUAGE FlexibleContexts, MonoLocalBinds #-}
module Aura.Pacman
(
pacman
, pacmanOutput, pacmanSuccess
, lockFile
, pacmanConfFile
, defaultLogFile
, getCachePath
, getLogFilePath
, Config(..), config
, getPacmanConf
, getIgnoredPkgs, getIgnoredGroups
, groupPackages
, getVersionInfo
, verMsgPad
) where
import Aura.Languages
import Aura.Types
import Aura.Utils (strictText)
import BasePrelude hiding (some, try)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy.Char8 as BL
import qualified Data.Map.Strict as M
import qualified Data.Set as S
import Data.Set.NonEmpty (NonEmptySet)
import qualified Data.Text as T
import Data.Text.Encoding (decodeUtf8With)
import Data.Text.Encoding.Error (lenientDecode)
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Encoding as TL
import Lens.Micro
import Lens.Micro.GHC ()
import System.Path (Path, Absolute, fromAbsoluteFilePath, toFilePath)
import System.Process.Typed
import Text.Megaparsec
import Text.Megaparsec.Char
import qualified Text.Megaparsec.Char.Lexer as L
newtype Config = Config (M.Map T.Text [T.Text]) deriving (Show)
config :: Parsec Void T.Text Config
config = Config . M.fromList . rights <$> (garbage *> some (fmap Right (try pair) <|> fmap Left single) <* eof)
single :: Parsec Void T.Text ()
single = L.lexeme garbage . void $ manyTill letterChar newline
pair :: Parsec Void T.Text (T.Text, [T.Text])
pair = L.lexeme garbage $ do
n <- takeWhile1P Nothing (/= ' ')
space
char '='
space
rest <- T.words <$> takeWhile1P Nothing (/= '\n')
pure (n, rest)
garbage :: Parsec Void T.Text ()
garbage = L.space space1 (L.skipLineComment "#") (L.skipBlockComment "[" "]")
pacmanConfFile :: Path Absolute
pacmanConfFile = fromAbsoluteFilePath "/etc/pacman.conf"
defaultLogFile :: Path Absolute
defaultLogFile = fromAbsoluteFilePath "/var/log/pacman.log"
lockFile :: Path Absolute
lockFile = fromAbsoluteFilePath "/var/lib/pacman/db.lck"
getPacmanConf :: Path Absolute -> IO (Either Failure Config)
getPacmanConf fp = do
file <- decodeUtf8With lenientDecode <$> BS.readFile (toFilePath fp)
pure . first (const (Failure confParsing_1)) $ parse config "pacman config" file
getIgnoredPkgs :: Config -> S.Set PkgName
getIgnoredPkgs (Config c) = maybe S.empty (S.fromList . map PkgName) $ M.lookup "IgnorePkg" c
getIgnoredGroups :: Config -> S.Set PkgGroup
getIgnoredGroups (Config c) = maybe S.empty (S.fromList . map PkgGroup) $ M.lookup "IgnoreGroup" c
groupPackages :: NonEmptySet PkgGroup -> IO (S.Set PkgName)
groupPackages igs | null igs = pure S.empty
| otherwise = fmap f . pacmanOutput $ "-Qg" : asFlag igs
where f = S.fromList . map (PkgName . strictText . (!! 1) . BL.words) . BL.lines
getCachePath :: Config -> Maybe (Path Absolute)
getCachePath (Config c) = c ^? at "CacheDir" . _Just . _head . to (fromAbsoluteFilePath . T.unpack)
getLogFilePath :: Config -> Maybe (Path Absolute)
getLogFilePath (Config c) = c ^? at "LogFile" . _Just . _head . to (fromAbsoluteFilePath . T.unpack)
pacman :: [String] -> IO (Either Failure ())
pacman args = do
ec <- runProcess $ proc "pacman" args
pure . bool (Left $ Failure pacmanFailure_1) (Right ()) $ ec == ExitSuccess
pacmanSuccess :: [String] -> IO Bool
pacmanSuccess = fmap (== ExitSuccess) . runProcess . setStderr closed . setStdout closed . proc "pacman"
pacmanOutput :: [String] -> IO BL.ByteString
pacmanOutput = fmap (^. _2) . readProcess . proc "pacman"
getVersionInfo :: IO [T.Text]
getVersionInfo = do
out <- pacmanOutput ["-V"]
pure . map (TL.toStrict . TL.drop verMsgPad . TL.decodeUtf8With lenientDecode) $ BL.lines out
verMsgPad :: Int64
verMsgPad = 23