{- |
Module:      PFile.Main.Switch
Copyright:   (c) 2024 Illia Shkroba
License:     BSD3
Maintainer:  Illia Shkroba <is@pjwstk.edu.pl>
Stability:   unstable
Portability: non-portable (Non-Unix systems are not supported)

Main for `pfile switch`.
-}

{-# LANGUAGE FlexibleContexts  #-}
{-# LANGUAGE LambdaCase        #-}
{-# LANGUAGE NamedFieldPuns    #-}
{-# LANGUAGE OverloadedStrings #-}

module PFile.Main.Switch
  ( main
  ) where

import           PFile.CLI.Switch (Options (..))
import           PFile.Env        (Env)
import           PFile.Error      (modifyError)
import qualified PFile.Log        as Log
import qualified PFile.Profile    as Profile
import           Protolude

main :: (MonadReader Env m, MonadIO m) => Options -> m ()
main :: forall (m :: * -> *).
(MonadReader Env m, MonadIO m) =>
Options -> m ()
main Options {Bool
forceRemoveOccupied :: Bool
forceRemoveOccupied :: Options -> Bool
forceRemoveOccupied, Text
nextProfileName :: Text
nextProfileName :: Options -> Text
nextProfileName} =
  (Text -> m ()) -> (() -> m ()) -> Either Text () -> m ()
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Text -> m ()
forall (m :: * -> *) a. MonadIO m => Text -> m a
Log.panic () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text () -> m ())
-> (ExceptT Text m () -> m (Either Text ()))
-> ExceptT Text m ()
-> m ()
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< ExceptT Text m () -> m (Either Text ())
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT Text m () -> m ()) -> ExceptT Text m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Profile
nextProfile <-
      Name -> ExceptT LoadError (ExceptT Text m) Profile
forall (m :: * -> *).
(MonadReader Env m, MonadError LoadError m, MonadIO m) =>
Name -> m Profile
Profile.load (Text -> Name
Profile.Name Text
nextProfileName) ExceptT LoadError (ExceptT Text m) Profile
-> (ExceptT LoadError (ExceptT Text m) Profile
    -> ExceptT Text m (Either LoadError Profile))
-> ExceptT Text m (Either LoadError Profile)
forall a b. a -> (a -> b) -> b
& ExceptT LoadError (ExceptT Text m) Profile
-> ExceptT Text m (Either LoadError Profile)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT ExceptT Text m (Either LoadError Profile)
-> (Either LoadError Profile -> ExceptT Text m Profile)
-> ExceptT Text m Profile
forall a b.
ExceptT Text m a -> (a -> ExceptT Text m b) -> ExceptT Text m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Left LoadError
error -> do
          Text -> ExceptT Text m ()
forall (m :: * -> *).
(MonadReader Env m, MonadIO m) =>
Text -> m ()
Log.info (Text -> ExceptT Text m ()) -> Text -> ExceptT Text m ()
forall a b. (a -> b) -> a -> b
$ LoadError -> Text
Profile.showLoadError LoadError
error
          Text -> ExceptT Text m Profile
forall (m :: * -> *) a. MonadIO m => Text -> m a
Log.panic (Text -> ExceptT Text m Profile) -> Text -> ExceptT Text m Profile
forall a b. (a -> b) -> a -> b
$ Text
"Unable to load profile: \"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
nextProfileName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\""
        Right Profile
profile -> Profile -> ExceptT Text m Profile
forall a. a -> ExceptT Text m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Profile
profile

    ExceptT LoadCurrentError (ExceptT Text m) Profile
forall (m :: * -> *).
(MonadReader Env m, MonadError LoadCurrentError m, MonadIO m) =>
m Profile
Profile.loadCurrent ExceptT LoadCurrentError (ExceptT Text m) Profile
-> (ExceptT LoadCurrentError (ExceptT Text m) Profile
    -> ExceptT Text m (Either LoadCurrentError Profile))
-> ExceptT Text m (Either LoadCurrentError Profile)
forall a b. a -> (a -> b) -> b
& ExceptT LoadCurrentError (ExceptT Text m) Profile
-> ExceptT Text m (Either LoadCurrentError Profile)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT ExceptT Text m (Either LoadCurrentError Profile)
-> (Either LoadCurrentError Profile -> ExceptT Text m ())
-> ExceptT Text m ()
forall a b.
ExceptT Text m a -> (a -> ExceptT Text m b) -> ExceptT Text m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Left LoadCurrentError
error -> do
        Text -> ExceptT Text m ()
forall (m :: * -> *).
(MonadReader Env m, MonadIO m) =>
Text -> m ()
Log.info (Text -> ExceptT Text m ()) -> Text -> ExceptT Text m ()
forall a b. (a -> b) -> a -> b
$ LoadCurrentError -> Text
Profile.showLoadCurrentError LoadCurrentError
error
        SwitchOptions -> Profile -> ExceptT LinkError (ExceptT Text m) ()
forall (m :: * -> *).
(MonadError LinkError m, MonadIO m) =>
SwitchOptions -> Profile -> m ()
Profile.link SwitchOptions
switchOptions Profile
nextProfile
          ExceptT LinkError (ExceptT Text m) ()
-> (ExceptT LinkError (ExceptT Text m) () -> ExceptT Text m ())
-> ExceptT Text m ()
forall a b. a -> (a -> b) -> b
& (LinkError -> Text)
-> ExceptT LinkError (ExceptT Text m) () -> ExceptT Text m ()
forall e2 (m :: * -> *) e1 a.
MonadError e2 m =>
(e1 -> e2) -> ExceptT e1 m a -> m a
modifyError LinkError -> Text
Profile.showLinkError
      Right Profile
currentProfile ->
        SwitchOptions
-> Profile -> Profile -> ExceptT SwitchError (ExceptT Text m) ()
forall (m :: * -> *).
(MonadError SwitchError m, MonadIO m) =>
SwitchOptions -> Profile -> Profile -> m ()
Profile.switch SwitchOptions
switchOptions Profile
currentProfile Profile
nextProfile
          ExceptT SwitchError (ExceptT Text m) ()
-> (ExceptT SwitchError (ExceptT Text m) () -> ExceptT Text m ())
-> ExceptT Text m ()
forall a b. a -> (a -> b) -> b
& (SwitchError -> Text)
-> ExceptT SwitchError (ExceptT Text m) () -> ExceptT Text m ()
forall e2 (m :: * -> *) e1 a.
MonadError e2 m =>
(e1 -> e2) -> ExceptT e1 m a -> m a
modifyError SwitchError -> Text
Profile.showSwitchError

    Profile -> ExceptT SetCurrentError (ExceptT Text m) ()
forall (m :: * -> *).
(MonadReader Env m, MonadError SetCurrentError m, MonadIO m) =>
Profile -> m ()
Profile.setCurrent Profile
nextProfile
      ExceptT SetCurrentError (ExceptT Text m) ()
-> (ExceptT SetCurrentError (ExceptT Text m) ()
    -> ExceptT Text m ())
-> ExceptT Text m ()
forall a b. a -> (a -> b) -> b
& (SetCurrentError -> Text)
-> ExceptT SetCurrentError (ExceptT Text m) () -> ExceptT Text m ()
forall e2 (m :: * -> *) e1 a.
MonadError e2 m =>
(e1 -> e2) -> ExceptT e1 m a -> m a
modifyError SetCurrentError -> Text
Profile.showSetCurrentError
  where
    switchOptions :: Profile.SwitchOptions
    switchOptions :: SwitchOptions
switchOptions = Profile.SwitchOptions {Bool
forceRemoveOccupied :: Bool
forceRemoveOccupied :: Bool
Profile.forceRemoveOccupied}