either-result 0.1.2.0 → 0.2.0.0

raw patch · 12 files changed

+553/−145 lines, 12 filesdep +mtldep +transformerssetup-changedPVP ok

version bump matches the API change (PVP)

Dependencies added: mtl, transformers

API changes (from Hackage documentation)

Files

• CHANGELOG.md +15/−0
• README.md +1/−1
• Setup.hs +2/−2
• either-result.cabal +14/−5
• spec/Control/Monad/ResultSpec.hs +60/−0
• spec/Control/Monad/Trans/Except/ResultSpec.hs +55/−0
• spec/Control/Monad/Trans/ResultSpec.hs +72/−0
• spec/Data/Either/ResultSpec.hs +0/−16
• src/Control/Monad/Result.hs +58/−0
• src/Control/Monad/Trans/Except/Result.hs +116/−0
• src/Control/Monad/Trans/Result.hs +155/−0
• src/Data/Either/Result.hs +5/−121

@@ -1,5 +1,20 @@ # Revision history for either-result +## 0.2.0.0++*2020.08.04*++### Breaking changes++- Change `Data.Either.Result.Result` from a `newtype` to a type synonym.+  - Get `Result` data constructor not to be exposed+    - Use `Result` pattern instead+    - Or use `Control.Monad.Trans.Except.Result.ResultT` data constructor instead++### Other changes++- Add monad transformers+ ## 0.1.2.0  *2020.07.31*

@@ -1,5 +1,5 @@ # either-result -[![Hackage](https://matrix.hackage.haskell.org/api/v2/packages/either-result/badge)](http://hackage.haskell.org/package/either-result) [![GitHub Actions: lint](https://github.com/kakkun61/either-result/workflows/test/badge.svg)](https://github.com/kakkun61/either-result/actions?query=workflow%3Atest) [![GitHub Actions: lint](https://github.com/kakkun61/either-result/workflows/lint/badge.svg)](https://github.com/kakkun61/either-result/actions?query=workflow%3Alint) [![Join the chat at https://gitter.im/either-result/community](https://badges.gitter.im/either-result/community.svg)](https://gitter.im/either-result/community?utm_source=badge&utm_medium=badge&utm_campaign=pr-badge&utm_content=badge)+[![Hackage](https://matrix.hackage.haskell.org/api/v2/packages/either-result/badge)](http://hackage.haskell.org/package/either-result) [![GitHub Actions: lint](https://github.com/kakkun61/either-result/workflows/test/badge.svg)](https://github.com/kakkun61/either-result/actions?query=workflow%3Atest) [![GitHub Actions: lint](https://github.com/kakkun61/either-result/workflows/lint/badge.svg)](https://github.com/kakkun61/either-result/actions?query=workflow%3Alint) [![Join the chat at https://gitter.im/either-result/community](https://badges.gitter.im/either-result/community.svg)](https://gitter.im/either-result/community?utm_source=badge&utm_medium=badge&utm_campaign=pr-badge&utm_content=badge) [![Sponsor](https://img.shields.io/badge/Sponsor-%E2%9D%A4-red?logo=GitHub)](https://github.com/sponsors/kakkun61)  `Result a` is a wrapper of `Either String a`, but `Result` is an instance of `MonadFail`.

@@ -1,2 +1,2 @@-import           Distribution.Simple
-main = defaultMain
+import Distribution.Simple+main = defaultMain

