module Web.Minion.Examples.Conduit.UpperCase (app) where

import Data.Binary.Put qualified as Binary
import Data.Conduit ((.|))
import Data.Conduit.Combinators qualified as Conduit
import Data.Functor (($>))
import Data.Text qualified as Text
import Data.Text.IO qualified as Text.IO
import Web.Minion
import Web.Minion.Conduit

app :: ApplicationM IO
app :: ApplicationM IO
app = Router' Void Void IO -> ApplicationM IO
forall (m :: * -> *) i.
(MonadIO m, MonadCatch m) =>
Router' i Void m -> ApplicationM m
serve Router' Void Void IO
api

api :: Router Void IO
api :: Router' Void Void IO
api = Router' Void Void IO -> Router' Void Void IO
"api" (Router' Void Void IO -> Router' Void Void IO)
-> Router' Void Void IO -> Router' Void Void IO
forall i ts (r :: * -> *).
(Router' i ts r -> Router' i ts r)
-> Router' i ts r -> Router' i ts r
/> Router' Void Void IO -> Router' Void Void IO
"conduit" (Router' Void Void IO -> Router' Void Void IO)
-> Router' Void Void IO -> Router' Void Void IO
forall i ts (r :: * -> *).
(Router' i ts r -> Router' i ts r)
-> Router' i ts r -> Router' i ts r
/> ValueCombinator Void (WithReq IO (ConduitRequest IO)) Void IO
forall (m :: * -> *) i ts.
(MonadIO m, Introspection i 'Request (ConduitRequest m)) =>
ValueCombinator i (WithReq m (ConduitRequest m)) ts m
streamBodyBytes ValueCombinator Void (WithReq IO (ConduitRequest IO)) Void IO
-> ValueCombinator Void (WithReq IO (ConduitRequest IO)) Void IO
forall i ts' (r :: * -> *) ts.
(Router' i ts' r -> Router' i ts r)
-> Router' i ts' r -> Router' i ts r
.> ByteString
-> (DelayedArgs '[WithReq IO (ConduitRequest IO)]
    ~> IO ConduitResponse)
-> Router' Void (Void :+ WithReq IO (ConduitRequest IO)) IO
forall o (m :: * -> *) ts i (st :: [*]).
(HandleArgs ts st m, ToResponse m o, CanRespond o,
 Introspection i 'Response o) =>
ByteString -> (DelayedArgs st ~> m o) -> Router' i ts m
handle ByteString
POST DelayedArgs '[WithReq IO (ConduitRequest IO)] ~> IO ConduitResponse
ConduitRequest IO -> IO ConduitResponse
upperCase

upperCase :: ConduitRequest IO -> IO ConduitResponse
upperCase :: ConduitRequest IO -> IO ConduitResponse
upperCase (ConduitRequest ConduitT () ByteString IO ()
source) = ConduitResponse -> IO ConduitResponse
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ConduitResponse -> IO ConduitResponse)
-> ConduitResponse -> IO ConduitResponse
forall a b. (a -> b) -> a -> b
$ ConduitT () Builder IO () -> ConduitResponse
ConduitResponse do
  ConduitT () ByteString IO ()
source
    ConduitT () ByteString IO ()
-> ConduitT ByteString Builder IO () -> ConduitT () Builder IO ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| ConduitT ByteString Text IO ()
forall (m :: * -> *). MonadThrow m => ConduitT ByteString Text m ()
Conduit.decodeUtf8
    ConduitT ByteString Text IO ()
-> ConduitT Text Builder IO () -> ConduitT ByteString Builder IO ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| (Text -> Text) -> ConduitT Text Text IO ()
forall (m :: * -> *) a b. Monad m => (a -> b) -> ConduitT a b m ()
Conduit.map Text -> Text
Text.toUpper
    ConduitT Text Text IO ()
-> ConduitT Text Builder IO () -> ConduitT Text Builder IO ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| (Text -> IO Text) -> ConduitT Text Text IO ()
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> ConduitT a b m ()
Conduit.mapM (\Text
a -> Text -> IO ()
Text.IO.putStrLn Text
a IO () -> Text -> IO Text
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Text
a)
    ConduitT Text Text IO ()
-> ConduitT Text Builder IO () -> ConduitT Text Builder IO ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| ConduitT Text ByteString IO ()
forall (m :: * -> *) text binary.
(Monad m, Utf8 text binary) =>
ConduitT text binary m ()
Conduit.encodeUtf8
    ConduitT Text ByteString IO ()
-> ConduitT ByteString Builder IO () -> ConduitT Text Builder IO ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| (ByteString -> Builder) -> ConduitT ByteString Builder IO ()
forall (m :: * -> *) a b. Monad m => (a -> b) -> ConduitT a b m ()
Conduit.map (PutM () -> Builder
forall a. PutM a -> Builder
Binary.execPut (PutM () -> Builder)
-> (ByteString -> PutM ()) -> ByteString -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> PutM ()
Binary.putByteString)