{-# OPTIONS_GHC -XFlexibleInstances -XTypeSynonymInstances #-}
module HSH.Channel (Channel(..),
chanAsString,
chanAsBSL,
chanAsBS,
chanToHandle,
Channelizable(..)
) where
import qualified Data.ByteString.Lazy as BSL
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy.Char8 as BSLC
import System.IO
import Control.Concurrent
data Channel = ChanString String
| ChanBSL BSL.ByteString
| ChanHandle Handle
chanAsString :: Channel -> IO String
chanAsString :: Channel -> IO String
chanAsString (ChanString String
s) = forall (m :: * -> *) a. Monad m => a -> m a
return String
s
chanAsString (ChanBSL ByteString
s) = forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
bsl2str forall a b. (a -> b) -> a -> b
$ ByteString
s
chanAsString (ChanHandle Handle
h) = Handle -> IO String
hGetContents Handle
h
chanAsBSL :: Channel -> IO BSL.ByteString
chanAsBSL :: Channel -> IO ByteString
chanAsBSL (ChanString String
s) = forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
str2bsl forall a b. (a -> b) -> a -> b
$ String
s
chanAsBSL (ChanBSL ByteString
s) = forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
s
chanAsBSL (ChanHandle Handle
h) = Handle -> IO ByteString
BSL.hGetContents Handle
h
chanAsBS :: Channel -> IO BS.ByteString
chanAsBS :: Channel -> IO ByteString
chanAsBS Channel
c = do ByteString
r <- Channel -> IO ByteString
chanAsBSL Channel
c
let contents :: [ByteString]
contents = ByteString -> [ByteString]
BSL.toChunks ByteString
r
forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> ByteString
BS.concat forall a b. (a -> b) -> a -> b
$ [ByteString]
contents
chanToHandle :: Bool -> Channel -> Handle -> IO ()
chanToHandle :: Bool -> Channel -> Handle -> IO ()
chanToHandle Bool
close Channel
c Handle
h = if Bool
close then IO () -> IO ThreadId
forkIO (Channel -> Handle -> IO ()
dumpChanToHandle Channel
c Handle
h forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> IO ()
hClose Handle
h) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ()
else Channel -> Handle -> IO ()
dumpChanToHandle Channel
c Handle
h
where dumpChanToHandle :: Channel -> Handle -> IO ()
dumpChanToHandle (ChanString String
s) Handle
h = Handle -> String -> IO ()
hPutStr Handle
h String
s
dumpChanToHandle (ChanBSL ByteString
s) Handle
h = Handle -> ByteString -> IO ()
BSL.hPut Handle
h ByteString
s
dumpChanToHandle (ChanHandle Handle
srchdl) Handle
desthdl
= Handle -> IO ByteString
BSL.hGetContents Handle
srchdl forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Handle -> ByteString -> IO ()
BSL.hPut Handle
desthdl
class Channelizable a where
toChannel :: a -> Channel
instance Channelizable String where
toChannel :: String -> Channel
toChannel = String -> Channel
ChanString
instance Channelizable BSL.ByteString where
toChannel :: ByteString -> Channel
toChannel = ByteString -> Channel
ChanBSL
instance Channelizable Handle where
toChannel :: Handle -> Channel
toChannel = Handle -> Channel
ChanHandle
instance Channelizable BS.ByteString where
toChannel :: ByteString -> Channel
toChannel ByteString
bs = ByteString -> Channel
ChanBSL forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> ByteString
BSL.fromChunks forall a b. (a -> b) -> a -> b
$ [ByteString
bs]
str2bsl :: String -> BSL.ByteString
str2bsl :: String -> ByteString
str2bsl = String -> ByteString
BSLC.pack
bsl2str :: BSL.ByteString -> String
bsl2str :: ByteString -> String
bsl2str = ByteString -> String
BSLC.unpack