@@ -1,7 +1,7 @@ cabal-version: 2.2  name: either-result-version: 0.1.2.0+version: 0.2.0.0 synopsis: ‘Result a’ is a wrapper of ‘Either String a’. description: ‘Result a’ is a wrapper of ‘Either String a’, but ‘Result’ is an instance of ‘MonadFail’. homepage: https://github.com/kakkun61/either-result@@ -18,7 +18,7 @@                     CHANGELOG.md  common common-  build-depends: base >=4 && <5+  build-depends: base >= 4 && < 5   ghc-options: -Wall                -Wcompat   default-language: Haskell2010@@ -26,13 +26,19 @@ library   import: common   hs-source-dirs: src-  exposed-modules: Data.Either.Result+  exposed-modules: Data.Either.Result,+                   Control.Monad.Trans.Except.Result,+                   Control.Monad.Trans.Result,+                   Control.Monad.Result+  build-depends: transformers,+                 mtl   ghc-options: -Wincomplete-uni-patterns                -Wincomplete-record-updates                -Wmonomorphism-restriction                -Wmissing-exported-signatures                -Wmissing-export-lists                -Wmissing-home-modules+               -Wmissing-import-lists                -Widentities                -Wredundant-constraints                -Wpartial-fields@@ -55,9 +61,12 @@   type: exitcode-stdio-1.0   main-is: Spec.hs   hs-source-dirs: spec-  other-modules: Data.Either.ResultSpec+  other-modules: Control.Monad.Trans.Except.ResultSpec,+                 Control.Monad.Trans.ResultSpec,+                 Control.Monad.ResultSpec   build-depends: either-result,-                 hspec+                 hspec,+                 transformers   ghc-options: -threaded                -rtsopts                -with-rtsopts=-N

@@ -0,0 +1,60 @@+module Control.Monad.ResultSpec (spec) where++import Control.Monad.Result++import Test.Hspec++spec :: Spec+spec = do+  describe "monad" $ do+    it "runResult . Result == id" $ do+      let e = pure 'a'+      runResult (Result e) `shouldBe` e++    it "Result . runResult == id" $ do+      let r = pure 'a'+      Result (runResult r) `shouldBe` r++    it "b == a where Result b = Result a" $ do+      let+        a = pure 'a'+        Result b = Result a+      b `shouldBe` a++    it "result id id (Error e) == e" $ do+      let e = "e"+      result id id (Error e) `shouldBe` e++    it "result id id (Success a) == a" $ do+      let a = "a"+      result id id (Success a) `shouldBe` a++    it "fromSuccess b (Error e) == b" $ do+      let b = "b"+      fromSuccess b (Error "e") `shouldBe` b++    it "fromSuccess b (Success a) == a" $ do+      let a = "a"+      fromSuccess "b" (Success a) `shouldBe` a++  describe "monad transformer" $ do+    it "runResultT . ResultT == id" $ do+      let e = pure 'a'+      runResult (Result e) `shouldBe` e++    it "Result . runResult == id" $ do+      let r = pure 'a'+      Result (runResult r) `shouldBe` r++  describe "exception" $ do+    it "throwError e `catchError` pure == pure e" $ do+      let+        e = "err"+        m = throwError e `catchError` pure :: Result String+      m `shouldBe` pure e++    it "pure a `catchError` pure == pure a" $ do+      let+        a = "ok"+        m = pure a `catchError` pure :: Result String+      m `shouldBe` pure a

@@ -0,0 +1,55 @@+module Control.Monad.Trans.Except.ResultSpec (spec) where++import Control.Monad.Trans.Except.Result++import Test.Hspec++import Control.Monad.Trans.Except (ExceptT (ExceptT))+import Data.Coerce                (coerce)+import Data.Functor.Identity      (Identity (Identity))++spec :: Spec+spec = do+  describe "monad" $ do+    it "runResult . Result == id" $ do+      let e = pure 'a'+      runResult (Result e) `shouldBe` e++    it "Result . runResult == id" $ do+      let r = pure 'a'+      Result (runResult r) `shouldBe` r++    it "b == a where Result b = Result a" $ do+      let+        a = pure 'a'+        Result b = Result a+      b `shouldBe` a++    describe "coercible" $ do+      it "Result Int -> Either String Int" $ do+        let+          actual = coerce $ Result $ pure (0 :: Int)+          expected = Right 0 :: Either String Int+        actual `shouldBe` expected++  describe "monad transformer" $ do+    it "runResultT . ResultT == id" $ do+      let e = pure 'a'+      runResult (Result e) `shouldBe` e++    it "Result . runResult == id" $ do+      let r = pure 'a'+      Result (runResult r) `shouldBe` r++  describe "exception" $ do+    it "throwE e `catchE` pure == pure e" $ do+      let+        e = "err"+        m = throwE e `catchE` pure :: Result String+      m `shouldBe` pure e++    it "pure a `catchE` pure == pure a" $ do+      let+        a = "ok"+        m = pure a `catchE` pure :: Result String+      m `shouldBe` pure a

