bloohm (empty) → 1.0.0.1

raw patch · 4 files changed

+139/−0 lines, 4 filesdep +ReadArgsdep +basedep +bloohm

Dependencies added: ReadArgs, base, bloohm, bytestring, crypton, hedgehog, memory, serialport

Files

app/Main.hs +38/−0
bloohm.cabal +47/−0
src/Bloohm.hs +40/−0
test/Main.hs +14/−0

+ app/Main.hs view

@@ -0,0 +1,38 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Main where++import Bloohm (findPos)+import qualified Data.ByteString.Char8 as B+import Data.List ( intercalate )+import ReadArgs (readArgs)+import System.Environment (getArgs)+import System.Hardware.Serialport+    ( hOpenSerial,+      defaultSerialSettings,+      CommSpeed(CS115200),+      SerialPortSettings(commSpeed) )+import System.IO ( hClose, hPutStr )++main :: IO ()+main = do+  (serialPort, color :: Color, dir, cmdline) <- readArgs+  let indices = findPos $ dir <> cmdline+      c = show color+      combined = (c <>) <$> (show <$> indices) -- 1,13 -> r1,r13+      total = intercalate "," combined+  h <- hOpenSerial serialPort $ defaultSerialSettings {commSpeed = CS115200}+  -- print $ "sending " <> total <> " to " <> serialPort+  hPutStr h total -- circuit python wants+  hClose h++data Color = Red | Green | Blue | Yellow deriving (Read, Eq, Ord)++instance Show Color where+  show = \case+    Red -> "r"+    Green -> "g"+    Blue -> "b"+    Yellow -> "y"

+ bloohm.cabal view

@@ -0,0 +1,47 @@+cabal-version:       3.4+name:                bloohm+synopsis:            visual bloom filter for neotrellis m4 output+description:         visual bloom filter for process status visualization+version:             1.0.0.1+homepage:            https://github.com/shapr/bloohm+license:             BSD-3-Clause+author:              Shae Erisson+maintainer:          Shae Erisson+copyright:           Shae Erisson+category:            Embedded+build-type:          Simple++source-repository head+  type: git+  location: https://github.com/shapr/bloohm.git++library+  hs-source-dirs:      src+  default-language:    Haskell2010+  exposed-modules:     Bloohm+  ghc-options:         -Wall -fno-warn-name-shadowing+  build-depends:       base >= 4.18.2 && < 4.20+                     , crypton >= 1.0.0 && < 1.1+                     , bytestring >= 0.11.5 && < 0.12+                     , memory >= 0.18.0 && < 0.19++executable bloohm+  main-is:            Main.hs+  hs-source-dirs:     app+  default-language:   Haskell2010+  ghc-options:        -threaded -O2+  build-depends:      base >= 4.18.2 && < 4.20+                    , bloohm+                    , serialport >= 0.5.5 && < 0.6+                    , bytestring >= 0.11.5 && < 0.12+                    , ReadArgs >= 1.2.3 && < 1.3++test-suite bloohm-tests+  type:             exitcode-stdio-1.0+  hs-source-dirs:   test+  main-is:          Main.hs+  default-language: Haskell2010+  ghc-options:      -Wall -threaded+  build-depends:    base+                  , bloohm+                  , hedgehog

+ src/Bloohm.hs view

@@ -0,0 +1,40 @@+module Bloohm where++import Crypto.Hash (hashWith)+import Crypto.Hash.Algorithms ( MD5(MD5) )+import Data.Bits ( Bits((.|.), shiftL) )+import qualified Data.ByteArray.Encoding as B (Base (..), convertToBase)+import Data.ByteString (ByteString)+import qualified Data.ByteString as BS+import qualified Data.ByteString.Char8 as BS8+import Data.List (sort)+import Data.Word (Word8)++doBloohm :: String+doBloohm = "Bloohm"++findPos :: String -> [Integer]+findPos s = findBits $ BS8.pack s++findBits :: ByteString -> [Integer]+findBits bs = sort [int1, int2, int3]+    where wz = BS.unpack $ runhashMD5 bs+          wzThird = length wz `div` 3+          multipleOfThree = drop (length wz `mod` 3) wz+          (int1,ws) = tritMod wzThird multipleOfThree+          (int2,ws') = tritMod wzThird ws+          (int3,_) = tritMod wzThird ws'++++tritMod :: Int -> [Word8] -> (Integer,[Word8])+tritMod _ [] = error "tritMod got empty list"+tritMod n ws = (roll (take n ws) `mod` 32, drop n ws)++roll :: [Word8] -> Integer+roll = foldr unstep 0+  where+    unstep b a = a `shiftL` 8 .|. fromIntegral b++runhashMD5 :: ByteString -> ByteString+runhashMD5 v = B.convertToBase B.Base16 $ hashWith MD5 v

+ test/Main.hs view

@@ -0,0 +1,14 @@+{-# LANGUAGE TemplateHaskell #-}++module Main where++import Hedgehog+import Hedgehog.Main+import Bloohm++prop_test :: Property+prop_test = property $ do+  doBloohm === "Bloohm"++main :: IO ()+main = defaultMain [checkParallel $$(discover)]