module Web.Minion.Response.Conduit where

import Conduit qualified as C
import Control.Monad ((>=>))
import Data.ByteString.Builder qualified as Data.ByteString
import Data.Conduit.Combinators qualified as C
import Network.HTTP.Types qualified as Http
import Network.Wai qualified as Wai
import Web.Minion.Response

newtype ConduitResponse = ConduitResponse (C.ConduitT () Data.ByteString.Builder IO ())

instance (Monad m) => ToResponse m ConduitResponse where
  toResponse :: [ByteString] -> ConduitResponse -> m Response
toResponse [ByteString]
_ (ConduitResponse ConduitT () Builder IO ()
c) = Response -> m Response
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Response -> m Response) -> Response -> m Response
forall a b. (a -> b) -> a -> b
$ Status -> ResponseHeaders -> StreamingBody -> Response
Wai.responseStream
    Status
Http.status200
    []
    \Builder -> IO ()
write IO ()
flush -> ConduitT () Void IO () -> IO ()
forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
C.runConduit (ConduitT () Void IO () -> IO ())
-> ConduitT () Void IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ ConduitT () Builder IO ()
c ConduitT () Builder IO ()
-> ConduitT Builder Void IO () -> ConduitT () Void IO ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
C..| (Builder -> IO ()) -> ConduitT Builder Any IO ()
forall (m :: * -> *) a o.
Monad m =>
(a -> m ()) -> ConduitT a o m ()
C.mapM_ (Builder -> IO ()
write (Builder -> IO ()) -> (() -> IO ()) -> Builder -> IO ()
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> IO () -> () -> IO ()
forall a b. a -> b -> a
const IO ()
flush) ConduitT Builder Any IO ()
-> ConduitT Any Void IO () -> ConduitT Builder Void IO ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
C..| ConduitT Any Void IO ()
forall (m :: * -> *) a o. Monad m => ConduitT a o m ()
C.sinkNull

instance CanRespond ConduitResponse where
  canRespond :: [ByteString] -> Bool
canRespond [ByteString]
_ = Bool
True