{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE NoImplicitPrelude #-}

module HWM.Core.Result
  ( Result (..),
    ResultT (..),
    Issue (..),
    MonadIssue (..),
    Severity (..),
    IssueDetails (..),
    fromEither,
  )
where

import Control.Monad.Except (MonadError (..))
import Data.Foldable (Foldable (..))
import Data.Text.Lazy.Builder ()
import Relude

data Severity = SeverityWarning | SeverityError
  deriving (Int -> Severity -> ShowS
[Severity] -> ShowS
Severity -> String
(Int -> Severity -> ShowS)
-> (Severity -> String) -> ([Severity] -> ShowS) -> Show Severity
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Severity -> ShowS
showsPrec :: Int -> Severity -> ShowS
$cshow :: Severity -> String
show :: Severity -> String
$cshowList :: [Severity] -> ShowS
showList :: [Severity] -> ShowS
Show, Severity -> Severity -> Bool
(Severity -> Severity -> Bool)
-> (Severity -> Severity -> Bool) -> Eq Severity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Severity -> Severity -> Bool
== :: Severity -> Severity -> Bool
$c/= :: Severity -> Severity -> Bool
/= :: Severity -> Severity -> Bool
Eq, Eq Severity
Eq Severity =>
(Severity -> Severity -> Ordering)
-> (Severity -> Severity -> Bool)
-> (Severity -> Severity -> Bool)
-> (Severity -> Severity -> Bool)
-> (Severity -> Severity -> Bool)
-> (Severity -> Severity -> Severity)
-> (Severity -> Severity -> Severity)
-> Ord Severity
Severity -> Severity -> Bool
Severity -> Severity -> Ordering
Severity -> Severity -> Severity
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Severity -> Severity -> Ordering
compare :: Severity -> Severity -> Ordering
$c< :: Severity -> Severity -> Bool
< :: Severity -> Severity -> Bool
$c<= :: Severity -> Severity -> Bool
<= :: Severity -> Severity -> Bool
$c> :: Severity -> Severity -> Bool
> :: Severity -> Severity -> Bool
$c>= :: Severity -> Severity -> Bool
>= :: Severity -> Severity -> Bool
$cmax :: Severity -> Severity -> Severity
max :: Severity -> Severity -> Severity
$cmin :: Severity -> Severity -> Severity
min :: Severity -> Severity -> Severity
Ord)

data IssueDetails
  = CommandIssue
      { IssueDetails -> Text
issueCommand :: Text,
        IssueDetails -> String
issueLogFile :: FilePath
      }
  | GenericIssue
      { IssueDetails -> String
issueFile :: FilePath
      }
  | DependencyIssue
      { IssueDetails -> [(Text, Text, Text, Text)]
issueDependencies :: [(Text, Text, Text, Text)],
        issueFile :: FilePath
      }
  deriving (Int -> IssueDetails -> ShowS
[IssueDetails] -> ShowS
IssueDetails -> String
(Int -> IssueDetails -> ShowS)
-> (IssueDetails -> String)
-> ([IssueDetails] -> ShowS)
-> Show IssueDetails
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> IssueDetails -> ShowS
showsPrec :: Int -> IssueDetails -> ShowS
$cshow :: IssueDetails -> String
show :: IssueDetails -> String
$cshowList :: [IssueDetails] -> ShowS
showList :: [IssueDetails] -> ShowS
Show, IssueDetails -> IssueDetails -> Bool
(IssueDetails -> IssueDetails -> Bool)
-> (IssueDetails -> IssueDetails -> Bool) -> Eq IssueDetails
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IssueDetails -> IssueDetails -> Bool
== :: IssueDetails -> IssueDetails -> Bool
$c/= :: IssueDetails -> IssueDetails -> Bool
/= :: IssueDetails -> IssueDetails -> Bool
Eq, Eq IssueDetails
Eq IssueDetails =>
(IssueDetails -> IssueDetails -> Ordering)
-> (IssueDetails -> IssueDetails -> Bool)
-> (IssueDetails -> IssueDetails -> Bool)
-> (IssueDetails -> IssueDetails -> Bool)
-> (IssueDetails -> IssueDetails -> Bool)
-> (IssueDetails -> IssueDetails -> IssueDetails)
-> (IssueDetails -> IssueDetails -> IssueDetails)
-> Ord IssueDetails
IssueDetails -> IssueDetails -> Bool
IssueDetails -> IssueDetails -> Ordering
IssueDetails -> IssueDetails -> IssueDetails
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: IssueDetails -> IssueDetails -> Ordering
compare :: IssueDetails -> IssueDetails -> Ordering
$c< :: IssueDetails -> IssueDetails -> Bool
< :: IssueDetails -> IssueDetails -> Bool
$c<= :: IssueDetails -> IssueDetails -> Bool
<= :: IssueDetails -> IssueDetails -> Bool
$c> :: IssueDetails -> IssueDetails -> Bool
> :: IssueDetails -> IssueDetails -> Bool
$c>= :: IssueDetails -> IssueDetails -> Bool
>= :: IssueDetails -> IssueDetails -> Bool
$cmax :: IssueDetails -> IssueDetails -> IssueDetails
max :: IssueDetails -> IssueDetails -> IssueDetails
$cmin :: IssueDetails -> IssueDetails -> IssueDetails
min :: IssueDetails -> IssueDetails -> IssueDetails
Ord)

data Issue = Issue
  { Issue -> Text
issueTopic :: Text,
    Issue -> Severity
issueSeverity :: Severity,
    Issue -> Text
issueMessage :: Text,
    Issue -> Maybe IssueDetails
issueDetails :: Maybe IssueDetails
  }
  deriving (Int -> Issue -> ShowS
[Issue] -> ShowS
Issue -> String
(Int -> Issue -> ShowS)
-> (Issue -> String) -> ([Issue] -> ShowS) -> Show Issue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Issue -> ShowS
showsPrec :: Int -> Issue -> ShowS
$cshow :: Issue -> String
show :: Issue -> String
$cshowList :: [Issue] -> ShowS
showList :: [Issue] -> ShowS
Show, Issue -> Issue -> Bool
(Issue -> Issue -> Bool) -> (Issue -> Issue -> Bool) -> Eq Issue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Issue -> Issue -> Bool
== :: Issue -> Issue -> Bool
$c/= :: Issue -> Issue -> Bool
/= :: Issue -> Issue -> Bool
Eq, Eq Issue
Eq Issue =>
(Issue -> Issue -> Ordering)
-> (Issue -> Issue -> Bool)
-> (Issue -> Issue -> Bool)
-> (Issue -> Issue -> Bool)
-> (Issue -> Issue -> Bool)
-> (Issue -> Issue -> Issue)
-> (Issue -> Issue -> Issue)
-> Ord Issue
Issue -> Issue -> Bool
Issue -> Issue -> Ordering
Issue -> Issue -> Issue
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Issue -> Issue -> Ordering
compare :: Issue -> Issue -> Ordering
$c< :: Issue -> Issue -> Bool
< :: Issue -> Issue -> Bool
$c<= :: Issue -> Issue -> Bool
<= :: Issue -> Issue -> Bool
$c> :: Issue -> Issue -> Bool
> :: Issue -> Issue -> Bool
$c>= :: Issue -> Issue -> Bool
>= :: Issue -> Issue -> Bool
$cmax :: Issue -> Issue -> Issue
max :: Issue -> Issue -> Issue
$cmin :: Issue -> Issue -> Issue
min :: Issue -> Issue -> Issue
Ord)

instance IsString Issue where
  fromString :: String -> Issue
fromString String
s =
    Issue
      { issueTopic :: Text
issueTopic = Text
"general",
        issueSeverity :: Severity
issueSeverity = Severity
SeverityError,
        issueMessage :: Text
issueMessage = String -> Text
forall a. IsString a => String -> a
fromString String
s,
        issueDetails :: Maybe IssueDetails
issueDetails = Maybe IssueDetails
forall a. Maybe a
Nothing
      }

class MonadIssue m where
  injectIssue :: Issue -> m ()
  catchIssues :: m a -> m (Maybe Severity, a)
  mapIssue :: (Issue -> Issue) -> m a -> m a

instance MonadIssue (Result Issue) where
  injectIssue :: Issue -> Result Issue ()
injectIssue Issue
issue = () -> [Issue] -> Result Issue ()
forall er a. a -> [er] -> Result er a
Success () [Issue
issue]
  catchIssues :: forall a. Result Issue a -> Result Issue (Maybe Severity, a)
catchIssues m :: Result Issue a
m@(Success a
_ [Issue]
ls) = do
    let l :: Maybe Severity
l = if [Issue] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Issue]
ls then Maybe Severity
forall a. Maybe a
Nothing else Severity -> Maybe Severity
forall a. a -> Maybe a
Just ([Severity] -> Severity
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Severity] -> Severity) -> [Severity] -> Severity
forall a b. (a -> b) -> a -> b
$ (Issue -> Severity) -> [Issue] -> [Severity]
forall a b. (a -> b) -> [a] -> [b]
map Issue -> Severity
issueSeverity [Issue]
ls)
     in (Maybe Severity
l,) (a -> (Maybe Severity, a))
-> Result Issue a -> Result Issue (Maybe Severity, a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Result Issue a
m
  catchIssues m :: Result Issue a
m@Failure {} = (Severity -> Maybe Severity
forall a. a -> Maybe a
Just Severity
SeverityError,) (a -> (Maybe Severity, a))
-> Result Issue a -> Result Issue (Maybe Severity, a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Result Issue a
m
  mapIssue :: forall a. (Issue -> Issue) -> Result Issue a -> Result Issue a
mapIssue Issue -> Issue
f (Success a
x [Issue]
ls) = a -> [Issue] -> Result Issue a
forall er a. a -> [er] -> Result er a
Success a
x ((Issue -> Issue) -> [Issue] -> [Issue]
forall a b. (a -> b) -> [a] -> [b]
map Issue -> Issue
f [Issue]
ls)
  mapIssue Issue -> Issue
f (Failure NonEmpty Issue
e) = NonEmpty Issue -> Result Issue a
forall er a. NonEmpty er -> Result er a
Failure (Issue -> Issue
f (Issue -> Issue) -> NonEmpty Issue -> NonEmpty Issue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty Issue
e)

instance (Monad m) => MonadIssue (ResultT m) where
  injectIssue :: Issue -> ResultT m ()
injectIssue Issue
issue = m (Result Issue ()) -> ResultT m ()
forall (m :: * -> *) a. m (Result Issue a) -> ResultT m a
ResultT (m (Result Issue ()) -> ResultT m ())
-> m (Result Issue ()) -> ResultT m ()
forall a b. (a -> b) -> a -> b
$ Result Issue () -> m (Result Issue ())
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Result Issue () -> m (Result Issue ()))
-> Result Issue () -> m (Result Issue ())
forall a b. (a -> b) -> a -> b
$ () -> [Issue] -> Result Issue ()
forall er a. a -> [er] -> Result er a
Success () [Issue
issue]
  catchIssues :: forall a. ResultT m a -> ResultT m (Maybe Severity, a)
catchIssues (ResultT m (Result Issue a)
m) = m (Result Issue (Maybe Severity, a))
-> ResultT m (Maybe Severity, a)
forall (m :: * -> *) a. m (Result Issue a) -> ResultT m a
ResultT (m (Result Issue (Maybe Severity, a))
 -> ResultT m (Maybe Severity, a))
-> m (Result Issue (Maybe Severity, a))
-> ResultT m (Maybe Severity, a)
forall a b. (a -> b) -> a -> b
$ Result Issue a -> Result Issue (Maybe Severity, a)
forall a. Result Issue a -> Result Issue (Maybe Severity, a)
forall (m :: * -> *) a.
MonadIssue m =>
m a -> m (Maybe Severity, a)
catchIssues (Result Issue a -> Result Issue (Maybe Severity, a))
-> m (Result Issue a) -> m (Result Issue (Maybe Severity, a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Result Issue a)
m
  mapIssue :: forall a. (Issue -> Issue) -> ResultT m a -> ResultT m a
mapIssue Issue -> Issue
f (ResultT m (Result Issue a)
m) = m (Result Issue a) -> ResultT m a
forall (m :: * -> *) a. m (Result Issue a) -> ResultT m a
ResultT (m (Result Issue a) -> ResultT m a)
-> m (Result Issue a) -> ResultT m a
forall a b. (a -> b) -> a -> b
$ (Issue -> Issue) -> Result Issue a -> Result Issue a
forall a. (Issue -> Issue) -> Result Issue a -> Result Issue a
forall (m :: * -> *) a.
MonadIssue m =>
(Issue -> Issue) -> m a -> m a
mapIssue Issue -> Issue
f (Result Issue a -> Result Issue a)
-> m (Result Issue a) -> m (Result Issue a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Result Issue a)
m

data Result er a
  = Success {forall er a. Result er a -> a
result :: a, forall er a. Result er a -> [er]
issues :: [er]}
  | Failure {forall er a. Result er a -> NonEmpty er
failure :: NonEmpty er}
  deriving ((forall a b. (a -> b) -> Result er a -> Result er b)
-> (forall a b. a -> Result er b -> Result er a)
-> Functor (Result er)
forall a b. a -> Result er b -> Result er a
forall a b. (a -> b) -> Result er a -> Result er b
forall er a b. a -> Result er b -> Result er a
forall er a b. (a -> b) -> Result er a -> Result er b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall er a b. (a -> b) -> Result er a -> Result er b
fmap :: forall a b. (a -> b) -> Result er a -> Result er b
$c<$ :: forall er a b. a -> Result er b -> Result er a
<$ :: forall a b. a -> Result er b -> Result er a
Functor)

instance Applicative (Result er) where
  pure :: forall a. a -> Result er a
pure = (a -> [er] -> Result er a
forall er a. a -> [er] -> Result er a
`Success` [])
  Success a -> b
f [er]
w1 <*> :: forall a b. Result er (a -> b) -> Result er a -> Result er b
<*> Success a
x [er]
w2 = b -> [er] -> Result er b
forall er a. a -> [er] -> Result er a
Success (a -> b
f a
x) ([er]
w1 [er] -> [er] -> [er]
forall a. Semigroup a => a -> a -> a
<> [er]
w2)
  Failure (er
e :| [er]
es) <*> Success a
_ [er]
e' = NonEmpty er -> Result er b
forall er a. NonEmpty er -> Result er a
Failure (er
e er -> [er] -> NonEmpty er
forall a. a -> [a] -> NonEmpty a
:| ([er]
es [er] -> [er] -> [er]
forall a. Semigroup a => a -> a -> a
<> [er]
e'))
  Failure NonEmpty er
e <*> Failure NonEmpty er
e' = NonEmpty er -> Result er b
forall er a. NonEmpty er -> Result er a
Failure (NonEmpty er
e NonEmpty er -> NonEmpty er -> NonEmpty er
forall a. Semigroup a => a -> a -> a
<> NonEmpty er
e')
  Success a -> b
_ [er]
e' <*> Failure (er
e :| [er]
es) = NonEmpty er -> Result er b
forall er a. NonEmpty er -> Result er a
Failure (er
e er -> [er] -> NonEmpty er
forall a. a -> [a] -> NonEmpty a
:| ([er]
es [er] -> [er] -> [er]
forall a. Semigroup a => a -> a -> a
<> [er]
e'))

instance Monad (Result er) where
  return :: forall a. a -> Result er a
return = a -> Result er a
forall a. a -> Result er a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  Success a
v [er]
w1 >>= :: forall a b. Result er a -> (a -> Result er b) -> Result er b
>>= a -> Result er b
fm = case a -> Result er b
fm a
v of
    (Success b
x [er]
w2) -> b -> [er] -> Result er b
forall er a. a -> [er] -> Result er a
Success b
x ([er]
w1 [er] -> [er] -> [er]
forall a. Semigroup a => a -> a -> a
<> [er]
w2)
    Failure NonEmpty er
e -> NonEmpty er -> Result er b
forall er a. NonEmpty er -> Result er a
Failure NonEmpty er
e
  Failure NonEmpty er
e >>= a -> Result er b
_ = NonEmpty er -> Result er b
forall er a. NonEmpty er -> Result er a
Failure NonEmpty er
e

instance MonadError er (Result er) where
  throwError :: forall a. er -> Result er a
throwError = NonEmpty er -> Result er a
forall er a. NonEmpty er -> Result er a
Failure (NonEmpty er -> Result er a)
-> (er -> NonEmpty er) -> er -> Result er a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. er -> NonEmpty er
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  catchError :: forall a. Result er a -> (er -> Result er a) -> Result er a
catchError (Failure NonEmpty er
e) er -> Result er a
f = er -> Result er a
f (NonEmpty er -> er
forall (f :: * -> *) a. IsNonEmpty f a a "head" => f a -> a
head NonEmpty er
e)
  catchError Result er a
x er -> Result er a
_ = Result er a
x

newtype ResultT (m :: Type -> Type) a = ResultT
  { forall (m :: * -> *) a. ResultT m a -> m (Result Issue a)
runResultT :: m (Result Issue a)
  }
  deriving ((forall a b. (a -> b) -> ResultT m a -> ResultT m b)
-> (forall a b. a -> ResultT m b -> ResultT m a)
-> Functor (ResultT m)
forall a b. a -> ResultT m b -> ResultT m a
forall a b. (a -> b) -> ResultT m a -> ResultT m b
forall (m :: * -> *) a b.
Functor m =>
a -> ResultT m b -> ResultT m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> ResultT m a -> ResultT m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> ResultT m a -> ResultT m b
fmap :: forall a b. (a -> b) -> ResultT m a -> ResultT m b
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> ResultT m b -> ResultT m a
<$ :: forall a b. a -> ResultT m b -> ResultT m a
Functor)

instance (Applicative m) => Applicative (ResultT m) where
  pure :: forall a. a -> ResultT m a
pure = m (Result Issue a) -> ResultT m a
forall (m :: * -> *) a. m (Result Issue a) -> ResultT m a
ResultT (m (Result Issue a) -> ResultT m a)
-> (a -> m (Result Issue a)) -> a -> ResultT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Result Issue a -> m (Result Issue a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Result Issue a -> m (Result Issue a))
-> (a -> Result Issue a) -> a -> m (Result Issue a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Result Issue a
forall a. a -> Result Issue a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  ResultT m (Result Issue (a -> b))
app1 <*> :: forall a b. ResultT m (a -> b) -> ResultT m a -> ResultT m b
<*> ResultT m (Result Issue a)
app2 = m (Result Issue b) -> ResultT m b
forall (m :: * -> *) a. m (Result Issue a) -> ResultT m a
ResultT (m (Result Issue b) -> ResultT m b)
-> m (Result Issue b) -> ResultT m b
forall a b. (a -> b) -> a -> b
$ (Result Issue (a -> b) -> Result Issue a -> Result Issue b)
-> m (Result Issue (a -> b))
-> m (Result Issue a)
-> m (Result Issue b)
forall a b c. (a -> b -> c) -> m a -> m b -> m c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Result Issue (a -> b) -> Result Issue a -> Result Issue b
forall a b.
Result Issue (a -> b) -> Result Issue a -> Result Issue b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>) m (Result Issue (a -> b))
app1 m (Result Issue a)
app2

instance (Monad m) => Monad (ResultT m) where
  return :: forall a. a -> ResultT m a
return = a -> ResultT m a
forall a. a -> ResultT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  (ResultT m (Result Issue a)
m1) >>= :: forall a b. ResultT m a -> (a -> ResultT m b) -> ResultT m b
>>= a -> ResultT m b
mFunc = m (Result Issue b) -> ResultT m b
forall (m :: * -> *) a. m (Result Issue a) -> ResultT m a
ResultT (m (Result Issue b) -> ResultT m b)
-> m (Result Issue b) -> ResultT m b
forall a b. (a -> b) -> a -> b
$ do
    Result Issue a
rs <- m (Result Issue a)
m1
    case Result Issue a
rs of
      Success a
value [Issue]
w1 -> do
        Result Issue b
result' <- ResultT m b -> m (Result Issue b)
forall (m :: * -> *) a. ResultT m a -> m (Result Issue a)
runResultT (a -> ResultT m b
mFunc a
value)
        case Result Issue b
result' of
          Success b
value' [Issue]
w2 -> Result Issue b -> m (Result Issue b)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Result Issue b -> m (Result Issue b))
-> Result Issue b -> m (Result Issue b)
forall a b. (a -> b) -> a -> b
$ b -> [Issue] -> Result Issue b
forall er a. a -> [er] -> Result er a
Success b
value' ([Issue]
w1 [Issue] -> [Issue] -> [Issue]
forall a. Semigroup a => a -> a -> a
<> [Issue]
w2)
          Failure NonEmpty Issue
e -> Result Issue b -> m (Result Issue b)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Result Issue b -> m (Result Issue b))
-> Result Issue b -> m (Result Issue b)
forall a b. (a -> b) -> a -> b
$ NonEmpty Issue -> Result Issue b
forall er a. NonEmpty er -> Result er a
Failure NonEmpty Issue
e
      Failure NonEmpty Issue
e -> Result Issue b -> m (Result Issue b)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Result Issue b -> m (Result Issue b))
-> Result Issue b -> m (Result Issue b)
forall a b. (a -> b) -> a -> b
$ NonEmpty Issue -> Result Issue b
forall er a. NonEmpty er -> Result er a
Failure NonEmpty Issue
e

instance MonadTrans ResultT where
  lift :: forall (m :: * -> *) a. Monad m => m a -> ResultT m a
lift = m (Result Issue a) -> ResultT m a
forall (m :: * -> *) a. m (Result Issue a) -> ResultT m a
ResultT (m (Result Issue a) -> ResultT m a)
-> (m a -> m (Result Issue a)) -> m a -> ResultT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Result Issue a) -> m a -> m (Result Issue a)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Result Issue a
forall a. a -> Result Issue a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

instance (Monad m) => MonadError Issue (ResultT m) where
  throwError :: forall a. Issue -> ResultT m a
throwError = m (Result Issue a) -> ResultT m a
forall (m :: * -> *) a. m (Result Issue a) -> ResultT m a
ResultT (m (Result Issue a) -> ResultT m a)
-> (Issue -> m (Result Issue a)) -> Issue -> ResultT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Result Issue a -> m (Result Issue a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Result Issue a -> m (Result Issue a))
-> (Issue -> Result Issue a) -> Issue -> m (Result Issue a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Issue -> Result Issue a
forall a. Issue -> Result Issue a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError
  catchError :: forall a. ResultT m a -> (Issue -> ResultT m a) -> ResultT m a
catchError (ResultT m (Result Issue a)
mx) Issue -> ResultT m a
f = m (Result Issue a) -> ResultT m a
forall (m :: * -> *) a. m (Result Issue a) -> ResultT m a
ResultT (m (Result Issue a)
mx m (Result Issue a)
-> (Result Issue a -> m (Result Issue a)) -> m (Result Issue a)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Result Issue a -> m (Result Issue a)
catchResultError)
    where
      catchResultError :: Result Issue a -> m (Result Issue a)
catchResultError (Failure NonEmpty Issue
e) = ResultT m a -> m (Result Issue a)
forall (m :: * -> *) a. ResultT m a -> m (Result Issue a)
runResultT (Issue -> ResultT m a
f (NonEmpty Issue -> Issue
forall (f :: * -> *) a. IsNonEmpty f a a "head" => f a -> a
head NonEmpty Issue
e))
      catchResultError Result Issue a
x = Result Issue a -> m (Result Issue a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Result Issue a
x

instance (MonadIO m) => MonadIO (ResultT m) where
  liftIO :: forall a. IO a -> ResultT m a
liftIO = m a -> ResultT m a
forall (m :: * -> *) a. Monad m => m a -> ResultT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> ResultT m a) -> (IO a -> m a) -> IO a -> ResultT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> m a
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO

fromEither :: (MonadError Issue m) => Text -> Either String a -> m a
fromEither :: forall (m :: * -> *) a.
MonadError Issue m =>
Text -> Either String a -> m a
fromEither Text
context = (String -> m a) -> (a -> m a) -> Either String a -> m a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Issue -> m a
forall a. Issue -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Issue -> m a) -> (String -> Issue) -> String -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Issue
forall a. IsString a => String -> a
fromString (String -> Issue) -> ShowS -> String -> Issue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text -> String
forall a. ToString a => a -> String
toString Text
context String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
": ") String -> ShowS
forall a. Semigroup a => a -> a -> a
<>)) a -> m a
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure