{-# LANGUAGE ForeignFunctionInterface #-}
module Happstack.Server.Internal.LazyLiner
(Lazy, newLinerHandle, headerLines, getBytes, getBytesStrict, getRest, L.toChunks
) where
import Control.Concurrent.MVar
import System.IO
import qualified Data.ByteString.Char8 as P
import qualified Data.ByteString.Lazy.Char8 as L
newtype Lazy = Lazy (MVar L.ByteString)
newLinerHandle :: Handle -> IO Lazy
newLinerHandle :: Handle -> IO Lazy
newLinerHandle Handle
h = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MVar ByteString -> Lazy
Lazy (forall a. a -> IO (MVar a)
newMVar forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Handle -> IO ByteString
L.hGetContents Handle
h)
headerLines :: Lazy -> IO [P.ByteString]
(Lazy MVar ByteString
mv) = forall a b. MVar a -> (a -> IO (a, b)) -> IO b
modifyMVar MVar ByteString
mv forall a b. (a -> b) -> a -> b
$ \ByteString
l -> do
let loop :: [ByteString] -> ByteString -> (ByteString, [ByteString])
loop [ByteString]
acc ByteString
r0 = let (ByteString
h,ByteString
r) = (Char -> Bool) -> ByteString -> (ByteString, ByteString)
L.break (forall a. Eq a => a -> a -> Bool
(==) Char
ch) ByteString
r0
ph :: ByteString
ph = ByteString -> ByteString
toStrict ByteString
h
phl :: Int
phl = ByteString -> Int
P.length ByteString
ph
ph2 :: ByteString
ph2 = if Int
phl forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
|| ByteString -> Char
P.last ByteString
ph forall a. Eq a => a -> a -> Bool
/= Char
'\x0D' then ByteString
ph else HasCallStack => ByteString -> ByteString
P.init ByteString
ph
ch :: Char
ch = Char
'\x0A'
r' :: ByteString
r' = if ByteString -> Bool
L.null ByteString
r then ByteString
r else HasCallStack => ByteString -> ByteString
L.tail ByteString
r
in if ByteString -> Int
P.length ByteString
ph2 forall a. Eq a => a -> a -> Bool
== Int
0 then (ByteString
r', forall a. [a] -> [a]
reverse [ByteString]
acc) else [ByteString] -> ByteString -> (ByteString, [ByteString])
loop (ByteString
ph2forall a. a -> [a] -> [a]
:[ByteString]
acc) ByteString
r'
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString -> (ByteString, [ByteString])
loop [] ByteString
l
getBytesStrict :: Lazy -> Int -> IO P.ByteString
getBytesStrict :: Lazy -> Int -> IO ByteString
getBytesStrict (Lazy MVar ByteString
mv) Int
len = forall a b. MVar a -> (a -> IO (a, b)) -> IO b
modifyMVar MVar ByteString
mv forall a b. (a -> b) -> a -> b
$ \ByteString
l -> do
let (ByteString
h,ByteString
p) = Int64 -> ByteString -> (ByteString, ByteString)
L.splitAt (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len) ByteString
l
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
p, ByteString -> ByteString
toStrict ByteString
h)
getBytes :: Lazy -> Int -> IO L.ByteString
getBytes :: Lazy -> Int -> IO ByteString
getBytes (Lazy MVar ByteString
mv) Int
len = forall a b. MVar a -> (a -> IO (a, b)) -> IO b
modifyMVar MVar ByteString
mv forall a b. (a -> b) -> a -> b
$ \ByteString
l -> do
let (ByteString
h,ByteString
p) = Int64 -> ByteString -> (ByteString, ByteString)
L.splitAt (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len) ByteString
l
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
p, ByteString
h)
getRest :: Lazy -> IO L.ByteString
getRest :: Lazy -> IO ByteString
getRest (Lazy MVar ByteString
mv) = forall a b. MVar a -> (a -> IO (a, b)) -> IO b
modifyMVar MVar ByteString
mv forall a b. (a -> b) -> a -> b
$ \ByteString
l -> forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
L.empty, ByteString
l)
toStrict :: L.ByteString -> P.ByteString
toStrict :: ByteString -> ByteString
toStrict = [ByteString] -> ByteString
P.concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
L.toChunks