{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
module GHCup.Prelude
(module GHCup.Prelude,
module GHCup.Prelude.Internal,
#if defined(IS_WINDOWS)
module GHCup.Prelude.Windows
#else
module GHCup.Prelude.Posix
#endif
)
where
import GHCup.Errors
import GHCup.Prelude.Internal
import GHCup.Types.Optics (HasLog)
import GHCup.Prelude.Logger (logWarn)
#if defined(IS_WINDOWS)
import GHCup.Prelude.Windows
#else
import GHCup.Prelude.Posix
#endif
import Control.Monad.IO.Class
import Control.Monad.Reader
import Haskus.Utils.Variant.Excepts
import Text.PrettyPrint.HughesPJClass ( prettyShow, Pretty )
import qualified Data.Text as T
catchWarn :: forall es m env . ( Pretty (V es)
, MonadReader env m
, HasLog env
, MonadIO m
, Monad m) => Excepts es m () -> Excepts '[] m ()
catchWarn :: Excepts es m () -> Excepts '[] m ()
catchWarn = (V es -> Excepts '[] m ()) -> Excepts es m () -> Excepts '[] m ()
forall (m :: * -> *) (es :: [*]) (es' :: [*]) a.
Monad m =>
(V es -> Excepts es' m a) -> Excepts es m a -> Excepts es' m a
catchAllE @_ @es (\V es
v -> m () -> Excepts '[] m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Excepts '[] m ()) -> m () -> Excepts '[] m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logWarn (String -> Text
T.pack (String -> Text) -> (V es -> String) -> V es -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. V es -> String
forall a. Pretty a => a -> String
prettyShow (V es -> Text) -> V es -> Text
forall a b. (a -> b) -> a -> b
$ V es
v))
runBothE' :: forall e m a b .
( Monad m
, Show (V e)
, Pretty (V e)
, PopVariant InstallSetError e
, LiftVariant' e (InstallSetError ': e)
, e :<< (InstallSetError ': e)
)
=> Excepts e m a
-> Excepts e m b
-> Excepts (InstallSetError ': e) m ()
runBothE' :: Excepts e m a
-> Excepts e m b -> Excepts (InstallSetError : e) m ()
runBothE' Excepts e m a
a1 Excepts e m b
a2 = do
VEither e a
r1 <- m (VEither e a) -> Excepts (InstallSetError : e) m (VEither e a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (VEither e a) -> Excepts (InstallSetError : e) m (VEither e a))
-> m (VEither e a) -> Excepts (InstallSetError : e) m (VEither e a)
forall a b. (a -> b) -> a -> b
$ Excepts e m a -> m (VEither e a)
forall (es :: [*]) a (m :: * -> *).
Excepts es m a -> m (VEither es a)
runE @e Excepts e m a
a1
VEither e b
r2 <- m (VEither e b) -> Excepts (InstallSetError : e) m (VEither e b)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (VEither e b) -> Excepts (InstallSetError : e) m (VEither e b))
-> m (VEither e b) -> Excepts (InstallSetError : e) m (VEither e b)
forall a b. (a -> b) -> a -> b
$ Excepts e m b -> m (VEither e b)
forall (es :: [*]) a (m :: * -> *).
Excepts es m a -> m (VEither es a)
runE @e Excepts e m b
a2
case (VEither e a
r1, VEither e b
r2) of
(VLeft V e
e1, VLeft V e
e2) -> InstallSetError -> Excepts (InstallSetError : e) m ()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
e -> Excepts es m a
throwE (V e -> V e -> InstallSetError
forall (xs1 :: [*]) (xs2 :: [*]).
(Show (V xs1), Pretty (V xs1), Show (V xs2), Pretty (V xs2)) =>
V xs1 -> V xs2 -> InstallSetError
InstallSetError V e
e1 V e
e2)
(VLeft V e
e , VEither e b
_ ) -> V e -> Excepts (InstallSetError : e) m ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, LiftVariant es' es) =>
V es' -> Excepts es m a
throwSomeE V e
e
(VEither e a
_ , VLeft V e
e ) -> V e -> Excepts (InstallSetError : e) m ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, LiftVariant es' es) =>
V es' -> Excepts es m a
throwSomeE V e
e
(VRight a
_, VRight b
_) -> () -> Excepts (InstallSetError : e) m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
throwSomeE :: forall es' es a m. (Monad m, LiftVariant es' es) => V es' -> Excepts es m a
{-# INLINABLE throwSomeE #-}
throwSomeE :: V es' -> Excepts es m a
throwSomeE = m (VEither es a) -> Excepts es m a
forall (es :: [*]) (m :: * -> *) a.
m (VEither es a) -> Excepts es m a
Excepts (m (VEither es a) -> Excepts es m a)
-> (V es' -> m (VEither es a)) -> V es' -> Excepts es m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VEither es a -> m (VEither es a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (VEither es a -> m (VEither es a))
-> (V es' -> VEither es a) -> V es' -> m (VEither es a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. V es -> VEither es a
forall x (xs :: [*]). V xs -> VEither xs x
VLeft (V es -> VEither es a) -> (V es' -> V es) -> V es' -> VEither es a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. V es' -> V es
forall (ys :: [*]) (xs :: [*]). LiftVariant xs ys => V xs -> V ys
liftVariant