diff --git a/default.nix b/default.nix new file mode 100644 --- /dev/null +++ b/default.nix @@ -0,0 +1,20 @@ +{ + mkDerivation, stdenv +, aeson, base, binary, bytestring, cereal, linear, milena, mtl +}: + +mkDerivation { + pname = "kafka-device"; + version = "1.0.0.0"; + src = ./.; + isLibrary = true; + isExecutable = true; + libraryHaskellDepends = [ + aeson base binary bytestring cereal linear milena mtl + ]; + executableHaskellDepends = [ + ]; + homepage = "https://bitbucket.org/functionally/kafka-device"; + description = "UI device events via a Kafka message broker"; + license = stdenv.lib.licenses.mit; +} diff --git a/kafka-device.cabal b/kafka-device.cabal --- a/kafka-device.cabal +++ b/kafka-device.cabal @@ -1,67 +1,73 @@ -name: kafka-device -version: 0.2.1.2 -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 \<\>. Also see \<\>, \<\>, \<\>, \<\>. -license: MIT -license-file: LICENSE -author: Brian W Bush -maintainer: Brian W Bush -copyright: (c) 2016-17 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-$version.tar.gz +name : kafka-device +version : 1.0.0.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 \<\>. Also see \<\>, \<\>, \<\>, \<\>. +license : MIT +license-file : LICENSE +author : Brian W Bush +maintainer : Brian W Bush +copyright : (c) 2016-19 Brian W Bush +category : Hardware +build-type : Simple +cabal-version: >= 1.10 +stability : Production +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-$version.tar.gz -extra-source-files: ReadMe.md +extra-source-files: ReadMe.md + default.nix source-repository head - type: git + type : git location: https://bitbucket.org/functionally/kafka-device library - exposed-modules: Network.UI.Kafka + exposed-modules : Network.UI.Kafka Network.UI.Kafka.Interpretation Network.UI.Kafka.Keyboard Network.UI.Kafka.Types - build-depends: base >= 4.8 && < 5 - , aeson >= 0.11.3 - , binary >= 0.7.2 - , bytestring >= 0.10.6 - , cereal >= 0.5.4 - , linear >= 1.20.5 - , milena >= 0.5.0 - , mtl >= 2.2.1 - hs-source-dirs: src - ghc-options: -Wall + build-depends : base >= 4.10 && < 5 + , aeson >= 1.3.1 + , binary >= 0.8.5 + , bytestring >= 0.10.8 + , cereal >= 0.5.7 + , linear >= 1.20.8 + , milena >= 0.5.2 + , mtl >= 2.2.2 + hs-source-dirs : src + ghc-options : -Wall default-language: Haskell2010 executable kafka-device - main-is: Main.hs - build-depends: base - , aeson - , binary - , bytestring - , cereal - , linear - , milena - , mtl - hs-source-dirs: src - ghc-options: -Wall -threaded + main-is : Main.hs + other-modules : Network.UI.Kafka + Network.UI.Kafka.Types + build-depends : base >= 4.10 && < 5 + , aeson >= 1.3.1 + , binary >= 0.8.5 + , bytestring >= 0.10.8 + , cereal >= 0.5.7 + , linear >= 1.20.8 + , milena >= 0.5.2 + , mtl >= 2.2.2 + 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 - , linear - , milena - , mtl - hs-source-dirs: src - ghc-options: -Wall -threaded + main-is : MainKeyboard.hs + other-modules : Network.UI.Kafka + Network.UI.Kafka.Keyboard + Network.UI.Kafka.Types + build-depends : base >= 4.10 && < 5 + , aeson >= 1.3.1 + , binary >= 0.8.5 + , bytestring >= 0.10.8 + , cereal >= 0.5.7 + , linear >= 1.20.8 + , milena >= 0.5.2 + , mtl >= 2.2.2 + hs-source-dirs : src + ghc-options : -Wall -threaded default-language: Haskell2010 diff --git a/src/Main.hs b/src/Main.hs --- a/src/Main.hs +++ b/src/Main.hs @@ -1,10 +1,10 @@ {-| Module : $Header$ -Copyright : (c) 2016-17 Brian W Bush +Copyright : (c) 2016-19 Brian W Bush License : MIT -Maintainer : Brian W Bush -Stability : Experimental -Portability : Stable +Maintainer : Brian W Bush +Stability : Production +Portability : Portable Simple consumer that echos UI events from a Kafka topic to the console. -} diff --git a/src/MainKeyboard.hs b/src/MainKeyboard.hs --- a/src/MainKeyboard.hs +++ b/src/MainKeyboard.hs @@ -1,10 +1,10 @@ {-| Module : $Header$ -Copyright : (c) 2016-17 Brian W Bush +Copyright : (c) 2016-19 Brian W Bush License : MIT -Maintainer : Brian W Bush -Stability : Experimental -Portability : Stable +Maintainer : Brian W Bush +Stability : Production +Portability : Portable Simple producer of keyboard events from standard input to a Kafka topic. -} diff --git a/src/Network/UI/Kafka.hs b/src/Network/UI/Kafka.hs --- a/src/Network/UI/Kafka.hs +++ b/src/Network/UI/Kafka.hs @@ -1,17 +1,18 @@ {-| Module : $Header$ -Copyright : (c) 2016-17 Brian W Bush +Copyright : (c) 2016-19 Brian W Bush License : MIT -Maintainer : Brian W Bush -Stability : Experimental -Portability : Stable +Maintainer : Brian W Bush +Stability : Production +Portability : Portable Produce and consume events on Kafka topics. -} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE RecordWildCards #-} module Network.UI.Kafka ( @@ -104,7 +105,7 @@ liftIO $ do mapM_ (uncurry consumer) messages - threadDelay 7500 -- FIXME: Is a thread delay really necessary in order not to miss messages? Why? + threadDelay 100 -- FIXME: Is a thread delay really necessary in order not to miss messages? Why? running <- liftIO $ isEmptyMVar exitFlag when running $ loop offset' diff --git a/src/Network/UI/Kafka/Interpretation.hs b/src/Network/UI/Kafka/Interpretation.hs --- a/src/Network/UI/Kafka/Interpretation.hs +++ b/src/Network/UI/Kafka/Interpretation.hs @@ -1,17 +1,16 @@ {-| Module : $Header$ -Copyright : (c) 2016-17 Brian W Bush +Copyright : (c) 2016-19 Brian W Bush License : MIT -Maintainer : Brian W Bush -Stability : Experimental -Portability : Stable +Maintainer : Brian W Bush +Stability : Production +Portability : Portable Interpret user-interfaces events on Kafka topics. -} {-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# OPTIONS_GHC -fno-warn-orphans #-} @@ -160,6 +159,11 @@ fromQuaternion (Quaternion w (V3 x y z)) = OrientationEvent (realToFrac w, realToFrac x, realToFrac y, realToFrac z) +-- | Convert from degrees to radians. +fromDegrees :: (Floating a, Num a) => a -> a +fromDegrees = (* pi) . (/ 180) + + -- | Location and orientation. type State a = (V3 a, Quaternion a) @@ -184,10 +188,10 @@ interpretationLoop analogHandler buttonHandler interpretation@TrackInterpretation{..} action = do first <- newMVar True - state <- newMVar (location, fromEuler orientation) + state <- newMVar (location, fromEuler $ fromDegrees <$> orientation) producerLoop kafka sensor $ do isFirst <- readMVar first if isFirst - then swapMVar first False >> return [fromV3 location, fromQuaternion $ fromEuler orientation] + then swapMVar first False >> return [fromV3 location, fromQuaternion $ fromEuler $ fromDegrees <$> orientation] else action >>= translate state analogHandler buttonHandler interpretation diff --git a/src/Network/UI/Kafka/Keyboard.hs b/src/Network/UI/Kafka/Keyboard.hs --- a/src/Network/UI/Kafka/Keyboard.hs +++ b/src/Network/UI/Kafka/Keyboard.hs @@ -1,10 +1,10 @@ {-| Module : $Header$ -Copyright : (c) 2016-17 Brian W Bush +Copyright : (c) 2016-19 Brian W Bush License : MIT -Maintainer : Brian W Bush -Stability : Experimental -Portability : Stable +Maintainer : Brian W Bush +Stability : Production +Portability : Portable Produce events on a Kafka topic from standard input. -} @@ -30,8 +30,8 @@ hSetBuffering stdin NoBuffering hSetEcho stdin False producerLoop topicConnection sensor - $ fmap (: []) - $ KeyEvent + . fmap (: []) + $ KeyEvent <$> getChar <*> return Nothing <*> return Nothing diff --git a/src/Network/UI/Kafka/Types.hs b/src/Network/UI/Kafka/Types.hs --- a/src/Network/UI/Kafka/Types.hs +++ b/src/Network/UI/Kafka/Types.hs @@ -1,16 +1,16 @@ {-| -Module : Network.UI.Kafka.Types -Copyright : (c) 2016 Brian W Bush +Module : $Header$ +Copyright : (c) 2016-19 Brian W Bush License : MIT -Maintainer : Brian W Bush -Stability : Experimental -Portability : Stable +Maintainer : Brian W Bush +Stability : Beta +Portability : Portable Event types. -} -{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveGeneric #-} module Network.UI.Kafka.Types (