{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
module PFile.Main.Unpack
( main
) where
import PFile.CLI.Unpack (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 -> 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
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 -> Text -> ExceptT Text m ()
forall (m :: * -> *) a. MonadIO m => Text -> m a
Log.panic (Text -> ExceptT Text m ()) -> Text -> ExceptT Text m ()
forall a b. (a -> b) -> a -> b
$ LoadCurrentError -> Text
Profile.showLoadCurrentError LoadCurrentError
error
Right Profile
currentProfile ->
SwitchOptions -> Profile -> ExceptT UnpackError (ExceptT Text m) ()
forall (m :: * -> *).
(MonadError UnpackError m, MonadIO m) =>
SwitchOptions -> Profile -> m ()
Profile.unpack SwitchOptions
switchOptions Profile
currentProfile
ExceptT UnpackError (ExceptT Text m) ()
-> (ExceptT UnpackError (ExceptT Text m) () -> ExceptT Text m ())
-> ExceptT Text m ()
forall a b. a -> (a -> b) -> b
& (UnpackError -> Text)
-> ExceptT UnpackError (ExceptT Text m) () -> ExceptT Text m ()
forall e2 (m :: * -> *) e1 a.
MonadError e2 m =>
(e1 -> e2) -> ExceptT e1 m a -> m a
modifyError UnpackError -> Text
Profile.showUnpackError
ExceptT UnsetCurrentError (ExceptT Text m) ()
forall (m :: * -> *).
(MonadReader Env m, MonadError UnsetCurrentError m, MonadIO m) =>
m ()
Profile.unsetCurrent
ExceptT UnsetCurrentError (ExceptT Text m) ()
-> (ExceptT UnsetCurrentError (ExceptT Text m) ()
-> ExceptT Text m ())
-> ExceptT Text m ()
forall a b. a -> (a -> b) -> b
& (UnsetCurrentError -> Text)
-> ExceptT UnsetCurrentError (ExceptT Text m) ()
-> ExceptT Text m ()
forall e2 (m :: * -> *) e1 a.
MonadError e2 m =>
(e1 -> e2) -> ExceptT e1 m a -> m a
modifyError UnsetCurrentError -> Text
Profile.showUnsetCurrentError
where
switchOptions :: Profile.SwitchOptions
switchOptions :: SwitchOptions
switchOptions = Profile.SwitchOptions {Bool
forceRemoveOccupied :: Bool
forceRemoveOccupied :: Bool
Profile.forceRemoveOccupied}