module Transient.Stream.Resource(sourceFile, sinkFile, process, initFinish, finish,unFinish, onFinish) where
import Transient.Base hiding (loop)
import Transient.EVars
import Control.Exception
import Control.Applicative
import Data.Typeable
import Data.Char
import System.IO
import Control.Concurrent
import Control.Concurrent.STM
import Control.Monad.State
sinkFile :: TransIO String -> String -> TransIO ()
sinkFile input file= process input (openFile file WriteMode) hClose' hPutStrLn'
where
hClose' h _= putStr "closing " >> putStrLn file >> hClose h
hPutStrLn' h x= liftIO $ (SMore <$> hPutStrLn h x)
`catch` (\(e::SomeException)-> return $ SError e)
sourceFile :: String -> TransIO String
sourceFile file= process (return ()) (openFile file ReadMode) hClose' read'
where
hGetLine' h= (SMore <$> hGetLine h)
`catch` (\(e::SomeException)-> return $ SError e)
read' h _ = parallel $ hGetLine' h
hClose' h _= putStr "closing ">> putStrLn file >> hClose h
process
:: TransIO a
-> IO handle
-> (handle -> FinishReason -> IO ())
-> (handle -> a -> TransIO (StreamData b))
-> TransIO b
process input open close proc=do
mh <- liftIO $ (Right <$> open) `catch` (\(e::SomeException)-> return $ Left e)
case mh of
Left e -> liftIO (putStr "process: " >> print e) >> finish (Just e) >> stop
Right h -> do
onFinish (liftIO . close h)
some <- input
v <- proc h some
liftIO $ myThreadId >>= print
checkFinalize v
type FinishReason= Maybe SomeException
checkFinalize v=
case v of
SDone -> finish Nothing >> stop
SLast x -> finish Nothing >> return x
SError e -> liftIO ( print e) >> finish Nothing >> stop
SMore x -> return x
data Finish= Finish (EVar FinishReason) deriving Typeable
initFinish :: TransIO Finish
initFinish= do
fin <- newEVar
let f = Finish fin
setSData f
return f
onFinish :: (FinishReason ->TransIO ()) -> TransIO ()
onFinish close= do
Finish finish <- getSData <|> initFinish
e <- readEVar finish
close e
stop
<|> return()
finish :: FinishReason -> TransIO ()
finish e= do
liftIO $ putStrLn "finish Called"
Finish finish <- getSData
writeEVar finish e
unFinish= do
Finish fin <- getSData
delEVar fin
<|> return ()