haskell - Incorporate websockets into Yesod -
how incorporate websockets yesod?
i've created project using yesod-postgres template.
stack new rl yesod-postgres
handler/home.hs file looks (no modification yet):
module handler.home import import import qualified data.text.lazy tl import yesod.form.bootstrap3 (bootstrapformlayout (..), renderbootstrap3) import text.julius (rawjs (..)) -- define our data used creating form. data fileform = fileform { fileinfo :: fileinfo , filedescription :: text } gethomer :: handler html gethomer = (formwidget, formenctype) <- generateformpost sampleform let submission = nothing :: maybe fileform handlername = "gethomer" :: text defaultlayout $ let (commentformid, commenttextareaid, commentlistid) = commentids adomid <- newident settitle "welcome yesod!" $(widgetfile "homepage") posthomer :: handler html posthomer = ((result, formwidget), formenctype) <- runformpost sampleform let handlername = "posthomer" :: text submission = case result of formsuccess res -> res _ -> nothing defaultlayout $ let (commentformid, commenttextareaid, commentlistid) = commentids adomid <- newident settitle "welcome yesod!" $(widgetfile "homepage") sampleform :: form fileform sampleform = renderbootstrap3 bootstrapbasicform $ fileform <$> fileaformreq "choose file" <*> areq textfield textsettings nothing -- add attributes placeholder , css classes. textsettings = fieldsettings { fslabel = "what's on file?" , fstooltip = nothing , fsid = nothing , fsname = nothing , fsattrs = [ ("class", "form-control") , ("placeholder", "file description") ] } commentids :: (text, text, text) commentids = ("js-commentform", "js-createcommenttextarea", "js-commentlist") and here websockets example github:
{-# language quasiquotes, templatehaskell, typefamilies, overloadedstrings #-} import yesod.core import yesod.websockets import qualified data.text.lazy tl import control.monad (forever) import control.concurrent (threaddelay) import data.time import data.conduit import qualified data.conduit.list data app = app instance yesod app mkyesod "app" [parseroutes| / homer |] timesource :: monadio m => source m tl.text timesource = forever $ <- liftio getcurrenttime yield $ tl.pack $ show liftio $ threaddelay 5000000 gethomer :: handler html gethomer = websockets $ race_ (sourcews $$ data.conduit.list.map tl.toupper =$ sinkwstext) (timesource $$ sinkwstext) defaultlayout $ towidget [julius| var conn = new websocket("ws://localhost:3000/"); conn.onopen = function() { document.write("<p>open!</p>"); document.write("<button id=button>send message</button>") document.getelementbyid("button").addeventlistener("click", function(){ var msg = prompt("enter message server"); conn.send(msg); }); conn.send("hello world"); }; conn.onmessage = function(e) { document.write("<p>" + e.data + "</p>"); }; conn.onclose = function () { document.write("<p>connection closed</p>"); }; |] main :: io () main = warp 3000 app based on example above tried insert these pieces of code below handler/home.hs.
... import qualified data.text.lazy tl .... timesource :: monadio m => source m tl.text timesource = forever $ <- liftio getcurrenttime yield $ tl.pack $ show liftio $ threaddelay 5000000 .... gethomer = websockets $ race_ (sourcews $$ data.conduit.list.map tl.toupper =$ sinkwstext) (timesource $$ sinkwstext) ... ... posthomer = websockets $ race_ (sourcews $$ data.conduit.list.map tl.toupper =$ sinkwstext) (timesource $$ sinkwstext) and here's final result:
{-# language quasiquotes, templatehaskell, typefamilies, overloadedstrings #-} module handler.home import import import qualified data.text.lazy tl import qualified data.conduit.list import yesod.form.bootstrap3 (bootstrapformlayout (..), renderbootstrap3) import text.julius (rawjs (..)) -- define our data used creating form. data fileform = fileform { fileinfo :: fileinfo , filedescription :: text } -- handler function request method on homer -- resource pattern. of resource patterns defined in -- config/routes -- -- majority of code write in yesod lives in these handler -- functions. can spread them across multiple files if -- inclined, or create single monolithic file. -- timesource :: monadio m => source m tl.text timesource = forever $ <- liftio getcurrenttime yield $ tl.pack $ show liftio $ threaddelay 5000000 gethomer :: handler html gethomer = (formwidget, formenctype) <- generateformpost sampleform let submission = nothing :: maybe fileform handlername = "gethomer" :: text websockets $ race_ (sourcews $$ data.conduit.list.map tl.toupper =$ sinkwstext) (timesource $$ sinkwstext) defaultlayout $ let (commentformid, commenttextareaid, commentlistid) = commentids adomid <- newident settitle "welcome yesod!" $(widgetfile "homepage") posthomer :: handler html posthomer = ((result, formwidget), formenctype) <- runformpost sampleform let handlername = "posthomer" :: text submission = case result of formsuccess res -> res _ -> nothing websockets $ race_ (sourcews $$ data.conduit.list.map tl.toupper =$ sinkwstext) (timesource $$ sinkwstext) defaultlayout $ let (commentformid, commenttextareaid, commentlistid) = commentids adomid <- newident settitle "welcome yesod!" $(widgetfile "homepage") sampleform :: form fileform sampleform = renderbootstrap3 bootstrapbasicform $ fileform <$> fileaformreq "choose file" <*> areq textfield textsettings nothing -- add attributes placeholder , css classes. textsettings = fieldsettings { fslabel = "what's on file?" , fstooltip = nothing , fsid = nothing , fsname = nothing , fsattrs = [ ("class", "form-control") , ("placeholder", "file description") ] } commentids :: (text, text, text) commentids = ("js-commentform", "js-createcommenttextarea", "js-commentlist") but when did stack build, got these errors:
rl-0.0.0: build (lib + exe) preprocessing library rl-0.0.0... [10 of 11] compiling handler.home ( handler/home.hs, .stack-work/dist/x86_64-osx/cabal-1.24.2.0/build/handler/home.o ) /users/ee/projects/haskell projects/rl/handler/home.hs:37:5: error: variable not in scope: websockets :: m0 () -> handlert app io a0 /users/ee/projects/haskell projects/rl/handler/home.hs:37:18: error: • couldn't match type ‘stm m0 (constraints-0.9.1:data.constraint.forall.skolem (pure m0))’ ‘constraints-0.9.1:data.constraint.forall.skolem (pure m0)’ arising use of ‘race_’ type variable ‘m0’ ambiguous • in second argument of ‘($)’, namely ‘race_ (sourcews $$ data.conduit.list.map tl.toupper =$ sinkwstext) (timesource $$ sinkwstext)’ in stmt of 'do' block: websockets $ race_ (sourcews $$ data.conduit.list.map tl.toupper =$ sinkwstext) (timesource $$ sinkwstext) in expression: { (formwidget, formenctype) <- generateformpost sampleform; let submission = ... handlername = ...; websockets $ race_ (sourcews $$ data.conduit.list.map tl.toupper =$ sinkwstext) (timesource $$ sinkwstext); defaultlayout $ { let ...; adomid <- newident; .... } } any ideas on how make websocket works yesod-postgres?
ps:i'm using ghc-8.02. if want try above code , have same ghc, might run stm-lifted dependency issue websockets. unpack stm-lifted , modify cabal file (change transformers version).
update 1:
this code below compiled. i'll try add julius. i'll post update later.
{-# language quasiquotes, templatehaskell, typefamilies, overloadedstrings #-} module handler.home import import import qualified yesod.websockets yw import qualified data.text.lazy tl --import control.concurrent (threaddelay) --import data.time --import data.conduit import qualified data.conduit.list import yesod.form.bootstrap3 (bootstrapformlayout (..), renderbootstrap3) import text.julius (rawjs (..)) -- define our data used creating form. data fileform = fileform { fileinfo :: fileinfo , filedescription :: text } -- handler function request method on homer -- resource pattern. of resource patterns defined in -- config/routes -- -- majority of code write in yesod lives in these handler -- functions. can spread them across multiple files if -- inclined, or create single monolithic file. -- timesource :: monadio m => source m tl.text timesource = forever $ <- liftio getcurrenttime yield $ tl.pack $ show liftio $ threaddelay 5000000 gethomer :: handler html gethomer = (formwidget, formenctype) <- generateformpost sampleform let submission = nothing :: maybe fileform handlername = "gethomer" :: text yw.websockets $ yw.race_ (yw.sourcews $$ data.conduit.list.map tl.toupper =$ yw.sinkwstext) (timesource $$ yw.sinkwstext) defaultlayout $ let (commentformid, commenttextareaid, commentlistid) = commentids adomid <- newident settitle "welcome yesod!" $(widgetfile "homepage") posthomer :: handler html posthomer = ((result, formwidget), formenctype) <- runformpost sampleform let handlername = "posthomer" :: text submission = case result of formsuccess res -> res _ -> nothing yw.websockets $ yw.race_ (yw.sourcews $$ data.conduit.list.map tl.toupper =$ yw.sinkwstext) (timesource $$ yw.sinkwstext) defaultlayout $ let (commentformid, commenttextareaid, commentlistid) = commentids adomid <- newident settitle "welcome yesod!" $(widgetfile "homepage") sampleform :: form fileform sampleform = renderbootstrap3 bootstrapbasicform $ fileform <$> fileaformreq "choose file" <*> areq textfield textsettings nothing -- add attributes placeholder , css classes. textsettings = fieldsettings { fslabel = "what's on file?" , fstooltip = nothing , fsid = nothing , fsname = nothing , fsattrs = [ ("class", "form-control") , ("placeholder", "file description") ] } commentids :: (text, text, text) commentids = ("js-commentform", "js-createcommenttextarea", "js-commentlist")
here solved problem:
{-# language quasiquotes, templatehaskell, typefamilies, overloadedstrings #-} module handler.home import import import qualified yesod.websockets yw import qualified data.text.lazy tl --import control.concurrent (threaddelay) --import data.time --import data.conduit import qualified data.conduit.list import yesod.form.bootstrap3 (bootstrapformlayout (..), renderbootstrap3) import text.julius (rawjs (..)) -- define our data used creating form. data fileform = fileform { fileinfo :: fileinfo , filedescription :: text } -- handler function request method on homer -- resource pattern. of resource patterns defined in -- config/routes -- -- majority of code write in yesod lives in these handler -- functions. can spread them across multiple files if -- inclined, or create single monolithic file. -- timesource :: monadio m => source m tl.text timesource = forever $ <- liftio getcurrenttime yield $ tl.pack $ show liftio $ threaddelay 100000 gethomer :: handler html gethomer = (formwidget, formenctype) <- generateformpost sampleform let submission = nothing :: maybe fileform handlername = "gethomer" :: text yw.websockets $ yw.race_ (yw.sourcews $$ data.conduit.list.map tl.toupper =$ yw.sinkwstext) (timesource $$ yw.sinkwstext) defaultlayout $ let (commentformid, commenttextareaid, commentlistid) = commentids adomid <- newident settitle "welcome yesod!" $(widgetfile "homepage") posthomer :: handler html posthomer = ((result, formwidget), formenctype) <- runformpost sampleform let handlername = "posthomer" :: text submission = case result of formsuccess res -> res _ -> nothing yw.websockets $ yw.race_ (yw.sourcews $$ data.conduit.list.map tl.toupper =$ yw.sinkwstext) (timesource $$ yw.sinkwstext) defaultlayout $ let (commentformid, commenttextareaid, commentlistid) = commentids adomid <- newident settitle "welcome yesod!" $(widgetfile "homepage") sampleform :: form fileform sampleform = renderbootstrap3 bootstrapbasicform $ fileform <$> fileaformreq "choose file" <*> areq textfield textsettings nothing -- add attributes placeholder , css classes. textsettings = fieldsettings { fslabel = "what's on file?" , fstooltip = nothing , fsid = nothing , fsname = nothing , fsattrs = [ ("class", "form-control") , ("placeholder", "file description") ] } commentids :: (text, text, text) commentids = ("js-commentform", "js-createcommenttextarea", "js-commentlist") and added code below homepage.julius.
var conn = new websocket("ws://localhost:3000/"); conn.onopen = function() { document.write("<p>open!</p>"); document.write("<button id=button>send message</button>") document.getelementbyid("button").addeventlistener("click", function(){ var msg = prompt("enter message server"); conn.send(msg); }); conn.send("hello world"); }; conn.onmessage = function(e) { document.write("<p>" + e.data + "</p>"); }; conn.onclose = function () { document.write("<p>connection closed</p>"); }; here's result:
Comments
Post a Comment