    {-# 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 s :: String
    s) = String -> IO String
    forall (m :: * -> *) a. Monad m => a -> m a
    return String
    s
    chanAsString (ChanBSL s :: ByteString
    s) = String -> IO String
    forall (m :: * -> *) a. Monad m => a -> m a
    return (String -> IO String)
    -> (ByteString -> String) -> ByteString -> IO String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> String
    bsl2str (ByteString -> IO String) -> ByteString -> IO String
    forall a b. (a -> b) -> a -> b
    $ ByteString
    s
    chanAsString (ChanHandle h :: Handle
    h) = Handle -> IO String
    hGetContents Handle
    h

    chanAsBSL :: Channel -> IO BSL.ByteString
    chanAsBSL :: Channel -> IO ByteString
    chanAsBSL (ChanString s :: String
    s) = ByteString -> IO ByteString
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ByteString -> IO ByteString)
    -> (String -> ByteString) -> String -> IO ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ByteString
    str2bsl (String -> IO ByteString) -> String -> IO ByteString
    forall a b. (a -> b) -> a -> b
    $ String
    s
    chanAsBSL (ChanBSL s :: ByteString
    s) = ByteString -> IO ByteString
    forall (m :: * -> *) a. Monad m => a -> m a
    return ByteString
    s
    chanAsBSL (ChanHandle h :: Handle
    h) = Handle -> IO ByteString
    BSL.hGetContents Handle
    h

    chanAsBS :: Channel -> IO BS.ByteString
    chanAsBS :: Channel -> IO ByteString
    chanAsBS c :: Channel
    c = do ByteString
    r <- Channel -> IO ByteString
    chanAsBSL Channel
    c
                    let contents :: [ByteString]
    contents = ByteString -> [ByteString]
    BSL.toChunks ByteString
    r
                    ByteString -> IO ByteString
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ByteString -> IO ByteString)
    -> ([ByteString] -> ByteString) -> [ByteString] -> IO ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [ByteString] -> ByteString
    BS.concat ([ByteString] -> IO ByteString) -> [ByteString] -> IO ByteString
    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 close :: Bool
    close c :: Channel
    c h :: Handle
    h = if Bool
    close then IO () -> IO ThreadId
    forkIO (Channel -> Handle -> IO ()
    dumpChanToHandle Channel
    c Handle
    h IO () -> IO () -> IO ()
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Handle -> IO ()
    hClose Handle
    h) IO ThreadId -> IO () -> IO ()
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> () -> IO ()
    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 s :: String
    s) h :: Handle
    h = Handle -> String -> IO ()
    hPutStr Handle
    h String
    s
             dumpChanToHandle (ChanBSL s :: ByteString
    s) h :: Handle
    h = Handle -> ByteString -> IO ()
    BSL.hPut Handle
    h ByteString
    s
             dumpChanToHandle (ChanHandle srchdl :: Handle
    srchdl) desthdl :: Handle
    desthdl
                  = Handle -> IO ByteString
    BSL.hGetContents Handle
    srchdl IO ByteString -> (ByteString -> IO ()) -> IO ()
    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 bs :: ByteString
    bs = ByteString -> Channel
    ChanBSL (ByteString -> Channel)
    -> ([ByteString] -> ByteString) -> [ByteString] -> Channel
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [ByteString] -> ByteString
    BSL.fromChunks ([ByteString] -> Channel) -> [ByteString] -> Channel
    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