-- |
-- Module    : Aura.State
-- Copyright : (c) Colin Woodbury, 2012 - 2020
-- License   : GPL3
-- Maintainer: Colin Woodbury <colin@fosskers.ca>
--
-- Handle the saving and restoring of installed package states.

module Aura.State
    ( PkgState(..)
    , saveState
    , restoreState
    , inState
    , readState
    , stateCache
    , getStateFiles
    ) where

import           Aura.Cache
import           Aura.Colour (red)
import           Aura.Core (Env(..), notify, report, warn)
import           Aura.IO
import           Aura.Languages
import           Aura.Pacman (pacman, pacmanLines)
import           Aura.Settings
import           Aura.Types
import           Aura.Utils (hush)
import           Data.Aeson
import           Data.Versions
import           RIO
import qualified RIO.ByteString.Lazy as BL
import           RIO.Directory
import           RIO.FilePath
import qualified RIO.List as L
import           RIO.List.Partial ((!!))
import qualified RIO.Map as M
import qualified RIO.Map.Unchecked as M
import qualified RIO.NonEmpty as NEL
import qualified RIO.Text as T
import           RIO.Time
import           Text.Printf (printf)

---

-- | All packages installed at some specific `ZonedTime`. Any "pinned" PkgState will
-- never be deleted by `-Bc`.
data PkgState = PkgState
  { PkgState -> ZonedTime
timeOf   :: !ZonedTime
  , PkgState -> Bool
pinnedOf :: !Bool
  , PkgState -> Map PkgName Versioning
pkgsOf   :: !(Map PkgName Versioning) }

instance ToJSON PkgState where
  toJSON :: PkgState -> Value
toJSON (PkgState ZonedTime
t Bool
pnd Map PkgName Versioning
ps) = [Pair] -> Value
object
    [ Text
"time" Text -> ZonedTime -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ZonedTime
t
    , Text
"pinned" Text -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Bool
pnd
    , Text
"packages" Text -> Map PkgName Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (Versioning -> Text) -> Map PkgName Versioning -> Map PkgName Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Versioning -> Text
prettyV Map PkgName Versioning
ps ]

instance FromJSON PkgState where
  parseJSON :: Value -> Parser PkgState
parseJSON = String -> (Object -> Parser PkgState) -> Value -> Parser PkgState
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"PkgState" ((Object -> Parser PkgState) -> Value -> Parser PkgState)
-> (Object -> Parser PkgState) -> Value -> Parser PkgState
forall a b. (a -> b) -> a -> b
$ \Object
v -> ZonedTime -> Bool -> Map PkgName Versioning -> PkgState
PkgState
    (ZonedTime -> Bool -> Map PkgName Versioning -> PkgState)
-> Parser ZonedTime
-> Parser (Bool -> Map PkgName Versioning -> PkgState)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser ZonedTime
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"time"
    Parser (Bool -> Map PkgName Versioning -> PkgState)
-> Parser Bool -> Parser (Map PkgName Versioning -> PkgState)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Bool
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"pinned"
    Parser (Map PkgName Versioning -> PkgState)
-> Parser (Map PkgName Versioning) -> Parser PkgState
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Map PkgName Text -> Map PkgName Versioning)
-> Parser (Map PkgName Text) -> Parser (Map PkgName Versioning)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Map PkgName Text -> Map PkgName Versioning
forall k. Map k Text -> Map k Versioning
f (Object
v Object -> Text -> Parser (Map PkgName Text)
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"packages")
    where f :: Map k Text -> Map k Versioning
f = (Text -> Maybe Versioning) -> Map k Text -> Map k Versioning
forall a b k. (a -> Maybe b) -> Map k a -> Map k b
M.mapMaybe (Either ParsingError Versioning -> Maybe Versioning
forall a b. Either a b -> Maybe b
hush (Either ParsingError Versioning -> Maybe Versioning)
-> (Text -> Either ParsingError Versioning)
-> Text
-> Maybe Versioning
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either ParsingError Versioning
versioning)

data StateDiff = StateDiff
  { StateDiff -> [SimplePkg]
_toAlter  :: ![SimplePkg]
  , StateDiff -> [PkgName]
_toRemove :: ![PkgName] }

-- | The default location of all saved states: \/var\/cache\/aura\/states
stateCache :: FilePath
stateCache :: String
stateCache = String
"/var/cache/aura/states"

-- | Does a given package have an entry in a particular `PkgState`?
inState :: SimplePkg -> PkgState -> Bool
inState :: SimplePkg -> PkgState -> Bool
inState (SimplePkg PkgName
n Versioning
v) PkgState
s = (Versioning -> Maybe Versioning
forall a. a -> Maybe a
Just Versioning
v Maybe Versioning -> Maybe Versioning -> Bool
forall a. Eq a => a -> a -> Bool
==) (Maybe Versioning -> Bool)
-> (Map PkgName Versioning -> Maybe Versioning)
-> Map PkgName Versioning
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PkgName -> Map PkgName Versioning -> Maybe Versioning
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup PkgName
n (Map PkgName Versioning -> Bool) -> Map PkgName Versioning -> Bool
forall a b. (a -> b) -> a -> b
$ PkgState -> Map PkgName Versioning
pkgsOf PkgState
s

rawCurrentState :: Environment -> IO [SimplePkg]
rawCurrentState :: Environment -> IO [SimplePkg]
rawCurrentState Environment
env = (Text -> Maybe SimplePkg) -> [Text] -> [SimplePkg]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Text -> Maybe SimplePkg
simplepkg' ([Text] -> [SimplePkg]) -> IO [Text] -> IO [SimplePkg]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Environment -> [Text] -> IO [Text]
pacmanLines Environment
env [Text
"-Q"]

currentState :: Environment -> IO PkgState
currentState :: Environment -> IO PkgState
currentState Environment
env = do
  [SimplePkg]
pkgs <- Environment -> IO [SimplePkg]
rawCurrentState Environment
env
  ZonedTime
time <- IO ZonedTime
forall (m :: * -> *). MonadIO m => m ZonedTime
getZonedTime
  PkgState -> IO PkgState
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PkgState -> IO PkgState)
-> ([(PkgName, Versioning)] -> PkgState)
-> [(PkgName, Versioning)]
-> IO PkgState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ZonedTime -> Bool -> Map PkgName Versioning -> PkgState
PkgState ZonedTime
time Bool
False (Map PkgName Versioning -> PkgState)
-> ([(PkgName, Versioning)] -> Map PkgName Versioning)
-> [(PkgName, Versioning)]
-> PkgState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(PkgName, Versioning)] -> Map PkgName Versioning
forall k a. Eq k => [(k, a)] -> Map k a
M.fromAscList ([(PkgName, Versioning)] -> IO PkgState)
-> [(PkgName, Versioning)] -> IO PkgState
forall a b. (a -> b) -> a -> b
$ (SimplePkg -> (PkgName, Versioning))
-> [SimplePkg] -> [(PkgName, Versioning)]
forall a b. (a -> b) -> [a] -> [b]
map (\(SimplePkg PkgName
n Versioning
v) -> (PkgName
n, Versioning
v)) [SimplePkg]
pkgs

compareStates :: PkgState -> PkgState -> StateDiff
compareStates :: PkgState -> PkgState -> StateDiff
compareStates PkgState
old PkgState
curr = StateDiff
tcar { _toAlter :: [SimplePkg]
_toAlter = PkgState -> PkgState -> [SimplePkg]
olds PkgState
old PkgState
curr [SimplePkg] -> [SimplePkg] -> [SimplePkg]
forall a. Semigroup a => a -> a -> a
<> StateDiff -> [SimplePkg]
_toAlter StateDiff
tcar }
  where tcar :: StateDiff
tcar = PkgState -> PkgState -> StateDiff
toChangeAndRemove PkgState
old PkgState
curr

-- | All packages that were changed and newly installed.
toChangeAndRemove :: PkgState -> PkgState -> StateDiff
toChangeAndRemove :: PkgState -> PkgState -> StateDiff
toChangeAndRemove PkgState
old PkgState
curr = ([SimplePkg] -> [PkgName] -> StateDiff)
-> ([SimplePkg], [PkgName]) -> StateDiff
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [SimplePkg] -> [PkgName] -> StateDiff
StateDiff (([SimplePkg], [PkgName]) -> StateDiff)
-> (Map PkgName Versioning -> ([SimplePkg], [PkgName]))
-> Map PkgName Versioning
-> StateDiff
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PkgName
 -> Versioning
 -> ([SimplePkg], [PkgName])
 -> ([SimplePkg], [PkgName]))