@@ -0,0 +1,72 @@+module Control.Monad.Trans.ResultSpec (spec) where++import Control.Monad.Trans.Result++import Test.Hspec++spec :: Spec+spec = do+  describe "monad" $ do+    it "runResult . Result == id" $ do+      let e = pure 'a'+      runResult (Result e) `shouldBe` e++    it "Result . runResult == id" $ do+      let r = pure 'a'+      Result (runResult r) `shouldBe` r++    it "b == a where Result b = Result a" $ do+      let+        a = pure 'a'+        Result b = Result a+      b `shouldBe` a++    it "result id id (Error e) == e" $ do+      let e = "e"+      result id id (Error e) `shouldBe` e++    it "result id id (Success a) == a" $ do+      let a = "a"+      result id id (Success a) `shouldBe` a++    it "fromSuccess b (Error e) == b" $ do+      let b = "b"+      fromSuccess b (Error "e") `shouldBe` b++    it "fromSuccess b (Success a) == a" $ do+      let a = "a"+      fromSuccess "b" (Success a) `shouldBe` a++    it "show (Error \"e\") == \"Error \\\"e\\\"\"" $ do+      show (Error "e" :: Result Int) `shouldBe` "Error \"e\""++    it "show (Success 1) == \"Success 1\"" $ do+      show (Success (1 :: Int)) `shouldBe` "Success 1"++    it "read \"Error \\\"e\\\"\" == Error \"e\"" $ do+      read "Error \"e\"" `shouldBe` (Error "e" :: Result Int)++    it "read \"Success 1\" == Success 1" $ do+      read "Success 1" `shouldBe` Success (1 :: Int)++  describe "monad transformer" $ do+    it "runResultT . ResultT == id" $ do+      let e = pure 'a'+      runResult (Result e) `shouldBe` e++    it "Result . runResult == id" $ do+      let r = pure 'a'+      Result (runResult r) `shouldBe` r++  describe "exception" $ do+    it "throwE e `catchE` pure == pure e" $ do+      let+        e = "err"+        m = throwE e `catchE` pure :: Result String+      m `shouldBe` pure e++    it "pure a `catchE` pure == pure a" $ do+      let+        a = "ok"+        m = pure a `catchE` pure :: Result String+      m `shouldBe` pure a

@@ -1,16 +0,0 @@-module Data.Either.ResultSpec (spec) where--import Data.Either.Result--import Test.Hspec--import Data.Coerce--spec :: Spec-spec = do-  describe "coercible" $ do-    it "Result Int -> Either String Int" $ do-      let-        actual = coerce $ Success (0 :: Int)-        expected = Right 0 :: Either String Int-      actual `shouldBe` expected

