wled-json 0.0.1.0 → 0.0.1.1

raw patch · 8 files changed

+220/−49 lines, 8 filesPVP: minor bump suggested

API additions: PVP suggests at least a minor version bump

API changes (from Hackage documentation)

Files

• CHANGELOG.md +10/−0
• LICENSE +1/−1
• README.md +1/−1
• app/Main.hs +83/−28
• src/WLED/Device.hs +1/−1
• src/WLED/Octocat/Flags.hs +107/−11
• src/WLED/Types.hs +5/−2
• wled-json.cabal +12/−5

@@ -6,6 +6,16 @@  ## Unreleased +- Awesome upcoming features!++## 0.0.1.1 - Small cosmetic improvements - 2025-03-28++- Demonstration:+  - Added menu and option to change wled device URL via terminal or command line argument+  - Added tool to traverse every single LED (to be able to better detect positions)+- Octolamp Support:+  - Added more flags with three vertical stripes+ ## 0.0.1.0 - Initial release - 2024-12-02  - Core Functionality:

@@ -1,4 +1,4 @@-Copyright 2024 Andreas Ländle+Copyright 2024-2025 Andreas Ländle  Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:

@@ -3,7 +3,7 @@ Haskell bindings for controlling WLED devices, with a focus on Octolamps  <p align="center">-  <img src="./images/octolamp.jpg" alt="Octolamp showing french flag" width="50%"/>+  <img src="https://raw.githubusercontent.com/alaendle/wled-json/main/images/octolamp.jpg" alt="Octolamp showing french flag" width="50%"/> </p>  ## Introduction 💡

