diff --git a/ReadMe.md b/ReadMe.md --- a/ReadMe.md +++ b/ReadMe.md @@ -7,8 +7,9 @@ Clients ------- -The simple Kafka client that produces events from the joystick can be run, for example, as follows: +The simple Kafka client that produces events from the joystick can be run, for example, as one of the following: cabal run kafka-device-spacenav -- /dev/input/spacenavigator spacenav-client localhost 9092 events spacenav + cabal run kafka-device-spacenav -- sample.yaml Also see https://hackage.haskell.org/package/kafka-device/. diff --git a/kafka-device-spacenav.cabal b/kafka-device-spacenav.cabal --- a/kafka-device-spacenav.cabal +++ b/kafka-device-spacenav.cabal @@ -1,12 +1,12 @@ name: kafka-device-spacenav -version: 0.1.5.0 +version: 0.2.1.0 synopsis: Linux SpaceNavigator events via a Kafka message broker description: This package contains functions for passing Linux device events from a SpaceNavigator \<\> to topics on a Kafka message broker \<\>. Also see \<\>. license: MIT license-file: LICENSE author: Brian W Bush maintainer: Brian W Bush -copyright: (c) 2016 Brian W Bush +copyright: (c) 2016-17 Brian W Bush category: Hardware build-type: Simple cabal-version: >= 1.10 @@ -23,6 +23,7 @@ library exposed-modules: Network.UI.Kafka.SpaceNav + Network.UI.Kafka.SpaceNav.Interpretation System.Hardware.Linux.Input System.Hardware.Linux.SpaceNav build-depends: base >= 4.8 && < 5 @@ -33,7 +34,7 @@ , kafka-device , milena hs-source-dirs: src - ghc-options: -Wall + ghc-options: -O2 -Wall default-language: Haskell2010 executable kafka-device-spacenav @@ -44,7 +45,9 @@ , bytestring , cereal , kafka-device + , linear , milena + , yaml hs-source-dirs: src - ghc-options: -Wall + ghc-options: -O2 -Wall default-language: Haskell2010 diff --git a/src/Main.hs b/src/Main.hs --- a/src/Main.hs +++ b/src/Main.hs @@ -1,6 +1,6 @@ {-| -Module : Main -Copyright : (c) 2016 Brian W Bush +Module : $Header$ +Copyright : (c) 2016-17 Brian W Bush License : MIT Maintainer : Brian W Bush Stability : Experimental @@ -16,11 +16,14 @@ ) where -import Data.String (IsString(fromString)) -import Network.UI.Kafka.SpaceNav (spacenavLoop) +import Data.Yaml.Config (loadYamlSettingsArgs, useEnv) +import Network.UI.Kafka (TopicConnection(TopicConnection)) import System.Environment (getArgs) +import qualified Network.UI.Kafka.SpaceNav as Raw (spacenavLoop) +import qualified Network.UI.Kafka.SpaceNav.Interpretation as Interpreted (spacenavLoop) + -- The main action. main :: IO () main = @@ -35,12 +38,19 @@ putStrLn $ "Kafka topic: " ++ topic putStrLn $ "Sensor name: " ++ sensor (_, loop) <- - spacenavLoop + Raw.spacenavLoop device - (fromString client) - (fromString host, toEnum $ read port) - (fromString topic) + (TopicConnection client (host, read port) topic) sensor result <- loop either print return result - _ -> putStrLn "USAGE: kafka-device-spacenav device client host port topic sensor" + [_] -> + do + interpretation <- loadYamlSettingsArgs [] useEnv + (_, loop) <- Interpreted.spacenavLoop interpretation + either print return =<< loop + _ -> + do + putStrLn "USAGE: kafka-device-spacenav device client host port topic sensor" + putStrLn "or" + putStrLn "USAGE: kafka-device-spacenav interpretation.yaml" diff --git a/src/Network/UI/Kafka/SpaceNav.hs b/src/Network/UI/Kafka/SpaceNav.hs --- a/src/Network/UI/Kafka/SpaceNav.hs +++ b/src/Network/UI/Kafka/SpaceNav.hs @@ -1,6 +1,6 @@ {-| -Module : Network.UI.Kafka.SpaceNav -Copyright : (c) 2016 Brian W Bush +Module : $Header$ +Copyright : (c) 2016-17 Brian W Bush License : MIT Maintainer : Brian W Bush Stability : Experimental @@ -20,9 +20,7 @@ import Data.ByteString.Lazy.Char8 (hGet) -import Network.Kafka (KafkaAddress, KafkaClientId) -import Network.Kafka.Protocol (TopicName) -import Network.UI.Kafka (ExitAction, LoopAction, Sensor, producerLoop) +import Network.UI.Kafka (ExitAction, LoopAction, TopicConnection, Sensor, producerLoop) import Network.UI.Kafka.Types (Button(..), Event(..), Toggle(..)) import System.Hardware.Linux.SpaceNav (SpaceNav(..), byteLength, interpretSpaceNav) import System.IO (IOMode(ReadMode), hClose, openFile) @@ -30,16 +28,14 @@ -- | Produce events for a Kafka topic from a Linux SpaceNav. spacenavLoop :: FilePath -- ^ The path to the spacenav device, e.g. "\/dev\/input\/spacenav0". - -> KafkaClientId -- ^ A Kafka client identifier for the producer. - -> KafkaAddress -- ^ The address of the Kafka broker. - -> TopicName -- ^ The Kafka topic name. + -> TopicConnection -- ^ The Kafka topic name and connection information. -> Sensor -- ^ The name of the sensor producing events. -> IO (ExitAction, LoopAction) -- ^ Action to create the exit and loop actions. -spacenavLoop path client address topic sensor = +spacenavLoop path topicConnection sensor = do spacenav <- openFile path ReadMode (exit, loop) <- - producerLoop client address topic sensor + producerLoop topicConnection sensor $ translate . interpretSpaceNav <$> hGet spacenav byteLength diff --git a/src/Network/UI/Kafka/SpaceNav/Interpretation.hs b/src/Network/UI/Kafka/SpaceNav/Interpretation.hs new file mode 100644 --- /dev/null +++ b/src/Network/UI/Kafka/SpaceNav/Interpretation.hs @@ -0,0 +1,49 @@ +{-| +Module : $Header$ +Copyright : (c) 2016-17 Brian W Bush +License : MIT +Maintainer : Brian W Bush +Stability : Experimental +Portability : Linux + +Produce interpreted events for a Kafka topic from a SpaceNavigator \<\> on Linux. +-} + + +{-# LANGUAGE RecordWildCards #-} + + +module Network.UI.Kafka.SpaceNav.Interpretation ( +-- * Event handling + spacenavLoop +) where + + +import Data.ByteString.Lazy.Char8 (hGet) +import Network.UI.Kafka (ExitAction, LoopAction) +import Network.UI.Kafka.Interpretation (Interpretation(..), interpretationLoop) +import System.Hardware.Linux.SpaceNav (SpaceNav(..), byteLength, interpretSpaceNav) +import System.IO (IOMode(ReadMode), hClose, openFile) + + +-- | Interpret events from a Linux SpaceNav. +spacenavLoop :: Interpretation Double -- ^ Instructions for interpretation. + -> IO (ExitAction, LoopAction) -- ^ Action to create the exit and loop actions. +spacenavLoop interpretation@TrackInterpretation{..} = + do + let + analogHandler SpaceNavAnalog{..} = Just (number, setting) + analogHandler _ = Nothing + buttonHandler SpaceNavButton{..} = Just (number, pressed) + buttonHandler _ = Nothing + spacenav <- openFile path ReadMode + (exit, loop) <- + interpretationLoop analogHandler buttonHandler interpretation + $ interpretSpaceNav <$> hGet spacenav byteLength + return + ( + do + exit + hClose spacenav + , loop + ) diff --git a/src/System/Hardware/Linux/Input.hs b/src/System/Hardware/Linux/Input.hs --- a/src/System/Hardware/Linux/Input.hs +++ b/src/System/Hardware/Linux/Input.hs @@ -1,6 +1,6 @@ {-| -Module : System.Hardware.Linux.Input -Copyright : (c) 2016 Brian W Bush +Module : $Header$ +Copyright : (c) 2016-17 Brian W Bush License : MIT Maintainer : Brian W Bush Stability : Experimental @@ -26,6 +26,7 @@ import Data.Word (Word16, Word32) import qualified Data.ByteString.Lazy as BS (length) + -- | Input events from Linux /dev/input streams. See \<\> for details. data InputEvent = diff --git a/src/System/Hardware/Linux/SpaceNav.hs b/src/System/Hardware/Linux/SpaceNav.hs --- a/src/System/Hardware/Linux/SpaceNav.hs +++ b/src/System/Hardware/Linux/SpaceNav.hs @@ -1,6 +1,6 @@ {-| -Module : System.Hardware.Linux.SpaceNav -Copyright : (c) 2016 Brian W Bush +Module : $Header$ +Copyright : (c) 2016-17 Brian W Bush License : MIT Maintainer : Brian W Bush Stability : Experimental