packages feed

cayene-lpp (empty) → 0.1.0.0

raw patch · 8 files changed

+334/−0 lines, 8 filesdep +basedep +base16-bytestringdep +binarysetup-changed

Dependencies added: base, base16-bytestring, binary, bytestring, cayene-lpp, hspec, text, time, timerep

Files

+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Richard Marko (c) 2018++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Author name here nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ cayene-lpp.cabal view
@@ -0,0 +1,42 @@+name:                cayene-lpp+version:             0.1.0.0+synopsis:            Cayenne Low Power Payload+description:         Cayenne Low Power Payload format encoding and decoding+homepage:            https://github.com/sorki/cayene-lpp+license:             BSD3+license-file:        LICENSE+author:              Richard Marko+maintainer:          srk@48.io+copyright:           2018 Richard Marko+category:            Web+build-type:          Simple+-- extra-source-files:+cabal-version:       >=1.10++library+  hs-source-dirs:      src+  exposed-modules:     Data.Cayene+                     , Data.Cayene.Types+  build-depends:       base >= 4.7 && < 5+                     , binary+                     , timerep+                     , bytestring+                     , text+                     , time+  default-language:    Haskell2010++test-suite cayene-lpp-tests+  type:                exitcode-stdio-1.0+  hs-source-dirs:      test+  main-is:             Spec.hs+  other-modules:       ParseSpec+                       SpecHelper+  build-depends:       base >= 4.7 && < 5+                     , cayene-lpp+                     , hspec+                     , base16-bytestring+  default-language:    Haskell2010++source-repository head+  type:     git+  location: https://github.com/sorki/cayene-lpp
+ src/Data/Cayene.hs view
@@ -0,0 +1,5 @@+module Data.Cayene (+    module Data.Cayene.Types+  ) where++import Data.Cayene.Types
+ src/Data/Cayene/Types.hs view
@@ -0,0 +1,196 @@+{-|+Description : Cayene Low Power Protocol encoding and decoding+Maintainer  : srk <srk@48.io>++Encoding example:+@+  import qualified Data.Cayene as CLPP+  import qualified Data.ByteString.Base16.Lazy as B16L+  import qualified Data.ByteString.Lazy.Char8 as BSL++  BSL.putStrLn $ B16L.encode . CLPP.encodeMany [(7, Illum 1337), (0, Power 13.5)]+@++-}+{-# LANGUAGE RecordWildCards     #-}+{-# LANGUAGE OverloadedStrings   #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Data.Cayene.Types (+    Sensor(..)+  , Channel+  , Reading+  , encode+  , encodeMany+  , decode+  , decodeMany+  , decodeMaybe+  ) where++import Control.Monad+import Control.Applicative+import Data.Monoid++import Data.Bits+import Data.Binary.Get+import Data.Binary.Put+import Data.Word+import Data.Int+import qualified Data.ByteString.Lazy.Char8 as BL++type Channel = Int+type Reading = (Channel, Sensor)++data Sensor =+    DigitalIn     Word8              -- ^ Digital input (8 bits)+  | DigitalOut    Word8              -- ^ Digital output (8 bits)+  | AnalogIn      Float              -- ^ Analog input+  | AnalogOut     Float              -- ^ Analog output+  | Illum         Word16             -- ^ Illuminance sensor (Lux)+  | Presence      Word8              -- ^ Presence+  | Temperature   Float              -- ^ Temperature (Celsius)+  | Humidity      Float              -- ^ Humidity (%)+  | Accelerometer Float Float Float  -- ^ Accelerometer (G)+  | Barometer     Float              -- ^ Barometer (hPa)+  | Voltage       Float              -- ^ Voltage (V)+  | Current       Float              -- ^ Current (A)+  | Percentage    Float              -- ^ Percentage+  | Pressure      Float              -- ^ Pressure+  | Power         Float              -- ^ Power (W)+  | Energy        Float              -- ^ Energy (J)+  | Direction     Word8              -- ^ ??? (this should probably be Word16)+  | Gyrometer     Float Float Float  -- ^ Gyrometer (°/s)+  | GPS           Float Float Float  -- ^ GPS Latitude (°) ,Longitude (°), Altitude (m)+  deriving (Eq, Ord, Show)++toID :: Sensor -> Int+toID (DigitalIn _)         = 0x0+toID (DigitalOut _)        = 0x1+toID (AnalogIn _)          = 0x2+toID (AnalogOut _)         = 0x3+toID (Illum _)             = 0x65+toID (Presence _)          = 0x66+toID (Temperature _)       = 0x67+toID (Humidity _)          = 0x68+toID (Accelerometer _ _ _) = 0x71+toID (Barometer _)         = 0x73+toID (Voltage _)           = 0x74+toID (Current _)           = 0x75+toID (Percentage _)        = 0x78+toID (Pressure _)          = 0x7b+toID (Power _)             = 0x80+toID (Energy _)            = 0x83+toID (Direction _)         = 0x84+toID (Gyrometer _ _ _)     = 0x86+toID (GPS _ _ _)           = 0x88++getSensor :: Get Sensor+getSensor =+      (isID 0x0 ) *> (DigitalIn     <$> getWord8)+  <|> (isID 0x1 ) *> (DigitalOut    <$> getWord8)+  <|> (isID 0x2 ) *> (AnalogIn      <$> ((/100) <$> getFloat16))+  <|> (isID 0x3 ) *> (AnalogOut     <$> ((/100) <$> getFloat16))+  <|> (isID 0x65) *> (Illum         <$> getWord16)+  <|> (isID 0x66) *> (Presence      <$> getWord8)+  <|> (isID 0x67) *> (Temperature   <$> ((/10)  <$> getFloat16))+  <|> (isID 0x68) *> (Humidity      <$> ((/2) . fromIntegral <$> getWord8))+  <|> (isID 0x71) *> (Accelerometer <$> ((/1000) <$> getFloat16) <*> ((/1000) <$> getFloat16) <*> ((/1000) <$> getFloat16))+  <|> (isID 0x73) *> (Barometer     <$> ((/10)  <$> getFloat16))+  <|> (isID 0x74) *> (Voltage       <$> ((/10)  <$> getFloat16))+  <|> (isID 0x75) *> (Current       <$> ((/10)  <$> getFloat16))+  <|> (isID 0x78) *> (Percentage    <$> getFloat16)+  <|> (isID 0x7b) *> (Pressure      <$> ((/10)  <$> getFloat16))+  <|> (isID 0x80) *> (Power         <$> ((/10)  <$> getFloat16))+  <|> (isID 0x83) *> (Energy        <$> ((/10)  <$> getFloat16))+  <|> (isID 0x84) *> (Direction     <$> getWord8)+  <|> (isID 0x86) *> (Gyrometer     <$> ((/100) <$> getFloat16) <*> ((/100) <$> getFloat16) <*> ((/100) <$> getFloat16))+  <|> (isID 0x88) *> (GPS           <$> ((/10000) <$> getFloat24) <*> ((/10000) <$> getFloat24) <*> ((/100) <$> getFloat24))++isID :: Word8 -> Get ()+isID x = do+  y <- getWord8+  unless (x == y) $ empty++putSensor :: Sensor -> Put+putSensor s = putWord8 (fromIntegral $ toID s) >> putSensor' s++putSensor'  (DigitalIn x)         =  putWord8 x+putSensor'  (DigitalOut x)        =  putWord8 x+putSensor'  (AnalogIn x)          = (putFloat16 . (*100)) x+putSensor'  (AnalogOut x)         = (putFloat16 . (*100)) x+putSensor'  (Illum x)             =  putWord16 x+putSensor'  (Presence x)          =  putWord8 x+putSensor'  (Temperature x)       = (putFloat16 . (*10)) x+putSensor'  (Humidity x)          = (putWord8 . round . (*2)) x+putSensor'  (Accelerometer x y z) = (putFloat16 . (*1000)) x >> (putFloat16 . (*1000)) y >> (putFloat16 . (*1000)) z+putSensor'  (Barometer x)         = (putFloat16 . (*10)) x+putSensor'  (Voltage x)           = (putFloat16 . (*10)) x+putSensor'  (Current x)           = (putFloat16 . (*10)) x+putSensor'  (Percentage x)        =  putFloat16 x+putSensor'  (Pressure x)          = (putFloat16 . (*10)) x+putSensor'  (Power x)             = (putFloat16 . (*10)) x+putSensor'  (Energy x)            = (putFloat16 . (*10)) x+putSensor'  (Direction x)         =  putWord8 x+putSensor'  (Gyrometer x y z)     = (putFloat16 . (*100)) x >> (putFloat16 . (*100)) y >> (putFloat16 . (*100)) z+putSensor'  (GPS x y z)           = (putFloat24 . (*10000)) x >> (putFloat24 . (*10000)) y >> (putFloat24 . (*100)) z++putReading :: Reading -> Put+putReading (chan, sens) = putChannel chan >> putSensor sens++putChannel :: Channel -> Put+putChannel = putWord8 . fromIntegral++putWord16 :: Word16 -> Put+putWord16 = putWord16be++putFloat16 :: Float -> Put+putFloat16 = putInt16be . round++putFloat24 :: Float -> Put+putFloat24 x = do+  let x' = round x :: Word32+  putWord8 $ fromIntegral $ x' `shiftR` 16+  putWord16be $ fromIntegral $ x'++-- | Encode a single 'Reading'+encode :: Reading -> BL.ByteString+encode = runPut . putReading++-- | Encode a list of 'Reading's+encodeMany :: [Reading] -> BL.ByteString+encodeMany = runPut . (mapM_ putReading)++getWord16 :: Get Word16+getWord16 = getWord16be++getFloat16 :: Get Float+getFloat16 = fromIntegral <$> getInt16be++getFloat24 :: Get Float+getFloat24 = do+  h :: Word32 <- fromIntegral <$> getWord8+  l :: Word32 <- fromIntegral <$> getWord16be+  let sum = (h `shiftL` 16) + l+      cast = fromIntegral :: Word32 -> Int32+      pls = (cast (h `shiftL` 16 + l) `shiftL` 8) `shiftR` 8+  return $ fromIntegral pls -- as in pls float24..++getChannel :: Get Channel+getChannel = fromIntegral <$> getWord8++clppP :: Get Reading+clppP = (,) <$> getChannel <*> getSensor++-- | Decode a single 'Reading', may fail+decode :: BL.ByteString -> Reading+decode = runGet clppP++-- | Decode multiple 'Reading's, returns empty list if nothing is decoded+decodeMany :: BL.ByteString -> [Reading]+decodeMany = runGet $ many clppP++-- | Maybe decode a single 'Reading'+decodeMaybe :: BL.ByteString -> Maybe Reading+decodeMaybe x = case runGetOrFail clppP x of+  Left _ -> Nothing+  Right (_, _, y) -> Just y
+ test/ParseSpec.hs view
@@ -0,0 +1,51 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell   #-}++module ParseSpec where++import SpecHelper++import qualified Data.ByteString.Base16.Lazy as B16L++testCases = [+    (0, DigitalIn 128)+  , (7, DigitalOut 255)+  , (0, AnalogIn 4.48)+  , (3, AnalogIn (-4.48))+  , (0, Illum 1337)+  , (1, Presence 14)+  , (2, Temperature (-15.6))+  , (3, Temperature 55.6)+  , (4, Humidity 55.5)+  , (0, Accelerometer 8.48 1.666 32)+  , (0, Accelerometer (8.484) (-1.666) (-1.132))+  , (4, Barometer 55.5)+  , (4, Voltage 230.7)+  , (4, Current 1337.7)+  , (4, Percentage 97)+  , (4, Percentage (-97))+  , (4, Pressure (-97.7))+  , (4, Pressure 99.9)+  , (4, Power 95.9)+  , (4, Energy (-95.9))+  , (4, Direction 100)+  , (0, GPS 8.48 1.37 100)+  , (0, GPS (-48.48) (-75.1337) 100)+  , (0, GPS 42.3519 (-87.9094) (-10))+  ]++spec :: Spec+spec = do+  it "parses samples" $ do+    mapM_ (\x -> (decode . encode) x `shouldBe` x) testCases+    (decode . fst $ B16L.decode "018806765ff2960a0003e8") `shouldBe` (1, GPS 42.3519 (-87.9094) 10.0)+    (decode . fst $ B16L.decode "067104D2FB2E0000")       `shouldBe` (6, Accelerometer 1.234 (-1.234) 0.0)+    (decode . fst $ B16L.decode "0167FFD7")               `shouldBe` (1, Temperature (-4.1))+    (decode . fst $ B16L.decode "03670110056700FF")       `shouldBe` (3, Temperature 27.2)++    (decodeMany . fst $ B16L.decode "018806765ff2960a0003e8067104D2FB2E00000167FFD703670110056700FF")+      `shouldBe`+      [(1, GPS 42.3519 (-87.9094) 10.0), (6, Accelerometer 1.234 (-1.234) 0.0), (1,Temperature (-4.1)), (3,Temperature 27.2), (5,Temperature 25.5)]++main :: IO ()+main = hspec spec
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
+ test/SpecHelper.hs view
@@ -0,0 +1,7 @@+module SpecHelper+    ( module Test.Hspec+    , module Data.Cayene+    ) where++import Test.Hspec+import Data.Cayene