Browse Source

Add ShellCommand and start refactoring into Ops.hs

master
Peter J. Jones 3 years ago
parent
commit
f334080cbf
Signed by: Peter Jones <pjones@devalot.com> GPG Key ID: 9DAFAA8D01941E49

+ 15
- 1
src/lib/Network/XXX/ZigBee/Commander/Event.hs View File

@@ -74,6 +74,7 @@ data SkipType = SkipMuted

--------------------------------------------------------------------------------
data EventAction = SendCommand Text
| ShellCommandAsync Text
| Wait Int
| Mute Int
| Skip SkipType
@@ -92,6 +93,7 @@ type EventHandler = EventHandler' Identity
--------------------------------------------------------------------------------
data Event = JoinNotification Address NodeName NodeType
| DiscoveryNotification Address NodeName NodeType
| ResetRequested Address
| DigitalSample Address PinID DigitalState
deriving (Show)

@@ -132,7 +134,12 @@ parseEventAction t =

where
paction :: Parser EventAction
paction = choice [try psend, try pwait, try pmute, pskip] <* eof
paction = choice [ try psend
, try pshella
, try pwait
, try pmute
, pskip
] <* eof

psend :: Parser EventAction
psend = do
@@ -140,6 +147,12 @@ parseEventAction t =
skipMany space
SendCommand . Text.pack <$> many1 anyChar

pshella :: Parser EventAction
pshella = do
void (string "sh")
skipMany space
ShellCommandAsync . Text.pack <$> many1 anyChar

pwait :: Parser EventAction
pwait = do
void (string "wait")
@@ -212,6 +225,7 @@ resolve nodes EventHandler {..} =
eventDetails :: Event -> (Address, EventType)
eventDetails (JoinNotification a _ _) = (a, NodeIdentification)
eventDetails (DiscoveryNotification a _ _) = (a, NodeIdentification)
eventDetails (ResetRequested a) = (a, NodeIdentification)
eventDetails (DigitalSample a _ _) = (a, DigitalSampleIndicator)

--------------------------------------------------------------------------------

+ 12
- 9
src/lib/Network/XXX/ZigBee/Commander/Internal/Dispatch.hs View File

@@ -19,12 +19,15 @@ module Network.XXX.ZigBee.Commander.Internal.Dispatch
--------------------------------------------------------------------------------
-- Package Imports:
import Control.Concurrent
import Control.Concurrent.Async
import Control.Monad (forever, void, when)
import Data.Monoid
import qualified Data.Text as Text
import qualified System.Process as Process

--------------------------------------------------------------------------------
-- Local Imports:
import qualified Network.XXX.ZigBee.Commander.CommandTable as CommandTable
import qualified Network.XXX.ZigBee.Commander.Internal.Ops as Ops
import Network.XXX.ZigBee.Commander.Config
import Network.XXX.ZigBee.Commander.Event
import Network.XXX.ZigBee.Commander.Internal.Commander
@@ -60,14 +63,14 @@ dispatch = forever go where
----------------------------------------------------------------------------
action :: (MonadIO m) => Event -> EventAction -> Commander m Bool
action event ea = case ea of
SendCommand name ->
do cmds <- asks (cCommandTable . config)
case CommandTable.lookup cmds name of
Nothing -> return ()
Just cmd -> logger ("sending command: " <> name) >>
asks commands >>= \chan ->
liftIO (writeChan chan cmd)
return True
SendCommand name -> do
Ops.send name
return True
ShellCommandAsync command -> do
debug (logger $ "running async shell command: " <> command)
liftIO . void . async . Process.callCommand . Text.unpack $ command
return True

Wait delay -> do
debug (loggerS $ "waiting: " ++ show delay)

+ 69
- 0
src/lib/Network/XXX/ZigBee/Commander/Internal/Ops.hs View File

