{-# OPTIONS_GHC -XFlexibleInstances -XTypeSynonymInstances #-}

{- Channel basics for HSH
Copyright (C) 2004-2008 John Goerzen <jgoerzen@complete.org>
Please see the COPYRIGHT file
-}

{- |
   Module     : HSH.Channel
   Copyright  : Copyright (C) 2006-2009 John Goerzen
   License    : GNU LGPL, version 2.1 or above

   Maintainer : John Goerzen <jgoerzen@complete.org>
   Stability  : provisional
   Portability: portable

Copyright (c) 2006-2009 John Goerzen, jgoerzen\@complete.org
-}

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

{- | The main type for communicating between commands.  All are expected to
be lazy. -}
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

{- | Writes the Channel to the given Handle. If the first parameter is True,
     do this in a separate thread and close the handle afterwards.
-}
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