module Transient.Stream.Resource(sourceFile, sinkFile, process, finish, onFinish) where
import Transient.Base hiding (loop)
import Transient.EVars
import Control.Exception
import Control.Applicative
import Control.Monad.IO.Class
import Data.Typeable
import Data.Char
import System.IO
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 (show 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(show e))
read' h _ = parallel $ hGetLine' h
hClose' h= putStr "closing ">> putStrLn file >> hClose h
process
:: TransIO a
-> IO handle
-> (handle -> IO ())
-> (handle -> a -> TransIO (StreamData b))
-> TransIO b
process input open close process=do
mh <- liftIO $ (Right <$> open) `catch` (\(e::SomeException)-> return $ Left e)
case mh of
Left e -> liftIO (putStr "process: " >> print e) >> finish >> stop
Right h -> do
onFinish (liftIO (close h) >> killChilds >> stop) <|> return()
some <- input
process' h some
where
process' h something = do
v <- process h something
checkFinalize v
checkFinalize v=
case v of
SDone -> finish >> stop
SLast x -> finish >> return x
SError e -> liftIO ( putStrLn e) >> finish >> stop
SMore x -> return x
newtype Finish= Finish (EVar Bool) deriving Typeable
initFinish :: TransIO Finish
initFinish= do
fin <- newEVar
let f = Finish fin
setSData f
return f
onFinish :: TransIO () -> TransIO a
onFinish close= do
Finish finish <- getSData <|> initFinish
readEVar finish
close
stop
finish :: TransIO ()
finish = do
liftIO $ putStrLn "finish Called"
Finish finish <- getSData
writeEVar finish True