{-# LANGUAGE CPP #-}
{-# LANGUAGE Rank2Types #-}
module System.IO.Machine where

#if !MIN_VERSION_base(4,8,0)
import Control.Applicative ((<$>))
#endif
import Control.Monad.IO.Class (MonadIO, liftIO)
import Data.IOData (IOData, hGetChunk, hGetLine, hPut, hPutStrLn)
import Data.Machine
import Data.Word (Word8)
import System.IO (Handle, hIsEOF)

import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BSC8

type DataModeIO m a = MonadIO m => ((Handle -> m a), (Handle -> a -> m ()))
type SinkIO m k = MonadIO m => forall a. ProcessT m k a
type SourceIO m a = MonadIO m => forall k. MachineT m k a

type IODataMode a = ((Handle -> IO a), (Handle -> a -> IO ()))
type IOSink k = forall a. ProcessT IO k a
type IOSource a = forall k. MachineT IO k a

byChar :: IODataMode Char
byChar :: IODataMode Char
byChar = (\Handle
h -> ByteString -> Char
BSC8.head (ByteString -> Char) -> IO ByteString -> IO Char
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Handle -> Int -> IO ByteString
BSC8.hGet Handle
h Int
1, \Handle
h Char
w -> Handle -> ByteString -> IO ()
BSC8.hPut Handle
h (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> ByteString
BSC8.pack [Char
w])

byChunk ::  IOData a => IODataMode a
byChunk :: IODataMode a
byChunk = (\Handle
h -> Handle -> IO a
forall a (m :: * -> *). (IOData a, MonadIO m) => Handle -> m a
hGetChunk Handle
h, \Handle
h a
xs -> Handle -> a -> IO ()
forall a (m :: * -> *).
(IOData a, MonadIO m) =>
Handle -> a -> m ()
hPut Handle
h a
xs)

byChunkOf :: Int -> IODataMode BS.ByteString
byChunkOf :: Int -> IODataMode ByteString
byChunkOf Int
n = (\Handle
h -> Handle -> Int -> IO ByteString
BS.hGet Handle
h Int
n, \Handle
h ByteString
xs -> Handle -> ByteString -> IO ()
BS.hPut Handle
h ByteString
xs)

byWord8 :: IODataMode Word8
byWord8 :: IODataMode Word8
byWord8 = (\Handle
h -> ByteString -> Word8
BS.head (ByteString -> Word8) -> IO ByteString -> IO Word8
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Handle -> Int -> IO ByteString
BS.hGet Handle
h Int
1, \Handle
h Word8
w -> Handle -> ByteString -> IO ()
BS.hPut Handle
h (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ [Word8] -> ByteString
BS.pack [Word8
w])

byLine :: IOData a => DataModeIO m a
byLine :: (Handle -> m a, Handle -> a -> m ())
byLine = (Handle -> m a
forall a (m :: * -> *). (IOData a, MonadIO m) => Handle -> m a
hGetLine, Handle -> a -> m ()
forall a (m :: * -> *).
(IOData a, MonadIO m) =>
Handle -> a -> m ()
hPutStrLn)

sourceIO :: IO a -> SourceIO m a
sourceIO :: IO a -> SourceIO m a
sourceIO IO a
f = PlanT k a m () -> MachineT m k a
forall (m :: * -> *) (k :: * -> *) o a.
Monad m =>
PlanT k o m a -> MachineT m k o
repeatedly (PlanT k a m () -> MachineT m k a)
-> PlanT k a m () -> MachineT m k a
forall a b. (a -> b) -> a -> b
$ IO a -> PlanT k a m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO a
f PlanT k a m a -> (a -> PlanT k a m ()) -> PlanT k a m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> PlanT k a m ()
forall o (k :: * -> *). o -> Plan k o ()
yield

sourceHandle :: DataModeIO m a -> Handle -> SourceIO m a
sourceHandle :: DataModeIO m a -> Handle -> SourceIO m a
sourceHandle (r, _) = (Handle -> m a) -> Handle -> SourceIO m a
forall (m :: * -> *) a. (Handle -> m a) -> Handle -> SourceIO m a
sourceHandleWith Handle -> m a
r

sourceIOWith :: m r -> (r -> m Bool) -> (r -> m a) -> SourceIO m a
sourceIOWith :: m r -> (r -> m Bool) -> (r -> m a) -> SourceIO m a
sourceIOWith m r
acquire r -> m Bool
release r -> m a
read' = m (Step k a (MachineT m k a)) -> MachineT m k a
forall (m :: * -> *) (k :: * -> *) o.
m (Step k o (MachineT m k o)) -> MachineT m k o
MachineT (m (Step k a (MachineT m k a)) -> MachineT m k a)
-> m (Step k a (MachineT m k a)) -> MachineT m k a
forall a b. (a -> b) -> a -> b
$ do
  r
r         <- m r
acquire
  Bool
released  <- r -> m Bool
release r
r
  if Bool
released then
    Step k a (MachineT m k a) -> m (Step k a (MachineT m k a))
forall (m :: * -> *) a. Monad m => a -> m a
return Step k a (MachineT m k a)
forall (k :: * -> *) o r. Step k o r
Stop
  else do
    a
x <- r -> m a
read' r
r
    Step k a (MachineT m k a) -> m (Step k a (MachineT m k a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step k a (MachineT m k a) -> m (Step k a (MachineT m k a)))
-> (MachineT m k a -> Step k a (MachineT m k a))
-> MachineT m k a
-> m (Step k a (MachineT m k a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> MachineT m k a -> Step k a (MachineT m k a)
forall (k :: * -> *) o r. o -> r -> Step k o r
Yield a
x (MachineT m k a -> m (Step k a (MachineT m k a)))
-> MachineT m k a -> m (Step k a (MachineT m k a))
forall a b. (a -> b) -> a -> b
$ m r -> (r -> m Bool) -> (r -> m a) -> SourceIO m a
forall (m :: * -> *) r a.
m r -> (r -> m Bool) -> (r -> m a) -> SourceIO m a
sourceIOWith m r
acquire r -> m Bool
release r -> m a
read'

sourceHandleWith :: (Handle -> m a) -> Handle -> SourceIO m a
sourceHandleWith :: (Handle -> m a) -> Handle -> SourceIO m a
sourceHandleWith Handle -> m a
f Handle
h = m Handle -> (Handle -> m Bool) -> (Handle -> m a) -> SourceIO m a
forall (m :: * -> *) r a.
m r -> (r -> m Bool) -> (r -> m a) -> SourceIO m a
sourceIOWith (Handle -> m Handle
forall (m :: * -> *) a. Monad m => a -> m a
return Handle
h) (IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> (Handle -> IO Bool) -> Handle -> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> IO Bool
hIsEOF) Handle -> m a
f

sinkIO :: (a -> IO ()) -> SinkIO m a
sinkIO :: (a -> IO ()) -> SinkIO m a
sinkIO a -> IO ()
f = PlanT (Is a) a m () -> MachineT m (Is a) a
forall (m :: * -> *) (k :: * -> *) o a.
Monad m =>
PlanT k o m a -> MachineT m k o
repeatedly (PlanT (Is a) a m () -> MachineT m (Is a) a)
-> PlanT (Is a) a m () -> MachineT m (Is a) a
forall a b. (a -> b) -> a -> b
$ PlanT (Is a) a m a
forall (k :: * -> * -> *) i o. Category k => Plan (k i) o i
await PlanT (Is a) a m a
-> (a -> PlanT (Is a) a m ()) -> PlanT (Is a) a m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO () -> PlanT (Is a) a m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> PlanT (Is a) a m ())
-> (a -> IO ()) -> a -> PlanT (Is a) a m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> IO ()
f

sinkHandle :: IODataMode a -> Handle -> SinkIO m a
sinkHandle :: IODataMode a -> Handle -> SinkIO m a
sinkHandle (Handle -> IO a
_, Handle -> a -> IO ()
w) Handle
h = PlanT (Is a) a m () -> MachineT m (Is a) a
forall (m :: * -> *) (k :: * -> *) o a.
Monad m =>
PlanT k o m a -> MachineT m k o
repeatedly (PlanT (Is a) a m () -> MachineT m (Is a) a)
-> PlanT (Is a) a m () -> MachineT m (Is a) a
forall a b. (a -> b) -> a -> b
$ PlanT (Is a) a m a
forall (k :: * -> * -> *) i o. Category k => Plan (k i) o i
await PlanT (Is a) a m a
-> (a -> PlanT (Is a) a m ()) -> PlanT (Is a) a m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO () -> PlanT (Is a) a m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> PlanT (Is a) a m ())
-> (a -> IO ()) -> a -> PlanT (Is a) a m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> a -> IO ()
w Handle
h

sinkHandleWith :: (Handle -> a -> IO ()) -> Handle -> SinkIO m a
sinkHandleWith :: (Handle -> a -> IO ()) -> Handle -> SinkIO m a
sinkHandleWith Handle -> a -> IO ()
f Handle
h = PlanT (Is a) a m () -> MachineT m (Is a) a
forall (m :: * -> *) (k :: * -> *) o a.
Monad m =>
PlanT k o m a -> MachineT m k o
repeatedly (PlanT (Is a) a m () -> MachineT m (Is a) a)
-> PlanT (Is a) a m () -> MachineT m (Is a) a
forall a b. (a -> b) -> a -> b
$ PlanT (Is a) a m a
forall (k :: * -> * -> *) i o. Category k => Plan (k i) o i
await PlanT (Is a) a m a
-> (a -> PlanT (Is a) a m ()) -> PlanT (Is a) a m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO () -> PlanT (Is a) a m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> PlanT (Is a) a m ())
-> (a -> IO ()) -> a -> PlanT (Is a) a m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> a -> IO ()
f Handle
h

filteredIO :: (a -> IO Bool) -> ProcessT IO a a
filteredIO :: (a -> IO Bool) -> ProcessT IO a a
filteredIO a -> IO Bool
p = PlanT (Is a) a IO () -> ProcessT IO a a
forall (m :: * -> *) (k :: * -> *) o a.
Monad m =>
PlanT k o m a -> MachineT m k o
repeatedly (PlanT (Is a) a IO () -> ProcessT IO a a)
-> PlanT (Is a) a IO () -> ProcessT IO a a
forall a b. (a -> b) -> a -> b
$ do
  a
i <- PlanT (Is a) a IO a
forall (k :: * -> * -> *) i o. Category k => Plan (k i) o i
await
  Bool
x <- IO Bool -> PlanT (Is a) a IO Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> PlanT (Is a) a IO Bool)
-> IO Bool -> PlanT (Is a) a IO Bool
forall a b. (a -> b) -> a -> b
$ a -> IO Bool
p a
i
  if Bool
x then a -> Plan (Is a) a ()
forall o (k :: * -> *). o -> Plan k o ()
yield a
i else () -> PlanT (Is a) a IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

printer :: Show a => SinkIO m a
printer :: forall a. ProcessT m a a
printer = (a -> IO ()) -> SinkIO m a
forall a (m :: * -> *). (a -> IO ()) -> SinkIO m a
sinkIO ((a -> IO ()) -> SinkIO m a) -> (a -> IO ()) -> SinkIO m a
forall a b. (a -> b) -> a -> b
$ IO () -> IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IO ()) -> (a -> IO ()) -> a -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> IO ()
forall a. Show a => a -> IO ()
print