Skip to content

Instantly share code, notes, and snippets.

@crabmusket
Last active December 24, 2015 09:39
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 1 You must be signed in to fork a gist
  • Save crabmusket/6778473 to your computer and use it in GitHub Desktop.
Save crabmusket/6778473 to your computer and use it in GitHub Desktop.
Monitoring a serial connection with a Threepenny UI frontend.
-- Imports for serial port
import qualified Data.ByteString.Char8 as B
import System.Hardware.Serialport
(openSerial, recv, closeSerial, defaultSerialSettings)
-- Imports for threading and stuff
import Control.Monad (void, forever, mapM_)
import Control.Concurrent (forkIO, killThread)
import Control.Concurrent.Chan
(Chan, newChan, dupChan, writeChan, getChanContents)
-- Threepenny
import qualified Graphics.UI.Threepenny as UI
import Graphics.UI.Threepenny.Core hiding (text)
import System.Cmd (system)
main = do
-- Start the serial read, which will just send all bytes into a Chan.
bus <- newChan
s <- openSerial "COM4" defaultSerialSettings
t <- forkIO $ forever $ recv s 1 >>= writeChan bus
-- Start the Threepenny GUI (and, under Windows, launch the webpage automatically)
let port = 10000
system $ "start \"\" \"http://localhost:" ++ show port ++ "\""
startGUI defaultConfig { tpPort = port } $ setup bus
-- Runs after the TP UI ends. I assume.
killThread t
closeSerial s
setup :: Bus -> Window -> IO ()
setup globalBus window = void $ do
-- Bus clone lets us listen in
bus <- dupChan globalBus
-- Page elements
updateList <- UI.div #. "updates"
return window # set title "Serial"
getBody window #+
[ UI.h1 #+ [string "Serial thing"]
, element updateList
]
-- Actual interesting bit. This process runs when you open the page.
-- It listens to the bus and creates a new element for each message.
listener <- forkIO $ listen window bus updateList
on UI.disconnect window $ const $ killThread listener
-- Hear a byte on the bus -> create a new div.
listen window bus elem = getChanContents bus >>= mapM_ add
where add u = atomic window $ element elem #+ [mkUpdate u]
-- Another utility function.
mkUpdate u = UI.div #. "update" #+ [string $ B.unpack u]
-- Bus type, if you hadn't guessed.
type Bus = Chan B.ByteString
@robinp
Copy link

robinp commented Oct 2, 2013

Cool! Could use bracket for open/closeSerial and forkIO/killThread to get automatic cleanup.

@crabmusket
Copy link
Author

@robinp Thanks! I've never used bracket before. I'll have a look!

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment