io-choice-0.0.6/0000755000000000000000000000000012703112472011541 5ustar0000000000000000io-choice-0.0.6/io-choice.cabal0000644000000000000000000000270212703112472014365 0ustar0000000000000000Name: io-choice Version: 0.0.6 Author: Kazu Yamamoto Maintainer: Kazu Yamamoto License: BSD3 License-File: LICENSE Synopsis: Choice for IO and lifted IO Description: Choice for IO and lifted IO Category: Control Cabal-Version: >= 1.8 Build-Type: Simple Library GHC-Options: -Wall Exposed-Modules: Control.Exception.IOChoice Control.Exception.IOChoice.TH Control.Exception.IOChoice.Lifted Control.Exception.IOChoice.Lifted.TH Other-Modules: Control.Exception.IOChoice.THUtil Build-Depends: base >= 4 && < 5 , lifted-base , monad-control , transformers , transformers-base , template-haskell Test-Suite spec Main-Is: Spec.hs Hs-Source-Dirs: test Type: exitcode-stdio-1.0 Ghc-Options: -Wall Build-Depends: base >= 4 && < 5 , hspec , io-choice , lifted-base , monad-control , transformers Source-Repository head Type: git Location: git://github.com/kazu-yamamoto/io-choice io-choice-0.0.6/LICENSE0000644000000000000000000000276512703112472012560 0ustar0000000000000000Copyright (c) 2012, IIJ Innovation Institute Inc. All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * 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. * Neither the name of the copyright holders 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 OWNER 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. io-choice-0.0.6/Setup.hs0000644000000000000000000000005612703112472013176 0ustar0000000000000000import Distribution.Simple main = defaultMain io-choice-0.0.6/Control/0000755000000000000000000000000012703112472013161 5ustar0000000000000000io-choice-0.0.6/Control/Exception/0000755000000000000000000000000012703112472015117 5ustar0000000000000000io-choice-0.0.6/Control/Exception/IOChoice.hs0000644000000000000000000000125412703112472017077 0ustar0000000000000000{-# LANGUAGE ScopedTypeVariables #-} -- | -- This package provides the choice operator ('||>') for -- IO monad. module Control.Exception.IOChoice where import Control.Exception (IOException) import qualified Control.Exception as E -- | -- If 'IOException' occurs or 'goNext' is used in the left IO, -- then the right IO is performed. Note that 'fail' -- throws 'IOException'. (||>) :: IO a -> IO a -> IO a x ||> y = x `E.catch` (\(_ :: IOException) -> y) infixr 3 ||> -- | Go to the next 'IO' monad by throwing 'IOException'. goNext :: IO a goNext = E.throwIO $ userError "goNext for IO" -- | Run any one 'IO' monad. runAnyOne :: [IO a] -> IO a runAnyOne = foldr (||>) goNext io-choice-0.0.6/Control/Exception/IOChoice/0000755000000000000000000000000012703112472016541 5ustar0000000000000000io-choice-0.0.6/Control/Exception/IOChoice/Lifted.hs0000644000000000000000000000171212703112472020305 0ustar0000000000000000{-# LANGUAGE ScopedTypeVariables, FlexibleContexts #-} -- | -- This package provides the choice operator ('||>') for -- lifted IO monad. module Control.Exception.IOChoice.Lifted where import Control.Exception (IOException) import qualified Control.Exception.Lifted as L (catch, throwIO) import Control.Monad.Base (MonadBase) import Control.Monad.IO.Class import Control.Monad.Trans.Control (MonadBaseControl) -- | -- If 'IOException' occurs or 'goNext' is used in the left monad, -- then the right monad is performed. Note that 'fail' -- throws 'IOException'. (||>) :: MonadBaseControl IO m => m a -> m a -> m a x ||> y = x `L.catch` (\(_ :: IOException) -> y) infixr 3 ||> -- | Go to the next 'IO' monad by throwing 'IOException'. goNext :: (MonadIO m, MonadBase IO m) => m a goNext = L.throwIO $ userError "goNext for lifted IO" -- | Run any one lifted 'IO' monad. runAnyOne :: (MonadIO m, MonadBaseControl IO m) => [m a] -> m a runAnyOne = foldr (||>) goNext io-choice-0.0.6/Control/Exception/IOChoice/TH.hs0000644000000000000000000000151112703112472017406 0ustar0000000000000000{-# LANGUAGE TemplateHaskell, ScopedTypeVariables #-} -- | -- This package provides a function to generate a choice operator -- in IO monad by specifying exceptions to be caught. module Control.Exception.IOChoice.TH (newIOChoice) where import Control.Exception import Language.Haskell.TH import Control.Exception.IOChoice.THUtil -- | -- A function to generate a choice operator in IO monad. -- 'IOException' is automatically added to specified exceptions. -- So, 'Control.Exception.IOChoice.goNext' can be used with -- the new operator. -- -- > {-# LANGUAGE TemplateHaskell #-} -- > import Control.Exception -- > import Control.Exception.IOChoice.TH -- > -- > (||>>) :: IO a -> IO a -> IO a -- > (||>>) = $(newIOChoice [''ErrorCall, ''ArithException]) newIOChoice :: [Name] -> ExpQ newIOChoice = newChoice [| catches |] [| Handler |] io-choice-0.0.6/Control/Exception/IOChoice/THUtil.hs0000644000000000000000000000320112703112472020242 0ustar0000000000000000{-# LANGUAGE TemplateHaskell, CPP #-} module Control.Exception.IOChoice.THUtil (newChoice) where import Language.Haskell.TH import Control.Exception (IOException) newChoice :: ExpQ -> ExpQ -> [Name] -> ExpQ newChoice catches handler typs = do ma <- newName "ma" mb <- newName "mb" let hs = map (mkHandler handler mb) (''IOException : typs) lamE [varP ma, varP mb] $ [| $catches $(varE ma) $(listE hs) |] mkHandler :: ExpQ -> Name -> Name -> ExpQ mkHandler handler act eName = do let exc = checkSupported eName [| $handler $ \_e -> let _ = _e :: $exc in $(varE act) |] checkSupported :: Name -> TypeQ checkSupported exc = do info <- reify exc case info of TyConI dec -> do case dec of #if __GLASGOW_HASKELL__ >= 800 DataD _ name [] _ _ _ -> conT name NewtypeD _ name [] _ _ _ -> conT name DataInstD _ name args _ _ _ -> foldl1 appT (conT name:map return args) NewtypeInstD _ name args _ _ _ -> foldl1 appT (conT name:map return args) #else DataD _ name [] _ _ -> conT name NewtypeD _ name [] _ _ -> conT name DataInstD _ name args _ _ -> foldl1 appT (conT name:map return args) NewtypeInstD _ name args _ _ -> foldl1 appT (conT name:map return args) #endif TySynD name [] _ -> conT name #if __GLASGOW_HASKELL__ >= 707 TySynInstD name (TySynEqn _ t) -> foldl1 appT (conT name:[return t]) #else TySynInstD name args _ -> foldl1 appT (conT name:map return args) #endif _ -> error $ "Exception type must not have any type argument: " ++ show exc PrimTyConI n _ _ -> conT n _ -> error $ "Type name required, but got: " ++ show exc io-choice-0.0.6/Control/Exception/IOChoice/Lifted/0000755000000000000000000000000012703112472017750 5ustar0000000000000000io-choice-0.0.6/Control/Exception/IOChoice/Lifted/TH.hs0000644000000000000000000000161112703112472020616 0ustar0000000000000000{-# LANGUAGE TemplateHaskell, ScopedTypeVariables #-} -- | -- This package provides a function to generate a choice operator -- in lifted IO monad by specifying exceptions to be caught. module Control.Exception.IOChoice.Lifted.TH (newIOChoice) where import Control.Exception.Lifted import Language.Haskell.TH import Control.Exception.IOChoice.THUtil -- | -- A function to generate a choice operator in lifted IO monad. -- 'IOException' is automatically added to specified exceptions. -- So, 'Control.Exception.IOChoice.Lifted.goNext' can be used with -- the new operator. -- -- > {-# LANGUAGE TemplateHaskell #-} -- > import Control.Exception -- > import Control.Exception.IOChoice.Lifted.TH -- > -- > (||>>) :: MonadBaseControl IO m => m a -> m a -> m a -- > (||>>) = $(newIOChoice [''ErrorCall, ''ArithException]) newIOChoice :: [Name] -> ExpQ newIOChoice = newChoice [| catches |] [| Handler |] io-choice-0.0.6/test/0000755000000000000000000000000012703112472012520 5ustar0000000000000000io-choice-0.0.6/test/Spec.hs0000644000000000000000000000005412703112472013745 0ustar0000000000000000{-# OPTIONS_GHC -F -pgmF hspec-discover #-}