-> ([SimplePkg], [PkgName])
-> Map PkgName Versioning
-> ([SimplePkg], [PkgName])
forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
M.foldrWithKey PkgName
-> Versioning
-> ([SimplePkg], [PkgName])
-> ([SimplePkg], [PkgName])
status ([], []) (Map PkgName Versioning -> StateDiff)
-> Map PkgName Versioning -> StateDiff
forall a b. (a -> b) -> a -> b
$ PkgState -> Map PkgName Versioning
pkgsOf PkgState
curr
    where status :: PkgName
-> Versioning
-> ([SimplePkg], [PkgName])
-> ([SimplePkg], [PkgName])
status PkgName
k Versioning
v ([SimplePkg]
d, [PkgName]
r) = case PkgName -> Map PkgName Versioning -> Maybe Versioning
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup PkgName
k (PkgState -> Map PkgName Versioning
pkgsOf PkgState
old) of
                               Maybe Versioning
Nothing -> ([SimplePkg]
d, PkgName
k PkgName -> [PkgName] -> [PkgName]
forall a. a -> [a] -> [a]
: [PkgName]
r)
                               Just Versioning
v' | Versioning
v Versioning -> Versioning -> Bool
forall a. Eq a => a -> a -> Bool
== Versioning
v' -> ([SimplePkg]
d, [PkgName]
r)
                                       | Bool
otherwise -> (PkgName -> Versioning -> SimplePkg
SimplePkg PkgName
k Versioning
v' SimplePkg -> [SimplePkg] -> [SimplePkg]
forall a. a -> [a] -> [a]
: [SimplePkg]
d, [PkgName]
r)

-- | Packages that were uninstalled since the last record.
olds :: PkgState -> PkgState -> [SimplePkg]
olds :: PkgState -> PkgState -> [SimplePkg]
olds PkgState
old PkgState
curr = ((PkgName, Versioning) -> SimplePkg)
-> [(PkgName, Versioning)] -> [SimplePkg]
forall a b. (a -> b) -> [a] -> [b]
map ((PkgName -> Versioning -> SimplePkg)
-> (PkgName, Versioning) -> SimplePkg
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry PkgName -> Versioning -> SimplePkg
SimplePkg) ([(PkgName, Versioning)] -> [SimplePkg])
-> (Map PkgName Versioning -> [(PkgName, Versioning)])
-> Map PkgName Versioning
-> [SimplePkg]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map PkgName Versioning -> [(PkgName, Versioning)]
forall k a. Map k a -> [(k, a)]
M.assocs (Map PkgName Versioning -> [SimplePkg])
-> Map PkgName Versioning -> [SimplePkg]
forall a b. (a -> b) -> a -> b
$ Map PkgName Versioning
-> Map PkgName Versioning -> Map PkgName Versioning
forall k a b. Ord k => Map k a -> Map k b -> Map k a
M.difference (PkgState -> Map PkgName Versioning
pkgsOf PkgState
old) (PkgState -> Map PkgName Versioning
pkgsOf PkgState
curr)

-- | The filepaths of every saved package state.
getStateFiles :: IO [FilePath]
getStateFiles :: IO [String]
getStateFiles = do
  Bool -> String -> IO ()
forall (m :: * -> *). MonadIO m => Bool -> String -> m ()
createDirectoryIfMissing Bool
True String
stateCache
  [String] -> [String]