@@ -1,45 +1,100 @@-{-# LANGUAGE Arrows                   #-}-{-# LANGUAGE DataKinds                #-}-{-# LANGUAGE StandaloneKindSignatures #-}+{-# LANGUAGE Arrows           #-}+{-# LANGUAGE CPP              #-}+{-# LANGUAGE DataKinds        #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeOperators    #-}+#if __GLASGOW_HASKELL__ < 904+{-# LANGUAGE TypeFamilies     #-}+#endif  module Main (main) where  import           Control.Monad      (void)-import           Data.Kind          (Type) import           FRP.Rhine-import           GHC.TypeLits       (Nat)+import           System.Environment (getArgs)+import           System.IO          (BufferMode (NoBuffering), hSetBuffering, stdout) import           WLED.Device-import           WLED.Octocat.Flags (france)+import           WLED.Octocat.Flags (belgium, cameroon, chad, france, guatemala, guinea, ireland, italy, ivoryCoast, mali, nigeria, peru) import           WLED.Types  waitForEnter :: ClSF (ExceptT () IO) StdinClock () () waitForEnter = arrMCl throwE -type TimeClock :: Nat -> Type-type TimeClock ms = LiftClock IO (ExceptT ()) (Millisecond ms)--sinusWave :: (Int -> ExceptT () IO ()) -> ClSF (ExceptT () IO) (TimeClock 100) () ()-sinusWave signalHandler = sinceStart >>> proc time -> do-    arrMCl (signalHandler . scaledSinusWave 0 255 0.1) -< time-    returnA -< ()+sinusWave :: Monad m => Int -> Int -> Double -> ClSF m cl Double Int+sinusWave low high frequency = arr scaledSinusWave   where-    timeToSinusWave :: Double -> Double -> Double-    timeToSinusWave frequency t = sin (2 * pi * frequency * t)-    scaledSinusWave :: Int -> Int -> Double -> Double -> Int-    scaledSinusWave a b frequency time = round $ fromIntegral (b - a) / 2 * timeToSinusWave frequency time + fromIntegral (a + b) / 2+    timeToSinusWave :: Double -> Double+    timeToSinusWave t = sin (2 * pi * frequency * t)+    scaledSinusWave :: Double -> Int+    scaledSinusWave time = round $ fromIntegral (high - low) / 2 * timeToSinusWave time + fromIntegral (high + low) / 2 +brightnessSinus :: Monad m => Double -> ClSF m cl Double StatePatch+brightnessSinus frequency = sinusWave 0 255 frequency >-> arr (\bri -> (mempty :: StatePatch) { stateBri = Just bri })++switchFlags :: Monad m => Double -> ClSF m cl Double StatePatch+switchFlags frequency = arr (\t -> allFlags !! (floor (t * frequency) `mod` length allFlags)) where+  allFlags = [belgium, cameroon, chad, france, guatemala, guinea, ireland, italy, ivoryCoast, mali, nigeria, peru]++animation :: (Monad m, TimeDomain (Time cl), Diff (Time cl) ~ Double) => ClSF m cl () StatePatch+animation = sinceStart >-> proc time -> do+  brightness <- brightnessSinus 0.1 -< time+  flag <- switchFlags 0.2 -< time+  returnA -< brightness <> flag++traverseLed :: (Monad m, TimeDomain (Time cl), Diff (Time cl) ~ Double) => ClSF m cl () StatePatch+traverseLed = sinceStart >-> arr (\t -> (mempty :: StatePatch) { stateBri = Just 255, stateSeg = Just [segment (floor (t / 3.0)) (floor (t / 3.0) + 1 ) [255, 255, 255]]})+ main :: IO () main = do-    lampState <- getLampState wledUrl-    case lampState of+  hSetBuffering stdout NoBuffering+  putStrLn "-----------------------------------------------------------------------"+  putStrLn "Welcome to the wled-json demo."+  putStrLn "-----------------------------------------------------------------------"+  args <- getArgs+  mainLoop $ case args of (url:_) -> url; _ -> defaultWledUrl+  where+    mainLoop :: String -> IO ()+    mainLoop wledUrl = do+      putStrLn ""+      putStrLn "1: Change URL for WLED device."+      putStrLn "2: Run octolamp flags demo."+      putStrLn "3: Traverse single LED."+      putStrLn "q: Quit."+      putStrLn ""+      putStr $ "(" ++ wledUrl ++ ") > "+      choice <- getLine+      case choice of+        "1" -> do+          putStrLn ""+          putStr "Enter new URL: "+          getLine >>= mainLoop+        "2" -> do+          putStrLn ""+          putStrLn "Press [Enter] to stop demonstration."+          localLampState wledUrl $ void $ runExceptT $ flow $ waitForEnter @@ StdinClock |@| (animation >-> arrMCl (liftIO . void . setLampState wledUrl)) @@ liftClock @IO @(ExceptT ()) (waitClock @100)+          mainLoop wledUrl+        "3" -> do+          putStrLn ""+          putStrLn "Press [Enter] to stop traversal."+          localLampState wledUrl $ void $ runExceptT $ flow $ waitForEnter @@ StdinClock |@| (traverseLed >-> arrMCl (liftIO . void . setLampState wledUrl)) @@ liftClock @IO @(ExceptT ()) (waitClock @100)+          mainLoop wledUrl+        "q" -> pure ()+        "Q" -> pure ()+        _ -> do+          putStrLn "Could not recognize option."+          mainLoop wledUrl+    localLampState :: String -> IO () -> IO ()+    localLampState wledUrl action = do+      lampState <- getLampState wledUrl+      case lampState of         Left errMsg -> putStrLn errMsg         Right initialState -> do-            _ <- setLampState wledUrl france-            void $ runExceptT $ flow $ waitForEnter @@ StdinClock |@| sinusWave (\bri -> liftIO $ void $ setLampState wledUrl (mempty :: StatePatch) { stateBri = Just bri }) @@ liftClock waitClock-            Right currentState <- getLampState wledUrl-            _ <- setLampState wledUrl (diff currentState initialState)-            -- validate that initial state is restored-            Right restoredState <- getLampState wledUrl-            putStrLn $ "Initial state is restored: " <> show (initialState == restoredState)-  where-    wledUrl = "http://192.168.178.34"+          action+          Right currentState <- getLampState wledUrl+          _ <- setLampState wledUrl (diff currentState initialState)+          -- validate that initial state is restored+          Right restoredState <- getLampState wledUrl+          putStrLn $ "Initial state is restored: " <> show (initialState == restoredState)+    defaultWledUrl :: String+    defaultWledUrl = "http://192.168.178.34"

@@ -3,7 +3,7 @@  {-| Module      : WLED.Device-Copyright   : (c) Andreas Ländle, 2024+Copyright   : (c) Andreas Ländle, 2024-2025 License     : BSD-3 Stability   : experimental 

@@ -1,26 +1,122 @@  {-| Module      : WLED.Octocat.Flags-Copyright   : (c) Andreas Ländle, 2024+Copyright   : (c) Andreas Ländle, 2024-2025 License     : BSD-3 Stability   : experimental  Octolamp specific feature to display flags. -} -module WLED.Octocat.Flags(france) where+module WLED.Octocat.Flags(belgium, cameroon, chad, france, guatemala, guinea, ireland, italy, ivoryCoast, mali, nigeria, peru) where  import           WLED.Types +-- | The Belgian flag.+belgium :: StatePatch+belgium = threeVerticalStripes ral9017 ral2007 ral3028++-- | The Cameroonian flag.+cameroon :: StatePatch+cameroon = threeVerticalStripes ral6024 ral3028 ral1018++-- | The Chad flag.+chad :: StatePatch+chad = threeVerticalStripes ral5026 ral2007 ral3028+ -- | The French flag. france :: StatePatch-france = (mempty :: StatePatch) { stateSeg = Just [ seg 0 5 white, seg 5 16 red, seg 16 23 white, seg 23 34 blue, seg 34 41 white, seg 41 52 blue, seg 52 57 white, seg 57 68 red, seg 68 101 white ]} where-    red :: [Int]-    red = [255,0,0]-    white :: [Int]-    white = [255,255,255]-    blue :: [Int]-    blue = [0,0,255]+france = threeVerticalStripes ral5002 white ral3020 -seg :: Int -> Int -> [Int] -> SegmentPatch-seg start stop color = (mempty :: SegmentPatch) { segmentStart = Just start, segmentStop = Just stop, segmentCol = Just [color], segmentFx = Just 0 }+-- | The Guatemalan flag.+guatemala :: StatePatch+guatemala = threeVerticalStripes ral5012 white ral5012++-- | The Guinean flag.+guinea :: StatePatch+guinea = threeVerticalStripes ral3028 ral1018 ral6024++-- | The Irish flag.+ireland :: StatePatch+ireland = threeVerticalStripes ral6024 white ral1028++-- | The Italian flag.+italy :: StatePatch+italy = threeVerticalStripes ral6024 ral9016 ral3028++-- | The Ivory Coast flag.+ivoryCoast :: StatePatch+ivoryCoast = threeVerticalStripes ral1028 white ral6024++-- | The Malian flag.+mali :: StatePatch+mali = threeVerticalStripes ral6038 ral1018 ral3028++-- | The Nigerian flag.+nigeria :: StatePatch+nigeria = threeVerticalStripes ral6001 white ral6001++-- | The Peruvian flag.+peru :: StatePatch+peru = threeVerticalStripes ral3028 white ral3028++threeVerticalStripes :: [Int] -> [Int] -> [Int] -> StatePatch+threeVerticalStripes leftColor middleColor rightColor = (mempty :: StatePatch) { stateSeg = Just [+    segment 0 3 middleColor,+    segment 3 17 rightColor,+    segment 17 21 middleColor,+    segment 21 36 leftColor,+    segment 36 40 middleColor,+    segment 40 53 leftColor,+    segment 53 57 middleColor,+    segment 57 69 rightColor,+    segment 69 75 middleColor,+    segment 75 80 rightColor,+    segment 80 84 middleColor,+    segment 84 91 leftColor,+    segment 91 94 middleColor,+    segment 94 98 leftColor,+    segment 98 101 middleColor ]}+--threeVerticalStripes leftColor middleColor rightColor = (mempty :: StatePatch) { stateSeg = Just [ segment 0 5 middleColor, segment 5 16 rightColor, segment 16 23 middleColor, segment 23 34 leftColor, segment 34 41 middleColor, segment 41 52 leftColor, segment 52 57 middleColor, segment 57 68 rightColor, segment 68 101 middleColor ]}++ral1018 :: [Int]+ral1018 = [252, 209, 22]++ral1028 :: [Int]+ral1028 = [255, 120, 0]++ral2007 :: [Int]+ral2007 = [255, 205, 0]++ral3020 :: [Int]+ral3020 = [255,0,15]++ral3028 :: [Int]+ral3028 = [200, 16, 46]++ral5002 :: [Int]+ral5002 = [0,0,145]++ral5012 :: [Int]+ral5012 = [73, 151, 208]++ral5026 :: [Int]+ral5026 = [0, 38, 100]++ral6001 :: [Int]+ral6001 = [27, 115, 57]++ral6024 :: [Int]+ral6024 = [0, 154, 68]++ral6038 :: [Int]+ral6038 = [20, 181, 58]++ral9016 :: [Int]+ral9016 = [244, 249, 255]++ral9017 :: [Int]+ral9017 = [45, 41, 28]++white :: [Int]+white = [255,255,255]

@@ -11,14 +11,14 @@  {-| Module      : WLED.Device-Copyright   : (c) Andreas Ländle, 2024+Copyright   : (c) Andreas Ländle, 2024-2025 License     : BSD-3 Stability   : experimental  Types representing states and state changes of a WLED device. -} -module WLED.Types (State (..), Nightlight (..), Segment (..), StateComplete, StatePatch, NightlightComplete, NightlightPatch, SegmentComplete, SegmentPatch, append, diff) where+module WLED.Types (State (..), Nightlight (..), Segment (..), StateComplete, StatePatch, NightlightComplete, NightlightPatch, SegmentComplete, SegmentPatch, append, diff, segment) where  import           Barbies.Bare import           Control.Applicative      (Alternative ((<|>)), empty)@@ -216,6 +216,9 @@     d' a b = if a == b then Nothing else Just $ diff' a b     d'' :: [Segment Bare Identity] -> [Segment Bare Identity] -> Maybe [Segment Covered Maybe]     d'' a b = if a == b then Nothing else Just $ zipWith (\i bb -> maybe (bmap (Just . runIdentity) $ bcover bb) (`diff'` bb) (a !? i)) [0..] b ++ replicate (length a - length b) ((mempty :: SegmentPatch) { segmentStop = Just 0 })++segment :: Int -> Int -> [Int] -> SegmentPatch+segment start stop color = (mempty :: SegmentPatch) { segmentStart = Just start, segmentStop = Just stop, segmentCol = Just [color], segmentFx = Just 0 }  #if __GLASGOW_HASKELL__ <= 906 -- | A total variant of the list index function `(!!)`.

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           wled-json-version:        0.0.1.0+version:        0.0.1.1 synopsis:       Convenient interface for interacting with WLED devices description:    Please see the README on GitHub at <https://github.com/alaendle/wled-json#readme> category:       Interfaces@@ -13,10 +13,17 @@ bug-reports:    https://github.com/alaendle/wled-json/issues author:         Andreas Ländle maintainer:     Andreas Ländle-copyright:      2024 Andreas Ländle+copyright:      2024-2025 Andreas Ländle license:        BSD-3-Clause license-file:   LICENSE build-type:     Simple+tested-with:+    GHC == 9.2.8+  , GHC == 9.4.8+  , GHC == 9.6.6+  , GHC == 9.8.4+  , GHC == 9.10.1+  , GHC == 9.12.1 extra-source-files:     README.md extra-doc-files:@@ -37,7 +44,7 @@       Paths_wled_json   hs-source-dirs:       src-  ghc-options: -O0 -Weverything -Wno-unsafe -Wno-missing-import-lists -Wno-prepositive-qualified-module -Wno-implicit-prelude -Wno-missing-safe-haskell-mode -Wno-safe+  ghc-options: -O0 -Weverything -Wno-unsafe -Wno-missing-import-lists -Wno-prepositive-qualified-module -Wno-implicit-prelude -Wno-missing-safe-haskell-mode -Wno-safe -Wno-missing-role-annotations   build-depends:       aeson >=2.2.3 && <2.3     , barbies >=2.0.5 && <2.2@@ -55,7 +62,7 @@       Paths_wled_json   hs-source-dirs:       app-  ghc-options: -O0 -Weverything -Wno-unsafe -Wno-missing-import-lists -Wno-prepositive-qualified-module -Wno-implicit-prelude -Wno-missing-safe-haskell-mode -Wno-safe -threaded -rtsopts -with-rtsopts=-N+  ghc-options: -O0 -Weverything -Wno-unsafe -Wno-missing-import-lists -Wno-prepositive-qualified-module -Wno-implicit-prelude -Wno-missing-safe-haskell-mode -Wno-safe -Wno-missing-role-annotations -threaded -rtsopts -with-rtsopts=-N   build-depends:       base >=4.7 && <5     , rhine >=1.4.0.1 && <1.6@@ -72,7 +79,7 @@       Paths_wled_json   hs-source-dirs:       test-  ghc-options: -O0 -Weverything -Wno-unsafe -Wno-missing-import-lists -Wno-prepositive-qualified-module -Wno-implicit-prelude -Wno-missing-safe-haskell-mode -Wno-safe -threaded -rtsopts -with-rtsopts=-N+  ghc-options: -O0 -Weverything -Wno-unsafe -Wno-missing-import-lists -Wno-prepositive-qualified-module -Wno-implicit-prelude -Wno-missing-safe-haskell-mode -Wno-safe -Wno-missing-role-annotations -threaded -rtsopts -with-rtsopts=-N   build-depends:       QuickCheck     , aeson