fallible (empty) → 0.1.0

raw patch · 7 files changed

+341/−0 lines, 7 filesdep +basedep +fallibledep +transformerssetup-changed

Dependencies added: base, fallible, transformers

Files

CHANGELOG.md +3/−0
LICENSE +29/−0
README.md +104/−0
Setup.hs +2/−0
example/Main.hs +69/−0
fallible.cabal +47/−0
src/Data/Fallible.hs +87/−0

+ CHANGELOG.md view

@@ -0,0 +1,3 @@+# Changelog for fallible++## Unreleased changes

+ LICENSE view

@@ -0,0 +1,29 @@+BSD 3-Clause License++Copyright (c) 2019, MATSUBARA Nobutada+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++1. Redistributions of source code must retain the above copyright notice, this+   list of conditions and the following disclaimer.++2. Redistributions in binary form must reproduce the above copyright notice,+   this list of conditions and the following disclaimer in the documentation+   and/or other materials provided with the distribution.++3. Neither the name of the copyright holder nor the names of its+   contributors may be used to endorse or promote products derived from+   this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"+AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,+OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

+ README.md view

@@ -0,0 +1,104 @@+# fallible++[![Build Status](https://travis-ci.com/matsubara0507/fallible.svg?branch=master)](https://travis-ci.com/matsubara0507/fallible)++An interface for fallible data types like Maybe and Either.++## Example++Dealing with Maybe and Either gets a bit annoying when monadic actions are+involved, often resulting in deep nests like this:++```Haskell+run :: String -> Token -> Bool -> IO ()+run targetName token verbose = do+  users <- getUsers token+  case users of+    Left err -> logDebug' err+    Right us -> do+      case userId <$> L.find isTarget us of+        Nothing  -> logDebug' emsg+        Just tid -> do+          channels <- getChannels token+          case channels of+            Left err  -> logDebug' err+            Right chs -> do+              let chs' = filter (elem tid . channelMembers) chs+              mapM_ (logDebug' . channelName) chs'+```++This package offers you several combinators to tidy up this eyesore. See+[example/Main.hs](example/Main.hs):++```Haskell+import           Data.Fallible+import qualified Data.List     as L++run :: String -> Token -> Bool -> IO ()+run targetName token verbose = evalContT $ do+  users    <- lift (getUsers token) !?= exit . logDebug'+  targetId <- userId <$> L.find isTarget users ??? exit (logDebug' emsg)+  channels <- lift (getChannels token) !?= exit . logDebug'+  lift $ mapM_ (logDebug' . channelName) $+    filter (elem targetId . channelMembers) channels+  where+    logDebug' = logDebug verbose+    emsg = "user not found: " ++ targetName+    isTarget user = userName user == targetName++logDebug :: Bool -> String -> IO ()+logDebug verbose msg = if verbose then putStrLn msg else pure ()+```++Notice the couple of operators, `(!?=)` and `(???)`:++```haskell+(!?=) :: Monad m => m (Either e a) -> (e -> m a) -> m a+(!??) :: Monad m => m (Maybe a) -> m a -> m a+(??=) :: Applicative f => Either e a -> (e -> f a) -> f a+(???) :: Applicative f => Maybe a -> f a -> f a+```++As you can guess from their type signatures, they run the right side when the+first arguments returns `Left` or `Nothing`. Then you can use whatever you like+to handle failures -- exception, MaybeT, ExceptT, ContT etc.++exec using ghci:++```+$ stack ghci+>>> :l example/Main.hs+*Main> run "Alice" "dummy" True+general+random+secret+*Main> run "Curry" "dummy" True+general+random+owners+*Main> run "Haskell" "dummy" True+user not found: Haskell+*Main> run "Haskell" "" True+invalid token+```++## Become a beta tester++### Stack++write to stack.yaml:++```yaml+extra-deps:+  github: matsubara0507/fallible+  commit: XXXXXXX+```++### cabal++```+source-repository-package+  type: git+  location: https://github.com/matsubara0507/fallible+  tag: XXXXXXX+```

+ Setup.hs view

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

+ example/Main.hs view

