packages feed

interruptible (empty) → 0.1.0.0

raw patch · 8 files changed

+410/−0 lines, 8 filesdep +Cabaldep +basedep +eithersetup-changed

Dependencies added: Cabal, base, either, interruptible, lifted-base, monad-control, transformers

Files

+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2016, Marcos Dumay de Medeiros++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 Marcos Dumay de Medeiros nor the names of other+      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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ dist/build/allStub/allStub-tmp/allStub.hs view
@@ -0,0 +1,5 @@+module Main ( main ) where+import Distribution.Simple.Test.LibV09 ( stubMain )+import Test ( tests )+main :: IO ()+main = stubMain tests
+ interruptible.cabal view
@@ -0,0 +1,68 @@+-- Initial interruptible.cabal generated by cabal init.  For further +-- documentation, see http://haskell.org/cabal/users-guide/++name:                interruptible+version:             0.1.0.0+synopsis:            Monad transformers that can be run and resumed later, conserving their context.+description:+    Given an inner monad and a transformer:+    > (Monad m, MonadTrans t)+    If @t@ is an interruptible transformer, it becomes possible to intercalate executions+    on the @t@ context with executions over the inner monad @m@ by breaking the execution+    on @t@ and resuming it later.+    .+    Interruptible monads implement the @runI@ function so that, given @f :: a -> t m b@ and+    @g :: b -> t m c@, @resume (f >>= g)@ is equivalent to @\x -> resume f x >>= resume g@.+    .+    That makes it possible to intercalate the execution of different monads, and even to+    return a monadic context for another function to resume it.+homepage:            https://sealgram.com/git/haskell/interruptible/+license:             BSD3+license-file:        LICENSE+author:              Marcos Dumay de Medeiros+maintainer:          marcos@marcosdumay.com+--copyright:           +category:            Control+build-type:          Simple+-- extra-source-files:  +cabal-version:       >=1.10++source-repository head+  type:     git+  location: https://sealgram.com/git/haskell/interruptible/+  branch:   master++source-repository this+  type:     git+  location: https://sealgram.com/git/haskell/interruptible/+  tag:   0.1.0.0+++library+  exposed-modules:+      Control.Monad.Trans.Interruptible+      Control.Monad.Trans.SafeIO+  other-modules:       Control.Monad.Trans.Interruptible.Class+  other-extensions:    TypeFamilies+  build-depends:+      base >=4.7 && <4.9,+      transformers,+      monad-control,+      lifted-base,+      either+  hs-source-dirs:      src+  default-language:    Haskell2010++Test-suite all+  type: detailed-0.9+  test-module: Test+  hs-source-dirs:+    test+  build-depends:+    base >=4.7 && <5.0,+    Cabal >= 1.9.2,+    either,+    transformers,+    interruptible+  ghc-options: -Wall -fno-warn-unused-do-bind -fwarn-incomplete-patterns -threaded+  default-language: Haskell2010
+ src/Control/Monad/Trans/Interruptible.hs view
@@ -0,0 +1,35 @@+{-# LANGUAGE TypeFamilies #-}++module Control.Monad.Trans.Interruptible (+  module Control.Monad.Trans.Interruptible.Class,+  -- * Interruptible applications+  intercalateWith+  )where++import Control.Monad.Trans.Interruptible.Class++{- |+Folds the second list with the function applied to the first,+intercalating the evaluation. That is:++@+intercalateWith resume f [a00, a10, a20] [b1, b2] = do+  a01 <- resume (f b1) a00+  a11 <- resume (f b1) a10+  a21 <- resume (f b1) a20+  a02 <- resume (f b2) a11+  a12 <- resume (f b2) a21+  a22 <- resume (f b2) a31+  return [a02, a12, a22]+@++Usefull for consuming lazy sequences.++The resume function is parametric for allowing resuming deeper Interruptible chains, with+resume2, resume3, etc.+-}+intercalateWith :: Monad m => ((a -> t a) -> rsta -> m (rsta)) -> (b -> a -> t a) -> [b] -> [rsta] -> m [rsta]+intercalateWith _ _ [] aa = return aa+intercalateWith res f (b:bb) aa = do+  aa' <- mapM (res $ f b) aa+  intercalateWith res f bb aa'
+ src/Control/Monad/Trans/Interruptible/Class.hs view
@@ -0,0 +1,80 @@+{-# LANGUAGE TypeFamilies #-}++module Control.Monad.Trans.Interruptible.Class (+  Interruptible(..),+  -- * Resumers for stacks of interruptibles+  resume2,+  resume3,+  resume4,+  resume5+  )where++import Control.Monad.Trans.Class+import Control.Monad.Trans.State+import Control.Monad.Trans.Either++{- |+Interruptible monad transformers.++A monad transformer can be interrupted if it returns its+final context from its type creator, and if it is possible+to hoist this context again into the monad at the begining+of its execution.++For example, @StateT@ can be interrupted because+@runStateT@ returns its final state, and because its state+can be set at the type creation. Error can not be hoisted,+thus is can not be interrupted.++Interruptible transformers can be stacked so that their+execution is resumed by composition of their @resume@+functions, and their data by the composition of their data+constructors at the inverse order. That is, in the stack:++> (Monad m, Interruptible i, Interruptible j) => i j m++Both i and j can be resumed by the function @resume . resume@,+and given @initI :: a -> RSt i a@ and @initJ :: a -> RSt j a@,+the total context is given by @initJ . initI@.++The context data constructors vary with each Interruptible,+as well as its signature.+-}+class MonadTrans t => Interruptible t where+  -- | Context data of the transformer+  type RSt t a :: *+  -- | Resumes the execution of an interruptible transformer+  resume :: Monad m => (a -> t m b) -> RSt t a -> m (RSt t b)++instance Interruptible (EitherT e) where+  -- | The context of @EitherT e a@ is @Either e a@.+  type RSt (EitherT e) a = Either e a+  resume f st = runEitherT (hoistEither st >>= f)++instance Interruptible (StateT st) where+  -- | The context of @StateT st a@ is @(a, st)@+  type RSt (StateT st) a = (a, st)+  resume f (a, st) = runStateT (f a) st++resume2 :: (Monad m, Interruptible t, Monad (t m), Interruptible u) =>+           (a -> u (t m) b) -> RSt t (RSt u a) -> m (RSt t (RSt u b))+resume2 = resume.resume++resume3 :: (Monad m, Interruptible t0, Monad (t0 m), Interruptible t1,+            Monad (t1 (t0 m)), Interruptible t2) =>+           (a -> t2 (t1 (t0 m)) b) -> RSt t0 (RSt t1 (RSt t2 a)) ->+           m (RSt t0 (RSt t1 (RSt t2 b)))+resume3 = resume2.resume++resume4 :: (Monad m, Interruptible t0, Interruptible t1, Interruptible t2,+            Interruptible t3, Monad (t0 m), Monad (t1 (t0 m)), Monad (t2 (t1 (t0 m)))) =>+           (a -> t3 (t2 (t1 (t0 m))) b) -> RSt t0 (RSt t1 (RSt t2 (RSt t3 a))) ->+           m (RSt t0 (RSt t1 (RSt t2 (RSt t3 b))))+resume4 = resume3.resume++resume5 :: (Monad m, Interruptible t0, Interruptible t1, Interruptible t2,+            Interruptible t3, Interruptible t4, Monad (t0 m), Monad (t1 (t0 m)),+            Monad (t2 (t1 (t0 m))), Monad (t3 (t2 (t1 (t0 m))))) =>+           (a -> t4 (t3 (t2 (t1 (t0 m)))) b) -> RSt t0 (RSt t1 (RSt t2 (RSt t3 (RSt t4 a)))) ->+           m (RSt t0 (RSt t1 (RSt t2 (RSt t3 (RSt t4 b)))))+resume5 = resume4.resume
+ src/Control/Monad/Trans/SafeIO.hs view
@@ -0,0 +1,75 @@+{-# LANGUAGE FlexibleContexts #-}+{- |+==The problem:++In Haskell it is usually simple to keep IOError bounded within a context,+so that they can not interfere with the overall execution of a program. Since functional+substitution is done in a hierarchical way, often a single try or catch statement is+enough to treat all errors on an entire section of code.++Interruptible monad transformers turn this realitty upside down. Since the entire point+of this type class is separating the hierarchical code organization from the monadic+contexts, it becomes usefull to keep the exceptions information at the monadic context,+instead of the default of carrying it in the code hierarchy.++That is, in the following example:++@+do+    let ct1 = createContext 1+        ct2 = createContext 2+    ct1' <- resume startClient ct1+    ct2' <- resume startClient ct2+    resume finishClient ct1'+    resume finishClient ct2'+@++It may be desirable to let any IO exception on @startClient@ with the @ct1@ context+influence only the execution of @finishClient@ with the @ct1'@ context, and not+affect any execution with the other contexts.++SafeIO was created to enforce this kind of behavior.++==How to use:++1. Do not import Control.Monad.Trans, Control.Monad.IO or anything similar at your module.+2. Create an error type (let's call it @e@), and make it an instance of IOErrorDerivation.+3. Wrap your computation inside an @EitherT e@ transformer.+4. Use the safe functions on this module instead of lift, liftIO, liftBase, etc.++Remember that the context of interruptible transformers are in the inverse order that the+transformers appear on the stack, thus, at the end of execution if you want to retrieve+the EitherT context, you'll have to peel all the other contexts from it first.+-}+module Control.Monad.Trans.SafeIO (+  IOErrorDerivation(..),+  safeIO,+  safeCT+  )where++import System.IO.Error+import Control.Monad.IO.Class+import Control.Monad.Trans.Class+import Control.Monad.Trans.Either+import Control.Monad.Trans.Control+import qualified Control.Exception.Lifted as Lift++{- |+Class for types that keep IOError information. Instantiate this for an error type for+using the safe functions from this module.+-}+class IOErrorDerivation e where+  -- | Transforms an IOError on another error type+  coerceIOError :: IOError -> e++-- | Safe alternative to liftIO+safeIO :: (MonadIO m, IOErrorDerivation e) => IO a -> EitherT e m a+safeIO io = (liftIO $ tryIOError io) >>= hoistResult++-- | Safe alternative to lift for an stack that implements MonadBaseControl.+safeCT :: (MonadBaseControl IO m, IOErrorDerivation e) => m a -> EitherT e m a+safeCT f = (lift $ Lift.try f) >>= hoistResult++hoistResult :: (IOErrorDerivation e, Monad m) => Either IOError a -> EitherT e m a+hoistResult (Left e) = left . coerceIOError $ e+hoistResult (Right v) = right v
+ test/Test.hs view
@@ -0,0 +1,115 @@+module Test (tests) where++import Distribution.TestSuite+import System.IO.Error++import Control.Monad.Trans.Either+import Control.Monad.Trans.State+import Data.Either.Combinators+import Control.Monad.Trans.Interruptible+import Control.Monad.IO.Class+import Control.Monad.Trans.SafeIO++simpleTest :: String -> IO Progress -> Test+simpleTest n t = +  let test = TestInstance+        {run = t',+         name = n,+         tags = [],+         options = [],+         setOption = \_ _ -> Right test+        }+  in Test test+  where+    t' :: IO Progress+    t' = catchIOError t (+      \e -> return . Finished . Fail $ "Raised exception: " ++ show e+      )++tests :: IO [Test]+tests = return [+  simpleTest "resume" tres,+  simpleTest "resume2" tres2,+  simpleTest "resume3" tres3,+  simpleTest "resume4" tres4,+  simpleTest "resume5" tres5,+  simpleTest "intercalate1" int1,+  simpleTest "intercalate5" int5,+  simpleTest "safeIO" tSafeIO,+  simpleTest "safeCL" tSafeCT+  ]++tres :: IO Progress+tres = do+  let f = (\x -> return $ x + 1) :: Int -> EitherT () IO Int+  r <- resume f (Right 1)+  let v = fromRight 0 r+  Finished <$> if v == 2 then return Pass else return $ Fail $ "Wrong value: " ++ show v+  +tres2 :: IO Progress+tres2 = do+  let f = (\x -> return $ x + 1) :: Int -> EitherT () (EitherT () IO) Int+  r <- resume2 f (Right . Right $ 1)+  let v = fromRight 0 . fromRight (Left ()) $ r+  Finished <$> if v == 2 then return Pass else return $ Fail $ "Wrong value: " ++ show v+  +tres3 :: IO Progress+tres3 = do+  let f = (\x -> return $ x + 1) :: Int -> EitherT () (EitherT () (EitherT () IO)) Int+  r <- resume3 f (Right . Right . Right $ 1)+  let v = fromRight 0 . fromRight (Left ()) . fromRight (Left ()) $ r+  Finished <$> if v == 2 then return Pass else return $ Fail $ "Wrong value: " ++ show v++tres4 :: IO Progress+tres4 = do+  let f = (\x -> return $ x + 1) :: Int -> EitherT () (EitherT () (EitherT () (EitherT () IO))) Int+  r <- resume4 f (Right . Right . Right . Right $ 1)+  let v = fromRight 0 . fromRight (Left ()) . fromRight (Left ()) . fromRight (Left ()) $ r+  Finished <$> if v == 2 then return Pass else return $ Fail $ "Wrong value: " ++ show v++tres5 :: IO Progress+tres5 = do+  let f = (\x -> return $ x + 1) :: Int -> EitherT () (EitherT () (EitherT () (EitherT () (EitherT () IO)))) Int+  r <- resume5 f (Right . Right . Right . Right . Right $ 1)+  let v = fromRight 0 . fromRight (Left ()) . fromRight (Left ()) . fromRight (Left ()) . fromRight (Left ()) $ r+  Finished <$> if v == 2 then return Pass else return $ Fail $ "Wrong value: " ++ show v++int1 :: IO Progress+int1 = do+  let f = (\x y -> return $ x + y) :: Int -> Int -> EitherT () IO Int+  r <- intercalateWith resume f [1, 2, 3] (map Right [10, 20])+  let v = map (fromRight 0) r+  Finished <$> if v == [16, 26] then return Pass else return $ Fail $ "Wrong value: " ++ show v++int5 :: IO Progress+int5 = do+  let f = (\x y -> return $ x + y) :: Int -> Int -> EitherT () (EitherT () (EitherT () (EitherT () (EitherT () IO)))) Int+  r <- intercalateWith resume5 f [1, 2, 3] (map (Right . Right . Right . Right . Right) [10, 20])+  let v = map (fromRight 0 . fromRight (Left ()) . fromRight (Left ()) . fromRight (Left ()) . fromRight (Left ())) r+  Finished <$> if v == [16, 26] then return Pass else return . Fail $ "Wrong value: " ++ show v++newtype Txt = Txt String+instance IOErrorDerivation Txt where+  coerceIOError = Txt . show++tSafeIO :: IO Progress+tSafeIO = do+  let msg = "test"+      err = show . userError $ msg+  r <- runEitherT (safeIO . ioError . userError $ msg)+  case r of+    Left (Txt msg') -> Finished <$> if err == msg' then return Pass else return . Fail $ "Wrong error: " ++ msg'+    Right _ -> return . Finished . Fail $ "Throwing error didn't create an error!"++tSafeCT :: IO Progress+tSafeCT = do+  let msg = "test"+      err = show . userError $ msg+  r <- fst <$> runStateT (runEitherT (safeCT . stateError $ msg)) ()+  case r of+    Left (Txt msg') -> Finished <$> if err == msg' then return Pass else return . Fail $ "Wrong error: " ++ msg'+    Right _ -> return . Finished . Fail $ "Throwing error didn't create an error!"+  where+    stateError :: String -> StateT () IO ()+    stateError = liftIO . ioError . userError+