@@ -0,0 +1,58 @@+{-# LANGUAGE ExplicitNamespaces    #-}+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE PatternSynonyms       #-}++{-# OPTIONS_GHC -Wno-orphans #-}+{-# OPTIONS_GHC -Wno-missing-import-lists #-}++{-# OPTIONS_HADDOCK show-extensions #-}++-- | This monad transformer extends a monad with the ability to fail.+module Control.Monad.Result+  ( -- * The class+    MonadError (throwError, catchError)+  , liftEither+    -- * The ResultT monad transformer+  , type ResultT (ResultT)+  , runResultT+  , mapResultT+    -- * The Result monad+  , type Result+  , pattern Result+  , runResult+  , pattern Error+  , pattern Success+  , result+  , fromEither+  , toEither+  , fromSuccess+  , toMonadFail+    -- * Re-exports+  , module Control.Monad+  , module Control.Monad.Fix+  , module Control.Monad.Trans+  ) where++import           Control.Monad.Error.Class         (MonadError (catchError, throwError))+import           Control.Monad.Trans.Except.Result (Result, ResultT)+import           Control.Monad.Trans.Result        (pattern Error, pattern Result, pattern ResultT, pattern Success,+                                                    catchE, fromEither, fromSuccess, mapResultT, result, runResult,+                                                    runResultT, throwE, toEither, toMonadFail)++import Control.Monad+import Control.Monad.Fix+import Control.Monad.Trans++instance Monad m => MonadError String (ResultT m) where+  throwError = throwE+  {-# INLINE throwError #-}++  catchError = catchE+  {-# INLINE catchError #-}++-- | Lift 'Either' into 'MonadError'.+liftEither :: MonadError String m => Either String a -> m a+liftEither = either throwError pure+{-# INLINE liftEither #-}

@@ -0,0 +1,116 @@+{-# LANGUAGE CPP                        #-}+{-# LANGUAGE DeriveGeneric              #-}+{-# LANGUAGE DeriveTraversable          #-}+{-# LANGUAGE DerivingStrategies         #-}+{-# LANGUAGE ExplicitNamespaces         #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE PatternSynonyms            #-}++{-# OPTIONS_HADDOCK show-extensions #-}++-- | This monad transformer extends a monad with the ability to fail.+module Control.Monad.Trans.Except.Result+  ( -- * The Result monad+    type Result+  , pattern Result+  , runResult+    -- * The ResultT monad transformer+  , type ResultT (ResultT)+  , runResultT+  , mapResultT+    -- * Exception operations+  , throwE+  , catchE+    -- * Lifting other operations+  , liftCallCC+  , liftListen+  , liftPass+  ) where++import           Control.Monad.Signatures   (CallCC, Listen, Pass)+import           Control.Monad.Trans.Class  (MonadTrans)+import           Control.Monad.Trans.Except (Except, ExceptT (ExceptT), mapExceptT, runExceptT)+import qualified Control.Monad.Trans.Except as Except++import Control.Applicative        (Alternative)+import Control.Monad              (MonadPlus)+import Control.Monad.Fix          (MonadFix)+import Control.Monad.IO.Class     (MonadIO)+import Control.Monad.Zip          (MonadZip)+import Data.Functor.Classes       (Eq1, Ord1, Read1 (liftReadPrec), Show1 (liftShowsPrec), readData, readUnaryWith,+                                   showsUnaryWith)+import Data.Functor.Contravariant (Contravariant)+import Data.Functor.Identity      (Identity)+import GHC.Generics               (Generic)++#if !MIN_VERSION_base(4,13,0)+import Control.Monad.Fail (MonadFail (fail))+#endif++-- | A result monad.+type Result = ResultT Identity++-- | Wrap @'Except' 'String' a@.+pattern Result :: Except String a -> Result a+pattern Result e = ResultT e++-- | Unwrap @'Result' a@.+runResult :: Result a -> Except String a+runResult = runResultT+{-# INLINE runResult #-}++-- | A monad transformer that is similar to 'ExceptT' except a 'MonadFail' instance.+--+-- @+-- 'fail' = 'ResultT' . 'throwE'+-- @+newtype ResultT m a =+  ResultT+    { -- | Unwrap @'ResultT' m a@.+      runResultT :: ExceptT String m a+    }+  deriving stock (Show, Read, Eq, Ord, Generic, Functor, Foldable, Traversable)+  deriving newtype (Eq1, Ord1, Applicative, Alternative, Monad, MonadTrans, MonadFix, MonadZip, MonadIO, MonadPlus, Contravariant)++instance Read1 m => Read1 (ResultT m) where+  liftReadPrec rp rl =+    readData $+      readUnaryWith (liftReadPrec rp rl) "ResultT" ResultT++instance Show1 m => Show1 (ResultT m) where+  liftShowsPrec sp sl d (ResultT m) =+    showsUnaryWith (liftShowsPrec sp sl) "ResultT" d m++instance Monad m => MonadFail (ResultT m) where+    fail = throwE+    {-# INLINE fail #-}++-- | Map the unwrapped computation using the given function.+mapResultT :: (ExceptT String m a -> ExceptT String n b) -> ResultT m a -> ResultT n b+mapResultT f m = ResultT $ mapExceptT (runExceptT . f . ExceptT) $ runResultT m+{-# INLINE mapResultT #-}++-- | Signal an exception.+throwE :: Monad m => String -> ResultT m a+throwE = ResultT . Except.throwE+{-# INLINE throwE #-}++-- | Handle an exception.+catchE :: Monad m => ResultT m a -> (String -> ResultT m a) -> ResultT m a+m `catchE` h = ResultT $ runResultT m `Except.catchE` (runResultT . h)+{-# INLINE catchE #-}++-- | Lift a @callCC@ operation to the new monad.+liftCallCC :: CallCC m (Either String a) (Either String b) -> CallCC (ResultT m) a b+liftCallCC callCC f = ResultT $ Except.liftCallCC callCC $ \c -> runResultT $ f $ ResultT . c+{-# INLINE liftCallCC #-}++-- | Lift a @listen@ operation to the new monad.+liftListen :: Monad m => Listen w m (Either String a) -> Listen w (ResultT m) a+liftListen listen = ResultT . Except.liftListen listen . runResultT+{-# INLINE liftListen #-}++-- | Lift a @pass@ operation to the new monad.+liftPass :: Monad m => Pass w m (Either String a) -> Pass w (ResultT m) a+liftPass pass = ResultT . Except.liftPass pass . runResultT+{-# INLINE liftPass #-}

@@ -0,0 +1,155 @@+{-# LANGUAGE CPP                  #-}+{-# LANGUAGE ExplicitNamespaces   #-}+{-# LANGUAGE FlexibleInstances    #-}+{-# LANGUAGE PatternSynonyms      #-}+{-# LANGUAGE ViewPatterns         #-}++{-# OPTIONS_GHC -Wno-orphans #-}++{-# OPTIONS_HADDOCK show-extensions #-}++-- | 'T.ResultT' interfaces with 'Result'.+module Control.Monad.Trans.Result+  ( -- * The Result monad+    type T.Result+  , pattern Result+  , runResult+  , pattern Error+  , pattern Success+  , result+  , fromEither+  , toEither+  , fromSuccess+  , toMonadFail+    -- * The ResultT monad transformer+  , type T.ResultT+  , pattern ResultT+  , runResultT+  , mapResultT+    -- * Exception operations+  , T.throwE+  , T.catchE+    -- * Lifting other operations+  , T.liftCallCC+  , T.liftListen+  , T.liftPass+  ) where++import           Control.Monad.Trans.Except        (ExceptT (ExceptT), runExcept, runExceptT)+import qualified Control.Monad.Trans.Except.Result as T+import           Data.Functor.Identity             (Identity (runIdentity))+import qualified GHC.Show                          as S+import           Text.Read                         (Read (readPrec))+import qualified Text.Read                         as R+import qualified Text.Read.Lex                     as R++#if !MIN_VERSION_base(4,13,0)+import Control.Monad.Fail (MonadFail)+#endif++instance {-# OVERLAPPING #-} Show a => Show (T.Result a) where+  showsPrec d (Error e)   = showParen (S.appPrec < d) $ showString "Error " . showsPrec S.appPrec1 e+  showsPrec d (Success a) = showParen (S.appPrec < d) $ showString "Success " . showsPrec S.appPrec1 a++instance {-# OVERLAPPING #-} Read a => Read (T.Result a) where+  readPrec =+    R.parens $+      R.prec S.appPrec (+        do+          R.lift $ R.expect $ R.Ident "Error"+          e <- R.step readPrec+          pure $ Error e+      )+      R.++++      R.prec S.appPrec (+        do+          R.lift $ R.expect $ R.Ident "Success"+          a <- R.step readPrec+          pure $ Success a+      )++instance Semigroup (T.Result a) where+  Error _ <> a = a+  a <> _ = a+  {-# INLINE (<>) #-}++instance Monoid (T.Result a) where+  mempty = Error "mempty"+  {-# INLINE mempty #-}++  mappend = (<>)+  {-# INLINE mappend #-}++-- | Wrap @'D.Result' a@.+pattern Result :: Either String a -> T.Result a+pattern Result r <- (runIdentity . runExceptT . T.runResultT -> r)+  where Result r = T.ResultT $ ExceptT $ pure r++-- | Unrap @'T.Result' a@.+runResult :: T.Result a -> Either String a+runResult = runExcept . T.runResult+{-# INLINE runResult #-}++-- | 'Error' means errors and failures etc.+pattern Error :: String -> T.Result a+pattern Error e = Result (Left e)++-- | 'Success' means successes and OKs etc.+pattern Success :: a -> T.Result a+pattern Success a = Result (Right a)++{-# COMPLETE Error, Success #-}++-- | Case analysis for the 'Result' type.+--+-- ==== __Examples__+--+-- >>> let s = Success 0+-- >>> let e = Error "critical"+-- >>> result ("Bad: " ++) (("OK: " ++) . show) s+-- "OK: 0"+-- >>> result ("Bad: " ++) (("OK: " ++) . show) e+-- "Bad: critical"+result :: (String -> b) -> (a -> b) -> T.Result a -> b+result f _ (Error e)   = f e+result _ g (Success a) = g a+{-# INLINE result #-}++-- | Convert @'Either' 'String' a@ to @'Result' a@.+fromEither :: Either String a -> T.Result a+fromEither = Result+{-# INLINE fromEither #-}++-- | Convert @'Result' a@ to @'Either' 'String' a@.+toEither :: T.Result a -> Either String a+toEither = runResult+{-# INLINE toEither #-}++-- | Convert @'Result' a@ to @a@ with a default value.+fromSuccess :: a -> T.Result a -> a+fromSuccess _ (Success a) = a+fromSuccess a _           = a+{-# INLINE fromSuccess #-}++-- | Convert @'Result' a@ to @'MonadFail' m => m a@.+toMonadFail :: MonadFail m => T.Result a -> m a+toMonadFail (Success a) = pure a+toMonadFail (Error e)   = fail e+{-# INLINE toMonadFail #-}++-- | Construct and destruct 'T.Result'.+pattern ResultT :: Functor m => m (Either String a) -> T.ResultT m a+pattern ResultT m <- (runExceptT . T.runResultT -> m)+  where ResultT m = T.ResultT $ ExceptT m++{-# COMPLETE ResultT #-}++-- | Unwrap 'ResultT'.+runResultT :: Functor m => T.ResultT m a -> m (Either String a)+runResultT (ResultT m) = m+{-# INLINE runResultT #-}++-- | Map the unwrapped computation using the given function.+mapResultT :: (Functor m, Functor n) => (m (Either String a) -> n (Either String b)) -> T.ResultT m a -> T.ResultT n b+mapResultT f = T.mapResultT $ T.runResultT . ResultT . f . runResultT . T.ResultT+{-# INLINE mapResultT #-}

@@ -1,9 +1,4 @@-{-# LANGUAGE CPP                        #-}-{-# LANGUAGE DeriveGeneric              #-}-{-# LANGUAGE DeriveTraversable          #-}-{-# LANGUAGE DerivingStrategies         #-} {-# LANGUAGE ExplicitNamespaces         #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE PatternSynonyms            #-}  {-# OPTIONS_HADDOCK show-extensions #-}@@ -11,9 +6,11 @@ -- | @'Result' a@ is a wrapper of @'Either' 'String' a@, but 'Result' is an instance of 'MonadFail'. -- A discussion about 'MonadFail' of 'Either' is <https://gitlab.haskell.org/ghc/ghc/-/issues/12160>. module Data.Either.Result-  ( type Result (Result, runResult)+  ( type Result+  , pattern Result   , pattern Error   , pattern Success+  , runResult   , result   , fromEither   , toEither@@ -21,118 +18,5 @@   , toMonadFail   ) where -#if !MIN_VERSION_base(4,13,0)-import           Prelude             hiding (fail)-#endif--import           Control.Applicative (Alternative (empty, (<|>)))-import           Control.Monad       (MonadPlus (mplus, mzero))-import           GHC.Generics        (Generic)-import qualified GHC.Show            as S-import           Text.Read           (Read (readPrec))-import qualified Text.Read           as R-import qualified Text.Read.Lex       as R--#if !MIN_VERSION_base(4,13,0)-import           Control.Monad.Fail  (MonadFail (fail))-#endif---- | @'Result' a@ is a wrapper of @'Either' 'String' a@.-newtype Result a =-  Result { runResult :: Either String a }-  deriving stock (Eq, Ord, Generic, Functor, Foldable, Traversable)-  deriving newtype (Semigroup, Applicative, Monad)--instance Show a => Show (Result a) where-  showsPrec d (Error e) = showParen (S.appPrec < d) $ showString "Error " . showsPrec S.appPrec1 e-  showsPrec d (Success a) = showParen (S.appPrec < d) $ showString "Success " . showsPrec S.appPrec1 a--instance Read a => Read (Result a) where-  readPrec =-    R.parens $-      R.prec S.appPrec (-        do-          R.lift $ R.expect $ R.Ident "Error"-          e <- R.step readPrec-          pure $ Error e-      )-      R.+++-      R.prec S.appPrec (-        do-          R.lift $ R.expect $ R.Ident "Success"-          a <- R.step readPrec-          pure $ Success a-      )--instance Monoid (Result a) where-  mempty = Error "mempty"-  {-# INLINE mempty #-}--  mappend = (<>)-  {-# INLINE mappend #-}--instance Alternative Result where-  empty = Error "empty"-  {-# INLINE empty #-}--  a@(Success _) <|> _ = a-  _ <|> b = b-  {-# INLINE (<|>) #-}--instance MonadFail Result where-  fail = Error-  {-# INLINE fail #-}--instance MonadPlus Result where-  mzero = Error "mzero"-  {-# INLINE mzero #-}--  mplus = (<|>)-  {-# INLINE mplus #-}---- | 'Error' means errors and failures etc.-pattern Error :: String -> Result a-pattern Error e = Result (Left e)---- | 'Success' means successes and OKs etc.-pattern Success :: a -> Result a-pattern Success a = Result (Right a)--{-# COMPLETE Error, Success #-}---- | Case analysis for the 'Result' type.------ ==== __Examples__------ >>> let s = Success 0--- >>> let e = Error "critical"--- >>> result ("Bad: " ++) (("OK: " ++) . show) s--- "OK: 0"--- >>> result ("Bad: " ++) (("OK: " ++) . show) e--- "Bad: critical"-result :: (String -> b) -> (a -> b) -> Result a -> b-result f _ (Error e)   = f e-result _ g (Success a) = g a-{-# INLINE result #-}---- | Convert @'Either' 'String' a@ to @'Result' a@.-fromEither :: Either String a -> Result a-fromEither = Result-{-# INLINE fromEither #-}---- | Convert @'Result' a@ to @'Either' 'String' a@.-toEither :: Result a -> Either String a-toEither = runResult-{-# INLINE toEither #-}---- | Convert @'Result' a@ to @a@ with a default value.-fromSuccess :: a -> Result a -> a-fromSuccess _ (Success a) = a-fromSuccess a _           = a-{-# INLINE fromSuccess #-}---- | Convert @'Result' a@ to @'MonadFail' m => m a@.-toMonadFail :: MonadFail m => Result a -> m a-toMonadFail (Success a) = pure a-toMonadFail (Error e)   = fail e-{-# INLINE toMonadFail #-}+import Control.Monad.Trans.Result (pattern Error, pattern Result, type Result, pattern Success, fromEither,+                                   fromSuccess, result, runResult, toEither, toMonadFail)