{- |
Copyright: 2009, Henning Thielemann

Unified interface to String and ByteStrings.
-}
module Network.MoHWS.Stream where

import Network.MoHWS.ParserUtility (crLf, )

import qualified System.IO as IO
import Numeric (showHex, )

import qualified Network.MoHWS.ByteString as BU
import qualified Data.ByteString.Lazy.Char8 as BL
import qualified Data.ByteString.Char8 as BS

import qualified Data.List.HT as ListHT
import qualified Data.List    as List
import Data.Monoid (Monoid, )

import Prelude hiding (length, drop, )


class Monoid stream => C stream where
   fromString :: Int -> String -> stream
   toString :: stream -> String
   isEmpty :: stream -> Bool
   length :: stream -> Integer
   isPrefixOf :: stream -> stream -> Bool
   break :: (Char -> Bool) -> stream -> (stream, stream)
   drop :: Int -> stream -> stream
   read :: IO.Handle -> Integer -> IO stream
   readAll :: Int -> IO.Handle -> IO stream
   write :: IO.Handle -> stream -> IO ()
   writeChunked :: Int -> IO.Handle -> stream -> IO ()

class Eq char => CharType char where
   fromChar :: Char -> char
   toChar   :: char -> Char

instance CharType Char where
   fromChar :: Char -> Char
fromChar = Char -> Char
forall a. a -> a
id
   toChar :: Char -> Char
toChar   = Char -> Char
forall a. a -> a
id

instance CharType char => C [char] where
   fromString :: Int -> String -> [char]
fromString Int
_chunkSize = (Char -> char) -> String -> [char]
forall a b. (a -> b) -> [a] -> [b]
map Char -> char
forall char. CharType char => Char -> char
fromChar
   toString :: [char] -> String
toString = (char -> Char) -> [char] -> String
forall a b. (a -> b) -> [a] -> [b]
map char -> Char
forall char. CharType char => char -> Char
toChar
   isEmpty :: [char] -> Bool
isEmpty = [char] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null
   length :: [char] -> Integer
length = Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Integer) -> ([char] -> Int) -> [char] -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [char] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
List.length
   isPrefixOf :: [char] -> [char] -> Bool
isPrefixOf = [char] -> [char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
List.isPrefixOf
   break :: (Char -> Bool) -> [char] -> ([char], [char])
break Char -> Bool
p = (char -> Bool) -> [char] -> ([char], [char])
forall a. (a -> Bool) -> [a] -> ([a], [a])
List.break (Char -> Bool
p (Char -> Bool) -> (char -> Char) -> char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. char -> Char
forall char. CharType char => char -> Char
toChar)
   drop :: Int -> [char] -> [char]
drop = Int -> [char] -> [char]
forall a. Int -> [a] -> [a]
List.drop
   read :: Handle -> Integer -> IO [char]
read Handle
h Integer
n = (String -> [char]) -> IO String -> IO [char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Char -> char) -> String -> [char]
forall a b. (a -> b) -> [a] -> [b]
map Char -> char
forall char. CharType char => Char -> char
fromChar) (IO String -> IO [char]) -> IO String -> IO [char]
forall a b. (a -> b) -> a -> b
$ Handle -> Int -> IO String
BU.hGetChars Handle
h (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
n)
   readAll :: Int -> Handle -> IO [char]
