front 0.0.0.2 → 0.0.0.3
raw patch · 11 files changed
+407/−106 lines, 11 filesdep −stm-lifteddep ~basePVP: minor bump suggested
API additions: PVP suggests at least a minor version bump
Dependencies removed: stm-lifted
Dependency ranges changed: base
API changes (from Hackage documentation)
+ Bridge: EnterAction :: ActionType
+ Bridge: OnEnter :: !a -> EventHandler a
+ Text.Blaze.Front.Event: onEnter :: act -> Attribute act
+ Text.Blaze.Front.Html5.Attributes: attribute :: Tag -> Tag -> AttributeValue -> Attribute ev
Files
- ChangeLog.md +5/−0
- README.md +9/−0
- examples/todo/ServantTodo.hs +5/−3
- examples/todo/Shared.hs +90/−0
- examples/todo/Todo.hs +241/−53
- examples/todo/YesodTodo.hs +9/−8
- front.cabal +8/−10
- shared/Bridge.hs +2/−1
- src/Text/Blaze/Front/Event.hs +26/−20
- src/Text/Blaze/Front/Html5/Attributes.hs +4/−3
- src/Web/Front/Broadcast.hs +8/−8
ChangeLog.md view
@@ -1,5 +1,10 @@ # Revision history for front +## 0.0.0.3 -- 2020-02-04++* `Todo` example reworked to be complaint with http://todomvc.com.+* `onBlur`, `onDoubleClick`, `onEnter` event handlers added.+ ## 0.0.0.2 -- 2019-04-10 * Integration with Servant established.
README.md view
@@ -72,6 +72,15 @@ -o bundle.js fay/Client.hs ``` +or++```+~/.local/bin/fay \+ --package fay-dom,fay-websockets \+ --include shared,fay \+ -o bundle.js fay/Client.hs+```+ Please do not hesitate to open Issue to discuss your questions or use cases. ## Acknowledgement
examples/todo/ServantTodo.hs view
@@ -45,7 +45,7 @@ import Text.Blaze.Front.Renderer (renderNewMarkup) import Text.Blaze.Html5 (Html) -import Control.Concurrent.STM.Lifted as STM+import Control.Concurrent.STM as STM import qualified Data.ByteString.Base64 as Base64 import qualified Data.ByteString.Char8 as BSC8 import qualified Data.ByteString.Lazy as BL@@ -55,6 +55,7 @@ import qualified Text.Blaze.Front.Html5.Attributes as A import Bridge+import Shared import Todo import Web.Front.Broadcast @@ -102,6 +103,7 @@ H.head $ do H.title "TODO" H.script ! A.src "/static/bundle.js" $ ""+ H.link ! A.rel "stylesheet" ! A.href "/static/todo.css" H.body $ do H.div ! A.id "root" $ renderModel state) @@ -140,7 +142,7 @@ ex :: AuthCookieExceptionHandler IO ex _e = pure Nothing -setSession :: MonadIO m => Config -> Int -> m ()+setSession :: Config -> Int -> IO () setSession Config{..} clientId = atomically $ do ids <- readTVar clients unless (clientId `elem` ids) $ modifyTVar' clients (clientId :)@@ -156,7 +158,7 @@ , fkspPath = "./test-key-set" } cfg <- Config- <$> STM.newTVarIO initModel+ <$> STM.newTVarIO newModel <*> atomically newBroadcastTChan <*> pure "./static" <*> newTVarIO []
@@ -0,0 +1,90 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}++module Shared where++import Prelude++import Data.Data+import Data.Text (Text)+#ifdef FAY+import Client+#endif+import Bridge++type EntryId = Int++data Visibility = All | Active | Completed+#ifdef FAY+ deriving (Typeable, Data)+#else+ deriving (Show, Typeable, Data, Eq)+#endif++data Msg = Msg1 MsgCommon | Msg2 MsgEntry+#ifdef FAY+ deriving (Typeable, Data)+#else+ deriving (Show, Typeable, Data)+#endif++data MsgCommon+ = Add+ | UpdateField Text+ | CheckAll Bool+ | DeleteComplete+ | ChangeVisibility Visibility+#ifdef FAY+ deriving (Typeable, Data)+#else+ deriving (Show, Typeable, Data)+#endif+++data MsgEntry+ = Editing EntryId Bool+ | UpdateEntry EntryId Text+ | Check EntryId Bool+ | Delete EntryId+#ifdef FAY+ deriving (Typeable, Data)+#else+ deriving (Show, Typeable, Data)+#endif+++#ifdef FAY+-- | Boilerplate that teaches client how to assign value into the message.+update :: Msg -> Text -> Msg+-- FIXME: update (Update ix _oldval) newval = Update ix newval+update (Msg1 msgCommon) x = Msg1 (updateMsgCommon msgCommon x)+update (Msg2 msgEntry) x = Msg2 (updateMsgEntry msgEntry x)++updateMsgCommon :: MsgCommon -> Text -> MsgCommon+updateMsgCommon Add _ = Add+updateMsgCommon (UpdateField _) val2 = UpdateField val2+updateMsgCommon (CheckAll _) val3 = case val3 of+ "checked" -> CheckAll True+ _ -> CheckAll False+updateMsgCommon DeleteComplete _ = DeleteComplete+updateMsgCommon (ChangeVisibility old) val4 = case val4 of+ "All" -> ChangeVisibility All+ "Active" -> ChangeVisibility Active+ "Completed" -> ChangeVisibility Completed+ _ -> ChangeVisibility old++updateMsgEntry :: MsgEntry -> Text -> MsgEntry+updateMsgEntry (Editing eid _old) val1 = case val1 of+ "" -> Editing eid False+ _ -> Editing eid True+updateMsgEntry (UpdateEntry eid _) val2 = UpdateEntry eid val2+updateMsgEntry (Check eid _) val3 = case val3 of+ "" -> Check eid False+ _ -> Check eid True+updateMsgEntry (Delete eid) _ = Delete eid++main = runWith update+#endif
examples/todo/Todo.hs view
@@ -7,10 +7,9 @@ module Todo where import Bridge-import Control.Concurrent.STM.Lifted as STM+import Control.Concurrent.STM as STM import Control.Monad (forM_, void) import Data.Char (isDigit)-import Data.Data import qualified Data.List as L import Data.Text (Text) import qualified Data.Text as T@@ -25,90 +24,266 @@ import Web.Front import Web.Front.Broadcast ++import Shared+ -- * Model data Model = Model- { entries :: [Entry]- , nextId :: Int+ { entries :: [Entry]+ , field :: Text+ , nextId :: EntryId+ , visibility :: Visibility } +newModel :: Model+newModel = Model+ { entries = []+ , field = ""+ , nextId = 0+ , visibility = All+ }+ data Entry = Entry { description :: Text- , eid :: Int+ , completed :: Bool+ , editing :: Bool+ , eid :: EntryId } -data Msg = Add- | Complete Int- | Update Int RecordValue- deriving (Show, Typeable, Data)--initModel :: Model-initModel = Model { entries = [], nextId = 0 }+newEntry :: Text -> EntryId -> Entry+newEntry desc _eid = Entry+ { description = desc+ , completed = False+ , editing = False+ , eid = _eid+ } -- * Event Handling instance CommandHandler TVar Model Msg where- onCommand cmd stateTVar client = do- m@Model{..} <- STM.readTVarIO stateTVar+ onCommand cmd stateTVar' client = do+ putStrLn (show cmd)+ m@Model{..} <- STM.readTVarIO stateTVar' case readFromFay' cmd of Left err -> do putStrLn $ "Error: " <> show err return (ExecuteClient client emptyTask ExecuteAll) Right (Send (Action _ _ acmd)) -> do case acmd of- Add -> do- let newTodo = Entry "TODO: " nextId- newState = Model (newTodo : entries) (succ nextId)- task = createTask "root" renderModel newState- atomically $ void $ swapTVar stateTVar newState- return (ExecuteClient client task ExecuteAll)- Complete _eid -> do- let newState = Model (filter ((/=_eid) . eid) entries) nextId- task = createTask "root" renderModel newState- atomically $ void $ swapTVar stateTVar newState- return (ExecuteClient client task ExecuteAll)- Update _eid val -> do- let newState = Model ((upd _eid val) <$> entries) nextId- upd _id val' e@Entry{..} =- if eid == _id then e { description = val', eid = _id } else e- task = createTask "root" renderModel newState- atomically $ void $ swapTVar stateTVar newState- return (ExecuteClient client task ExecuteExcept)+ Msg1 msgCommon -> onMsgCommon m msgCommon stateTVar' client+ Msg2 msgEntry -> onMsgEntry m msgEntry stateTVar' client Right AskEvents -> do let task = createTask "root" renderModel m return $ ExecuteClient client task ExecuteAll Right PingPong -> return (ExecuteClient client emptyTask ExecuteAll) +onMsgCommon+ :: Model -> MsgCommon -> TVar Model -> ClientId -> IO (Out (Action Msg))+onMsgCommon m@Model{..} msg tvar client = case msg of+ Add -> do+ let update t =+ t { entries = newEntry field nextId : entries, nextId = succ nextId, field = "" }+ go (\t _ -> update t) ()+ UpdateField val -> go2 (\t v -> t { field = v }) val+ CheckAll isChecked -> do+ let update v e = e { completed = v }+ go (\t v -> t { entries = update v <$> entries }) isChecked+ DeleteComplete ->+ go (\t _ -> t { entries = filter (not . completed) entries } ) ()+ ChangeVisibility v -> go (\t x -> t { visibility = x }) v+ where+ go = pushAll m tvar client+ go2 = pushExcept m tvar client++onMsgEntry+ :: Model -> MsgEntry -> TVar Model -> ClientId -> IO (Out (Action Msg))+onMsgEntry m@Model{..} msg tvar client = case msg of+ Editing entryId val -> do+ let update v t = t { editing = v }+ go (\t v -> updateModel t v entryId update) val+ Check entryId val -> do+ let update v t = t { completed = v }+ go (\t v -> updateModel t v entryId update) val+ UpdateEntry entryId val -> do+ let update desc t = t { description = desc }+ go2 (\t v -> updateModel t v entryId update) val+ Delete entryId -> do+ let update e v = e { entries = filter ((/= v) . eid) entries }+ go update entryId+ where+ go = pushAll m tvar client+ go2 = pushExcept m tvar client+ updateModel :: Model -> val -> EntryId -> (val -> Entry -> Entry) -> Model+ updateModel t v i f = t { entries = filterMap entries ((== i) . eid) (f v) }++-- * Helpers++pushExcept+ :: state+ -> TVar Model+ -> ClientId+ -> (state -> val -> Model)+ -> val+ -> IO (Out (Action Msg))+pushExcept model tvar client f val =+ push model tvar client f val ExecuteExcept++pushAll+ :: state+ -> TVar Model+ -> ClientId+ -> (state -> val -> Model)+ -> val+ -> IO (Out (Action Msg))+pushAll model tvar client f val =+ push model tvar client f val ExecuteAll++push+ :: state+ -> TVar Model+ -> ClientId+ -> (state -> val -> Model)+ -> val+ -> ExecuteStrategy+ -> IO (Out (Action Msg))+push model tvar client f val execStrategy = do+ let newState = f model val+ task = createTask "root" renderModel newState+ atomically $ void $ swapTVar tvar newState+ pure (ExecuteClient client task execStrategy)+ -- * Rendering renderModel :: Model -> H.Markup (Action Msg) renderModel Model{..} = do- H.h1 $ "TODO MVC: Servant"- H.br- forM_ entries $ \entry -> renderEntry entry- let btnId = "todo-add"- H.button- ! A.id "todo-add"- ! A.type_ "submit"- ! E.onClick (Action btnId ObjectAction Add)- $ "Add"+ H.div ! A.class_ "todomvc-wrapper" $ do+ H.section ! A.class_ "todoapp" $ do+ H.header ! A.class_ "header" $ do+ H.h1 $ "todos"+ H.input+ ! A.class_ "new-todo"+ ! A.id "new-todo"+ ! A.placeholder "What needs to be done?"+ ! A.autofocus ""+ ! A.value (toValue field)+ ! E.onEnter (Action "new-todo" EnterAction (Msg1 Add))+ ! E.onKeyPress (Action "new-todo" RecordAction (Msg1 $ UpdateField field))+ ! A.name "newTodo" + renderEntries visibility entries+ renderControls visibility entries++ H.footer ! A.class_ "info" $ do+ H.p $ "Double-click to edit todo"+ H.p $ do+ H.span $ "Written by "+ H.a ! A.href "https://github.com/swamp-agr" $ "Andrey Prokopenko"+ H.p $ do+ H.span "Part of "+ H.a ! A.href "https://todomvc.com" $ "TODO MVC"++renderEntries :: Visibility -> [Entry] -> H.Markup (Action Msg)+renderEntries visibility entries = do+ H.section+ ! A.class_ "main" ! A.style ("visibility: " <> cssVisibility entries <> ";")+ $ do H.input+ ! A.class_ "toggle-all"+ ! A.type_ "checkbox"+ ! A.name "toggle"+ ! checkIfTrue allCompleted+ H.label ! A.for "toggle-all" $ "Mark all as complete"+ H.ul ! A.class_ "todo-list" $ do+ forM_ (filter isVisible entries) $ \entry -> renderEntry entry+ where+ cssVisibility [] = "hidden"+ cssVisibility _ = "visible"++ allCompleted = all (==True) $ completed <$> entries+ isVisible Entry{..} =+ case visibility of+ Completed -> completed+ Active -> not completed+ _ -> True+ renderEntry :: Entry -> H.Markup (Action Msg) renderEntry Entry{..} = do- let elemId = "todo-" <> (T.pack $ show eid)- removeId = "remove-" <> (T.pack $ show eid)- H.input- ! A.id (toValue elemId)- ! A.type_ "text"- ! A.value (toValue description)- ! E.onKeyUp (Action elemId RecordAction (Update eid ""))- H.button- ! A.id (toValue removeId)- ! A.type_ "submit"- ! E.onClick (Action removeId ObjectAction (Complete eid))- $ "Done"+ let elemId = "todo-" <> tid+ labelId = "label-" <> tid+ checkId = "check-" <> tid+ removeId = "remove-" <> tid+ tid = T.pack $ show eid+ H.li+ ! A.class_ (toValue $ T.intercalate " " $+ [ "completed" | completed ] <> [ "editing" | editing ])+ $ do+ H.div ! A.class_ "view" $ do+ H.input+ ! A.class_ "toggle"+ ! A.id (toValue checkId)+ ! A.type_ "checkbox"+ ! checkIfTrue completed+ ! A.value ""+ ! E.onClick+ (Action checkId ObjectAction (Msg2 $ Check eid (not completed)))+ H.label+ ! A.id (toValue labelId)+ ! E.onDoubleClick+ (Action labelId ObjectAction (Msg2 $ Editing eid True))+ $ H.toHtml description+ H.button+ ! A.id (toValue removeId)+ ! A.class_ "destroy"+ ! A.type_ "submit"+ ! E.onClick+ (Action removeId ObjectAction (Msg2 $ Delete eid))+ $ ""+ H.input+ ! A.class_ "edit"+ ! A.value (toValue description)+ ! A.name "title"+ ! A.id (toValue elemId)+ ! E.onValueChange+ (Action elemId RecordAction (Msg2 $ UpdateEntry eid description))+ ! E.onBlur+ (Action elemId ObjectAction (Msg2 $ Editing eid False))+ ! E.onEnter+ (Action elemId EnterAction (Msg2 $ Editing eid False))+ H.br +renderControls :: Visibility -> [Entry] -> H.Markup (Action Msg)+renderControls visibility entries = do+ H.footer ! A.class_ "footer" ! hideIfTrue (null entries) $ do+ H.span ! A.class_ "todo-count" $ do+ H.strong (H.toHtml $ show entriesLeft)+ H.span $ H.toHtml+ (" item" <> (if entriesLeft == 1 then "" else "s") <> " left" :: String)++ H.ul ! A.class_ "filters" $ do+ swapVisibility "#/" All visibility+ swapVisibility "#/active" Active visibility+ swapVisibility "#/completed" Completed visibility++ H.button ! A.class_ "clear-completed"+ ! A.id "clear-completed"+ ! hideIfTrue (entriesCompleted == 0)+ ! E.onClick (Action "clear-completed" ObjectAction (Msg1 DeleteComplete))+ $ H.toHtml ("Clear completed (" <> show entriesCompleted <> ")")++ where+ entriesLeft = length entries - entriesCompleted+ entriesCompleted = length . filter completed $ entries+ swapVisibility :: Text -> Visibility -> Visibility -> H.Markup (Action Msg)+ swapVisibility uri visibility' actualVisibility = H.li $ do+ let uid = T.pack $ show visibility'+ H.a ! A.href (toValue uri)+ ! A.id (toValue uid)+ ! A.class_ (toValue $ T.concat [ "selected" | visibility' == actualVisibility ])+ ! E.onClick+ (Action uid ObjectAction (Msg1 $ ChangeVisibility visibility'))+ $ H.toHtml uid+ -- * Helpers parseInt :: Text -> Int@@ -123,3 +298,16 @@ safeFromJust :: forall t. t -> Maybe t -> t safeFromJust defv Nothing = defv safeFromJust _ (Just a) = a++filterMap :: [a] -> (a -> Bool) -> (a -> a) -> [a]+filterMap xs f g = (\x -> if f x then g x else x) <$> xs++hideIfTrue :: Bool -> (H.Attribute (Action Msg))+hideIfTrue predicate = if predicate+ then A.hidden ""+ else A.attribute "" "" ""++checkIfTrue :: Bool -> (H.Attribute (Action Msg))+checkIfTrue predicate = if predicate+ then A.checked "checked"+ else A.attribute "" "" ""
examples/todo/YesodTodo.hs view
@@ -12,18 +12,19 @@ module YesodTodo where import Conduit-import Control.Concurrent.STM.Lifted as STM+import Control.Concurrent.STM as STM import Control.Monad.Reader-import Prelude hiding (interact)-import System.Random (randomRIO)-import Text.Blaze.Front.Renderer (renderNewMarkup)+import Prelude hiding (interact)+import System.Random (randomRIO)+import Text.Blaze.Front.Renderer (renderNewMarkup) import Yesod.Core import Yesod.Static import Yesod.WebSockets -import qualified Data.Text as T+import qualified Data.Text as T import Bridge+import Shared import Todo import Web.Front.Broadcast @@ -58,7 +59,7 @@ getHomeR :: Handler Html getHomeR = do modelTVar <- appModel <$> getYesod- model <- STM.readTVarIO modelTVar+ model <- liftIO $ STM.readTVarIO modelTVar webSockets $ webApp modelTVar defaultLayout $ do setTitle "TODO"@@ -71,7 +72,7 @@ conn <- ask cid <- clientSession writeChan' <- appChannel <$> getYesod- readChan' <- atomically $ do+ readChan' <- liftIO $ atomically $ do dupTChan writeChan' liftIO $ interact conn writeChan' readChan' tvar cid @@ -93,7 +94,7 @@ main :: IO () main = do (App- <$> STM.newTVarIO initModel+ <$> STM.newTVarIO newModel <*> atomically newBroadcastTChan <*> staticDevel "./static") >>= warp 3000
front.cabal view
@@ -2,7 +2,7 @@ -- see http://haskell.org/cabal/users-guide/ name: front-version: 0.0.0.2+version: 0.0.0.3 synopsis: A reactive frontend web framework description: A reactive frontend web framework. See haskell-front.org for more details. homepage: haskell-front.org@@ -14,7 +14,7 @@ category: Web build-type: Simple extra-source-files: ChangeLog.md, README.md-cabal-version: >=1.10+cabal-version: >=2.0 source-repository head type: git@@ -35,11 +35,10 @@ , Bridge -- other-modules: other-extensions: FlexibleInstances, TypeSynonymInstances, OverloadedStrings, GeneralizedNewtypeDeriving, Rank2Types, ExistentialQuantification, DeriveDataTypeable, MultiParamTypeClasses, DeriveFunctor, FunctionalDependencies, ScopedTypeVariables- build-depends: base <5+ build-depends: base >=4.0 && <5 , aeson , async , stm- , stm-lifted , conduit , text >=1.2 && <1.3 , mtl@@ -66,7 +65,7 @@ buildable: False else hs-source-dirs: examples/todo- build-depends: base+ build-depends: base >=4.0 && <5 , aeson , conduit , async@@ -75,7 +74,6 @@ , unordered-containers , stm , random- , stm-lifted >=0.1.1.0 , fay , base-compat >= 0.9.1 , base64-bytestring@@ -101,7 +99,7 @@ , wai >= 3.0 , warp >= 3.0 , front- other-modules: Todo+ other-modules: Todo, Shared ghc-options: -main-is ServantTodo -Wall default-language: Haskell2010 @@ -111,7 +109,7 @@ buildable: False else hs-source-dirs: examples/todo- build-depends: base+ build-depends: base >=4.0 && <5 , front , text , mtl@@ -122,9 +120,9 @@ , yesod-websockets , conduit , aeson- , stm-lifted >=0.1.1.0+ , stm , bytestring - other-modules: Todo+ other-modules: Todo, Shared ghc-options: -main-is YesodTodo -Wall default-language: Haskell2010
@@ -17,6 +17,7 @@ = OnKeyDown !a | OnKeyUp !a | OnKeyPress !a+ | OnEnter !a | OnFocus !a | OnBlur !a | OnValueChange !a@@ -108,7 +109,7 @@ updateAction :: Action a -> a -> Action a updateAction (Action e a _) c = Action e a c-} -data ActionType = RecordAction | ObjectAction+data ActionType = RecordAction | ObjectAction | EnterAction #ifdef FAY deriving (Typeable, Data) #else
src/Text/Blaze/Front/Event.hs view
@@ -6,42 +6,44 @@ -- ** Keyboard events , onKeyDown- , onKeyUp + , onKeyUp , onKeyPress+ , onEnter -- ** Focus events- , onFocus - , onBlur + , onFocus+ , onBlur -- ** Form events , onValueChange , onCheckedChange , onSelectedChange- , onSubmit + , onSubmit -- ** Mouse events- , onClick - , onDoubleClick - , onMouseDown - , onMouseUp - , onMouseMove - , onMouseEnter - , onMouseLeave - , onMouseOver - , onMouseOut + , onClick+ , onDoubleClick+ , onMouseDown+ , onMouseUp+ , onMouseMove+ , onMouseEnter+ , onMouseLeave+ , onMouseOver+ , onMouseOut -- ** UI Events- , onScroll + , onScroll -- ** Wheel Events- , onWheel + , onWheel ) where -import Text.Blaze.Front.Internal (MarkupM(..), Attribute(..), Markup)-import Prelude+import Prelude+import Text.Blaze.Front.Internal (Attribute (..), Markup,+ MarkupM (..)) -import Bridge+import Bridge -- | Modify all event handlers attached to a 'Markup' tree so that the given -- function is applied to the return values of their callbacks.@@ -53,15 +55,19 @@ -- | The user has pressed a physical key while the target element was focused. onKeyDown :: act -> Attribute act-onKeyDown = onEvent . OnKeyDown +onKeyDown = onEvent . OnKeyDown -- | The user has released a phyiscal key while the target element was focused. onKeyUp :: act -> Attribute act onKeyUp = onEvent . OnKeyUp --- | The user has input some ASCII character while the target element was+-- | The user has input some ASCII character while the target element was focused. onKeyPress :: act -> Attribute act onKeyPress = onEvent . OnKeyPress++-- | The user has pressed <Enter> while the target element was focused.+onEnter :: act -> Attribute act+onEnter = onEvent . OnEnter -- Focus events -------------------------------------------------------------------------------
src/Text/Blaze/Front/Html5/Attributes.hs view
@@ -4,8 +4,8 @@ -- | This module exports combinators that provide you with the -- ability to set attributes on HTML elements. ---{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-} module Text.Blaze.Front.Html5.Attributes ( accept , accesskey@@ -14,6 +14,7 @@ , allowtransparency , alt , async+ , attribute , autocapitalize , autocomplete , autocorrect@@ -111,8 +112,8 @@ -- src/Util/GenerateHtmlCombinators.hs:99 -- -import Text.Blaze.Front.Internal- ( Attribute, AttributeValue, attribute )+import Text.Blaze.Front.Internal (Attribute, AttributeValue,+ attribute) -- WARNING: The next block of code was automatically generated by -- src/Util/GenerateHtmlCombinators.hs:249
src/Web/Front/Broadcast.hs view
@@ -4,16 +4,16 @@ import Bridge import Conduit import Control.Concurrent.Async-import Control.Concurrent.STM.Lifted as STM-import Control.Monad (forever)-import Data.Aeson (Value, decode, toJSON)+import Control.Concurrent.STM as STM+import Control.Monad (forever)+import Data.Aeson (Value, decode, toJSON) import Data.Aeson.Text-import qualified Data.ByteString.Lazy as BL+import qualified Data.ByteString.Lazy as BL import Data.Data-import Data.Text.Encoding (encodeUtf8)-import Data.Text.Lazy.Builder (toLazyText)-import Fay.Convert (showToFay)-import Network.WebSockets hiding (Headers)+import Data.Text.Encoding (encodeUtf8)+import Data.Text.Lazy.Builder (toLazyText)+import Fay.Convert (showToFay)+import Network.WebSockets hiding (Headers) -- | The common way how to use websocket 'Connection' obtained from 'Handler' via 'Conduit'. -- 'interact' starts two concurrent processes.