content: -- |
  -- Module    : Aura.State
  -- Copyright : (c) Colin Woodbury, 2012 - 2024
  -- 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
    { timeOf   :: !ZonedTime
    , pinnedOf :: !Bool
    , pkgsOf   :: !(Map PkgName Versioning) }
  
  instance ToJSON PkgState where
    toJSON (PkgState t pnd ps) = object
      [ "time" .= t
      , "pinned" .= pnd
      , "packages" .= fmap prettyV ps ]
  
  instance FromJSON PkgState where
    parseJSON = withObject "PkgState" $ \v -> PkgState
      <$> v .: "time"
      <*> v .: "pinned"
      <*> fmap f (v .: "packages")
      where f = M.mapMaybe (hush . versioning)
  
  data StateDiff = StateDiff
    { _toAlter  :: ![SimplePkg]
    , _toRemove :: ![PkgName] }
  
  -- | The default location of all saved states: \/var\/cache\/aura\/states
  stateCache :: FilePath
  stateCache = "/var/cache/aura/states"
  
  -- | Does a given package have an entry in a particular `PkgState`?
  inState :: SimplePkg -> PkgState -> Bool
  inState (SimplePkg n v) s = (Just v ==) . M.lookup n $ pkgsOf s
  
  rawCurrentState :: Environment -> IO [SimplePkg]
  rawCurrentState env = mapMaybe simplepkg' <$> pacmanLines env ["-Q"]
  
  currentState :: Environment -> IO PkgState
  currentState env = do
    pkgs <- rawCurrentState env
    time <- getZonedTime
    pure . PkgState time False . M.fromAscList $ map (\(SimplePkg n v) -> (n, v)) pkgs
  
  compareStates :: PkgState -> PkgState -> StateDiff
  compareStates old curr = tcar { _toAlter = olds old curr <> _toAlter tcar }
    where tcar = toChangeAndRemove old curr
  
  -- | All packages that were changed and newly installed.
  toChangeAndRemove :: PkgState -> PkgState -> StateDiff
  toChangeAndRemove old curr = uncurry StateDiff . M.foldrWithKey status ([], []) $ pkgsOf curr
      where status k v (d, r) = case M.lookup k (pkgsOf old) of
                                 Nothing -> (d, k : r)
                                 Just v' | v == v' -> (d, r)
                                         | otherwise -> (SimplePkg k v' : d, r)
  
  -- | Packages that were uninstalled since the last record.
  olds :: PkgState -> PkgState -> [SimplePkg]
  olds old curr = map (uncurry SimplePkg) . M.assocs $ M.difference (pkgsOf old) (pkgsOf curr)
  
  -- | The filepaths of every saved package state.
  getStateFiles :: IO [FilePath]
  getStateFiles = do
    createDirectoryIfMissing True stateCache
    L.sort . map (stateCache </>) <$> listDirectory stateCache
  
  -- | Save a package state.
  -- In writing the first state file, the `states` directory is created automatically.
  saveState :: Settings -> IO ()
  saveState ss = do
    state <- currentState $ envOf ss
    let filename = stateCache </> dotFormat (timeOf state) <.> "json"
    createDirectoryIfMissing True stateCache
    BL.writeFile filename $ encode state
    notify ss saveState_1
  
  dotFormat :: ZonedTime -> String
  dotFormat (ZonedTime t _) = L.intercalate "." items
      where items = [ show ye
                    , printf "%02d(%s)" mo (mnths !! (mo - 1))
                    , printf "%02d" da
                    , printf "%02d" (todHour $ localTimeOfDay t)
                    , printf "%02d" (todMin $ localTimeOfDay t)
                    , printf "%02d" ((round . todSec $ localTimeOfDay t) :: Int) ]
            (ye, mo, da) = toGregorian $ localDay t
            mnths :: [String]
            mnths = [ "Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec" ]
  
  -- | Does its best to restore a state chosen by the user.
  restoreState :: RIO Env ()
  restoreState =
    liftIO getStateFiles >>= maybe (throwM . Failure $ FailMsg restoreState_2) f . NEL.nonEmpty
    where f :: NonEmpty FilePath -> RIO Env ()
          f sfs = do
            ss  <- asks settings
            let pth = either id id . cachePathOf $ commonConfigOf ss
            mpast  <- liftIO $ selectState sfs >>= readState
            case mpast of
              Nothing   -> throwM . Failure $ FailMsg readState_1
              Just past -> do
                curr <- liftIO . currentState $ envOf ss
                Cache cache <- liftIO $ cacheContents pth
                let StateDiff rein remo = compareStates past curr
                    (okay, nope)        = L.partition (`M.member` cache) rein
                traverse_ (report red restoreState_1 . fmap spName) $ NEL.nonEmpty nope
                reinstallAndRemove (mapMaybe (`M.lookup` cache) okay) remo
  
  selectState :: NonEmpty FilePath -> IO FilePath
  selectState = getSelection 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 = fmap decode . BL.readFile
  
  -- | `reinstalling` can mean true reinstalling, or just altering.
  reinstallAndRemove :: [PackagePath] -> [PkgName] -> RIO Env ()
  reinstallAndRemove [] [] = asks settings >>= \ss -> warn ss reinstallAndRemove_1
  reinstallAndRemove down remo
    | null remo = reinstall
    | null down = remove
    | otherwise = reinstall *> remove
    where
      remove = asks (envOf . settings) >>= \env -> liftIO . pacman env $ "-R" : asFlag remo
      reinstall = asks (envOf . settings) >>= \env -> liftIO . pacman env $ "-U" : map (T.pack . ppPath) down
  