From 662dd69d1990de0853814b85c6f15fa267cc4cfc Mon Sep 17 00:00:00 2001 From: Morgan Thomas Date: Fri, 19 Feb 2021 16:33:15 -0500 Subject: [PATCH 1/9] wip streaming library --- cabal.project | 1 + default.nix | 1 + examples/package.yaml | 1 + nix/hpackall.sh | 1 + nix/overlay-shpadoinkle.nix | 1 + streaming/LICENSE | 27 ++++++++++++++++++++++++ streaming/Setup.hs | 2 ++ streaming/Shpadoinkle/Streaming.hs | 19 +++++++++++++++++ streaming/default.nix | 4 ++++ streaming/package.yaml | 34 ++++++++++++++++++++++++++++++ 10 files changed, 91 insertions(+) create mode 100644 streaming/LICENSE create mode 100644 streaming/Setup.hs create mode 100644 streaming/Shpadoinkle/Streaming.hs create mode 100644 streaming/default.nix create mode 100644 streaming/package.yaml diff --git a/cabal.project b/cabal.project index 29a1c6a7..a6a761b7 100644 --- a/cabal.project +++ b/cabal.project @@ -10,6 +10,7 @@ packages: core , marketing , html , router + , streaming , widgets , examples diff --git a/default.nix b/default.nix index 710e36f0..fb7bec0d 100644 --- a/default.nix +++ b/default.nix @@ -37,6 +37,7 @@ in Shpadoinkle-lens Shpadoinkle-html Shpadoinkle-router + Shpadoinkle-streaming Shpadoinkle-widgets Shpadoinkle-isreal diff --git a/examples/package.yaml b/examples/package.yaml index 82684227..88b55e2d 100644 --- a/examples/package.yaml +++ b/examples/package.yaml @@ -57,6 +57,7 @@ executables: - Shpadoinkle - Shpadoinkle-html - Shpadoinkle-lens + - Shpadoinkle-streaming - Shpadoinkle-backend-snabbdom lens: diff --git a/nix/hpackall.sh b/nix/hpackall.sh index 560c5f77..906451f1 100755 --- a/nix/hpackall.sh +++ b/nix/hpackall.sh @@ -16,3 +16,4 @@ p widgets p examples p tests p isreal +p streaming diff --git a/nix/overlay-shpadoinkle.nix b/nix/overlay-shpadoinkle.nix index 8b82ff13..06f0ef9d 100644 --- a/nix/overlay-shpadoinkle.nix +++ b/nix/overlay-shpadoinkle.nix @@ -160,6 +160,7 @@ in { Shpadoinkle-marketing = call "Shpadoinkle-marketing" ../marketing; Shpadoinkle-html = call "Shpadoinkle-html" ../html; Shpadoinkle-router = call "Shpadoinkle-router" ../router; + Shpadoinkle-streaming = call "Shpadoinkle-streaming" ../streaming; Shpadoinkle-widgets = addTest (call "Shpadoinkle-widgets" ../widgets) hpkgs; Shpadoinkle-tests = super.haskell.packages.${compiler}.callCabal2nix "tests" (gitignore ../tests) {}; diff --git a/streaming/LICENSE b/streaming/LICENSE new file mode 100644 index 00000000..e0066cfb --- /dev/null +++ b/streaming/LICENSE @@ -0,0 +1,27 @@ +Shpadoinkle Streaming aka S11 Streaming +Copyright © 2021 Morgan Thomas +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 Shpadoinkle nor the names of its 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. diff --git a/streaming/Setup.hs b/streaming/Setup.hs new file mode 100644 index 00000000..44671092 --- /dev/null +++ b/streaming/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/streaming/Shpadoinkle/Streaming.hs b/streaming/Shpadoinkle/Streaming.hs new file mode 100644 index 00000000..8d7aec8b --- /dev/null +++ b/streaming/Shpadoinkle/Streaming.hs @@ -0,0 +1,19 @@ +module Shpadoinkle.Streaming + ( consumeStream + ) where + + +{- + - import Shpadoinkle + +import Data.Functor.Of (Of) +import Streaming (Stream) +import Streaming.Internal (destroy) + + +consumeStream :: Stream (Of a) m () -> (a -> +consumeStream = consumeStream +-} + +consumeStream :: a +consumeStream = consumeStream diff --git a/streaming/default.nix b/streaming/default.nix new file mode 100644 index 00000000..c7b5bb88 --- /dev/null +++ b/streaming/default.nix @@ -0,0 +1,4 @@ +import ../default.nix { pack = "Shpadoinkle-streaming"; } + + + diff --git a/streaming/package.yaml b/streaming/package.yaml new file mode 100644 index 00000000..c158cdd5 --- /dev/null +++ b/streaming/package.yaml @@ -0,0 +1,34 @@ +name: Shpadoinkle-streaming +license: BSD3 +license-file: LICENSE +version: 0.0.0.1 +author: Morgan Thomas +maintainer: morgan.a.s.thomas@gmail.com +category: Web +build-type: Simple +synopsis: Integration of the streaming library with Shpadoinkle continuations. +description: + Integration of the streaming library with Shpadoinkle continuations. + + +ghc-options: + - -Wall + - -Wcompat + - -fwarn-redundant-constraints + - -fwarn-tabs + - -fwarn-incomplete-record-updates + - -fwarn-identities + + +dependencies: + - base >= 4.12.0 && < 4.16 + - lens + - streaming >= 0.2 && < 0.3 + - text + + - Shpadoinkle + + +library: + exposed-modules: Shpadoinkle.Streaming + source-dirs: . -- GitLab From 8b0dfda71832c37c4b7ebc89773b8a8c00ce3d07 Mon Sep 17 00:00:00 2001 From: Morgan Thomas Date: Fri, 19 Feb 2021 17:12:12 -0500 Subject: [PATCH 2/9] add midflight updates to Continuation --- core/Shpadoinkle/Continuation.hs | 35 ++++++++++++++++++++++++-------- 1 file changed, 26 insertions(+), 9 deletions(-) diff --git a/core/Shpadoinkle/Continuation.hs b/core/Shpadoinkle/Continuation.hs index 175f5a73..33212f7b 100644 --- a/core/Shpadoinkle/Continuation.hs +++ b/core/Shpadoinkle/Continuation.hs @@ -72,6 +72,7 @@ import UnliftIO.Concurrent (forkIO) -- finishes and they are all done atomically together. data Continuation m a = Continuation (a -> a, a -> m (Continuation m a)) | Rollback (Continuation m a) + | Merge (Continuation m a) | Pure (a -> a) @@ -124,6 +125,7 @@ runContinuation' f (Continuation (g, h)) x = do i <- h (f x) runContinuation' (g.f) i x runContinuation' _ (Rollback f) x = runContinuation' id f x +runContinuation' f (Merge g) x = runContinuation' f g x runContinuation' f (Pure g) _ = return (g.f) @@ -141,13 +143,15 @@ instance Continuous Continuation where hoist :: Functor m => (forall b. m b -> n b) -> Continuation m a -> Continuation n a hoist _ (Pure f) = Pure f hoist f (Rollback r) = Rollback (hoist f r) +hoist f (Merge g) = Merge (hoist f g) hoist f (Continuation (g, h)) = Continuation . (g,) $ \x -> f $ hoist f <$> h x -- | Apply a lens inside a Continuation to change the Continuation's type. liftC' :: Functor m => (a -> b -> b) -> (b -> a) -> Continuation m a -> Continuation m b -liftC' f g (Pure h) = Pure (\x -> f (h (g x)) x) -liftC' f g (Rollback r) = Rollback (liftC' f g r) +liftC' f g (Pure h) = Pure (\x -> f (h (g x)) x) +liftC' f g (Rollback r) = Rollback (liftC' f g r) +liftC' f g (Merge h) = Merge (liftC' f g h) liftC' f g (Continuation (h, i)) = Continuation (\x -> f (h (g x)) x, \x -> liftC' f g <$> i (g x)) @@ -155,6 +159,7 @@ liftC' f g (Continuation (h, i)) = Continuation (\x -> f (h (g x)) x, \x -> lift liftCMay' :: Applicative m => (a -> b -> b) -> (b -> Maybe a) -> Continuation m a -> Continuation m b liftCMay' f g (Pure h) = Pure $ \x -> maybe x (flip f x . h) $ g x liftCMay' f g (Rollback r) = Rollback (liftCMay' f g r) +liftCMay' f g (Merge h) = Merge (liftCMay' f g h) liftCMay' f g (Continuation (h, i)) = Continuation (\x -> maybe x (flip f x . h) $ g x, maybe (pure done) (fmap (liftCMay' f g) . i) . g) @@ -208,8 +213,9 @@ rightC = mapC rightC' -- | Transform a Continuation to work on 'Maybe's. If it encounters 'Nothing', then it cancels itself. maybeC' :: Applicative m => Continuation m a -> Continuation m (Maybe a) -maybeC' (Pure f) = Pure (fmap f) -maybeC' (Rollback r) = Rollback (maybeC' r) +maybeC' (Pure f) = Pure (fmap f) +maybeC' (Rollback r) = Rollback (maybeC' r) +maybeC' (Merge f) = Merge (maybeC' f) maybeC' (Continuation (f, g)) = Continuation . (fmap f,) $ \case Just x -> maybeC' <$> g x @@ -232,8 +238,9 @@ comaybe f x = fromMaybe x . f $ Just x -- when the input Continuation would replace the current value with 'Nothing', -- instead the current value is retained. comaybeC' :: Functor m => Continuation m (Maybe a) -> Continuation m a -comaybeC' (Pure f) = Pure (comaybe f) -comaybeC' (Rollback r) = Rollback (comaybeC' r) +comaybeC' (Pure f) = Pure (comaybe f) +comaybeC' (Rollback r) = Rollback (comaybeC' r) +comaybeC' (Merge f) = Merge (comaybeC' f) comaybeC' (Continuation (f,g)) = Continuation (comaybe f, fmap comaybeC' . g . Just) @@ -265,12 +272,14 @@ eitherC' f g = Continuation . (id,) $ \case Left x -> case f of Pure h -> return (Pure (mapLeft h)) Rollback r -> return . Rollback $ eitherC' r done + Merge h -> return . Merge $ eitherC' h done Continuation (h, i) -> do j <- i x return $ Continuation (mapLeft h, const . return $ eitherC' j (Rollback done)) Right x -> case g of Pure h -> return (Pure (mapRight h)) Rollback r -> return . Rollback $ eitherC' done r + Merge h -> return . Merge $ eitherC' done h Continuation (h, i) -> do j <- i x return $ Continuation (mapRight h, const . return $ eitherC' (Rollback done) j) @@ -290,7 +299,8 @@ eitherC _ r (Right x) = mapC (eitherC' (pur id)) (r x) contIso :: Functor m => (a -> b) -> (b -> a) -> Continuation m a -> Continuation m b contIso f g (Continuation (h, i)) = Continuation (f.h.g, fmap (contIso f g) . i . g) contIso f g (Rollback h) = Rollback (contIso f g h) -contIso f g (Pure h) = Pure (f.h.g) +contIso f g (Merge h) = Merge (contIso f g h) +contIso f g (Pure h) = Pure (f.h.g) -- | @Continuation m@ is a Functor in the EndoIso category (where the objects @@ -303,8 +313,9 @@ instance Applicative m => F.Functor EndoIso EndoIso (Continuation m) where -- | You can combine multiple Continuations homogeneously using the 'Monoid' typeclass -- instance. The resulting Continuation will execute all the subcontinuations in parallel, -- allowing them to see each other's state updates and roll back each other's updates, --- applying all of the updates generated by all the subcontinuations atomically once --- all of them are done. +-- applying all of the unmerged updates generated by all the subcontinuations atomically once +-- all of them are done. A merge in any one of the branches will cause all of +-- the changes that branch can see to be merged. instance Monad m => Semigroup (Continuation m a) where (Continuation (f, g)) <> (Continuation (h, i)) = Continuation (f.h, \x -> liftM2 (<>) (g x) (i x)) @@ -318,6 +329,8 @@ instance Monad m => Semigroup (Continuation m a) where (Continuation (f,g)) <> (Pure h) = Continuation (f.h,g) (Pure f) <> (Rollback g) = Continuation (f, const (return (Rollback g))) (Rollback f) <> (Pure _) = Rollback f + (Merge f) <> g = Merge (f <> g) + f <> (Merge g) = Merge (f <> g) -- | Since combining Continuations homogeneously is an associative operation, @@ -333,6 +346,9 @@ writeUpdate' h model f = do case m of Continuation (g,gs) -> writeUpdate' (g.h) model gs Pure g -> atomically (writeTVar model . g . h =<< readTVar model) + Merge g -> do + atomically $ writeTVar model . h =<< readTVar model + writeUpdate' id model (const (return g)) Rollback gs -> writeUpdate' id model (const (return gs)) @@ -343,6 +359,7 @@ writeUpdate :: MonadUnliftIO m => TVar a -> Continuation m a -> m () writeUpdate model = \case Continuation (f,g) -> void . forkIO $ writeUpdate' f model g Pure f -> atomically (writeTVar model . f =<< readTVar model) + Merge f -> writeUpdate model f Rollback f -> writeUpdate model f -- GitLab From 6444fd2be0673db69c9bde450f1378f11ff62e82 Mon Sep 17 00:00:00 2001 From: Morgan Thomas Date: Fri, 19 Feb 2021 17:16:04 -0500 Subject: [PATCH 3/9] add merge function --- core/Shpadoinkle/Continuation.hs | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/core/Shpadoinkle/Continuation.hs b/core/Shpadoinkle/Continuation.hs index 33212f7b..e1f0da50 100644 --- a/core/Shpadoinkle/Continuation.hs +++ b/core/Shpadoinkle/Continuation.hs @@ -17,7 +17,7 @@ module Shpadoinkle.Continuation ( -- * The Continuation Type Continuation (..) , runContinuation - , done, pur, impur, kleisli, causes, contIso + , done, pur, impur, kleisli, causes, merge, contIso -- * The Class , Continuous (..) -- ** Hoist @@ -108,6 +108,11 @@ causes :: Monad m => m () -> Continuation m a causes m = impur (m >> return id) +-- | A continuation can be forced to write its changes midflight. +merge :: Continuation m a -> Continuation m a +merge = Merge + + -- | 'runContinuation' takes a 'Continuation' and a state value and runs the whole Continuation -- as if the real state was frozen at the value given to 'runContinuation'. It performs all the -- IO actions in the stages of the Continuation and returns a pure state updating function -- GitLab From fff1caf423cef59a6920193bf6acedb442057a66 Mon Sep 17 00:00:00 2001 From: Morgan Thomas Date: Fri, 19 Feb 2021 17:32:12 -0500 Subject: [PATCH 4/9] causedBy --- core/Shpadoinkle/Continuation.hs | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/core/Shpadoinkle/Continuation.hs b/core/Shpadoinkle/Continuation.hs index e1f0da50..7b81885e 100644 --- a/core/Shpadoinkle/Continuation.hs +++ b/core/Shpadoinkle/Continuation.hs @@ -17,7 +17,7 @@ module Shpadoinkle.Continuation ( -- * The Continuation Type Continuation (..) , runContinuation - , done, pur, impur, kleisli, causes, merge, contIso + , done, pur, impur, kleisli, causes, causedBy, merge, contIso -- * The Class , Continuous (..) -- ** Hoist @@ -108,6 +108,10 @@ causes :: Monad m => m () -> Continuation m a causes m = impur (m >> return id) +causedBy :: m (Continuation m a) -> Continuation m a +causedBy = Continuation . (id,) . const + + -- | A continuation can be forced to write its changes midflight. merge :: Continuation m a -> Continuation m a merge = Merge -- GitLab From f297b6832bed65f5a93695eb7a7d947c3681b20d Mon Sep 17 00:00:00 2001 From: Morgan Thomas Date: Fri, 19 Feb 2021 17:32:18 -0500 Subject: [PATCH 5/9] consumeStream --- streaming/Shpadoinkle/Streaming.hs | 25 +++++++++++++++++-------- 1 file changed, 17 insertions(+), 8 deletions(-) diff --git a/streaming/Shpadoinkle/Streaming.hs b/streaming/Shpadoinkle/Streaming.hs index 8d7aec8b..e6448aea 100644 --- a/streaming/Shpadoinkle/Streaming.hs +++ b/streaming/Shpadoinkle/Streaming.hs @@ -1,19 +1,28 @@ +{-# LANGUAGE ScopedTypeVariables #-} + + module Shpadoinkle.Streaming ( consumeStream ) where -{- - - import Shpadoinkle +import Shpadoinkle hiding (h) -import Data.Functor.Of (Of) +import Data.Functor.Of (Of ((:>))) import Streaming (Stream) import Streaming.Internal (destroy) -consumeStream :: Stream (Of a) m () -> (a -> -consumeStream = consumeStream --} +consumeStream :: forall m a b. Monad m => Stream (Of a) m () -> (a -> m (b -> b)) -> Continuation m b +consumeStream stream f = destroy stream g h j + where + g :: Of a (Continuation m b) -> Continuation m b + g (a :> k) = voidRunContinuationT $ do + commit (impur (f a)) + commit (merge k) + + h :: m (Continuation m b) -> Continuation m b + h = causedBy -consumeStream :: a -consumeStream = consumeStream + j :: () -> Continuation m b + j = const done -- GitLab From 50e862119e799d33bab95b191b5ba855de9e2cf8 Mon Sep 17 00:00:00 2001 From: Morgan Thomas Date: Fri, 19 Feb 2021 17:32:55 -0500 Subject: [PATCH 6/9] remove fake dependency --- examples/package.yaml | 1 - 1 file changed, 1 deletion(-) diff --git a/examples/package.yaml b/examples/package.yaml index 88b55e2d..82684227 100644 --- a/examples/package.yaml +++ b/examples/package.yaml @@ -57,7 +57,6 @@ executables: - Shpadoinkle - Shpadoinkle-html - Shpadoinkle-lens - - Shpadoinkle-streaming - Shpadoinkle-backend-snabbdom lens: -- GitLab From be8bf33fbba8ff380d8f11ff3cb404403506a106 Mon Sep 17 00:00:00 2001 From: Morgan Thomas Date: Fri, 19 Feb 2021 17:37:15 -0500 Subject: [PATCH 7/9] stub out streaming example --- examples/Streaming.hs | 4 ++++ examples/package.yaml | 12 ++++++++++++ 2 files changed, 16 insertions(+) create mode 100644 examples/Streaming.hs diff --git a/examples/Streaming.hs b/examples/Streaming.hs new file mode 100644 index 00000000..33581fa8 --- /dev/null +++ b/examples/Streaming.hs @@ -0,0 +1,4 @@ +module Main where + +main :: IO () +main = putStrLn "hello world" diff --git a/examples/package.yaml b/examples/package.yaml index 82684227..2cbc7ce3 100644 --- a/examples/package.yaml +++ b/examples/package.yaml @@ -289,6 +289,18 @@ executables: - Shpadoinkle-backend-pardiff - Shpadoinkle-lens + streaming: + main: Streaming.hs + other-modules: [] + source-dirs: . + dependencies: + - text + + - Shpadoinkle + - Shpadoinkle-streaming + - Shpadoinkle-html + - Shpadoinkle-backend-pardiff + git: https://gitlab.com/fresheyeball/Shpadoinkle.git -- GitLab From 4b51584561d7cfc3e76084747271f462a61d7e46 Mon Sep 17 00:00:00 2001 From: Morgan Thomas Date: Tue, 23 Feb 2021 14:18:24 -0500 Subject: [PATCH 8/9] fill out example --- examples/Streaming.hs | 47 ++++++++++++++++++++++++++++++++++++++++++- examples/package.yaml | 1 + 2 files changed, 47 insertions(+), 1 deletion(-) diff --git a/examples/Streaming.hs b/examples/Streaming.hs index 33581fa8..89c5923c 100644 --- a/examples/Streaming.hs +++ b/examples/Streaming.hs @@ -1,4 +1,49 @@ +{-# LANGUAGE ExtendedDefaultRules #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PackageImports #-} + + module Main where + +import Prelude hiding (div) + +import Control.Concurrent (threadDelay) +import Control.Monad.IO.Class (MonadIO (liftIO)) +import Data.Text (Text, pack) +import Shpadoinkle (Html, liftC) +import Shpadoinkle.Backend.ParDiff (runParDiff) +import Shpadoinkle.Html (button, div, getBody, text, onClickC) +import Shpadoinkle.Streaming (consumeStream) +import Shpadoinkle.Run (runJSorWarp, simple) +import "streaming" Streaming (Stream, Of) +import Streaming.Prelude (repeatM) + +default (Text) + + +exampleStream :: MonadIO m => Stream (Of Int) m () +exampleStream = repeatM $ do + liftIO $ threadDelay 1000000 + return 1 + + +newtype Model = Model { streamContents :: [Int] } + deriving (Eq, Show) + + +view :: MonadIO m => Model -> Html m Model +view (Model ns) = + div + [] + [ text (pack (show ns)) + , liftC (\c m -> m { streamContents = c}) streamContents $ + button + [ onClickC (consumeStream exampleStream (return . (:))) ] + [ text "Go" ] + ] + + main :: IO () -main = putStrLn "hello world" +main = runJSorWarp 8080 $ + simple runParDiff (Model []) view getBody diff --git a/examples/package.yaml b/examples/package.yaml index 2cbc7ce3..543d2d73 100644 --- a/examples/package.yaml +++ b/examples/package.yaml @@ -294,6 +294,7 @@ executables: other-modules: [] source-dirs: . dependencies: + - streaming - text - Shpadoinkle -- GitLab From 89d860b0fd15e9ad9fca7e1eab9ab4c2f42a7262 Mon Sep 17 00:00:00 2001 From: Morgan Thomas Date: Tue, 23 Feb 2021 14:36:57 -0500 Subject: [PATCH 9/9] stylish haskell --- examples/Streaming.hs | 27 ++++++++++++++------------- streaming/Shpadoinkle/Streaming.hs | 8 ++++---- 2 files changed, 18 insertions(+), 17 deletions(-) diff --git a/examples/Streaming.hs b/examples/Streaming.hs index 89c5923c..f24a68df 100644 --- a/examples/Streaming.hs +++ b/examples/Streaming.hs @@ -6,18 +6,19 @@ module Main where -import Prelude hiding (div) - -import Control.Concurrent (threadDelay) -import Control.Monad.IO.Class (MonadIO (liftIO)) -import Data.Text (Text, pack) -import Shpadoinkle (Html, liftC) -import Shpadoinkle.Backend.ParDiff (runParDiff) -import Shpadoinkle.Html (button, div, getBody, text, onClickC) -import Shpadoinkle.Streaming (consumeStream) -import Shpadoinkle.Run (runJSorWarp, simple) -import "streaming" Streaming (Stream, Of) -import Streaming.Prelude (repeatM) +import Prelude hiding (div) + +import Control.Concurrent (threadDelay) +import Control.Monad.IO.Class (MonadIO (liftIO)) +import Data.Text (Text, pack) +import Shpadoinkle (Html, liftC) +import Shpadoinkle.Backend.ParDiff (runParDiff) +import Shpadoinkle.Html (button, div, getBody, onClickC, + text) +import Shpadoinkle.Run (runJSorWarp, simple) +import Shpadoinkle.Streaming (consumeStream) +import "streaming" Streaming (Of, Stream) +import Streaming.Prelude (repeatM) default (Text) @@ -37,7 +38,7 @@ view (Model ns) = div [] [ text (pack (show ns)) - , liftC (\c m -> m { streamContents = c}) streamContents $ + , liftC (\c m -> m { streamContents = c }) streamContents $ button [ onClickC (consumeStream exampleStream (return . (:))) ] [ text "Go" ] diff --git a/streaming/Shpadoinkle/Streaming.hs b/streaming/Shpadoinkle/Streaming.hs index e6448aea..0e744914 100644 --- a/streaming/Shpadoinkle/Streaming.hs +++ b/streaming/Shpadoinkle/Streaming.hs @@ -6,11 +6,11 @@ module Shpadoinkle.Streaming ) where -import Shpadoinkle hiding (h) +import Shpadoinkle hiding (h) -import Data.Functor.Of (Of ((:>))) -import Streaming (Stream) -import Streaming.Internal (destroy) +import Data.Functor.Of (Of ((:>))) +import Streaming (Stream) +import Streaming.Internal (destroy) consumeStream :: forall m a b. Monad m => Stream (Of a) m () -> (a -> m (b -> b)) -> Continuation m b -- GitLab