wled-json 0.0.1.1 → 0.1.0.0

raw patch · 11 files changed

+341/−156 lines, 11 filesnew-component:exe:wled-json-demonew-component:exe:wled-json-simplePVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +4/−0
• README.md +11/−20
• app-simple/Main.hs +27/−0
• app/Main.hs +6/−5
• src/WLED/Device.hs +0/−1
• src/WLED/Lamp/Octocat.hs +113/−0
• src/WLED/LampSpec.hs +17/−0
• src/WLED/Octocat/Flags.hs +0/−122
• src/WLED/Pattern/Flags.hs +139/−0
• src/WLED/Types.hs +1/−1
• wled-json.cabal +23/−7

@@ -8,6 +8,10 @@  - Awesome upcoming features! +## 0.1.0.0 - Support differently designed lamps - 2025-05-29++- Separate lamp specification from WLED interaction - so that own designs could be integrated.+ ## 0.0.1.1 - Small cosmetic improvements - 2025-03-28  - Demonstration:

@@ -13,23 +13,14 @@ - **Color:** Set the color of your lights using various color spaces (RGB, HSV, etc.) - **Brightness:** Adjust the overall brightness of your lights -## Installation ⚙️--```bash-# Using cabal-cabal add wled-json--# Using stack-stack add wled-json-```- ## Usage 📲  ```haskell-import           Control.Concurrent-import           WLED.Device-import           WLED.Octocat.Flags (france)-import           WLED.Types+import           Control.Concurrent (threadDelay)+import           WLED.Device        (getLampState, setLampState)+import           WLED.Lamp.Octocat  (octocatSpec)+import           WLED.Pattern.Flags (bulgaria)+import           WLED.Types         (diff)  main :: IO () main = do@@ -38,19 +29,18 @@     case lampState of         Left errMsg -> putStrLn errMsg         Right initialState -> do-            -- Display the French flag on an Octolamp-            _ <- setLampState wledUrl france+            -- Display the Bulgarian flag on an Octolamp+            _ <- setLampState wledUrl (bulgaria octocatSpec) -            -- Just sleep one second-            threadDelay 1000000-            +            -- Just sleep five seconds+            threadDelay 5000000+             -- Restore the initial state             Right currentState <- getLampState wledUrl             _ <- setLampState wledUrl (diff currentState initialState)             pure ()   where     wledUrl = "http://192.168.178.34"- ```  ## Features 👍@@ -59,6 +49,7 @@ - Type-safe interactions - Easy-to-use API - Specific support for Octolamps+- Reusable pattern for other lamp designs  ## Contributing 🤝 

@@ -0,0 +1,27 @@+module Main (main) where++import           Control.Concurrent (threadDelay)+import           WLED.Device        (getLampState, setLampState)+import           WLED.Lamp.Octocat  (octocatSpec)+import           WLED.Pattern.Flags (bulgaria)+import           WLED.Types         (diff)++main :: IO ()+main = do+    -- Connect to a WLED device+    lampState <- getLampState wledUrl+    case lampState of+        Left errMsg -> putStrLn errMsg+        Right initialState -> do+            -- Display the Bulgarian flag on an Octolamp+            _ <- setLampState wledUrl (bulgaria octocatSpec)++            -- Just sleep five seconds+            threadDelay 5000000++            -- Restore the initial state+            Right currentState <- getLampState wledUrl+            _ <- setLampState wledUrl (diff currentState initialState)+            pure ()+  where+    wledUrl = "http://192.168.178.34"

