Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
try で複数の例外をキャッチしたい場合
{-# LANGUAGE GADTs #-}
module Control.ExceptionUtil where
import Control.Exception
data TrySelection a where
TrySelection :: Exception e => (e -> a) -> TrySelection a
trySelectionBuilder :: [TrySelection a] -> SomeException -> Maybe a
trySelectionBuilder ss e = foldr buildResult Nothing ss
where
buildResult (TrySelection selection) res = case fromException e of
Just e' -> Just $ selection e'
Nothing -> res
{-# INLINE trySelectionBuilder #-}
trySelection :: [TrySelection b] -> IO a -> IO (Either b a)
trySelection ss m = tryJust (trySelectionBuilder ss) m
{-# INLINE trySelection #-}
{-# LANGUAGE BlockArguments #-}
module Main where
import Control.Exception
import Control.ExceptionUtil
main :: IO ()
main = do
v1 <- trySelection selection
$ print $ (head []) `div` (0 :: Int)
fromLeftAction v1
-- => some Prelude.head: empty list
v2 <- trySelection selection
$ print $ 1 `div` (0 :: Int)
fromLeftAction v2
-- => arith divide by zero
v3 <- trySelection selection
$ print $ 1 `div` (1 :: Int)
fromLeftAction v3
-- => 1
where
selection =
[ TrySelection \e -> putStrLn $ "arith " <> displayException (e :: ArithException)
, TrySelection \e -> putStrLn $ "some " <> displayException (e :: SomeException)
]
fromLeftAction (Right v) = pure v
fromLeftAction (Left m) = m
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment