Browse Source

Get serial IO working, fake main code

master
Peter J. Jones 4 years ago
parent
commit
4d82d6813f

+ 21
- 0
src/bin/zbc.hs View File

@@ -0,0 +1,21 @@
{-

This file is part of the zigbee-commander package. It is subject to
the license terms in the LICENSE file found in the top-level directory
of this distribution and at git://pmade.com/zbc/LICENSE. No part of
the zigbee-commander package, including this file, may be copied,
modified, propagated, or distributed except according to the terms
contained in the LICENSE file.

-}

--------------------------------------------------------------------------------
module Main (main) where

--------------------------------------------------------------------------------
-- Local Imports:
import Network.XXX.ZigBee.Commander.Internal.Main

--------------------------------------------------------------------------------
main :: IO ()
main = commanderMain

+ 4
- 2
src/lib/Network/XXX/ZigBee/Commander/Config.hs View File

@@ -17,11 +17,13 @@ module Network.XXX.ZigBee.Commander.Config

--------------------------------------------------------------------------------
data Config = Config
{ cConnectionRetryTimeout :: Int
{ cDeviceFile :: FilePath
, cConnectionRetryTimeout :: Int
}

--------------------------------------------------------------------------------
defaultConfig :: Config
defaultConfig =
Config { cConnectionRetryTimeout = 5
Config { cDeviceFile = "/dev/ttyUSB0"
, cConnectionRetryTimeout = 5
}

+ 5
- 5
src/lib/Network/XXX/ZigBee/Commander/Internal/Commander.hs View File

@@ -50,16 +50,16 @@ newtype Commander m a =
--------------------------------------------------------------------------------
-- FIXME:
logger :: (MonadIO m) => Text -> Commander m ()
logger = liftIO . Text.hPutStrLn stdout
logger = liftIO . Text.hPutStrLn stderr

--------------------------------------------------------------------------------
runCommander :: (Monad m)
=> FilePath
-> Config
=> Config
-> Commander m a
-> m (Either String a)
runCommander path config cmdr = do
result <- runEitherT $ evalRWST (unC cmdr) config (initialState path)
runCommander config cmdr = do
result <- runEitherT $ evalRWST (unC cmdr) config
(initialState $ cDeviceFile config)

return $ case result of
Left e -> Left e

+ 49
- 0
src/lib/Network/XXX/ZigBee/Commander/Internal/Main.hs View File

@@ -0,0 +1,49 @@
{-

This file is part of the zigbee-commander package. It is subject to
the license terms in the LICENSE file found in the top-level directory
of this distribution and at git://pmade.com/zbc/LICENSE. No part of
the zigbee-commander package, including this file, may be copied,
modified, propagated, or distributed except according to the terms
contained in the LICENSE file.

-}

--------------------------------------------------------------------------------
module Network.XXX.ZigBee.Commander.Internal.Main
( commanderMain
) where

--------------------------------------------------------------------------------
-- Package Imports:
import Control.Concurrent
import Control.Concurrent.Async
import Control.Monad (forever)
import qualified Network.Protocol.ZigBee.ZNet25 as Z
import System.IO

--------------------------------------------------------------------------------
-- Local Imports:
import Network.XXX.ZigBee.Commander.Config
import Network.XXX.ZigBee.Commander.Internal.Commander
import Network.XXX.ZigBee.Commander.Internal.Serial

--------------------------------------------------------------------------------
commanderMain :: IO ()
commanderMain = do
inchan <- newChan
outchan <- newChan

serialIOThread <- async (serialIO inchan outchan)

_ <- forever $ do
incoming <- readChan outchan
hPrint stderr incoming

cancel serialIOThread

where
serialIO :: Chan Z.Frame -> Chan Z.Frame -> IO ()
serialIO inchan outchan = do
_ <- runCommander defaultConfig $ forever (serialThread inchan outchan)
return ()

+ 55
- 26
src/lib/Network/XXX/ZigBee/Commander/Internal/Serial.hs View File

@@ -13,21 +13,23 @@ contained in the LICENSE file.

--------------------------------------------------------------------------------
module Network.XXX.ZigBee.Commander.Internal.Serial
( writer
, reader
( serialThread
) where

--------------------------------------------------------------------------------
-- Package Imports:
import Control.Concurrent
import Control.Concurrent.Async
import Control.Monad.State (runState)
import Data.ByteString (ByteString)
import qualified Data.ByteString as ByteString
import Data.Either
import Data.Text (Text)
import Data.Monoid
import qualified Data.Text as Text
import Data.Time.Clock
import qualified Network.Protocol.ZigBee.ZNet25 as Z
import System.IO
import Text.Printf (printf)

--------------------------------------------------------------------------------
-- Local Imports:
@@ -35,6 +37,33 @@ import Network.XXX.ZigBee.Commander.Config
import Network.XXX.ZigBee.Commander.Internal.Commander
import Network.XXX.ZigBee.Commander.Internal.State

--------------------------------------------------------------------------------
-- | Process incoming and outgoing frames in a separate thread. This
-- computation is expected to be wrapped in a @forever@ call.
serialThread :: (MonadIO m) => Chan Z.Frame -> Chan Z.Frame -> Commander m ()
serialThread inchan outchan = do
readThread <- waitRead
writeThread <- waitWrite
action <- liftIO (waitEitherCancel readThread writeThread)

case action of
Left _ -> reader >>= liftIO . writeList2Chan outchan
Right f -> writer [f]

where
-- Wait for data from the locally connected ZigBee device to be
-- available. If no device is connected, wait for it to become
-- connected.
waitRead :: (MonadIO m) => Commander m (Async Bool)
waitRead = withConnectedDevice $ \mh ->
case mh of
Nothing -> liftIO (threadDelay 1000000) >> waitRead
Just h -> liftIO (async $ hWaitForInput h (-1))

-- Wait for another thread to ask for frames to be written.
waitWrite :: (MonadIO m) => Commander m (Async Z.Frame)
waitWrite = liftIO (async $ readChan inchan)

--------------------------------------------------------------------------------
device :: (MonadIO m) => Commander m DeviceNodeState
device = do
@@ -53,9 +82,9 @@ device = do
connect :: (MonadIO m) => FilePath -> UTCTime -> Commander m (Maybe DeviceNodeState)
connect path t = do
now <- liftIO getCurrentTime
wait <- fromIntegral <$> asks cConnectionRetryTimeout
secs <- fromIntegral <$> asks cConnectionRetryTimeout

if diffUTCTime now t < wait
if diffUTCTime now t < secs
then return Nothing
else do
-- FIXME: Guard for exceptions.
@@ -65,30 +94,27 @@ device = do

--------------------------------------------------------------------------------
withConnectedDevice :: (MonadIO m)
=> Maybe Text
-- ^ Error message to display if the local
-- device node is not currently connected.

-> (Handle -> Commander m ())
=> (Maybe Handle -> Commander m a)
-- ^ Function to call when the local device node
-- is connected.

-> Commander m ()
-> Commander m a
-- ^ Result.
withConnectedDevice e f = do
withConnectedDevice f = do
ns <- device

case ns of
DeviceNodeState _ (Left _) -> maybe (return ()) logger e
DeviceNodeState _ (Right h) -> f h -- FIXME: catch exceptions,
-- disable device.
DeviceNodeState _ (Left _) -> f Nothing
DeviceNodeState _ (Right h) -> f (Just h) -- FIXME: catch exceptions,
-- disable device.

--------------------------------------------------------------------------------
writer :: (MonadIO m) => [Z.Frame] -> Commander m ()
writer frames = withConnectedDevice (Just "not connected, dropping frames") go
writer frames = withConnectedDevice go
where
go :: (MonadIO m) => Handle -> Commander m ()
go h = mapM_ (write h . Z.encode) frames
go :: (MonadIO m) => Maybe Handle -> Commander m ()
go Nothing = logger "not connected, dropping frames"
go (Just h) = mapM_ (write h . Z.encode) frames

-- FIXME: add support for hPutNonBlocking by maintaining a write
-- buffer and trying to flush that buffer when called.
@@ -96,20 +122,23 @@ writer frames = withConnectedDevice (Just "not connected, dropping frames") go
write h = liftIO . ByteString.hPut h . ByteString.concat

--------------------------------------------------------------------------------
reader :: (MonadIO m) => Commander m ()
reader = withConnectedDevice Nothing go
reader :: (MonadIO m) => Commander m [Z.Frame]
reader = withConnectedDevice go
where
go :: (MonadIO m) => Handle -> Commander m ()
go h = do
go :: (MonadIO m) => Maybe Handle -> Commander m [Z.Frame]
go Nothing = return []
go (Just h) = do
s <- get
bs <- liftIO (ByteString.hGetNonBlocking h 1024)
bs <- liftIO (ByteString.hGetSome h 1024)
hexdump bs -- FIXME: only when debugging output is enabled

let (results, decoderState') = runState (Z.decode bs) (decoderState s)
(errors, frames) = partitionEithers results

put s {decoderState = decoderState'}
mapM_ (logger . Text.pack) errors
addFrames frames
return frames

-- FIXME: Where do frames go after they are read?
addFrames = undefined
hexdump :: (MonadIO m) => ByteString -> Commander m ()
hexdump bs = let encoded = concatMap (printf "%02x ") (ByteString.unpack bs)
in logger ("read bytes: " <> Text.pack encoded)

+ 10
- 1
zigbee-commander.cabal View File

@@ -40,11 +40,12 @@ library
Network.XXX.ZigBee.Commander.Address
Network.XXX.ZigBee.Commander.Command
Network.XXX.ZigBee.Commander.Config
Network.XXX.ZigBee.Commander.Node
Network.XXX.ZigBee.Commander.GPIO
Network.XXX.ZigBee.Commander.Internal.Commander
Network.XXX.ZigBee.Commander.Internal.Main
Network.XXX.ZigBee.Commander.Internal.Serial
Network.XXX.ZigBee.Commander.Internal.State
Network.XXX.ZigBee.Commander.Node

other-modules:

@@ -57,6 +58,7 @@ library
ghc-prof-options: -prof -auto-all

build-depends: aeson >= 0.8 && < 0.10
, async >= 2.0 && < 2.1
, base >= 4.6 && < 5.0
, bytestring >= 0.10 && < 0.11
, containers >= 0.5 && < 0.6
@@ -74,11 +76,11 @@ library
, zigbee-znet25 >= 0.1 && < 0.2

--------------------------------------------------------------------------------
executable zbc
default-language: Haskell2010
main-is: src/bin/zbc.hs
build-depends: base, zigbee-commander
ghc-options: -Wall -fwarn-incomplete-uni-patterns -threaded

if flag(maintainer)
ghc-options: -Werror

Loading…
Cancel
Save