readAll Int
_chunkSize = (String -> [char]) -> IO String -> IO [char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Char -> char) -> String -> [char]
forall a b. (a -> b) -> [a] -> [b]
map Char -> char
forall char. CharType char => Char -> char
fromChar) (IO String -> IO [char])
-> (Handle -> IO String) -> Handle -> IO [char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> IO String
IO.hGetContents
   write :: Handle -> [char] -> IO ()
write Handle
h = Handle -> String -> IO ()
IO.hPutStr Handle
h (String -> IO ()) -> ([char] -> String) -> [char] -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (char -> Char) -> [char] -> String
forall a b. (a -> b) -> [a] -> [b]
map char -> Char
forall char. CharType char => char -> Char
toChar
   writeChunked :: Int -> Handle -> [char] -> IO ()
writeChunked Int
chunkSize Handle
h =
      Handle -> String -> IO ()
IO.hPutStr Handle
h (String -> IO ()) -> ([char] -> String) -> [char] -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      ((String -> String) -> String -> String)
-> String -> [String -> String] -> String
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
($) String
"" ([String -> String] -> String)
-> ([char] -> [String -> String]) -> [char] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      ([char] -> String -> String) -> [[char]] -> [String -> String]
forall a b. (a -> b) -> [a] -> [b]
map (\[char]
chunk ->
              Integer -> String -> String
forall a. (Integral a, Show a) => a -> String -> String
showHex ([char] -> Integer
forall stream. C stream => stream -> Integer
length [char]
chunk) (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
showString String
crLf (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
              String -> String -> String
showString ((char -> Char) -> [char] -> String
forall a b. (a -> b) -> [a] -> [b]
map char -> Char
forall char. CharType char => char -> Char
toChar [char]
chunk) (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
showString String
crLf) ([[char]] -> [String -> String])
-> ([char] -> [[char]]) -> [char] -> [String -> String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      Int -> [char] -> [[char]]
forall a. Int -> [a] -> [[a]]
ListHT.sliceVertical Int
chunkSize

instance C BL.ByteString where
--   fromString = BL.pack
   fromString :: Int -> String -> ByteString
fromString Int
chunkSize =
      [ByteString] -> ByteString
BL.fromChunks ([ByteString] -> ByteString)
-> (String -> [ByteString]) -> String -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      (String -> ByteString) -> [String] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map String -> ByteString
BS.pack ([String] -> [ByteString])
-> (String -> [String]) -> String -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      Int -> String -> [String]
forall a. Int -> [a] -> [[a]]
ListHT.sliceVertical Int
chunkSize
   toString :: ByteString -> String
toString = ByteString -> String
BL.unpack
   isEmpty :: ByteString -> Bool
isEmpty = ByteString -> Bool
BL.null
   length :: ByteString -> Integer
length = Int64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Integer)
-> (ByteString -> Int64) -> ByteString -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int64
BL.length
   isPrefixOf :: ByteString -> ByteString -> Bool
isPrefixOf = ByteString -> ByteString -> Bool
BL.isPrefixOf
   break :: (Char -> Bool) -> ByteString -> (ByteString, ByteString)
break = (Char -> Bool) -> ByteString -> (ByteString, ByteString)
BL.break
   drop :: Int -> ByteString -> ByteString
drop = Int64 -> ByteString -> ByteString
BL.drop (Int64 -> ByteString -> ByteString)
-> (Int -> Int64) -> Int -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral
   read :: Handle -> Integer -> IO ByteString
read Handle
h Integer
n = Handle -> Int -> IO ByteString
BL.hGet Handle
h (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
n)
   readAll :: Int -> Handle -> IO ByteString
readAll = Int -> Handle -> IO ByteString
BU.hGetContentsN
   write :: Handle -> ByteString -> IO ()
write = Handle -> ByteString -> IO ()
BL.hPut
   writeChunked :: Int -> Handle -> ByteString -> IO ()
writeChunked Int
_chunkSize Handle
h ByteString
str =
      ((ByteString -> IO ()) -> [ByteString] -> IO ())
-> [ByteString] -> (ByteString -> IO ()) -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip (ByteString -> IO ()) -> [ByteString] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (ByteString -> [ByteString]
BL.toChunks ByteString
str) ((ByteString -> IO ()) -> IO ()) -> (ByteString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ByteString
chunk ->
         do Handle -> String -> IO ()
IO.hPutStr Handle
h (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> String -> String
forall a. (Integral a, Show a) => a -> String -> String
showHex (ByteString -> Int
BS.length ByteString
chunk) String
crLf
            Handle -> ByteString -> IO ()
BS.hPut Handle
h ByteString
chunk
            Handle -> String -> IO ()
IO.hPutStr Handle
h (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
crLf