oi 0.1.1 → 0.2.0.1

raw patch · 17 files changed

+452/−324 lines, 17 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• oi.cabal +12/−7
• sample/catsIO.hs +18/−0
• sample/catsLIO.hs +14/−2
• sample/catsOI.hs +26/−12
• sample/catsSIO.hs +18/−1
• sample/echo.hs +3/−3
• sample/recdircs.hs +1/−1
• sample/talk.hs +3/−3
• src/Data/OI.hs +6/−2
• src/Data/OI/Base.hs +0/−275
• src/Data/OI/Combinator.hs +3/−4
• src/Data/OI/Force.hs +28/−0
• src/Data/OI/IFun.hs +37/−0
• src/Data/OI/IO.hs +16/−12
• src/Data/OI/Internal.hs +263/−0
• src/Data/OI/Resource.hs +3/−1
• src/Data/OI/System.hs +1/−1

@@ -1,11 +1,10 @@ Name:			oi-Version:		0.1.1+Version:		0.2.0.1 Category:		Data-Synopsis:		Purely Functional Lazy Interaction with the outer world-Description:		This package implements a data structure and operations on it -			for making interactive program without using explicitly IO monads.-			-			Version 0.1.1: APIs are changed!+Synopsis:		Library for purely functional lazy interactions with the outer world.+Description:		This package implements a data structure and operations on it for writing interactive program with no imperative flavor of IO monads.+			.+			[N.B.] At the moment, APIs maybe change.  Stability:		Experimental License:		BSD3@@ -24,8 +23,14 @@   Build-Depends:	    base >= 4.5 && < 5, parallel, comonad, filepath   GHC-Options:		    -Wall -O0   Exposed-modules:	    Data.OI-                           ,Data.OI.Base+                           ,Data.OI.Internal                            ,Data.OI.Combinator+                           ,Data.OI.Force+                           ,Data.OI.IFun                            ,Data.OI.IO                            ,Data.OI.Resource                            ,Data.OI.System++Source-Repository head+  type:		  darcs+  location:	  http://darcs.sampou.org/oi/