@@ -0,0 +1,69 @@+module Main where++import           Data.Fallible+import qualified Data.List     as L++main :: IO ()+main = test+  where+    test = run "Alice" "dummy" False++run :: String -> Token -> Bool -> IO ()+run targetName token verbose = evalContT $ do+  users    <- lift (getUsers token) !?= exit . logDebug'+  targetId <- userId <$> L.find isTarget users ??? exit (logDebug' emsg)+  channels <- lift (getChannels token) !?= exit . logDebug'+  lift $ mapM_ (logDebug' . channelName) $+    filter (elem targetId . channelMembers) channels+  where+    logDebug' = logDebug verbose+    emsg = "user not found: " ++ targetName+    isTarget user = userName user == targetName++logDebug :: Bool -> String -> IO ()+logDebug verbose msg = if verbose then putStrLn msg else pure ()++-- Dummy API++type UserId = String++data User = User+  { userId    :: UserId+  , userName  :: String+  , userEmail :: String+  , userAdmin :: Bool+  } deriving (Show, Eq)++data Channel = Channel+  { channelId      :: String+  , channelName    :: String+  , channelMembers :: [UserId]+  , channelPrivate :: Bool+  } deriving (Show, Eq)++type Error = String++type Token = String++getUsers :: Token -> IO (Either Error [User])+getUsers ""     = pure (Left "invalid token")+getUsers _token = pure (Right _users)++_users :: [User]+_users =+  [ User "u123456" "Alice" "alice@example.com" False+  , User "u123457" "Bob"   "bob@example.com"   False+  , User "u123458" "Curry" "curry@example.com" True+  ]++getChannels :: Token -> IO (Either Error [Channel])+getChannels ""     = pure (Left "invalid token")+getChannels _token = pure (Right _channels)++_channels :: [Channel]+_channels =+  [ Channel "c123456" "general" (map userId _users) False+  , Channel "c123457" "random"  (map userId _users) False+  , Channel "c123458" "owners"  (map userId $ filter userAdmin _users) True+  , Channel "c123459" "secret"  (map userId $ take 2 _users) True+  ]

+ fallible.cabal view

@@ -0,0 +1,47 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.31.2.+--+-- see: https://github.com/sol/hpack+--+-- hash: 2749a57a85fe4df30b950899d02ac2874071071ac2711408960a8e7c8426bf08++name:           fallible+version:        0.1.0+description:    Please see the README on GitHub at <https://github.com/matsubara0507/mixlogue#readme>+category:       Data+homepage:       https://github.com/matsubara0507/fallible#readme+author:         MATSUBARA Nobutada+maintainer:     t12307043@gunma-u.ac.jp+copyright:      MATSUBARA Nobutada+license:        BSD3+license-file:   LICENSE+build-type:     Simple+extra-source-files:+    README.md+    CHANGELOG.md++library+  exposed-modules:+      Data.Fallible+  other-modules:+      Paths_fallible+  hs-source-dirs:+      src+  ghc-options: -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints+  build-depends:+      base >=4.7 && <5+    , transformers+  default-language: Haskell2010++test-suite fallible-example+  type: exitcode-stdio-1.0+  main-is: Main.hs+  hs-source-dirs:+      example+  ghc-options: -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints+  build-depends:+      base >=4.7 && <5+    , fallible+    , transformers+  default-language: Haskell2010

+ src/Data/Fallible.hs view

@@ -0,0 +1,87 @@+{-# LANGUAGE TypeFamilies #-}++module Data.Fallible+  ( Fallible (..)+  , (??=)+  , (???)+  , (!?=)+  , (!??)+  , catchFailure+  , catchFailure_+  , exit+  , exitA+  , module Cont+  , lift+  ) where++import           Control.Applicative+import           Control.Monad.Trans.Class (lift)+import           Control.Monad.Trans.Cont  as Cont+import           Data.Functor.Identity+import           Data.Proxy+import           Data.Void++-- | Types that may contain failures.+class Applicative f => Fallible f where+  type Failure f :: *++  -- | Get a success or a failure.+  --+  -- @'tryFallible' (pure a) ≡ Right a@+  tryFallible :: f a -> Either (Failure f) a++instance Fallible Identity where+  type Failure Identity = Void+  tryFallible = Right . runIdentity++instance Monoid e => Fallible (Const e) where+  type Failure (Const e) = e+  tryFallible = Left . getConst++instance Fallible Proxy where+  type Failure Proxy = ()+  tryFallible _ = Left ()++instance Fallible Maybe where+  type Failure Maybe = ()+  tryFallible = maybe (Left ()) Right++instance Fallible (Either e) where+  type Failure (Either e) = e+  tryFallible = id++(??=) :: (Applicative f, Fallible t) => t a -> (Failure t -> f a) -> f a+t ??= k = either k pure $ tryFallible t+{-# INLINE (??=) #-}+infixl 1 ??=++(???) :: (Applicative f, Fallible t) => t a -> f a -> f a+t ??? k = t ??= const k+{-# INLINE (???) #-}+infixl 1 ???++(!?=) :: (Monad m, Fallible t) => m (t a) -> (Failure t -> m a) -> m a+t !?= k = t >>= (??=k)+{-# INLINE (!?=) #-}+infixl 1 !?=++catchFailure :: (Monad m, Fallible t) => m (t a) -> (Failure t -> m a) -> m a+catchFailure = (!?=)+{-# INLINE catchFailure #-}++(!??) :: (Monad m, Fallible t) => m (t a) -> m a -> m a+t !?? k = t >>= (???k)+{-# INLINE (!??) #-}+infixl 1 !??++catchFailure_ :: (Monad m, Fallible t) => m (t a) -> m a -> m a+catchFailure_ = (!??)+{-# INLINE catchFailure_ #-}++exit :: m r -> ContT r m a+exit = ContT . const+{-# INLINE exit #-}++exitA :: Applicative m => r -> ContT r m a+exitA = exit . pure+{-# INLINE exitA #-}