reflex-backend-wai (empty) → 0.1.0.0

raw patch · 7 files changed

+287/−0 lines, 7 filesdep +basedep +containersdep +http-typessetup-changed

Dependencies added: base, containers, http-types, mtl, reflex, reflex-backend-wai, reflex-basic-host, stm, wai, warp

Files

ChangeLog.md +5/−0
LICENSE +30/−0
Setup.hs +2/−0
exe/Main.hs +20/−0
reflex-backend-wai.cabal +62/−0
src/Reflex/Backend/Wai.hs +132/−0
src/Reflex/Backend/Warp.hs +36/−0

+ ChangeLog.md view

@@ -0,0 +1,5 @@+# Revision history for wai-reflex++## 0.1.0.0  -- YYYY-mm-dd++* First version. Released on an unsuspecting world.

+ LICENSE view

@@ -0,0 +1,30 @@+Copyright (c) 2017, Dave Laing++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Dave Laing nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

+ Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

+ exe/Main.hs view

@@ -0,0 +1,20 @@+{-|+Copyright   : (c) Dave Laing, 2017-2019+License     : BSD3+Maintainer  : dave.laing.80@gmail.com+Stability   : experimental+Portability : non-portable+-}+{-# LANGUAGE OverloadedStrings #-}+module Main (main) where++import Network.Wai (responseLBS)+import Network.HTTP.Types.Status (status200)++import Reflex.Backend.Warp (runAppForever)++main :: IO ()+main =+  runAppForever 8080 $ \eReq -> do+    let eRes = responseLBS status200 [] "Hi" <$ eReq+    pure eRes

+ reflex-backend-wai.cabal view

@@ -0,0 +1,62 @@+name:                reflex-backend-wai+version:             0.1.0.0+synopsis:            Reflex interface to `wai`+description:+  Reflex interface to `wai`.+  .+  A minimal example:+  .+  > {-# LANGUAGE OverloadedStrings #-}+  > module Main where+  >  +  > import Network.Wai (responseLBS)+  > import Network.HTTP.Types.Status (status200)+  >  +  > import Reflex.Backend.Warp (runAppForever)+  >  +  > main :: IO ()+  > main =+  >   runAppForever 8080 $ \eReq -> do+  >     let eRes = responseLBS status200 [] "Hi" <$ eReq+  >     pure eRes++license:             BSD3+license-file:        LICENSE+author:              Dave Laing+maintainer:          dave.laing.80@gmail.com+-- copyright:           +category:            FRP, Web+build-type:          Simple+extra-source-files:  ChangeLog.md+cabal-version:       >=1.10+tested-with:         GHC==8.0.2+                   , GHC==8.2.2+                   , GHC==8.4.3+                   , GHC==8.6.4++library+  exposed-modules:     Reflex.Backend.Wai+                     , Reflex.Backend.Warp+  build-depends:       base       >=4.9    && < 4.13+                     , containers >= 0.5   && < 0.7+                     , mtl        >= 2.2.1 && < 2.3+                     , reflex     >= 0.5   && < 0.6+                     , reflex-basic-host >= 0.1 && < 0.2+                     , stm        >= 2.4.4 && < 2.6+                     , wai        >= 3.2.1 && < 3.3+                     , warp >= 3.2.13 && < 3.3+  hs-source-dirs:      src+  ghc-options:         -Wall+  default-language:    Haskell2010++executable example+  main-is:             Main.hs+  build-depends:       base              >=4.9     && < 4.13+                     , http-types        >= 0.9.1  && < 0.13+                     , reflex            >= 0.5    && < 0.6+                     , wai               >= 3.2.1  && < 3.3+                     , reflex-backend-wai+  hs-source-dirs:      exe+  ghc-options:         -Wall+  default-language:    Haskell2010+

+ src/Reflex/Backend/Wai.hs view

@@ -0,0 +1,132 @@+{-|+Copyright   : (c) Dave Laing, 2017-2019+License     : BSD3+Maintainer  : dave.laing.80@gmail.com+Stability   : experimental+Portability : non-portable++Low level operations for integrating reflex networks with WAI+'Application's.++If you just want to serve a reflex network then have a look+at "Reflex.Backend.Warp".++-}++{-# LANGUAGE FlexibleContexts #-}+module Reflex.Backend.Wai+  ( WaiSource(..), newWaiSource+  , waiApplicationGuest+  , waiApplicationHost+  , liftWaiApplication, liftWaiApplicationTagged+  )+where++import Network.Wai+import Network.Wai.Internal (ResponseReceived(..))++import Control.Monad (void, forever)++import Control.Monad.Trans (MonadIO, liftIO)++import Data.Map (Map)+import qualified Data.Map as Map++import Control.Concurrent (forkIO)+import Control.Monad.STM+import Control.Concurrent.STM++import Reflex hiding (Request, Response)++-- | The source of the WAI application data.+--+-- Requests generated by the web server are stored here, and read+-- by the reflex network.+--+-- Responses generated by the reflex network are stored here, and+-- read (and subsequently returned) by the web server.+data WaiSource+  = WaiSource+  { wsRequest :: TMVar Request+  , wsResponse :: TMVar Response+  }++-- | Initialise a 'WaiSource'+newWaiSource :: MonadIO m => m WaiSource+newWaiSource =+  liftIO $ WaiSource <$> newEmptyTMVarIO <*> newEmptyTMVarIO++-- | Build an 'Application' that deposits a 'Request' into the+-- 'WaiSource', then reads a 'Response' from the 'WaiSource', then+-- responds with it.+waiApplicationHost :: WaiSource -> Application+waiApplicationHost (WaiSource wReq wRes) req response = do+  atomically $ putTMVar wReq req+  res <- atomically $ takeTMVar wRes+  response res++-- | Build a reflex network that pumps 'Request's and 'Response's to+-- and from the 'WaiSource'+waiApplicationGuest ::+  ( Reflex t+  , MonadIO m+  , PerformEvent t m+  , MonadIO (Performable m)+  , TriggerEvent t m+  ) =>+  WaiSource ->+  (Event t Request -> m (Event t Response)) ->+  m ()+waiApplicationGuest (WaiSource wReq wRes) network = do+  (eReq, onReq) <- newTriggerEvent+  eRes <- network eReq++  performEvent_ $ liftIO . atomically . putTMVar wRes <$> eRes++  void . liftIO . forkIO . forever $ do+    req <- atomically $ takeTMVar wReq+    onReq req++  pure ()++-- | Given a WAI 'Application' and a 'Request' event, create an+-- 'Event' that yield a 'Response' by running the 'Application'.+--+-- The output 'Event' will fire some time after the input 'Event'.+liftWaiApplication ::+  ( Reflex t+  , PerformEvent t m+  , MonadIO (Performable m)+  , TriggerEvent t m+  ) =>+  Application ->+  Event t Request ->+  m (Event t Response)+liftWaiApplication app eReq = do+  (eRes, onRes) <- newTriggerEvent++  let go res = ResponseReceived <$ onRes res++  performEvent_ $ (\req -> void . liftIO $ app req go) <$> eReq++  pure eRes++-- | Similar to 'liftWaiApplication', but the 'Request' event should yield+-- a tag which is then attached to the 'Response'.+liftWaiApplicationTagged ::+  ( Reflex t+  , PerformEvent t m+  , MonadIO (Performable m)+  , TriggerEvent t m+  ) =>+  Application ->+  Event t (tag, Request) ->+  m (Event t (Map tag Response))+liftWaiApplicationTagged app eReq = do+  (eRes, onRes) <- newTriggerEvent++  let go t res = ResponseReceived <$ onRes (Map.singleton t res)++  performEvent_ $ (\(t, req) -> void . liftIO . app req $ go t) <$> eReq++  pure eRes

+ src/Reflex/Backend/Warp.hs view

@@ -0,0 +1,36 @@+{-|+Copyright   : (c) Dave Laing, 2017-2019+License     : BSD3+Maintainer  : dave.laing.80@gmail.com+Stability   : experimental+Portability : non-portable++Serving reflex networks using @warp@.++-}++{-# language FlexibleContexts, TypeFamilies #-}+{-# language RankNTypes #-}+module Reflex.Backend.Warp where++import Reflex hiding (Request, Response)+import Reflex.Host.Basic (BasicGuestConstraints, BasicGuest, basicHostForever)+import Reflex.Backend.Wai++import Control.Concurrent (forkIO)+import Control.Monad (void)+import Network.Wai (Request, Response)+import Network.Wai.Handler.Warp (Port, run)++-- | Serve a reflex network using warp.+runAppForever+  :: Port -- ^ Server port+  -> (forall t m.+      BasicGuestConstraints t m =>+      Event t Request ->+      BasicGuest t m (Event t Response)) -- ^ Reflex network+  -> IO ()+runAppForever port network = do+  waiSource <- newWaiSource+  void . forkIO $ basicHostForever (waiApplicationGuest waiSource network)+  void . run port $ waiApplicationHost waiSource