@@ -15,7 +15,8 @@ import           System.Environment (getArgs) import           System.IO          (BufferMode (NoBuffering), hSetBuffering, stdout) import           WLED.Device-import           WLED.Octocat.Flags (belgium, cameroon, chad, france, guatemala, guinea, ireland, italy, ivoryCoast, mali, nigeria, peru)+import           WLED.Lamp.Octocat  (octocatSpec)+import           WLED.Pattern.Flags (belgium, bulgaria, cameroon, chad, france, guatemala, guinea, ireland, italy, ivoryCoast, mali, nigeria, peru) import           WLED.Types  waitForEnter :: ClSF (ExceptT () IO) StdinClock () ()@@ -34,7 +35,7 @@  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]+  allFlags = ($ octocatSpec) <$> [bulgaria, 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@@ -62,7 +63,7 @@       putStrLn "3: Traverse single LED."       putStrLn "q: Quit."       putStrLn ""-      putStr $ "(" ++ wledUrl ++ ") > "+      putStr $ "(" <> wledUrl <> ") > "       choice <- getLine       case choice of         "1" -> do@@ -72,12 +73,12 @@         "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)+          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)+          localLampState wledUrl . void . runExceptT . flow $ waitForEnter @@ StdinClock |@| (traverseLed >-> arrMCl (liftIO . void . setLampState wledUrl)) @@ liftClock @IO @(ExceptT ()) (waitClock @100)           mainLoop wledUrl         "q" -> pure ()         "Q" -> pure ()

@@ -54,4 +54,3 @@       req <- parseRequest wledUrl       res <- httpBS $ setRequestBodyJSON patch req { method = "POST", path = "json/state" }       pure (toStrict body, getResponseBody res)-

@@ -0,0 +1,113 @@+module WLED.Lamp.Octocat(octocatSpec) where++import           WLED.LampSpec (LampSpec (..))++octocatSpec :: LampSpec Int+octocatSpec = LampSpec { positions = lightPositions, size = (100, 100) }++-- >>> length lightPositions+-- 101+lightPositions :: [(Int, Int)]+lightPositions = [+    (51,96),+    (54,96),+    (61,95),+    (70,92),+    (77,88),+    (82,83),+    (88,77),+    (92,69),+    (94,63),+    (96,55),+    (95,46),+    (94,37),+    (91,31),+    (88,24),+    (82,17),+    (77,12),+    (71,8),+    (64,5),+    (57,3),+    (48,3),+    (41,4),+    (33,6),+    (25,10),+    (19,14),+    (14,19),+    (9,26),+    (5,33),+    (4,39),+    (3,48),+    (3,55),+    (5,63),+    (8,71),+    (13,79),+    (17,84),+    (23,88),+    (30,92),+    (37,95),+    (45,96),+    (46,98),+    (41,93),+    (33,92),+    (25,87),+    (19,82),+    (13,76),+    (8,68),+    (6,60),+    (4,51),+    (5,43),+    (8,34),+    (11,27),+    (17,19),+    (23,14),+    (30,10),+    (38,7),+    (45,5),+    (55,5),+    (63,7),+    (71,11),+    (78,16),+    (84,22),+    (88,29),+    (91,37),+    (93,46),+    (93,54),+    (91,62),+    (88,71),+    (83,79),+    (77,84),+    (71,88),+    (63,92),+    (56,87),+    (57,79),+    (56,70),+    (60,65),+    (66,63),+    (71,58),+    (73,51),+    (72,43),+    (68,37),+    (69,28),+    (65,30),+    (56,31),+    (49,32),+    (42,32),+    (33,29),+    (29,28),+    (30,36),+    (26,42),+    (25,51),+    (28,58),+    (33,63),+    (40,66),+    (42,73),+    (36,77),+    (28,74),+    (23,69),+    (24,72),+    (28,78),+    (34,79),+    (42,84),+    (41,88)+  ]

@@ -0,0 +1,17 @@+{-# LANGUAGE StandaloneKindSignatures #-}++{-|+Module      : WLED.Device+Copyright   : (c) Andreas Ländle, 2024-2025+License     : BSD-3+Stability   : experimental++Represent the logical model fo the lamp.+-}++module WLED.LampSpec (LampSpec(..)) where++import           Data.Kind (Type)++type LampSpec :: Type -> Type+data LampSpec a = LampSpec { positions :: [(a, a)], size :: (a, a) }

@@ -1,122 +0,0 @@--{-|-Module      : WLED.Octocat.Flags-Copyright   : (c) Andreas Ländle, 2024-2025-License     : BSD-3-Stability   : experimental--Octolamp specific feature to display flags.--}--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 = threeVerticalStripes ral5002 white ral3020---- | 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]

@@ -0,0 +1,139 @@++{-|+Module      : WLED.Pattern.Flags+Copyright   : (c) Andreas Ländle, 2024-2025+License     : BSD-3+Stability   : experimental++Module containing flags.+-}++module WLED.Pattern.Flags(bulgaria, belgium, cameroon, chad, france, guatemala, guinea, ireland, italy, ivoryCoast, mali, nigeria, peru) where++import           Data.List     (group)+import           WLED.LampSpec (LampSpec (LampSpec))+import           WLED.Types    (State (stateSeg), StatePatch, segment)++-- | The Belgian flag.+belgium :: Real a => LampSpec a -> StatePatch+belgium = threeVerticalStripes ral9017 ral2007 ral3028++-- | The Cameroonian flag.+cameroon :: Real a => LampSpec a -> StatePatch+cameroon = threeVerticalStripes ral6024 ral3028 ral1018++-- | The Chad flag.+chad :: Real a => LampSpec a -> StatePatch+chad = threeVerticalStripes ral5026 ral2007 ral3028++-- | The French flag.+france :: Real a => LampSpec a -> StatePatch+france = threeVerticalStripes ral5002 white ral3020++-- | The Guatemalan flag.+guatemala :: Real a => LampSpec a -> StatePatch+guatemala = threeVerticalStripes ral5012 white ral5012++-- | The Guinean flag.+guinea :: Real a => LampSpec a -> StatePatch+guinea = threeVerticalStripes ral3028 ral1018 ral6024++-- | The Irish flag.+ireland :: Real a => LampSpec a -> StatePatch+ireland = threeVerticalStripes ral6024 white ral1028++-- | The Italian flag.+italy :: Real a => LampSpec a -> StatePatch+italy = threeVerticalStripes ral6024 ral9016 ral3028++-- | The Ivory Coast flag.+ivoryCoast :: Real a => LampSpec a -> StatePatch+ivoryCoast = threeVerticalStripes ral1028 white ral6024++-- | The Malian flag.+mali :: Real a => LampSpec a -> StatePatch+mali = threeVerticalStripes ral6038 ral1018 ral3028++-- | The Nigerian flag.+nigeria :: Real a => LampSpec a -> StatePatch+nigeria = threeVerticalStripes ral6001 white ral6001++-- | The Peruvian flag.+peru :: Real a => LampSpec a -> StatePatch+peru = threeVerticalStripes ral3028 white ral3028++-- | The Bulgarian flag.+bulgaria :: Real a => LampSpec a -> StatePatch+bulgaria = threeHorizontalStripes white ral5021 ral3028++threeVerticalStripes :: Real a => [Int] -> [Int] -> [Int] -> LampSpec a -> StatePatch+threeVerticalStripes leftColor middleColor rightColor lampSpec = (mempty :: StatePatch) { stateSeg = segments } where+        segments = Just $ (\(start, stop, index) -> segment start stop ([leftColor, middleColor, rightColor] !! index)) <$> buildSegments (verticalLayer lampSpec 3)++threeHorizontalStripes :: Real a => [Int] -> [Int] -> [Int] -> LampSpec a -> StatePatch+threeHorizontalStripes topColor middleColor buttomColor lampSpec = (mempty :: StatePatch) { stateSeg = segments } where+        segments = Just $ (\(start, stop, index) -> segment start stop ([topColor, middleColor, buttomColor] !! index)) <$> buildSegments (horizontalLayer lampSpec 3)++-- >>> length <$> (group $ horizontalLayer (LampSpec lightPositions (100,100)) 3)+-- [8,4,15,4,14,4,12,4,8,6,7,6,9]+horizontalLayer :: Real a => LampSpec a -> Int -> [Int]+horizontalLayer (LampSpec pos (_, sy)) n = fmap (\(_, y) -> floor (toRational  y / toRational sy * toRational n)) pos++-- >>> length <$> (group $ verticalLayer (LampSpec lightPositions (100,100)) 3)+-- [3,14,4,15,4,13,4,12,6,5,4,7,3,4,3]+verticalLayer :: Real a => LampSpec a -> Int -> [Int]+verticalLayer (LampSpec pos (sx, _)) n = fmap (\(x, _) -> floor (toRational  x / toRational sx * toRational n)) pos++-- >>> buildSegments $ verticalLayer (LampSpec lightPositions (100,100)) 3+-- [(0,3,1),(3,17,2),(17,21,1),(21,36,0),(36,40,1),(40,53,0),(53,57,1),(57,69,2),(69,75,1),(75,80,2),(80,84,1),(84,91,0),(91,94,1),(94,98,0),(98,101,1)]+buildSegments :: [Int] -> [(Int, Int, Int)]+buildSegments =  step 0 . group where+    step :: Int -> [[Int]] -> [(Int, Int, Int)]+    step n (xs@(x:_):r) = (n, n + length xs, x) : step (n + length xs) r+    step _ _            = []+++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]++ral5021 :: [Int]+ral5021 = [0, 150, 110]++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]