forall a. Ord a => [a] -> [a]
L.sort ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
stateCache String -> String -> String
</>) ([String] -> [String]) -> IO [String] -> IO [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO [String]
forall (m :: * -> *). MonadIO m => String -> m [String]
listDirectory String
stateCache

-- | Save a package state.
-- In writing the first state file, the `states` directory is created automatically.
saveState :: Settings -> IO ()
saveState :: Settings -> IO ()
saveState Settings
ss = do
  PkgState
state <- Environment -> IO PkgState
currentState (Environment -> IO PkgState) -> Environment -> IO PkgState
forall a b. (a -> b) -> a -> b
$ Settings -> Environment
envOf Settings
ss
  let filename :: String
filename = String
stateCache String -> String -> String
</> ZonedTime -> String
dotFormat (PkgState -> ZonedTime
timeOf PkgState
state) String -> String -> String
<.> String
"json"
  Bool -> String -> IO ()
forall (m :: * -> *). MonadIO m => Bool -> String -> m ()
createDirectoryIfMissing Bool
True String
stateCache
  String -> LByteString -> IO ()
forall (m :: * -> *). MonadIO m => String -> LByteString -> m ()
BL.writeFile String
filename (LByteString -> IO ()) -> LByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ PkgState -> LByteString
forall a. ToJSON a => a -> LByteString
encode PkgState
state
  Settings -> (Language -> Doc AnsiStyle) -> IO ()
forall (m :: * -> *).
MonadIO m =>
Settings -> (Language -> Doc AnsiStyle) -> m ()
notify Settings
ss Language -> Doc AnsiStyle
saveState_1

dotFormat :: ZonedTime -> String
dotFormat :: ZonedTime -> String
dotFormat (ZonedTime LocalTime
t TimeZone
_) = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
L.intercalate String
"." [String]
items
    where items :: [String]
items = [ Integer -> String
forall a. Show a => a -> String
show Integer
ye
                  , String -> Int -> String -> String
forall r. PrintfType r => String -> r
printf String
"%02d(%s)" Int
mo ([String]
mnths [String] -> Int -> String
forall a. [a] -> Int -> a
!! (Int
mo Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1))
                  , String -> Int -> String
forall r. PrintfType r => String -> r
printf String
"%02d" Int
da
                  , String -> Int -> String
forall r. PrintfType r => String -> r
printf String
"%02d" (TimeOfDay -> Int
todHour (TimeOfDay -> Int) -> TimeOfDay -> Int
forall a b. (a -> b) -> a -> b
$ LocalTime -> TimeOfDay
localTimeOfDay LocalTime
t)
                  , String -> Int -> String
forall r. PrintfType r => String -> r
printf String
"%02d" (TimeOfDay -> Int
todMin (TimeOfDay -> Int) -> TimeOfDay -> Int
forall a b. (a -> b) -> a -> b
$ LocalTime -> TimeOfDay
localTimeOfDay LocalTime
t)
                  , String -> Int -> String
forall r. PrintfType r => String -> r
printf String
"%02d" ((Pico -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round (Pico -> Int) -> (TimeOfDay -> Pico) -> TimeOfDay -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeOfDay -> Pico
todSec (TimeOfDay -> Int) -> TimeOfDay -> Int
forall a b. (a -> b) -> a -> b
$ LocalTime -> TimeOfDay
localTimeOfDay LocalTime
t) :: Int) ]
          (Integer
ye, Int
mo, Int
da) = Day -> (Integer, Int, Int)
toGregorian (Day -> (Integer, Int, Int)) -> Day -> (Integer, Int, Int)
forall a b. (a -> b) -> a -> b
$ LocalTime -> Day
localDay LocalTime
t
          mnths :: [String]
          mnths :: [String]
mnths = [ String
"Jan", String
"Feb", String
"Mar", String
"Apr", String
"May", String
"Jun", String
"Jul", String
"Aug", String
"Sep", String
"Oct", String
"Nov", String
"Dec" ]

-- | Does its best to restore a state chosen by the user.
restoreState :: RIO Env ()
restoreState :: RIO Env ()
restoreState =
  IO [String] -> RIO Env [String]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO [String]
getStateFiles RIO Env [String] -> ([String] -> RIO Env ()) -> RIO Env ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= RIO Env ()
-> (NonEmpty String -> RIO Env ())
-> Maybe (NonEmpty String)
-> RIO Env ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Failure -> RIO Env ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (Failure -> RIO Env ())
-> (FailMsg -> Failure) -> FailMsg -> RIO Env ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FailMsg -> Failure
Failure (FailMsg -> RIO Env ()) -> FailMsg -> RIO Env ()
forall a b. (a -> b) -> a -> b
$ (Language -> Doc AnsiStyle) -> FailMsg
FailMsg Language -> Doc AnsiStyle
restoreState_2) NonEmpty String -> RIO Env ()
f (Maybe (NonEmpty String) -> RIO Env ())
-> ([String] -> Maybe (NonEmpty String)) -> [String] -> RIO Env ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> Maybe (NonEmpty String)
forall a. [a] -> Maybe (NonEmpty a)
NEL.nonEmpty
  where f :: NonEmpty FilePath -> RIO Env ()
        f :: NonEmpty String -> RIO Env ()
