{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE ScopedTypeVariables #-}

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

Interacting with the WLED device.
-}

module WLED.Device
    ( getLampState,
      setLampState
    ) where

import           Data.Aeson                  (eitherDecodeStrict, encode)
import           Data.ByteString             (ByteString, toStrict)
import           Network.HTTP.Client.Conduit (Request (method), path)
import           Network.HTTP.Simple         (getResponseBody, httpBS, parseRequest, setRequestBodyJSON)
import           WLED.Types                  (StateComplete, StatePatch)


{- |
Retrieves the current lamp state.

==== __Example__

>>> getLampState "http://192.168.178.34"
Right (State {stateOn = True, stateBri = 128, stateTransition = 7, statePs = -1, statePl = -1, stateNl = Nightlight {nightlightOn = False, nightlightDur = 60, nightlightMode = 1, nightlightTbri = 0, nightlightRem = -1}, stateLor = 0, stateMainseg = 0, stateSeg = [Segment {segmentId = 0, segmentStart = 0, segmentStop = 101, segmentLen = 101, segmentGrp = 1, segmentSpc = 0, segmentOf = 0, segmentOn = True, segmentFrz = False, segmentBri = 255, segmentCct = 127, segmentSet = 0, segmentCol = [[255,160,0],[0,0,0],[0,0,0]], segmentFx = 0, segmentSx = 128, segmentIx = 128, segmentPal = 0, segmentC1 = 128, segmentC2 = 128, segmentC3 = 16, segmentSel = True, segmentRev = False, segmentMi = False, segmentO1 = False, segmentO2 = False, segmentO3 = False, segmentSi = 0, segmentM12 = 0}]})
-}
getLampState :: String -> IO (Either String StateComplete)
getLampState :: String -> IO (Either String StateComplete)
getLampState String
wledUrl = do
    Request
req <- String -> IO Request
forall (m :: * -> *). MonadThrow m => String -> m Request
parseRequest String
wledUrl
    Response Method
res <- Request -> IO (Response Method)
forall (m :: * -> *). MonadIO m => Request -> m (Response Method)
httpBS Request
req { path = "json/state" }
    Either String StateComplete -> IO (Either String StateComplete)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Method -> Either String StateComplete
forall a. FromJSON a => Method -> Either String a
eitherDecodeStrict (Method -> Either String StateComplete)
-> Method -> Either String StateComplete
forall a b. (a -> b) -> a -> b
$ Response Method -> Method
forall a. Response a -> a
getResponseBody Response Method
res)

{- |
Alters the current lamp state.

==== __Examples__

>>> setLampState "http://192.168.178.34" $ (mempty :: StatePatch) { stateBri = Just 255 } <> (mempty :: StatePatch) { stateOn = Nothing }
("{\"bri\":255}","{\"success\":true}")

>>> setLampState "http://192.168.178.34" france
("{\"seg\":[{\"start\":0,\"stop\":5,\"col\":[[255,255,255]]},{\"start\":5,\"stop\":16,\"col\":[[255,0,0]]},{\"start\":16,\"stop\":23,\"col\":[[255,255,255]]},{\"start\":23,\"stop\":34,\"col\":[[0,0,255]]},{\"start\":34,\"stop\":41,\"col\":[[255,255,255]]},{\"start\":41,\"stop\":52,\"col\":[[0,0,255]]},{\"start\":52,\"stop\":57,\"col\":[[255,255,255]]},{\"start\":57,\"stop\":68,\"col\":[[255,0,0]]},{\"start\":68,\"stop\":101,\"col\":[[255,255,255]]}]}","{\"success\":true}")
-}
setLampState :: String -> StatePatch -> IO (ByteString, ByteString)
setLampState :: String -> StatePatch -> IO (Method, Method)
setLampState String
wledUrl StatePatch
patch =
    let body :: ByteString
body = StatePatch -> ByteString
forall a. ToJSON a => a -> ByteString
encode StatePatch
patch
    in do
      Request
req <- String -> IO Request
forall (m :: * -> *). MonadThrow m => String -> m Request
parseRequest String
wledUrl
      Response Method
res <- Request -> IO (Response Method)
forall (m :: * -> *). MonadIO m => Request -> m (Response Method)
httpBS (Request -> IO (Response Method))
-> Request -> IO (Response Method)
forall a b. (a -> b) -> a -> b
$ StatePatch -> Request -> Request
forall a. ToJSON a => a -> Request -> Request
setRequestBodyJSON StatePatch
patch Request
req { method = "POST", path = "json/state" }
      (Method, Method) -> IO (Method, Method)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> Method
toStrict ByteString
body, Response Method -> Method
forall a. Response a -> a
getResponseBody Response Method
res)