{-# LANGUAGE LambdaCase #-}
{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}

module Data.Either.ToolsYj (forceRight, forceRight') where

import Control.Exception

forceRight :: Exception e => Either e a -> a
forceRight :: forall e a. Exception e => Either e a -> a
forceRight = \case Left e
e -> e -> a
forall a e. (HasCallStack, Exception e) => e -> a
throw e
e; Right a
x -> a
x

forceRight' :: Either String a -> a
forceRight' :: forall a. Either String a -> a
forceRight' = Either ErrorCall a -> a
forall e a. Exception e => Either e a -> a
forceRight (Either ErrorCall a -> a)
-> (Either String a -> Either ErrorCall a) -> Either String a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Either ErrorCall a)
-> (a -> Either ErrorCall a)
-> Either String a
-> Either ErrorCall a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (ErrorCall -> Either ErrorCall a
forall a b. a -> Either a b
Left (ErrorCall -> Either ErrorCall a)
-> (String -> ErrorCall) -> String -> Either ErrorCall a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ErrorCall
ErrorCall) a -> Either ErrorCall a
forall a b. b -> Either a b
Right