f NonEmpty String
sfs = do
          Settings
ss  <- (Env -> Settings) -> RIO Env Settings
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Env -> Settings
settings
          let pth :: String
pth = (String -> String)
-> (String -> String) -> Either String String -> String
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> String
forall a. a -> a
id String -> String
forall a. a -> a
id (Either String String -> String)
-> (CommonConfig -> Either String String) -> CommonConfig -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CommonConfig -> Either String String
cachePathOf (CommonConfig -> String) -> CommonConfig -> String
forall a b. (a -> b) -> a -> b
$ Settings -> CommonConfig
commonConfigOf Settings
ss
          Maybe PkgState
mpast  <- IO (Maybe PkgState) -> RIO Env (Maybe PkgState)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe PkgState) -> RIO Env (Maybe PkgState))
-> IO (Maybe PkgState) -> RIO Env (Maybe PkgState)
forall a b. (a -> b) -> a -> b
$ NonEmpty String -> IO String
selectState NonEmpty String
sfs IO String -> (String -> IO (Maybe PkgState)) -> IO (Maybe PkgState)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> IO (Maybe PkgState)
readState
          case Maybe PkgState
mpast of
            Maybe PkgState
Nothing   -> Failure -> RIO Env ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (Failure -> RIO Env ())
-> (FailMsg -> Failure) -> FailMsg -> RIO Env ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FailMsg -> Failure
Failure (FailMsg -> RIO Env ()) -> FailMsg -> RIO Env ()
forall a b. (a -> b) -> a -> b
$ (Language -> Doc AnsiStyle) -> FailMsg
FailMsg Language -> Doc AnsiStyle
readState_1
            Just PkgState
past -> do
              PkgState
curr <- IO PkgState -> RIO Env PkgState
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO PkgState -> RIO Env PkgState)
-> (Environment -> IO PkgState) -> Environment -> RIO Env PkgState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Environment -> IO PkgState
currentState (Environment -> RIO Env PkgState)
-> Environment -> RIO Env PkgState
forall a b. (a -> b) -> a -> b
$ Settings -> Environment
envOf Settings
ss
              Cache Map SimplePkg PackagePath
cache <- IO Cache -> RIO Env Cache
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Cache -> RIO Env Cache) -> IO Cache -> RIO Env Cache
forall a b. (a -> b) -> a -> b
$ String -> IO Cache
cacheContents String
pth
              let StateDiff [SimplePkg]
rein [PkgName]
remo = PkgState -> PkgState -> StateDiff
compareStates PkgState
past PkgState
curr
                  ([SimplePkg]
okay, [SimplePkg]
nope)        = (SimplePkg -> Bool) -> [SimplePkg] -> ([SimplePkg], [SimplePkg])
forall a. (a -> Bool) -> [a] -> ([a], [a])
L.partition (SimplePkg -> Map SimplePkg PackagePath -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`M.member` Map SimplePkg PackagePath
cache) [SimplePkg]
rein
              (NonEmpty SimplePkg -> RIO Env ())
-> Maybe (NonEmpty SimplePkg) -> RIO Env ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ ((Doc AnsiStyle -> Doc AnsiStyle)
-> (Language -> Doc AnsiStyle) -> NonEmpty PkgName -> RIO Env ()
report Doc AnsiStyle -> Doc AnsiStyle
red Language -> Doc AnsiStyle
restoreState_1 (NonEmpty PkgName -> RIO Env ())
-> (NonEmpty SimplePkg -> NonEmpty PkgName)
-> NonEmpty SimplePkg
-> RIO Env ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SimplePkg -> PkgName) -> NonEmpty SimplePkg -> NonEmpty PkgName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SimplePkg -> PkgName
spName) (Maybe (NonEmpty SimplePkg) -> RIO Env ())
-> Maybe (NonEmpty SimplePkg) -> RIO Env ()
forall a b. (a -> b) -> a -> b
$ [SimplePkg] -> Maybe (NonEmpty SimplePkg)
forall a. [a] -> Maybe (NonEmpty a)
NEL.nonEmpty [SimplePkg]
nope
              [PackagePath] -> [PkgName] -> RIO Env ()
