packages feed

kafka-device (empty) → 0.1.5.0

raw patch · 9 files changed

+689/−0 lines, 9 filesdep +aesondep +basedep +binarysetup-changed

Dependencies added: aeson, base, binary, bytestring, cereal, milena, mtl

Files

+ LICENSE view
@@ -0,0 +1,20 @@+Copyright (c) 2016 Brian W Bush++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ ReadMe.md view
@@ -0,0 +1,24 @@+UI device events via a Kafka message broker+===========================================+++This package contains functions passing UI device events to topics on a [Kafka message broker](https://kafka.apache.org/).+++Clients+-------++The simple Kafka client that produces events from the keyboard can be run, for example, as follows:++	cabal run kafka-device-keyboard -- keyboard-client localhost 9092 events keyboard++The simple Kafka client that consumes events can be run, for example, as follows:++	cabal run kafka-device -- consumer-client localhost 9092 events++See also++*   https://hackage.haskell.org/package/kafka-device-joystick/: events from Linux joysticks+*   https://hackage.haskell.org/package/kafka-device-glut/: events from GLUT-compatible devices+*   https://hackage.haskell.org/package/kafka-device-spacenav/: events from SpaceNavigator devices+*   https://hackage.haskell.org/package/kafka-device-leap/: events from Leap Motion devices
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ kafka-device.cabal view
@@ -0,0 +1,63 @@+name:                kafka-device+version:             0.1.5.0+synopsis:            UI device events via a Kafka message broker+description:         This package contains functions for passing UI device events to topics on a Kafka message broker \<<https://kafka.apache.org/>\>.  Also see \<<https://hackage.haskell.org/package/kafka-device-joystick/>\>, \<<https://hackage.haskell.org/package/kafka-device-glut/>\>, \<<https://hackage.haskell.org/package/kafka-device-spacenav/>\>, \<<https://hackage.haskell.org/package/kafka-device-leap/>\>.+license:             MIT+license-file:        LICENSE+author:              Brian W Bush <consult@brianwbush.info>+maintainer:          Brian W Bush <consult@brianwbush.info>+copyright:           (c) 2016 Brian W Bush+category:            Hardware+build-type:          Simple+cabal-version:       >= 1.10+stability:           Experimental+homepage:            https://bitbucket.org/functionally/kafka-device+bug-reports:         https://bwbush.atlassian.net/projects/HKAFDEV/issues/+package-url:         https://bitbucket.org/functionally/kafka-device/downloads/kafka-device-0.1.5.0.tar.gz++extra-source-files:  ReadMe.md++source-repository head+  type: git+  location: https://bitbucket.org/functionally/kafka-device+ +library+  exposed-modules:  Network.UI.Kafka+                    Network.UI.Kafka.Keyboard+                    Network.UI.Kafka.Types+  build-depends:    base         >= 4.8 && < 5+               ,    aeson+               ,    binary+               ,    bytestring+               ,    cereal+               ,    milena+               ,    mtl+  hs-source-dirs:   src+  ghc-options:      -Wall+  default-language: Haskell2010++executable kafka-device+  main-is:          Main.hs+  build-depends:    base+               ,    aeson+               ,    binary+               ,    bytestring+               ,    cereal+               ,    milena+               ,    mtl+  hs-source-dirs:   src+  ghc-options:      -Wall -threaded+  default-language: Haskell2010++executable kafka-device-keyboard+  main-is:          MainKeyboard.hs+  build-depends:    base+               ,    aeson+               ,    binary+               ,    bytestring+               ,    cereal+               ,    milena+               ,    mtl+  hs-source-dirs:   src+  ghc-options:      -Wall -threaded+  default-language: Haskell2010
+ src/Main.hs view
@@ -0,0 +1,43 @@+{-|+Module      :  Main+Copyright   :  (c) 2016 Brian W Bush+License     :  MIT+Maintainer  :  Brian W Bush <consult@brianwbush.info>+Stability   :  Experimental+Portability :  Stable++Simple consumer that echos UI events from a Kafka topic to the console.+-}+++module Main (+-- * Entry point+  main+) where+++import Data.String (IsString(fromString))+import Network.UI.Kafka (consumerLoop)+import System.Environment (getArgs)+++-- | The main action.+main :: IO ()+main =+  do+    args <- getArgs+    case args of+      [client, host, port, topic] ->+        do+          putStrLn $ "Kafka client:  " ++ client+          putStrLn $ "Kafka address: (" ++ host ++ "," ++ port ++ ")"+          putStrLn $ "Kafka topic:   " ++ topic+          (_, loop) <-+            consumerLoop+              (fromString client)+              (fromString host, toEnum $ read port)+              (fromString topic)+              $ curry print+          result <- loop+          either print return result+      _ -> putStrLn "USAGE: kafka-device client host port topic"
+ src/MainKeyboard.hs view
@@ -0,0 +1,44 @@+{-|+Module      :  Main+Copyright   :  (c) 2016 Brian W Bush+License     :  MIT+Maintainer  :  Brian W Bush <consult@brianwbush.info>+Stability   :  Experimental+Portability :  Stable++Simple producer of keyboard events from standard input to a Kafka topic.+-}+++module Main (+-- * Entry point+  main+) where+++import Data.String (IsString(fromString))+import Network.UI.Kafka.Keyboard (keyboardLoop)+import System.Environment (getArgs)+++-- | The main action.+main :: IO ()+main =+  do+    args <- getArgs+    case args of+      [client, host, port, topic, sensor] ->+        do+          putStrLn $ "Kafka client:  " ++ client+          putStrLn $ "Kafka address: (" ++ host ++ "," ++ port ++ ")"+          putStrLn $ "Kafka topic:   " ++ topic+          putStrLn $ "Sensor name:   " ++ sensor+          (_, loop) <-+            keyboardLoop+              (fromString client)+              (fromString host, toEnum $ read port)+              (fromString topic)+              sensor+          result <- loop+          either print return result+      _ -> putStrLn "USAGE: kafka-device-keyboard client host port topic sensor"
+ src/Network/UI/Kafka.hs view
@@ -0,0 +1,127 @@+{-|+Module      :  Network.UI.Kafka+Copyright   :  (c) 2016 Brian W Bush+License     :  MIT+Maintainer  :  Brian W Bush <consult@brianwbush.info>+Stability   :  Experimental+Portability :  Stable++Produce and consume events on Kafka topics.+-}+++module Network.UI.Kafka (+-- * Types+  Sensor+, LoopAction+, ExitAction+-- * Consumption+, ConsumerCallback+, consumerLoop+-- * Production+, ProducerCallback+, producerLoop+) where+++import Control.Concurrent (MVar, newEmptyMVar, isEmptyMVar, threadDelay, tryPutMVar)+import Control.Monad (void, when)+import Control.Monad.Except (liftIO)+import Data.Binary (decode, encode)+import Data.ByteString.Char8 (pack, unpack)+import Data.ByteString.Lazy (fromStrict, toStrict)+import Network.UI.Kafka.Types (Event)+import Network.Kafka (KafkaAddress, KafkaClientError, KafkaClientId, KafkaTime(..), TopicAndMessage(..), getLastOffset, mkKafkaState, runKafka, withAddressHandle)+import Network.Kafka.Consumer (fetch', fetchMessages, fetchRequest)+import Network.Kafka.Producer (makeKeyedMessage, produceMessages)+import Network.Kafka.Protocol (FetchResponse(..), KafkaBytes(..), Key(..), Message(..), TopicName, Value(..))+++-- | A name for a sensor.+type Sensor = String+++-- | Action for iterating to produce or consume events.+type LoopAction = IO (Either KafkaClientError ())+++-- | Action for ending iteration.+type ExitAction = IO ()+++-- | Callback for consuming events from a sensor.+type ConsumerCallback =  Sensor -- ^ The name of the sensor producing the event.+                      -> Event  -- ^ The event.+                      -> IO ()  -- ^ The action for consuming the event.+++-- | Consume events for a Kafka topic.+consumerLoop :: KafkaClientId               -- ^ A Kafka client identifier for the consumer.+             -> KafkaAddress                -- ^ The address of the Kafka broker.+             -> TopicName                   -- ^ The Kafka topic name.+             -> ConsumerCallback            -- ^ The consumer callback.+             -> IO (ExitAction, LoopAction) -- ^ Action to create the exit and loop actions.+consumerLoop clientId address topic consumer =+  do+    exitFlag <- newEmptyMVar :: IO (MVar ())+    let+      fromMessage :: Message -> (Sensor, Event)+      fromMessage message =+        let+          (_, _, _, Key (Just (KBytes k)), Value (Just (KBytes v))) = _messageFields message+        in+          (unpack k, decode $ fromStrict v)+      loop offset =+        do+          result <- withAddressHandle address $ \handle -> fetch' handle =<< fetchRequest offset 0 topic+          let+            (_, [(_, _, offset', _)]) : _ = _fetchResponseFields result+            messages = fromMessage . _tamMessage <$> fetchMessages result+          liftIO+            $ do+              mapM_ (uncurry consumer) messages+              threadDelay 7500 -- FIXME: Is a thread delay really necessary in order not to miss messages?  Why?+          running <- liftIO $ isEmptyMVar exitFlag+          when running+            $ loop offset'+    return+      (+        void $ tryPutMVar exitFlag ()+      , fmap void $ runKafka (mkKafkaState clientId address)+        $ do+          offset <- getLastOffset LatestTime 0 topic+          loop offset+      )+++-- | Callback for producing events from a sensor.+type ProducerCallback = IO [Event] -- ^ Action for producing events.+++-- | Produce events for a Kafka topic.+producerLoop :: KafkaClientId               -- ^ A Kafka client identifier for the producer.+             -> KafkaAddress                -- ^ The address of the Kafka broker.+             -> TopicName                   -- ^ The Kafka topic name.+             -> Sensor                      -- ^ The name of the sensor producing the event.+             -> ProducerCallback            -- ^ The producer callback.+             -> IO (ExitAction, LoopAction) -- ^ Action to create the exit and loop actions.+producerLoop clientId address topic sensor producer =+  do+    exitFlag <- newEmptyMVar :: IO (MVar ())+    let+      loop =+        do+          events <- liftIO producer+          void+            $ produceMessages+            $ map+              (TopicAndMessage topic . makeKeyedMessage (pack sensor) . toStrict . encode)+              events+          running <- liftIO $ isEmptyMVar exitFlag+          when running+            loop+    return+      (+        void $ tryPutMVar exitFlag ()+      , void <$> runKafka (mkKafkaState clientId address) loop+      )
+ src/Network/UI/Kafka/Keyboard.hs view
@@ -0,0 +1,42 @@+{-|+Module      :  Network.UI.Kafka.Keyboard+Copyright   :  (c) 2016 Brian W Bush+License     :  MIT+Maintainer  :  Brian W Bush <consult@brianwbush.info>+Stability   :  Experimental+Portability :  Stable++Produce events on a Kafka topic from standard input.+-}+++module Network.UI.Kafka.Keyboard (+-- * Event handling +  keyboardLoop+) where+++import Network.Kafka (KafkaAddress, KafkaClientId)+import Network.Kafka.Protocol (TopicName)+import Network.UI.Kafka (ExitAction, LoopAction, Sensor, producerLoop)+import Network.UI.Kafka.Types (Event(KeyEvent))+import System.IO (BufferMode(NoBuffering), hSetBuffering, hSetEcho, stdin)+++-- | Produce keyboard events on a Kafka topic from standard input.+keyboardLoop :: KafkaClientId               -- ^ A Kafka client identifier for the producer.+             -> KafkaAddress                -- ^ The address of the Kafka broker.+             -> TopicName                   -- ^ The Kafka topic name.+             -> Sensor                      -- ^ The name of the sensor producing events.+             -> IO (ExitAction, LoopAction) -- ^ Action to create the exit and loop actions.+keyboardLoop client address topic sensor =+  do+    hSetBuffering stdin NoBuffering+    hSetEcho stdin False+    producerLoop client address topic sensor+      $ fmap (: [])+      $ KeyEvent+      <$> getChar+      <*> return Nothing+      <*> return Nothing+      <*> return Nothing
+ src/Network/UI/Kafka/Types.hs view
@@ -0,0 +1,324 @@+{-|+Module      :  Network.UI.Kafka.Types+Copyright   :  (c) 2016 Brian W Bush+License     :  MIT+Maintainer  :  Brian W Bush <consult@brianwbush.info>+Stability   :  Experimental+Portability :  Stable++Event types.+-}+++{-# LANGUAGE DeriveGeneric    #-}+++module Network.UI.Kafka.Types (+-- * Types+  Event(..)+, SpecialKey(..)+, Toggle(..)+, Modifiers(..)+, Button(..)+, ButtonState+, Hand(..)+, Finger(..)+) where+++import Data.Aeson.Types (FromJSON, ToJSON)+import Data.Binary (Binary)+import Data.Serialize (Serialize)+import GHC.Generics (Generic)+++-- | An event.+data Event =+    -- | A character from a keyboard.+    KeyEvent+    {+      key           :: Char                   -- ^ The character.+    , toggle        :: Maybe Toggle           -- ^ The state of the key.+    , modifiers     :: Maybe Modifiers        -- ^ Modifiers for the key.+    , mousePosition :: Maybe (Double, Double) -- ^ The position of the mouse pointer.+    }+  | -- | A special key from a keyboard.+    SpecialKeyEvent+    {+      specialKey    :: SpecialKey             -- ^ The special key.+    , toggle        :: Maybe Toggle           -- ^ The state of the key.+    , modifiers     :: Maybe Modifiers        -- ^ Modifiers for the key.+    , mousePosition :: Maybe (Double, Double) -- ^ The position of the mouse pointer.+    }+  | -- | A button press on a mouse.+    MouseEvent+    {+      button        :: ButtonState            -- ^ The state of the mouse button.+    , modifiers     :: Maybe Modifiers        -- ^ Modifiers on the keyboard.+    , mousePosition :: Maybe (Double, Double) -- ^ The position of the mouse pointer.+    }+  | -- | The press of of a button.+    ButtonEvent+    {+      button :: ButtonState -- ^ The state of the button.+    }+  | -- | The pressing of several buttons.+    ButtonsEvent+    {+      buttons :: [ButtonState] -- ^ The states of the buttons.+    }+  | -- | The movement of a mouse.+    PositionEvent+    {+      mousePosition :: Maybe (Double, Double) -- ^ The position of the mouse pointer.+    }+  | -- | Motion.+    MotionEvent+    {+      motionRightward :: Double -- ^ Motion rightward (+1) to leftward (-1).+    , motionUpward    :: Double -- ^ Motion upward (+1) to downward (-1).+    , motionBackward  :: Double -- ^ Motion backward (+1) to forward (-1).+    }+  | -- | Rotation.+    RotationEvent+    {+      rotationForward   :: Double -- ^ Rotation forward (+1) to backward (-1).+    , rotationClockwise :: Double -- ^ Rotation clockwise (+1) to counterclockwise (-1).+    , rotationRightward :: Double -- ^ Rotation rightward (+1) to leftward (-1).+    }+  | -- | Joystick position.+    JoystickEvent+    {+      joystickRightward :: Double        -- ^ Positioning rigthward (+1) to leftward (-1).+    , joystickForward   :: Double        -- ^ Positioning forward (+1) to backward (-1).+    , joystickUpward    :: Double        -- ^ Positioning upward (+1) to downward (-1).+    , buttons           :: [ButtonState] -- ^ The states of joystick buttons.+    }+  | -- | Moving a finger.+    FingerEvent+    {+      hand            :: Hand                     -- ^ The hand of the finger.+    , finger          :: Finger                   -- ^ The finger.+    , pointerPosition :: (Double, Double, Double) -- ^ The position of the finger.+    }+  | -- | Moving a pointer.+    PointerEvent+    {+      pointerPosition :: (Double, Double, Double) -- ^ The position of the pointer.+    }+  | -- | An analog value.+    AnalogEvent+    {+      axis        :: Int    -- ^ The axis for the value.+    , analogValue :: Double -- ^ The value, between +1 and -1.+    }+  | -- | A dial value.+    DialEvent+    {+      axis      :: Int    -- ^ The axis for the value.+    , dialValue :: Double -- ^ The value, between 0 and +1.+    }+  | -- | Location in space.+    LocationEvent {+      location :: (Double, Double, Double)  -- ^ The location vector in space.+    }+  | -- | Orientation in space.+    OrientationEvent {+      orientation :: (Double, Double, Double, Double) -- ^ The orientation quaternion in space.+    }+  | -- | An error.+    EventError+    {+      message :: String -- ^ The error message.+    }+    deriving (Eq, Generic, Ord, Read, Show)++instance FromJSON Event++instance ToJSON Event++instance Binary Event++instance Serialize Event+++-- | Keyboard modifiers.+data Modifiers =+  Modifiers+  {+    shiftModifier :: Bool -- ^ Whether the shift key is down.+  , ctrlModifier  :: Bool -- ^ Whether the control key is down.+  , altModifier   :: Bool -- ^ Whether the alt key is down.+  }+    deriving (Eq, Generic, Ord, Read, Show)++instance FromJSON Modifiers++instance ToJSON Modifiers++instance Binary Modifiers++instance Serialize Modifiers+++-- | A special key.+data SpecialKey =+    -- | F1+    KeyF1+  | -- | F2+    KeyF2+  | -- | F3+    KeyF3+  | -- | F4+    KeyF4+  | -- | F5+    KeyF5+  | -- | F6+    KeyF6+  | -- | F7+    KeyF7+  | -- | F8+    KeyF8+  | -- | F9+    KeyF9+  | -- | F10+    KeyF10+  | -- | F11+    KeyF11+  | -- | F12+    KeyF12+  | -- | left arrow+    KeyLeft+  | -- | up arrow+    KeyUp+  | -- | right arrow+    KeyRight+  | -- | down arrow+    KeyDown+  | -- | page up+    KeyPageUp+  | -- | page down+    KeyPageDown+  | -- | home+    KeyHome+  | -- | end+    KeyEnd+  | -- | insert+    KeyInsert+  | -- | number lock+    KeyNumLock+  | -- | begin+    KeyBegin+  | -- | delete+    KeyDelete+  | -- | left shift+    KeyShiftL+  | -- | right shift+    KeyShiftR+  | -- | left control+    KeyCtrlL+  | -- | right control+    KeyCtrlR+  | -- | left alt+    KeyAltL+  | -- | right alt+    KeyAltR+  | -- | unknown, with a specified index+    KeyUnknown Int+  deriving (Eq, Generic, Ord, Read, Show)++instance FromJSON SpecialKey++instance ToJSON SpecialKey++instance Binary SpecialKey++instance Serialize SpecialKey+++-- | A button and its state.+type ButtonState = (Button, Toggle)+++-- | A button.+data Button =+    -- | left mouse button+    LeftButton+  | -- |  middle mouse button+    MiddleButton+  | -- | right mouse button+    RightButton+  | -- | mouse wheel upward+    WheelUp+  | -- | mouse wheel downward+    WheelDown+  | -- | button specified by an index+    IndexButton Int+  | -- | button specified by a letter+    LetterButton Char+  deriving (Eq, Generic, Ord, Read, Show)++instance FromJSON Button++instance ToJSON Button++instance Binary Button++instance Serialize Button+++-- | The state of a button.+data Toggle =+    -- | pressed down+    Down+  | -- | released and up+    Up+  deriving (Bounded, Enum, Eq, Generic, Ord, Read, Show)++instance FromJSON Toggle++instance ToJSON Toggle++instance Binary Toggle++instance Serialize Toggle+++-- | A hand.+data Hand =+    -- | right hand+    RightHand+  | -- | left hand+    LeftHand+  deriving (Bounded, Enum, Eq, Generic, Ord, Read, Show)++instance FromJSON Hand++instance ToJSON Hand++instance Binary Hand++instance Serialize Hand+++-- | A finger.+data Finger =+    -- | thumb+    Thumb+  | -- | first or index finger+    IndexFinger+  | -- | second or middle finger+    MiddleFinger+  | -- | third of ring finger+    RingFinger+  | -- | fourth finger or pinky+    Pinky+  deriving (Bounded, Enum, Eq, Generic, Ord, Read, Show)++instance FromJSON Finger++instance ToJSON Finger++instance Binary Finger++instance Serialize Finger