io-choice-0.0.7/0000755000000000000000000000000013403674236011553 5ustar0000000000000000io-choice-0.0.7/Setup.hs0000644000000000000000000000005613403674236013210 0ustar0000000000000000import Distribution.Simple main = defaultMain io-choice-0.0.7/LICENSE0000644000000000000000000000276513403674236012572 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.7/io-choice.cabal0000644000000000000000000000272513403674236014404 0ustar0000000000000000Name: io-choice Version: 0.0.7 Author: Kazu Yamamoto Maintainer: Kazu Yamamoto License: BSD3 License-File: LICENSE Synopsis: Choice for IO and lifted IO Description: Providing choice features 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.7/test/0000755000000000000000000000000013403674236012532 5ustar0000000000000000io-choice-0.0.7/test/Spec.hs0000644000000000000000000000005413403674236013757 0ustar0000000000000000{-# OPTIONS_GHC -F -pgmF hspec-discover #-} io-choice-0.0.7/Control/0000755000000000000000000000000013403674236013173 5ustar0000000000000000io-choice-0.0.7/Control/Exception/0000755000000000000000000000000013403674236015131 5ustar0000000000000000io-choice-0.0.7/Control/Exception/IOChoice.hs0000644000000000000000000000125413403674236017111 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.7/Control/Exception/IOChoice/0000755000000000000000000000000013403674236016553 5ustar0000000000000000io-choice-0.0.7/Control/Exception/IOChoice/THUtil.hs0000644000000000000000000000321113403674236020255 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 args _) -> foldl1 appT (conT name:map return args) #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.7/Control/Exception/IOChoice/TH.hs0000644000000000000000000000151113403674236017420 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.7/Control/Exception/IOChoice/Lifted.hs0000644000000000000000000000171213403674236020317 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.7/Control/Exception/IOChoice/Lifted/0000755000000000000000000000000013403674236017762 5ustar0000000000000000io-choice-0.0.7/Control/Exception/IOChoice/Lifted/TH.hs0000644000000000000000000000161113403674236020630 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 |]