    {-# 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 = (MVar ByteString -> Lazy) -> IO (MVar ByteString) -> IO Lazy
    forall a b. (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap MVar ByteString -> Lazy
    Lazy (ByteString -> IO (MVar ByteString)
    forall a. a -> IO (MVar a)
    newMVar (ByteString -> IO (MVar ByteString))
    -> IO ByteString -> IO (MVar ByteString)
    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) = MVar ByteString
    -> (ByteString -> IO (ByteString, [ByteString])) -> IO [ByteString]
    forall a b. MVar a -> (a -> IO (a, b)) -> IO b
    modifyMVar MVar ByteString
    mv ((ByteString -> IO (ByteString, [ByteString])) -> IO [ByteString])
    -> (ByteString -> IO (ByteString, [ByteString])) -> IO [ByteString]
    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 (Char -> Char -> Bool
    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 Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    0 Bool -> Bool -> Bool
    || ByteString -> Char
    P.last ByteString
    ph Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Char
    '\x0D' then ByteString
    ph else HasCallStack => ByteString -> ByteString
    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
    ByteString -> ByteString
    L.tail ByteString
    r
                        in if ByteString -> Int
    P.length ByteString
    ph2 Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    0 then (ByteString
    r', [ByteString] -> [ByteString]
    forall a. [a] -> [a]
    reverse [ByteString]
    acc) else [ByteString] -> ByteString -> (ByteString, [ByteString])
    loop (ByteString
    ph2ByteString -> [ByteString] -> [ByteString]
    forall a. a -> [a] -> [a]
    :[ByteString]
    acc) ByteString
    r'
      (ByteString, [ByteString]) -> IO (ByteString, [ByteString])
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((ByteString, [ByteString]) -> IO (ByteString, [ByteString]))
    -> (ByteString, [ByteString]) -> IO (ByteString, [ByteString])
    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 = MVar ByteString
    -> (ByteString -> IO (ByteString, ByteString)) -> IO ByteString
    forall a b. MVar a -> (a -> IO (a, b)) -> IO b
    modifyMVar MVar ByteString
    mv ((ByteString -> IO (ByteString, ByteString)) -> IO ByteString)
    -> (ByteString -> IO (ByteString, ByteString)) -> IO ByteString
    forall a b. (a -> b) -> a -> b
    $ \ByteString
    l -> do
      let (ByteString
    h,ByteString
    p) = Int64 -> ByteString -> (ByteString, ByteString)
    L.splitAt (Int -> Int64
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    len) ByteString
    l
      (ByteString, ByteString) -> IO (ByteString, ByteString)
    forall a. a -> IO a
    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 = MVar ByteString
    -> (ByteString -> IO (ByteString, ByteString)) -> IO ByteString
    forall a b. MVar a -> (a -> IO (a, b)) -> IO b
    modifyMVar MVar ByteString
    mv ((ByteString -> IO (ByteString, ByteString)) -> IO ByteString)
    -> (ByteString -> IO (ByteString, ByteString)) -> IO ByteString
    forall a b. (a -> b) -> a -> b
    $ \ByteString
    l -> do
      let (ByteString
    h,ByteString
    p) = Int64 -> ByteString -> (ByteString, ByteString)
    L.splitAt (Int -> Int64
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    len) ByteString
    l
      (ByteString, ByteString) -> IO (ByteString, ByteString)
    forall a. a -> IO a
    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) = MVar ByteString
    -> (ByteString -> IO (ByteString, ByteString)) -> IO ByteString
    forall a b. MVar a -> (a -> IO (a, b)) -> IO b
    modifyMVar MVar ByteString
    mv ((ByteString -> IO (ByteString, ByteString)) -> IO ByteString)
    -> (ByteString -> IO (ByteString, ByteString)) -> IO ByteString
    forall a b. (a -> b) -> a -> b
    $ \ByteString
    l -> (ByteString, ByteString) -> IO (ByteString, ByteString)
    forall a. a -> IO a
    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 ([ByteString] -> ByteString)
    -> (ByteString -> [ByteString]) -> ByteString -> ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> [ByteString]
    L.toChunks