reinstallAndRemove ((SimplePkg -> Maybe PackagePath) -> [SimplePkg] -> [PackagePath]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (SimplePkg -> Map SimplePkg PackagePath -> Maybe PackagePath
forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` Map SimplePkg PackagePath
cache) [SimplePkg]
okay) [PkgName]
remo

selectState :: NonEmpty FilePath -> IO FilePath
selectState :: NonEmpty String -> IO String
selectState = (String -> Text) -> NonEmpty String -> IO String
forall (f :: * -> *) a. Foldable f => (a -> Text) -> f a -> IO a
getSelection String -> Text
T.pack

-- | Given a `FilePath` to a package state file, attempt to read and parse
-- its contents. As of Aura 2.0, only state files in JSON format are accepted.
readState :: FilePath -> IO (Maybe PkgState)
readState :: String -> IO (Maybe PkgState)
readState = (LByteString -> Maybe PkgState)
-> IO LByteString -> IO (Maybe PkgState)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LByteString -> Maybe PkgState
forall a. FromJSON a => LByteString -> Maybe a
decode (IO LByteString -> IO (Maybe PkgState))
-> (String -> IO LByteString) -> String -> IO (Maybe PkgState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO LByteString
forall (m :: * -> *). MonadIO m => String -> m LByteString
BL.readFile

-- | `reinstalling` can mean true reinstalling, or just altering.
reinstallAndRemove :: [PackagePath] -> [PkgName] -> RIO Env ()
reinstallAndRemove :: [PackagePath] -> [PkgName] -> RIO Env ()
reinstallAndRemove [] [] = (Env -> Settings) -> RIO Env Settings
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Env -> Settings
settings RIO Env Settings -> (Settings -> RIO Env ()) -> RIO Env ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Settings
ss -> Settings -> (Language -> Doc AnsiStyle) -> RIO Env ()
forall (m :: * -> *).
MonadIO m =>
Settings -> (Language -> Doc AnsiStyle) -> m ()
warn Settings
ss Language -> Doc AnsiStyle
reinstallAndRemove_1
reinstallAndRemove [PackagePath]
down [PkgName]
remo
  | [PkgName] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [PkgName]
remo = RIO Env ()
reinstall
  | [PackagePath] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [PackagePath]
down = RIO Env ()
remove
  | Bool
otherwise = RIO Env ()
reinstall RIO Env () -> RIO Env () -> RIO Env ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RIO Env ()
remove
  where
    remove :: RIO Env ()
remove = (Env -> Environment) -> RIO Env Environment
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Settings -> Environment
envOf (Settings -> Environment)
-> (Env -> Settings) -> Env -> Environment
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Env -> Settings
settings) RIO Env Environment -> (Environment -> RIO Env ()) -> RIO Env ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Environment
env -> IO () -> RIO Env ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> RIO Env ()) -> ([Text] -> IO ()) -> [Text] -> RIO Env ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Environment -> [Text] -> IO ()
pacman Environment
env ([Text] -> RIO Env ()) -> [Text] -> RIO Env ()
forall a b. (a -> b) -> a -> b
$ Text
"-R" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [PkgName] -> [Text]
forall a. Flagable a => a -> [Text]
asFlag [PkgName]
remo
    reinstall :: RIO Env ()
reinstall = (Env -> Environment) -> RIO Env Environment
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Settings -> Environment
envOf (Settings -> Environment)
-> (Env -> Settings) -> Env -> Environment
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Env -> Settings
settings) RIO Env Environment -> (Environment -> RIO Env ()) -> RIO Env ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Environment
env -> IO () -> RIO Env ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> RIO Env ()) -> ([Text] -> IO ()) -> [Text] -> RIO Env ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Environment -> [Text] -> IO ()
pacman Environment
env ([Text] -> RIO Env ()) -> [Text] -> RIO Env ()
forall a b. (a -> b) -> a -> b
$ Text
"-U" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: (PackagePath -> Text) -> [PackagePath] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Text
T.pack (String -> Text) -> (PackagePath -> String) -> PackagePath -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackagePath -> String
ppPath) [PackagePath]
down