@@ -215,7 +215,7 @@     d' :: (AllB Eq (b Covered), Eq (b Bare Identity), Monoid (b Covered Maybe), ConstraintsB (b Covered), ApplicativeB (b Covered), BareB b) => b Bare Identity -> b Bare Identity -> Maybe (b Covered Maybe)     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 })+    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 }

@@ -1,11 +1,11 @@ cabal-version: 2.2 --- This file has been generated from package.yaml by hpack version 0.37.0.+-- This file has been generated from package.yaml by hpack version 0.38.0. -- -- see: https://github.com/sol/hpack  name:           wled-json-version:        0.0.1.1+version:        0.1.0.0 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@@ -20,10 +20,10 @@ tested-with:     GHC == 9.2.8   , GHC == 9.4.8-  , GHC == 9.6.6+  , GHC == 9.6.7   , GHC == 9.8.4-  , GHC == 9.10.1-  , GHC == 9.12.1+  , GHC == 9.10.2+  , GHC == 9.12.2 extra-source-files:     README.md extra-doc-files:@@ -36,7 +36,9 @@ library   exposed-modules:       WLED.Device-      WLED.Octocat.Flags+      WLED.Lamp.Octocat+      WLED.LampSpec+      WLED.Pattern.Flags       WLED.Types   other-modules:       Paths_wled_json@@ -54,7 +56,7 @@     , http-conduit >=2.3.9.1 && <2.4   default-language: Haskell2010 -executable wled-json-exe+executable wled-json-demo   main-is: Main.hs   other-modules:       Paths_wled_json@@ -66,6 +68,20 @@   build-depends:       base >=4.7 && <5     , rhine >=1.4.0.1 && <1.6+    , wled-json+  default-language: Haskell2010++executable wled-json-simple+  main-is: Main.hs+  other-modules:+      Paths_wled_json+  autogen-modules:+      Paths_wled_json+  hs-source-dirs:+      app-simple+  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     , wled-json   default-language: Haskell2010