packages feed

either-result (empty) → 0.1.0.0

raw patch · 7 files changed

+206/−0 lines, 7 filesdep +basedep +doctestdep +either-resultsetup-changed

Dependencies added: base, doctest, either-result

Files

+ CHANGELOG.md view
@@ -0,0 +1,7 @@+# Revision history for either-result++## 0.1.0.0++*2020.07.26*++- Release.
+ LICENSE view
@@ -0,0 +1,13 @@+Copyright 2020 Kazuki Okamoto (岡本和樹)
+
+Licensed under the Apache License, Version 2.0 (the "License");
+you may not use this file except in compliance with the License.
+You may obtain a copy of the License at
+
+    http://www.apache.org/licenses/LICENSE-2.0
+
+Unless required by applicable law or agreed to in writing, software
+distributed under the License is distributed on an "AS IS" BASIS,
+WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+See the License for the specific language governing permissions and
+limitations under the License.
+ README.md view
@@ -0,0 +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)++`Result a` is a wrapper of `Either String a`, but `Result` is an instance of `MonadFail`.
+ Setup.hs view
@@ -0,0 +1,2 @@+import           Distribution.Simple
+main = defaultMain
+ doctest/main.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF doctest-discover #-}
+ either-result.cabal view
@@ -0,0 +1,51 @@+cabal-version: 2.2++name: either-result+version: 0.1.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+bug-reports: https://github.com/kakkun61/either-result/issues+license: Apache-2.0+license-file: LICENSE+author: Kazuki Okamoto (岡本和樹)+maintainer: kazuki.okamoto@kakkun61.com+copyright: 2020 Kazuki Okamoto (岡本和樹)+category: Data+build-type: Simple+tested-with: GHC == 8.6.5, GHC == 8.8.3, GHC == 8.10.1+extra-source-files: README.md,+                    CHANGELOG.md++common common+  build-depends: base >=4 && <5+  ghc-options: -Wall+               -Wcompat+  default-language: Haskell2010++library+  import: common+  hs-source-dirs: src+  exposed-modules: Data.Either.Result+  ghc-options: -Wincomplete-uni-patterns+               -Wincomplete-record-updates+               -Wmonomorphism-restriction+               -Wmissing-exported-signatures+               -Wmissing-export-lists+               -Wmissing-home-modules+               -Widentities+               -Wredundant-constraints+               -Wpartial-fields+               -Wno-name-shadowing++test-suite doctest+  import: common+  type: exitcode-stdio-1.0+  main-is: main.hs+  hs-source-dirs: doctest+  build-depends: either-result,+                 doctest+  ghc-options: -threaded+               -rtsopts+               -with-rtsopts=-N+  build-tool-depends: doctest-discover:doctest-discover
+ src/Data/Either/Result.hs view
@@ -0,0 +1,127 @@+{-# LANGUAGE CPP                        #-}+{-# LANGUAGE DeriveGeneric              #-}+{-# LANGUAGE DeriveTraversable          #-}+{-# LANGUAGE DerivingStrategies         #-}+{-# LANGUAGE ExplicitNamespaces         #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE PatternSynonyms            #-}++{-# OPTIONS_HADDOCK show-extensions #-}++-- | @'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+  , pattern Error+  , pattern Success+  , result+  , fromEither+  , toEither+  , fromSuccess+  ) where++import           Prelude             hiding (either)++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 { either :: 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++-- | Convert @'Either' 'String' a@ to @'Result' a@.+fromEither :: Either String a -> Result a+fromEither = Result+{-# INLINE fromEither #-}++-- | Convert @'Either' 'String' a@ from @'Result' a@.+toEither :: Result a -> Either String a+toEither = either+{-# INLINE toEither #-}++-- | Convert @'Result' a@ to @a@ with a default value.+fromSuccess :: a -> Result a -> a+fromSuccess _ (Success a) = a+fromSuccess a _           = a