@@ -0,0 +1,69 @@
{-# LANGUAGE OverloadedStrings #-}

{-

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.Ops
( send
, reset
) where

--------------------------------------------------------------------------------
-- Package Imports:
import Control.Concurrent
import Control.Monad (forM_)
import Data.Monoid
import Data.Text (Text)

--------------------------------------------------------------------------------
-- Local Imports:
import Network.XXX.ZigBee.Commander.Address
import qualified Network.XXX.ZigBee.Commander.CommandTable as CommandTable
import Network.XXX.ZigBee.Commander.Config
import Network.XXX.ZigBee.Commander.Event
import Network.XXX.ZigBee.Commander.Internal.Commander
import Network.XXX.ZigBee.Commander.Internal.Environment
import qualified Network.XXX.ZigBee.Commander.NodeTable as NodeTable

--------------------------------------------------------------------------------
-- | Send a command to a device, given the name of the command.
send :: (MonadIO m) => Text -> Commander m ()
send name = do
env <- ask

let cmds = cCommandTable (config env)
chan = commands env

case CommandTable.lookup cmds name of
Nothing -> return ()
Just cmd -> do
logger ("sending command: " <> name)
liftIO (writeChan chan cmd)

--------------------------------------------------------------------------------
-- | Reset a specific node if given a node name, otherwise all nodes
-- are reset. Nodes are reset by sending a @ResetRequested@ event to
-- the server which in turn simulates a node joining the network.
-- This will cause its initialization code in the configuration file
-- to be executed.
reset :: (MonadIO m) => Maybe Text -> Commander m ()
reset name = do
env <- ask

let nodes = cNodeTable (config env)
chan = events env

case NodeTable.lookupOneOrAll nodes name of
Left e -> loggerS e
Right addrs -> forM_ addrs $ \addr -> do
loggerS ("resetting node " <> show addr)
liftIO (writeChan chan (ResetRequested (Network addr)))

+ 12
- 0
src/lib/Network/XXX/ZigBee/Commander/NodeTable.hs View File

@@ -17,6 +17,7 @@ module Network.XXX.ZigBee.Commander.NodeTable
, defaultNodeTable
, resolve
, lookup
, lookupOneOrAll
) where

--------------------------------------------------------------------------------
@@ -26,6 +27,7 @@ import Data.Aeson.Types (typeMismatch)
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Text (Text)
import qualified Data.Text as Text
import qualified Data.Vector as Vector
import Prelude hiding (lookup)

@@ -82,3 +84,13 @@ resolve tbl (UnresolvedText name) =
-- | Look up a node's MAC address using its name.
lookup :: NodeTable -> Text -> Maybe MAC
lookup (NodeTable m) key = Map.lookup key m

--------------------------------------------------------------------------------
-- | If given a name, lookup just that node. Otherwise return all
-- nodes in the node table. This is helpful for commands that
-- optionally take a node name and a missing name means all nodes.
lookupOneOrAll :: NodeTable -> Maybe Text -> Either String [MAC]
lookupOneOrAll (NodeTable m) Nothing = Right (Map.elems m)
lookupOneOrAll (NodeTable m) (Just name) = case Map.lookup name m of
Nothing -> Left ("unknown node name: " ++ Text.unpack name)
Just mac -> Right [mac]

+ 4
- 3
zigbee-commander.cabal View File

@@ -44,15 +44,16 @@ library
Network.XXX.ZigBee.Commander.Event
Network.XXX.ZigBee.Commander.GPIO
Network.XXX.ZigBee.Commander.Internal.Commander
Network.XXX.ZigBee.Commander.Internal.Dispatch
Network.XXX.ZigBee.Commander.Internal.Environment
Network.XXX.ZigBee.Commander.Internal.Main
Network.XXX.ZigBee.Commander.Internal.Ops
Network.XXX.ZigBee.Commander.Internal.Resolve
Network.XXX.ZigBee.Commander.Internal.Serial
Network.XXX.ZigBee.Commander.Internal.State
Network.XXX.ZigBee.Commander.Internal.Util
Network.XXX.ZigBee.Commander.Node
Network.XXX.ZigBee.Commander.NodeTable
Network.XXX.ZigBee.Commander.Internal.Resolve
Network.XXX.ZigBee.Commander.Internal.Dispatch
Network.XXX.ZigBee.Commander.Internal.Environment

other-modules:


Loading…
Cancel
Save