{-# 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]
headerLines :: Lazy -> IO [ByteString]
headerLines (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