front 0.0.0.7 → 0.0.0.8

raw patch · 5 files changed

+31/−10 lines, 5 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• ChangeLog.md +5/−0
• front.cabal +1/−1
• shared/Bridge.hs +4/−1
• src/Web/Front.hs +14/−4
• src/Web/Front/Broadcast.hs +7/−4

@@ -1,5 +1,10 @@ # Revision history for front +## 0.0.0.8 -- 2020-05-01++* Added custom script invokation.+* Added custom disconnect handling.+ ## 0.0.0.7 -- 2020-04-07  * Add new strategy for only client session.

@@ -2,7 +2,7 @@ --  see http://haskell.org/cabal/users-guide/  name:                front-version:             0.0.0.7+version:             0.0.0.8 synopsis:            A reactive frontend web framework description:         A reactive frontend web framework. See haskell-front.org for more details. homepage:            haskell-front.org

@@ -75,6 +75,7 @@ data ClientTask a = ClientTask   { executeRenderHtml :: [RenderHtml]   , executeAction     :: [CallbackAction a]+  , executeScript     :: [Script]   } deriving (Data, Typeable)  data RenderHtml = AttachText ElementId HtmlText@@ -109,7 +110,7 @@ updateAction :: Action a -> a -> Action a updateAction (Action e a _) c = Action e a c-} -data ActionType = RecordAction | ObjectAction | EnterAction+data ActionType = RecordAction | ObjectAction | EnterAction | EvalAction #ifdef FAY   deriving (Typeable, Data) #else@@ -129,6 +130,8 @@ type RowNumber = Int  type RecordValue = Text++type Script = Text  -- | Pretty-printer for command expected from Client. ppIncomingCommand :: In a -> Text

@@ -9,20 +9,30 @@  import qualified Data.Text                 as T +data ClientTaskType = OnlyHtml | OnlyEvents | BothHtmlEvents | None+  deriving (Eq, Show)+ -- | Generate message that will be pushed to client(s) based on underlying communication. createTask   :: Show a   => Text -- ^ DOM Element Id.+  -> ClientTaskType -- ^ Type of task to execute on client.   -> (t -> Markup a) -- ^ How to render state.   -> t -- ^ State to render.   -> ClientTask a -- ^ Message that will be pushed to client(s).-createTask eid renderer state = task+createTask eid taskType renderer state = task   where rhtml = AttachText eid (T.pack . renderHtml $ markup)         markup = renderer state+        (html, events) = case taskType of+          OnlyHtml       -> ([rhtml], mempty)+          OnlyEvents     -> ([], markup)+          BothHtmlEvents -> ([rhtml], markup)+          None           -> ([], mempty)         task = ClientTask-          { executeRenderHtml = [rhtml]-          , executeAction = registerEvents markup []+          { executeRenderHtml = html+          , executeAction = registerEvents events []+          , executeScript = []           }  emptyTask :: ClientTask a-emptyTask = ClientTask { executeRenderHtml = [], executeAction = [] }+emptyTask = ClientTask { executeRenderHtml = [], executeAction = [], executeScript = [] }

@@ -1,10 +1,12 @@-{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE RankNTypes          #-}+{-# LANGUAGE ScopedTypeVariables #-} module Web.Front.Broadcast where  import           Bridge import           Conduit import           Control.Concurrent.Async import           Control.Concurrent.STM   as STM+import           Control.Exception        (catch) import           Control.Monad            (forever) import           Data.Aeson               (Value, decode, toJSON) import           Data.Aeson.Text@@ -26,9 +28,10 @@   -> TChan (Out (Action message))   -> TChan (Out message2)   -> cache model+  -> (IO ())   -> ClientId   -> IO ()-interact onCommand stream in' out' tvar client = do+interact onCommand stream in' out' tvar onClose client = do   race_     (readLoop stream in' tvar client)     (writeLoop stream out' client)@@ -54,7 +57,7 @@                 ExecuteClient cid task ExecuteAll               sendTextData _stream (toLazyText $ encodeToTextBuilder json2) -    readLoop _stream _in _tvar _client = forever $ liftIO $ do+    readLoop _stream _in _tvar _client = (forever $ liftIO $ do       data' <- receiveData _stream       runConduit $ yield data' .| mapM_C (\cmdstr -> do         case (decode $ BL.fromChunks [encodeUtf8 cmdstr] :: Maybe Value) of@@ -62,4 +65,4 @@           Just cmd -> do             liftIO $ putStrLn $ show cmd             res <- onCommand cmd _tvar _client-            atomically $ writeTChan _in res)+            atomically $ writeTChan _in res)) `catch` \(_ex :: ConnectionException) -> onClose