@@ -1,7 +1,13 @@ module Main where  import System.Environment+import System.IO hiding (readFile, writeFile)+import Prelude hiding (readFile, writeFile) +{-+ If "files" contains much many files, "./catsIO" throws a resource-exhaused exception."+-}+ main :: IO () main = do   args     <- getArgs@@ -15,3 +21,15 @@  textproc :: String -> String textproc = unlines . take 1 . lines++readFile :: String -> IO String+readFile f = do+  h  <- openFile f ReadMode+  cs <- hGetContents h+  return cs++writeFile :: String -> String -> IO ()+writeFile f cs = do+  h  <- openFile f WriteMode+  r  <- hPutStr h cs+  return r

@@ -1,9 +1,9 @@ module Main where  import System.Environment-import System.IO+import System.IO hiding (readFile, writeFile) import System.IO.Unsafe-import Prelude+import Prelude hiding (readFile, writeFile)  main :: IO () main = do@@ -31,3 +31,15 @@   r  <- lazy i   rs <- sequenceLz is   return (r:rs)++readFile :: String -> IO String+readFile f = do+  h  <- openFile f ReadMode+  cs <- hGetContents h+  return cs++writeFile :: String -> String -> IO ()+writeFile f cs = do+  h  <- openFile f WriteMode+  r  <- hPutStr h cs+  return r

@@ -1,24 +1,38 @@ {-# LANGUAGE TypeOperators #-} module Main where -import Data.OI+import Data.OI hiding (openFile)+import System.IO (IOMode (..), Handle)+import qualified System.IO as IO+import Prelude hiding (readFile, writeFile)  main :: IO ()-main = run pmain+main = runInteraction pmain -pmain :: (([String], Either (String, [String]) [String]), ()) :-> ()+pmain +  :: (([String],Either ((Handle, String), [(Handle, String)]) [(Handle, String)]), (Handle, ()))+  :-> () pmain = args -    |/| choiceOIOn (const $ lines . readFile' "files" |/| zipWithOI readFile') -                   (zipWithOI readFile')+    |/| choiceOIOn (const $ lines . readFile "files" |/| zipWithOI readFile) +                   (zipWithOI readFile)                    null-    |/| writeFile' "output.txt" . concatMap textproc--readFile' :: FilePath -> OI String -> String-readFile'  = iooi . readFile--writeFile' :: FilePath -> String -> OI () -> ()-writeFile' = (iooi .) . writeFile+    |/| writeFile "output.txt" . concatMap textproc  textproc :: String -> String textproc = id -- unlines . take 1 . lines++readFile :: FilePath -> (Handle, String) :-> String+readFile f      = openFile f ReadMode   |/| hGetContents++writeFile :: FilePath -> String -> (Handle, ()) :-> ()+writeFile f cs  = openFile f WriteMode  |/| flip hPutStr cs++openFile :: FilePath -> IOMode -> Handle :-> Handle+openFile     = (iooi .) . IO.openFile++hGetContents :: Handle -> String :-> String+hGetContents = iooi . IO.hGetContents++hPutStr :: Handle -> String -> () :-> ()+hPutStr      = (iooi .) . IO.hPutStr 

@@ -1,9 +1,14 @@ module Main where  import System.Environment-import System.IO.Strict+import qualified System.IO as IO+import System.IO.Strict hiding (readFile, writeFile) import Prelude hiding (readFile, writeFile) +{-+ If the amount of size of files contained in "files" is too much, "./catsSIO" throws a out-of-memory exception."+-}+ main :: IO () main = do   args     <- getArgs@@ -21,3 +26,15 @@  textproc :: String -> String textproc = unlines . take 1 . lines++readFile :: String -> SIO String+readFile f = do+  h  <- openFile f IO.ReadMode+  cs <- hGetContents h+  return cs++writeFile :: String -> String -> SIO ()+writeFile f cs = do+  h  <- openFile f IO.WriteMode+  r  <- hPutStr h cs+  return r

@@ -7,10 +7,10 @@ import System.IO  main :: IO ()-main = run $ pmain1+main = runInteraction $ pmain1 -pmain0 = forces . mapOI echo-pmain1 = forces . echos+pmain0 = forceSeq . mapOI echo+pmain1 = forceSeq . echos  eof :: Int eof = -1

@@ -11,7 +11,7 @@ import System.Directory  main :: IO ()-main = run pmain+main = runInteraction pmain  pmain :: (([String], [(Bool, IOResult [FilePath])]), ()) :-> () pmain = ((args |> head) |/| getDirCsRec) |> snd |/| putStrOI . unlines

@@ -10,7 +10,7 @@  main :: IO () main = do { kbd1:scr1:kbd2:scr2:_ <- getArgs-          ; run $ pmain (kbd1,scr1) (kbd2,scr2)+          ; runInteraction $ pmain (kbd1,scr1) (kbd2,scr2)           }  pmain ::  (FilePath,FilePath)@@ -28,10 +28,10 @@     (is,os,us) = deTriple r     ins = map ((name ++ ": ")++) $ lines $ readkbd kbd is -readkbd :: FilePath -> OI String -> String+readkbd :: FilePath -> String :-> String readkbd = iooi . readFile -showscr :: FilePath -> [String] -> OI () -> ()+showscr :: FilePath -> [String] -> () :-> () showscr s = iooi . writeFile s . unlines  mergeOI = (iooi .) . mergeIO

@@ -9,15 +9,19 @@ module Data.OI    (   -- * Export modules-   module Data.OI.Base+   module Data.OI.Internal   ,module Data.OI.Combinator+  ,module Data.OI.IFun   ,module Data.OI.IO   ,module Data.OI.Resource   ,module Data.OI.System+  ,module Data.OI.Force   ) where -import Data.OI.Base+import Data.OI.Internal import Data.OI.Combinator+import Data.OI.Force+import Data.OI.IFun import Data.OI.IO import Data.OI.Resource import Data.OI.System

@@ -1,275 +0,0 @@-{-# LANGUAGE TypeOperators-            ,ScopedTypeVariables-            ,PostfixOperators-            ,NoMonomorphismRestriction-            ,BangPatterns-  #-}-{-# OPTIONS_GHC -fno-cse #-}--- |--- Module      : Data.OI.Base--- Copyright   : (c) Nobuo Yamashita 2011-2012--- License     : BSD3--- Author      : Nobuo Yamashita--- Maintainer  : nobsun@sampou.org--- Stability   : experimental----module Data.OI.Base-  (-  -- * Interaction datatypes-   OI-  ,(:->)-  -- * Drive an interaction-  ,run-  -- * Primitive operators on OI-  ,(=:)-  ,(??)-  -- * Splitter against OI-  ,dePair-  ,deList-  ,deTriple-  ,deTuple4-  ,deTuple5-  ,deTuple6-  ,deTuple7-  ,deLeft-  ,deRight-  -- * Convert IO to interaction-  ,IOResult(..)-  ,iooi-  ,iooi'-   -- * Forcing-  ,forces-  ,force-  ,split-  )-  where--import Control.Applicative-import Control.Category-import Control.Comonad-import Control.Exception-import Control.Monad-import Control.Concurrent-import Control.Parallel-import System.IO.Unsafe-import Prelude hiding ((.),id,catch)---- | Datatype for intermediating interaction-data OI a = OI (LeftValueOf a) (RightValueOf a)---- | Interaction type-type a :-> b = OI a -> b-infixr 0 :->--instance Functor OI where-  fmap f = (##) . f . (??)--instance Monad OI where-  return = (##)-  (>>=)  = flip ($) . (??)--instance Extend OI where-  duplicate = (##)--instance Comonad OI where-  extract = (??)---- | Assign operator-(=:) :: a -> OI a -> a-(=:) !x (OI var val) = put (return x) var `pseq` val---- | Dereference operator-(??) :: OI a -> a-(??) (OI _ val) = val---- | Reference operator-(##) :: a -> OI a-(##) x = OI (unsafeNew x) x----- | Decomposer for pair-dePair :: OI (a,b) -> (OI a, OI b)-dePair (OI vxy ~(x,y)) = put io vxy `pseq` (OI vx x, OI vy y)-  where-    vx  = new x-    vy  = new y-    io  = (,) <$> lazy (deref vx) <*> lazy (deref vy)---- | Decomposer for list-deList :: OI [a] -> Maybe (OI a, OI [a])-deList (OI vxxs xxs) = put io vxxs-  `pseq` case xxs of-     x:xs -> Just (OI vx x, OI vxs xs)-     _    -> Nothing-  where-    vx  = new (undefined :: a)-    vxs = new (undefined :: [a])-    io = (:) <$> lazy (deref vx) <*> lazy (deref vxs)---- | Decomposer for triple-deTriple :: OI (a,b,c) -> (OI a, OI b, OI c)-deTriple (OI vxyz ~(x,y,z)) = put io vxyz-  `pseq` (OI vx x, OI vy y, OI vz z)-  where-    vx  = new x-    vy  = new y-    vz  = new z-    io  = (,,) <$> lazy (deref vx) -               <*> lazy (deref vy)-               <*> lazy (deref vz)---- | Decomposer for 4-tuple-deTuple4 :: OI (a,b,c,d) -> (OI a, OI b, OI c, OI d)-deTuple4 (OI vwxyz ~(w,x,y,z)) = put io vwxyz-  `pseq` (OI vw w, OI vx x, OI vy y, OI vz z)-  where-    vw  = new w-    vx  = new x-    vy  = new y-    vz  = new z-    io  = (,,,) -      <$> lazy (deref vw) -      <*> lazy (deref vx) -      <*> lazy (deref vy)-      <*> lazy (deref vz)---- | Decomposer for 5-tuple-deTuple5 :: OI (a,b,c,d,e) -> (OI a, OI b, OI c, OI d, OI e)-deTuple5 (OI vvwxyz ~(v,w,x,y,z)) = put io vvwxyz-  `pseq` (OI vv v, OI vw w, OI vx x, OI vy y, OI vz z)-  where-    vv  = new v-    vw  = new w-    vx  = new x-    vy  = new y-    vz  = new z-    io  = (,,,,) -      <$> lazy (deref vv) -      <*> lazy (deref vw) -      <*> lazy (deref vx) -      <*> lazy (deref vy)-      <*> lazy (deref vz)---- | Decomposer for 6-tuple-deTuple6 :: OI (a,b,c,d,e,f) -> (OI a, OI b, OI c, OI d, OI e, OI f)-deTuple6 (OI vuvwxyz ~(u,v,w,x,y,z)) = put io vuvwxyz-  `pseq` (OI vu u, OI vv v, OI vw w, OI vx x, OI vy y, OI vz z)-  where-    vu  = new u-    vv  = new v-    vw  = new w-    vx  = new x-    vy  = new y-    vz  = new z-    io  = (,,,,,) -      <$> lazy (deref vu) -      <*> lazy (deref vv) -      <*> lazy (deref vw) -      <*> lazy (deref vx) -      <*> lazy (deref vy)-      <*> lazy (deref vz)---- | Decomposer for 7-tuple-deTuple7 :: OI (a,b,c,d,e,f,g) -> (OI a, OI b, OI c, OI d, OI e, OI f, OI g)-deTuple7 (OI vtuvwxyz ~(t,u,v,w,x,y,z)) = put io vtuvwxyz-  `pseq` (OI vt t, OI vu u, OI vv v, OI vw w, OI vx x, OI vy y, OI vz z)-  where-    vt  = new t-    vu  = new u-    vv  = new v-    vw  = new w-    vx  = new x-    vy  = new y-    vz  = new z-    io  = (,,,,,,) -      <$> lazy (deref vt) -      <*> lazy (deref vu) -      <*> lazy (deref vv) -      <*> lazy (deref vw) -      <*> lazy (deref vx) -      <*> lazy (deref vy)-      <*> lazy (deref vz)--deLeft  :: OI (Either a b) -> Either (OI a) (OI b)-deRight :: OI (Either a b) -> Either (OI a) (OI b)--deLeft (OI ve ~(Left a)) = put io ve `pseq` Left (OI vl a)-  where-    vl = new a-    io = Left <$> lazy (deref vl)--deRight (OI ve ~(Right b)) = put io ve `pseq` Right (OI vr b)-  where-    vr = new b-    io = Right <$> lazy (deref vr)---- | Drive interaction-run :: (OI a -> b) -> IO b-run pmain = do -  { v <- newEmptyMVar-  ; x <- lazy (deref v)-  ; return $! pmain (OI v x)-  }---- | Convert IO to interaction-iooi :: IO a -> OI a -> a-iooi io (OI var val) = put io var `pseq` val--data IOResult a = Success a | Failure String--instance Functor IOResult where-  fmap f (Success x) = Success (f x)-  fmap _ (Failure s) = Failure s--instance (Show a) => Show (IOResult a) where-  show (Success x) = show x-  show (Failure s) = "Failure: "++s--iooi' :: IO a -> OI (IOResult a) -> IOResult a-iooi' io (OI var val)-  = put ( do { r <- try io-             ; case r of { Left  e -> return $ Failure (show (e :: SomeException))-                         ; Right a -> return $ Success a }}-        ) var `par` val---- | Forcing utilities--forces :: [a] -> ()-forces = force . dropWhile (()==) . map force--force :: a -> ()-force x = x `pseq` ()--split :: a -> (a,())-split x = x `pseq` (x,())---- Wrapper--type LeftValueOf  a = MVar (IO a)-type RightValueOf a = a--new :: a -> LeftValueOf a-new   = unsafeNew--deref :: MVar a -> a-deref = unsafeDeref--put   :: a -> MVar a -> a-put   = unsafePut--lazy :: IO a -> IO a-lazy = unsafeInterleaveIO---- Unsafe primitive--unsafeNew :: a -> LeftValueOf a-unsafeNew _ = unsafePerformIO newEmptyMVar--unsafeDeref :: MVar a -> a-unsafeDeref = unsafePerformIO . readMVar--unsafePut :: a -> MVar a -> a-unsafePut x v = unsafePerformIO $ do-              { s <- tryPutMVar v x-              ; if s then return x else readMVar v-              }

@@ -31,7 +31,8 @@   ,seqsOI'   ) where -import Data.OI.Base+import Data.OI.Internal+import Data.OI.Force  (|>) :: (a -> b) -> (b -> c) -> (a -> c) (|>) = flip (.)@@ -95,11 +96,9 @@  -- | Sequencing seqsOI :: [a :-> b] -> ([a] :-> ())-seqsOI s os =  forces $ zipWithOI ($) s os-+seqsOI s os =  forceSeq $ zipWithOI ($) s os  seqsOI' :: [a] :-> ([a :-> b] -> ()) seqsOI' os is = case dropWhile (()==) $ map force $ zipWithOI id is os of   [] -> ()   _  -> error "seqsOI': Impossible!"-

@@ -0,0 +1,28 @@+-- |+-- Module      : Data.OI.Force+-- Copyright   : (c) Nobuo Yamashita 2012+-- License     : BSD3+-- Author      : Nobuo Yamashita+-- Maintainer  : nobsun@sampou.org+-- Stability   : experimental+--+module Data.OI.Force (+  -- * Forcing utility functions+   force+  ,force'+  ,forceSeq+  ) where++import Control.Parallel++-- | forces sequence+forceSeq :: [a] -> ()+forceSeq = force . dropWhile (()==) . map force++-- | forces+force :: a -> ()+force x = x `pseq` ()++-- | returns forcing invoker+force' :: a -> (a,())+force' x = x `pseq` (x,())

@@ -0,0 +1,37 @@+{-# LANGUAGE TypeOperators+            ,BangPatterns+  #-}+-- |+-- Module      : Data.OI.IFun+-- Copyright   : (c) Nobuo Yamashita 2012+-- License     : BSD3+-- Author      : Nobuo Yamashita+-- Maintainer  : nobsun@sampou.org+-- Stability   : experimental+--+module Data.OI.IFun+  (+  -- * Type of function with interaction+   IFun+  -- * IFun combinator+  ,(|::|)+  ,(|->|)+  ,(|<>|)+  ) where++import Data.OI.Internal++type IFun p a b = a -> p :-> b++(|::|) :: IFun p a c -> IFun q  b d -> IFun (p,q) (a,b) (c,d)+(f |::| g) (a,b) opq = case dePair opq of+  (p,q) -> (f a p, g b q)++(|->|) :: IFun p a (b',c) -> IFun q (b',b) d -> IFun (p,q) (a,b) (c,d)+(f |->| g) (a,b) opq = case dePair opq of+  (p,q) -> case f a p of+    (b',c) -> (c, g (b',b) q)++(|<>|) :: IFun p (a',a) (b',c) -> IFun q (b',b) (a',d) -> IFun (p,q) (a,b) (c,d)+(f |<>| g) (a,b) opq = case dePair opq of+  (p,q) -> (c,d) where (b',c) = f (a',a) p; (a',d) = g (b',b) q 

@@ -9,8 +9,10 @@ -- module Data.OI.IO   (+  -- * Interaction enable to handle I/O error+   (:~>)   -- * I/O oprations-   openFile+  ,openFile   ,hIsClosed   ,hIsEOF   ,hGetLine@@ -21,37 +23,39 @@   ,putStrLn   ) where -import Data.OI.Base+import Data.OI.Internal+ import System.IO (IOMode(..),Handle) import qualified System.IO as IO import System.FilePath import Prelude hiding (getLine,putStrLn) -type a :=> b = OI (IOResult a) -> IOResult b+type a :~> b = OI (IOResult a) -> IOResult b+infixr 0 :~> -openFile :: FilePath -> IOMode -> Handle :=> Handle+openFile :: FilePath -> IOMode -> Handle :~> Handle openFile = (iooi' .) . IO.openFile -hIsClosed :: IO.Handle -> Bool :=> Bool+hIsClosed :: IO.Handle -> Bool :~> Bool hIsClosed = iooi' . IO.hIsClosed -hIsEOF :: IO.Handle -> Bool :=> Bool+hIsEOF :: IO.Handle -> Bool :~> Bool hIsEOF = iooi' . IO.hIsEOF -hGetLine :: IO.Handle -> String :=> String+hGetLine :: IO.Handle -> String :~> String hGetLine = iooi' . IO.hGetLine -hClose :: IO.Handle -> () :=> ()+hClose :: IO.Handle -> () :~> () hClose = iooi' . IO.hClose -hPutStrLn :: IO.Handle -> String -> () :=> ()+hPutStrLn :: IO.Handle -> String -> () :~> () hPutStrLn = (iooi' .) . IO.hPutStrLn -isEOF :: Bool :=> Bool+isEOF :: Bool :~> Bool isEOF = iooi' IO.isEOF -getLine :: String :=> String+getLine :: String :~> String getLine = iooi' IO.getLine -putStrLn :: String -> () :=> ()+putStrLn :: String -> () :~> () putStrLn = iooi' . IO.putStrLn

@@ -0,0 +1,263 @@+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE PostfixOperators #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# OPTIONS_GHC -fno-cse #-}+-- |+-- Module      : Data.OI.Base+-- Copyright   : (c) Nobuo Yamashita 2011-2012+-- License     : BSD3+-- Author      : Nobuo Yamashita+-- Maintainer  : nobsun@sampou.org+-- Stability   : experimental+--+module Data.OI.Internal+  (+   -- * Types+   OI+  ,(:->)+  -- * Primitive operators on OI+  ,(??)+  -- * Splitters against `OI' datatype+  ,dePair+  ,deList+  ,deTriple+  ,deTuple4+  ,deTuple5+  ,deTuple6+  ,deTuple7+  ,deLeft+  ,deRight+  -- * Interaction driver+  ,runInteraction+  -- * IO converters+  ,IOResult(..)+  ,iooi+  ,iooi'+  ) +  where++import Control.Applicative+import Control.Category+import Control.Comonad+import Control.Exception+import Control.Monad+import Control.Concurrent+import Control.Parallel+import System.IO.Unsafe+import Prelude hiding ((.),id,catch)++-- | Datatype for intermediating interaction: +-- @OI@ has two states, non-expressed and exressed. +-- `Non-expressed' indicates that no computation is assigned.+-- In other words, it's value is never denotated by any expression.+-- So, if you refer the value then the process will be suspended +-- until other process determins the value.+-- Non-expressed value can be determined to become 'expressed' for a value by a expression at most once.+-- `Expressed' indicates that some computation is assigned for the value.+-- And expressed values are never changed.+data OI a = OI (LeftValueOf a) (RightValueOf a)++-- | Interaction (a function from a intermediating type to another type) type+type a :-> b = OI a -> b+infixr 0 :->++instance Functor OI where+  fmap f = (##) . f . (??)++instance Monad OI where+  return = (##)+  (>>=)  = flip ($) . (??)++instance Extend OI where+  duplicate = (##)++instance Comonad OI where+  extract = (??)++-- | Dereference operator+(??) :: OI a -> a+(??) (OI _ val) = val++-- | Reference operator+(##) :: a -> OI a+(##) x = OI (unsafeNew x) x++-- | Decomposer for pair+dePair :: OI (a,b) -> (OI a, OI b)+dePair (OI vxy ~(x,y)) = put io vxy `pseq` (OI vx x, OI vy y)+  where+    vx  = new x+    vy  = new y+    io  = (,) <$> lazy (deref vx) <*> lazy (deref vy)++-- | Decomposer for list+deList :: OI [a] -> Maybe (OI a, OI [a])+deList (OI vxxs xxs) = put io vxxs+  `pseq` case xxs of+     x:xs -> Just (OI vx x, OI vxs xs)+     _    -> Nothing+  where+    vx  = new (undefined :: a)+    vxs = new (undefined :: [a])+    io = (:) <$> lazy (deref vx) <*> lazy (deref vxs)++-- | Decomposer for triple+deTriple :: OI (a,b,c) -> (OI a, OI b, OI c)+deTriple (OI vxyz ~(x,y,z)) = put io vxyz+  `pseq` (OI vx x, OI vy y, OI vz z)+  where+    vx  = new x+    vy  = new y+    vz  = new z+    io  = (,,) <$> lazy (deref vx) +               <*> lazy (deref vy)+               <*> lazy (deref vz)++-- | Decomposer for 4-tuple+deTuple4 :: OI (a,b,c,d) -> (OI a, OI b, OI c, OI d)+deTuple4 (OI vwxyz ~(w,x,y,z)) = put io vwxyz+  `pseq` (OI vw w, OI vx x, OI vy y, OI vz z)+  where+    vw  = new w+    vx  = new x+    vy  = new y+    vz  = new z+    io  = (,,,) +      <$> lazy (deref vw) +      <*> lazy (deref vx) +      <*> lazy (deref vy)+      <*> lazy (deref vz)++-- | Decomposer for 5-tuple+deTuple5 :: OI (a,b,c,d,e) -> (OI a, OI b, OI c, OI d, OI e)+deTuple5 (OI vvwxyz ~(v,w,x,y,z)) = put io vvwxyz+  `pseq` (OI vv v, OI vw w, OI vx x, OI vy y, OI vz z)+  where+    vv  = new v+    vw  = new w+    vx  = new x+    vy  = new y+    vz  = new z+    io  = (,,,,) +      <$> lazy (deref vv) +      <*> lazy (deref vw) +      <*> lazy (deref vx) +      <*> lazy (deref vy)+      <*> lazy (deref vz)++-- | Decomposer for 6-tuple+deTuple6 :: OI (a,b,c,d,e,f) -> (OI a, OI b, OI c, OI d, OI e, OI f)+deTuple6 (OI vuvwxyz ~(u,v,w,x,y,z)) = put io vuvwxyz+  `pseq` (OI vu u, OI vv v, OI vw w, OI vx x, OI vy y, OI vz z)+  where+    vu  = new u+    vv  = new v+    vw  = new w+    vx  = new x+    vy  = new y+    vz  = new z+    io  = (,,,,,) +      <$> lazy (deref vu) +      <*> lazy (deref vv) +      <*> lazy (deref vw) +      <*> lazy (deref vx) +      <*> lazy (deref vy)+      <*> lazy (deref vz)++-- | Decomposer for 7-tuple+deTuple7 :: OI (a,b,c,d,e,f,g) -> (OI a, OI b, OI c, OI d, OI e, OI f, OI g)+deTuple7 (OI vtuvwxyz ~(t,u,v,w,x,y,z)) = put io vtuvwxyz+  `pseq` (OI vt t, OI vu u, OI vv v, OI vw w, OI vx x, OI vy y, OI vz z)+  where+    vt  = new t+    vu  = new u+    vv  = new v+    vw  = new w+    vx  = new x+    vy  = new y+    vz  = new z+    io  = (,,,,,,) +      <$> lazy (deref vt) +      <*> lazy (deref vu) +      <*> lazy (deref vv) +      <*> lazy (deref vw) +      <*> lazy (deref vx) +      <*> lazy (deref vy)+      <*> lazy (deref vz)++deLeft  :: OI (Either a b) -> Either (OI a) (OI b)+deLeft (OI ve ~(Left a)) = put io ve `pseq` Left (OI vl a)+  where+    vl = new a+    io = Left <$> lazy (deref vl)++deRight :: OI (Either a b) -> Either (OI a) (OI b)+deRight (OI ve ~(Right b)) = put io ve `pseq` Right (OI vr b)+  where+    vr = new b+    io = Right <$> lazy (deref vr)++-- | Drive interaction+runInteraction :: (OI a -> b) -> IO b+runInteraction pmain = do +  { v <- newEmptyMVar+  ; x <- lazy (deref v)+  ; return $! pmain (OI v x)+  }++-- | @IOResult@ for error handling+data IOResult a = Success { result :: a }+                | Failure { errmsg :: String }++instance (Show a) => Show (IOResult a) where+  show (Success x) = show x+  show (Failure e) = e++instance Functor IOResult where+  fmap f (Success x) = Success (f x)+  fmap _ (Failure e) = Failure e++-- | Convert IO to interaction+iooi :: IO a -> OI a -> a+iooi io (OI var val) = put io var `pseq` val++iooi' :: IO a -> OI (IOResult a) -> IOResult a+iooi' io (OI var val)+  = put ( do { r <- try io+             ; case r of { Left  e -> return $ Failure (show (e :: SomeException))+                         ; Right a -> return $ Success a }}+        ) var `par` val++-- Wrapper++type LeftValueOf  a = MVar (IO a)+type RightValueOf a = a++new :: a -> LeftValueOf a+new   = unsafeNew++deref :: MVar a -> a+deref = unsafeDeref++put   :: a -> MVar a -> a+put   = unsafePut++lazy :: IO a -> IO a+lazy = unsafeInterleaveIO++-- Unsafe primitive++unsafeNew :: a -> LeftValueOf a+unsafeNew _ = unsafePerformIO newEmptyMVar++unsafeDeref :: MVar a -> a+unsafeDeref = unsafePerformIO . readMVar++unsafePut :: a -> MVar a -> a+unsafePut x v = unsafePerformIO $ do+              { s <- tryPutMVar v x+              ; if s then return x else readMVar v+              }+

@@ -18,13 +18,15 @@   ,mapR   ,mapR'   ,filterR+  ,filterR'   ,takeR   ,takeR'   ,takeWhileR+  ,takeWhileR'   ) where  import Control.Exception-import Data.OI.Base+import Data.OI.Internal import System.IO (IOMode(..)) import qualified System.IO as IO import System.IO.Unsafe

@@ -10,7 +10,7 @@  where  import System.Environment-import Data.OI.Base+import Data.OI.Internal  args :: [String] :-> [String] args = iooi getArgs