essence-of-live-coding-warp 0.2.6 → 0.2.7

raw patch · 3 files changed

+40/−39 lines, 3 filesdep ~essence-of-live-codingsetup-changedPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: essence-of-live-coding

API changes (from Hackage documentation)

Files

• Setup.hs +1/−0
• essence-of-live-coding-warp.cabal +6/−6
• src/LiveCoding/Warp.hs +33/−33

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

@@ -1,5 +1,5 @@ name:                essence-of-live-coding-warp-version:             0.2.6+version:             0.2.7 synopsis: General purpose live coding framework description:   essence-of-live-coding is a general purpose and type safe live coding framework.@@ -28,12 +28,12 @@  source-repository head   type:     git-  location: git@github.com:turion/essence-of-live-coding.git+  location: https://github.com/turion/essence-of-live-coding.git  source-repository this   type:     git-  location: git@github.com:turion/essence-of-live-coding.git-  tag:      v0.2.6+  location: https://github.com/turion/essence-of-live-coding.git+  tag:      v0.2.7  library   exposed-modules:@@ -44,7 +44,7 @@     , http-types >= 0.12.3     , wai >= 3.2.2.1     , warp >= 3.3.13-    , essence-of-live-coding >= 0.2.6+    , essence-of-live-coding >= 0.2.7   hs-source-dirs:      src   default-language:    Haskell2010   default-extensions:  StrictData@@ -57,6 +57,6 @@       base >= 4.11 && < 5     , http-client >= 0.6.4.1     , bytestring >= 0.10-    , essence-of-live-coding >= 0.2.6+    , essence-of-live-coding >= 0.2.7     , essence-of-live-coding-warp   default-language:    Haskell2010

@@ -1,16 +1,17 @@ {-# LANGUAGE Arrows #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TupleSections #-}+ {- | Live coding backend to the [@warp@](https://hackage.haskell.org/package/warp) server.  If you write a cell that consumes 'Request's and produces 'Response's, you can use the functions here that run this cell as a @warp@ application. -}-module LiveCoding.Warp-  ( runWarpC-  , runWarpC_-  , module X-  ) where+module LiveCoding.Warp (+  runWarpC,+  runWarpC_,+  module X,+) where  -- base import Control.Concurrent@@ -29,26 +30,27 @@ import LiveCoding  data WaiHandle = WaiHandle-  { requestVar  :: MVar Request+  { requestVar :: MVar Request   , responseVar :: MVar Response-  , appThread   :: ThreadId+  , appThread :: ThreadId   }  -- I believe there is a bug here where a request is missed if the app blocks because the requestVar isn't emptied, or the response not filled.  waiHandle :: Port -> Handle IO WaiHandle-waiHandle port = Handle-  { create = do-      requestVar <- newEmptyMVar-      responseVar <- newEmptyMVar-      let app request respond = do+waiHandle port =+  Handle+    { create = do+        requestVar <- newEmptyMVar+        responseVar <- newEmptyMVar+        let app request respond = do               putMVar requestVar request               response <- takeMVar responseVar               respond response-      appThread <- forkIO $ run port app-      return WaiHandle { .. }-  , destroy = \WaiHandle { .. } -> killThread appThread-  }+        appThread <- forkIO $ run port app+        return WaiHandle {..}+    , destroy = \WaiHandle {..} -> killThread appThread+    }  {- | Run a 'Cell' as a WARP application. @@ -57,22 +59,21 @@ 3. Supplies the cell with the input and the current request 4. Serve the response and return the output -}--runWarpC-  :: Port-  -> Cell IO (a, Request) (b, Response)-  -> Cell (HandlingStateT IO) a (Maybe b)+runWarpC ::+  Port ->+  Cell IO (a, Request) (b, Response) ->+  Cell (HandlingStateT IO) a (Maybe b) runWarpC port cell = proc a -> do-  WaiHandle { .. } <- handling $ waiHandle port -< ()-  requestMaybe <- arrM $ liftIO . tryTakeMVar   -< requestVar+  WaiHandle {..} <- handling $ waiHandle port -< ()+  requestMaybe <- arrM $ liftIO . tryTakeMVar -< requestVar   case requestMaybe of     Just request -> do-      (b, response) <- liftCell cell  -< (a, request)+      (b, response) <- liftCell cell -< (a, request)       arrM $ liftIO . uncurry putMVar -< (responseVar, response)-      returnA                         -< Just b+      returnA -< Just b     Nothing -> do-      arrM $ liftIO . threadDelay     -< 1000 -- Prevent too much CPU load-      returnA                         -< Nothing+      arrM $ liftIO . threadDelay -< 1000 -- Prevent too much CPU load+      returnA -< Nothing  -- | A simple live-codable web application is a cell that consumes HTTP 'Request's and emits 'Response's for each. type LiveWebApp = Cell IO Request Response@@ -92,9 +93,8 @@ main = liveMain liveProgram @ -}--runWarpC_-  :: Port-  -> LiveWebApp-  -> Cell (HandlingStateT IO) () ()-runWarpC_ port cell = runWarpC port (arr snd >>> cell >>> arr ((), )) >>> arr (const ())+runWarpC_ ::+  Port ->+  LiveWebApp ->+  Cell (HandlingStateT IO) () ()+runWarpC_ port cell = runWarpC port (arr snd >>> cell >>> arr ((),)) >>> arr (const ())