{-# LANGUAGE CPP                      #-}
{-# LANGUAGE DataKinds                #-}
{-# LANGUAGE DeriveGeneric            #-}
{-# LANGUAGE DerivingVia              #-}
{-# LANGUAGE FlexibleInstances        #-}
{-# LANGUAGE StandaloneDeriving       #-}
{-# LANGUAGE StandaloneKindSignatures #-}
{-# LANGUAGE TypeApplications         #-}
{-# LANGUAGE UndecidableInstances     #-}


{-|
Module      : WLED.Device
Copyright   : (c) Andreas Ländle, 2024
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

import           Barbies.Bare
import           Control.Applicative      (Alternative ((<|>)), empty)
import qualified Data.Aeson               as A
import           Data.Char                (toLower)
import           Data.Functor.Barbie
import           Data.Functor.Identity    (Identity (..))
import           Data.Functor.Transformer
import           Data.Kind                (Type)
import           Deriving.Aeson

#if __GLASGOW_HASKELL__ > 906
import           Data.List                ((!?))
#endif

-- | State data type.
type State :: Type -> (Type -> Type)-> (Type -> Type) -> Type
data State t f f' = State
    { forall t (f :: * -> *) (f' :: * -> *).
State t f f' -> Wear t f Bool
stateOn         :: Wear t f Bool
    , forall t (f :: * -> *) (f' :: * -> *). State t f f' -> Wear t f Int
stateBri        :: Wear t f Int
    , forall t (f :: * -> *) (f' :: * -> *). State t f f' -> Wear t f Int
stateTransition :: Wear t f Int
    , forall t (f :: * -> *) (f' :: * -> *). State t f f' -> Wear t f Int
statePs         :: Wear t f Int
    , forall t (f :: * -> *) (f' :: * -> *). State t f f' -> Wear t f Int
statePl         :: Wear t f Int
    , forall t (f :: * -> *) (f' :: * -> *).
State t f f' -> Wear t f (Nightlight t f')
stateNl         :: Wear t f (Nightlight t f')
--    , udpn :: Wear t f UdpNetwork
    , forall t (f :: * -> *) (f' :: * -> *). State t f f' -> Wear t f Int
stateLor        :: Wear t f Int
    , forall t (f :: * -> *) (f' :: * -> *). State t f f' -> Wear t f Int
stateMainseg    :: Wear t f Int
    , forall t (f :: * -> *) (f' :: * -> *).
State t f f' -> Wear t f [Segment t f']
stateSeg        :: Wear t f [Segment t f']
    } deriving stock ((forall x. State t f f' -> Rep (State t f f') x)
-> (forall x. Rep (State t f f') x -> State t f f')
-> Generic (State t f f')
forall x. Rep (State t f f') x -> State t f f'
forall x. State t f f' -> Rep (State t f f') x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall t (f :: * -> *) (f' :: * -> *) x.
Rep (State t f f') x -> State t f f'
forall t (f :: * -> *) (f' :: * -> *) x.
State t f f' -> Rep (State t f f') x
$cfrom :: forall t (f :: * -> *) (f' :: * -> *) x.
State t f f' -> Rep (State t f f') x
from :: forall x. State t f f' -> Rep (State t f f') x
$cto :: forall t (f :: * -> *) (f' :: * -> *) x.
Rep (State t f f') x -> State t f f'
to :: forall x. Rep (State t f f') x -> State t f f'
Generic) --, ConstraintsB, FunctorB, ApplicativeB)

instance Functor f => FunctorB (State Covered f)
instance FunctorB (State Bare f)

instance FunctorT (State Covered)
instance ApplicativeT (State Covered)

deriving stock instance Show (State Bare f f')
deriving stock instance Eq (State Bare f f')
deriving stock instance (Show (f Bool), Show (f Int), Show (f (Nightlight Covered f')), Show (f [Segment Covered f'])) => Show (State Covered f f')
deriving stock instance (Eq (f Bool), Eq (f Int), Eq (f (Nightlight Covered f')), Eq (f [Segment Covered f'])) => Eq (State Covered f f')
deriving via CustomJSON '[OmitNothingFields, FieldLabelModifier '[StripPrefix "state", ToLower]] (State Bare f f') instance A.FromJSON (State Bare f f')
deriving via CustomJSON '[OmitNothingFields, FieldLabelModifier '[StripPrefix "state", ToLower]] (State Bare f f') instance A.ToJSON (State Bare f f')
deriving via CustomJSON '[OmitNothingFields, FieldLabelModifier '[StripPrefix "state", ToLower]] (State Covered f f') instance (FromJSON (f Bool), FromJSON (f Int), FromJSON (f (Nightlight Covered f')), FromJSON (f [Segment Covered f'])) => A.FromJSON (State Covered f f')
deriving via CustomJSON '[OmitNothingFields, FieldLabelModifier '[StripPrefix "state", ToLower]] (State Covered f f') instance (ToJSON (f Bool), ToJSON (f Int), ToJSON (f (Nightlight Covered f')), ToJSON (f [Segment Covered f'])) => A.ToJSON (State Covered f f')

instance Semigroup StatePatch where
  (State Wear Covered Maybe Bool
aOn Wear Covered Maybe Int
aBri Wear Covered Maybe Int
aTransition Wear Covered Maybe Int
aPs Wear Covered Maybe Int
aPl Wear Covered Maybe (Nightlight Covered Maybe)
aNl Wear Covered Maybe Int
aLor Wear Covered Maybe Int
aMainseg Wear Covered Maybe [Segment Covered Maybe]
aSeg) <> :: StatePatch -> StatePatch -> StatePatch
<> (State Wear Covered Maybe Bool
bOn Wear Covered Maybe Int
bBri Wear Covered Maybe Int
bTransition Wear Covered Maybe Int
bPs Wear Covered Maybe Int
bPl Wear Covered Maybe (Nightlight Covered Maybe)
bNl Wear Covered Maybe Int
bLor Wear Covered Maybe Int
bMainseg Wear Covered Maybe [Segment Covered Maybe]
bSeg) = Wear Covered Maybe Bool
-> Wear Covered Maybe Int
-> Wear Covered Maybe Int
-> Wear Covered Maybe Int
-> Wear Covered Maybe Int
-> Wear Covered Maybe (Nightlight Covered Maybe)
-> Wear Covered Maybe Int
-> Wear Covered Maybe Int
-> Wear Covered Maybe [Segment Covered Maybe]
-> StatePatch
forall t (f :: * -> *) (f' :: * -> *).
Wear t f Bool
-> Wear t f Int
-> Wear t f Int
-> Wear t f Int
-> Wear t f Int
-> Wear t f (Nightlight t f')
-> Wear t f Int
-> Wear t f Int
-> Wear t f [Segment t f']
-> State t f f'
State (Maybe Bool
Wear Covered Maybe Bool
aOn Maybe Bool -> Maybe Bool -> Maybe Bool
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Bool
Wear Covered Maybe Bool
bOn) (Maybe Int
Wear Covered Maybe Int
aBri Maybe Int -> Maybe Int -> Maybe Int
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Int
Wear Covered Maybe Int
bBri) (Maybe Int
Wear Covered Maybe Int
aTransition Maybe Int -> Maybe Int -> Maybe Int
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Int
Wear Covered Maybe Int
bTransition) (Maybe Int
Wear Covered Maybe Int
aPs Maybe Int -> Maybe Int -> Maybe Int
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Int
Wear Covered Maybe Int
bPs) (Maybe Int
Wear Covered Maybe Int
aPl Maybe Int -> Maybe Int -> Maybe Int
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Int
Wear Covered Maybe Int
bPl) (Maybe (Nightlight Covered Maybe)
Wear Covered Maybe (Nightlight Covered Maybe)
aNl Maybe (Nightlight Covered Maybe)
-> Maybe (Nightlight Covered Maybe)
-> Maybe (Nightlight Covered Maybe)
forall a. Semigroup a => Maybe a -> Maybe a -> Maybe a
<||> Maybe (Nightlight Covered Maybe)
Wear Covered Maybe (Nightlight Covered Maybe)
bNl) (Maybe Int
Wear Covered Maybe Int
aLor Maybe Int -> Maybe Int -> Maybe Int
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Int
Wear Covered Maybe Int
bLor) (Maybe Int
Wear Covered Maybe Int
aMainseg Maybe Int -> Maybe Int -> Maybe Int
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Int
Wear Covered Maybe Int
bMainseg) (Maybe [Segment Covered Maybe]
Wear Covered Maybe [Segment Covered Maybe]
aSeg Maybe [Segment Covered Maybe]
-> Maybe [Segment Covered Maybe] -> Maybe [Segment Covered Maybe]
forall a. Semigroup a => Maybe [a] -> Maybe [a] -> Maybe [a]
<|||> Maybe [Segment Covered Maybe]
Wear Covered Maybe [Segment Covered Maybe]
bSeg)
    where
      (<||>) :: Semigroup a => Maybe a -> Maybe a -> Maybe a
      <||> :: forall a. Semigroup a => Maybe a -> Maybe a -> Maybe a
(<||>) (Just a
a) (Just a
b) = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ a
a a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
b
      (<||>) Maybe a
Nothing Maybe a
r         = Maybe a
r
      (<||>) Maybe a
l       Maybe a
_         = Maybe a
l
      (<|||>) :: Semigroup a => Maybe [a] -> Maybe [a] -> Maybe [a]
      <|||> :: forall a. Semigroup a => Maybe [a] -> Maybe [a] -> Maybe [a]
(<|||>) (Just [a]
a) (Just [a]
b) = [a] -> Maybe [a]
forall a. a -> Maybe a
Just ([a] -> Maybe [a]) -> [a] -> Maybe [a]
forall a b. (a -> b) -> a -> b
$ (a -> a -> a) -> [a] -> [a] -> [a]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith a -> a -> a
forall a. Semigroup a => a -> a -> a
(<>) [a]
a [a]
b
      (<|||>) Maybe [a]
Nothing Maybe [a]
r         = Maybe [a]
r
      (<|||>) Maybe [a]
l       Maybe [a]
_         = Maybe [a]
l

instance Monoid StatePatch where
  mempty :: StatePatch
mempty = (forall a. Maybe a) -> StatePatch
forall k k' (t :: (k -> *) -> k' -> *) (f :: k -> *) (x :: k').
ApplicativeT t =>
(forall (a :: k). f a) -> t f x
forall (f :: * -> *) (x :: * -> *).
(forall a. f a) -> State Covered f x
tpure Maybe a
forall a. Maybe a
forall (f :: * -> *) a. Alternative f => f a
empty

-- | Nightlight data type.
type Nightlight :: Type -> (Type -> Type) -> Type
data Nightlight t f = Nightlight
    { forall t (f :: * -> *). Nightlight t f -> Wear t f Bool
nightlightOn   :: Wear t f Bool
    , forall t (f :: * -> *). Nightlight t f -> Wear t f Int
nightlightDur  :: Wear t f Int
    , forall t (f :: * -> *). Nightlight t f -> Wear t f Int
nightlightMode ::Wear t f  Int
    , forall t (f :: * -> *). Nightlight t f -> Wear t f Int
nightlightTbri ::Wear t f  Int
    , forall t (f :: * -> *). Nightlight t f -> Wear t f Int
nightlightRem  ::Wear t f  Int
    } deriving stock ((forall x. Nightlight t f -> Rep (Nightlight t f) x)
-> (forall x. Rep (Nightlight t f) x -> Nightlight t f)
-> Generic (Nightlight t f)
forall x. Rep (Nightlight t f) x -> Nightlight t f
forall x. Nightlight t f -> Rep (Nightlight t f) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall t (f :: * -> *) x. Rep (Nightlight t f) x -> Nightlight t f
forall t (f :: * -> *) x. Nightlight t f -> Rep (Nightlight t f) x
$cfrom :: forall t (f :: * -> *) x. Nightlight t f -> Rep (Nightlight t f) x
from :: forall x. Nightlight t f -> Rep (Nightlight t f) x
$cto :: forall t (f :: * -> *) x. Rep (Nightlight t f) x -> Nightlight t f
to :: forall x. Rep (Nightlight t f) x -> Nightlight t f
Generic)

instance ConstraintsB (Nightlight Covered)
instance FunctorB (Nightlight Covered)
instance ApplicativeB (Nightlight Covered)

instance ConstraintsB (Nightlight Bare)
instance FunctorB (Nightlight Bare)
instance BareB Nightlight

deriving stock instance (AllBF Show f (Nightlight Bare)) => Show (Nightlight Bare f)
deriving stock instance (AllBF Eq f (Nightlight Bare)) => Eq (Nightlight Bare f)
deriving stock instance (AllBF Show f (Nightlight Covered)) => Show (Nightlight Covered f)
deriving stock instance (AllBF Eq f (Nightlight Covered)) => Eq (Nightlight Covered f)
deriving via CustomJSON '[OmitNothingFields, FieldLabelModifier '[StripPrefix "nightlight", ToLower]] (Nightlight Bare f) instance (AllBF A.FromJSON f (Nightlight Bare)) => A.FromJSON (Nightlight Bare f)
deriving via CustomJSON '[OmitNothingFields, FieldLabelModifier '[StripPrefix "nightlight", ToLower]] (Nightlight Bare f) instance (AllBF A.ToJSON f (Nightlight Bare)) => A.ToJSON (Nightlight Bare f)
deriving via CustomJSON '[OmitNothingFields, FieldLabelModifier '[StripPrefix "nightlight", ToLower]] (Nightlight Covered f) instance (AllBF A.FromJSON f (Nightlight Covered)) => A.FromJSON (Nightlight Covered f)
deriving via CustomJSON '[OmitNothingFields, FieldLabelModifier '[StripPrefix "nightlight", ToLower]] (Nightlight Covered f) instance (AllBF A.ToJSON f (Nightlight Covered)) => A.ToJSON (Nightlight Covered f)

instance (Alternative f) => Semigroup (Nightlight Covered f) where
  <> :: Nightlight Covered f
-> Nightlight Covered f -> Nightlight Covered f
(<>) = (forall a. f a -> f a -> f a)
-> Nightlight Covered f
-> Nightlight Covered f
-> Nightlight Covered f
forall {k} (b :: (k -> *) -> *) (f :: k -> *) (g :: k -> *)
       (h :: k -> *).
ApplicativeB b =>
(forall (a :: k). f a -> g a -> h a) -> b f -> b g -> b h
bzipWith f a -> f a -> f a
forall a. f a -> f a -> f a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>)

instance (Alternative f) => Monoid (Nightlight Covered f) where
  mempty :: Nightlight Covered f
mempty = (forall a. f a) -> Nightlight Covered f
forall k (b :: (k -> *) -> *) (f :: k -> *).
ApplicativeB b =>
(forall (a :: k). f a) -> b f
forall (f :: * -> *). (forall a. f a) -> Nightlight Covered f
bpure f a
forall a. f a
forall (f :: * -> *) a. Alternative f => f a
empty

-- | Segment data type.
type Segment :: Type -> (Type -> Type) -> Type
data Segment t f = Segment
    { forall t (f :: * -> *). Segment t f -> Wear t f Int
segmentId    :: Wear t f Int
    , forall t (f :: * -> *). Segment t f -> Wear t f Int
segmentStart :: Wear t f Int
    , forall t (f :: * -> *). Segment t f -> Wear t f Int
segmentStop  :: Wear t f Int
    , forall t (f :: * -> *). Segment t f -> Wear t f Int
segmentLen   :: Wear t f Int
    , forall t (f :: * -> *). Segment t f -> Wear t f Int
segmentGrp   :: Wear t f Int
    , forall t (f :: * -> *). Segment t f -> Wear t f Int
segmentSpc   :: Wear t f Int
    , forall t (f :: * -> *). Segment t f -> Wear t f Int
segmentOf    :: Wear t f Int
    , forall t (f :: * -> *). Segment t f -> Wear t f Bool
segmentOn    :: Wear t f Bool
    , forall t (f :: * -> *). Segment t f -> Wear t f Bool
segmentFrz   :: Wear t f Bool
    , forall t (f :: * -> *). Segment t f -> Wear t f Int
segmentBri   :: Wear t f Int
    , forall t (f :: * -> *). Segment t f -> Wear t f Int
segmentCct   :: Wear t f Int
    , forall t (f :: * -> *). Segment t f -> Wear t f Int
segmentSet   :: Wear t f Int
    , forall t (f :: * -> *). Segment t f -> Wear t f [[Int]]
segmentCol   :: Wear t f [[Int]]
    , forall t (f :: * -> *). Segment t f -> Wear t f Int
segmentFx    :: Wear t f Int
    , forall t (f :: * -> *). Segment t f -> Wear t f Int
segmentSx    :: Wear t f Int
    , forall t (f :: * -> *). Segment t f -> Wear t f Int
segmentIx    :: Wear t f Int
    , forall t (f :: * -> *). Segment t f -> Wear t f Int
segmentPal   :: Wear t f Int
    , forall t (f :: * -> *). Segment t f -> Wear t f Int
segmentC1    :: Wear t f Int
    , forall t (f :: * -> *). Segment t f -> Wear t f Int
segmentC2    :: Wear t f Int
    , forall t (f :: * -> *). Segment t f -> Wear t f Int
segmentC3    :: Wear t f Int
    , forall t (f :: * -> *). Segment t f -> Wear t f Bool
segmentSel   :: Wear t f Bool
    , forall t (f :: * -> *). Segment t f -> Wear t f Bool
segmentRev   :: Wear t f Bool
    , forall t (f :: * -> *). Segment t f -> Wear t f Bool
segmentMi    :: Wear t f Bool
    , forall t (f :: * -> *). Segment t f -> Wear t f Bool
segmentO1    :: Wear t f Bool
    , forall t (f :: * -> *). Segment t f -> Wear t f Bool
segmentO2    :: Wear t f Bool
    , forall t (f :: * -> *). Segment t f -> Wear t f Bool
segmentO3    :: Wear t f Bool
    , forall t (f :: * -> *). Segment t f -> Wear t f Int
segmentSi    :: Wear t f Int
    , forall t (f :: * -> *). Segment t f -> Wear t f Int
segmentM12   :: Wear t f Int
    } deriving stock ((forall x. Segment t f -> Rep (Segment t f) x)
-> (forall x. Rep (Segment t f) x -> Segment t f)
-> Generic (Segment t f)
forall x. Rep (Segment t f) x -> Segment t f
forall x. Segment t f -> Rep (Segment t f) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall t (f :: * -> *) x. Rep (Segment t f) x -> Segment t f
forall t (f :: * -> *) x. Segment t f -> Rep (Segment t f) x
$cfrom :: forall t (f :: * -> *) x. Segment t f -> Rep (Segment t f) x
from :: forall x. Segment t f -> Rep (Segment t f) x
$cto :: forall t (f :: * -> *) x. Rep (Segment t f) x -> Segment t f
to :: forall x. Rep (Segment t f) x -> Segment t f
Generic)

instance ConstraintsB (Segment Covered)
instance FunctorB (Segment Covered)
instance ApplicativeB (Segment Covered)

instance ConstraintsB (Segment Bare)
instance FunctorB (Segment Bare)
instance BareB Segment

deriving stock instance (AllBF Show f (Segment Bare)) => Show (Segment Bare f)
deriving stock instance (AllBF Eq f (Segment Bare)) => Eq (Segment Bare f)
deriving stock instance (AllBF Show f (Segment Covered)) => Show (Segment Covered f)
deriving stock instance (AllBF Eq f (Segment Covered)) => Eq (Segment Covered f)
deriving via CustomJSON '[OmitNothingFields, FieldLabelModifier '[StripPrefix "segment", ToLower]] (Segment Bare f) instance (AllBF A.FromJSON f (Segment Bare)) => A.FromJSON (Segment Bare f)
deriving via CustomJSON '[OmitNothingFields, FieldLabelModifier '[StripPrefix "segment", ToLower]] (Segment Bare f) instance (AllBF A.ToJSON f (Segment Bare)) => A.ToJSON (Segment Bare f)
deriving via CustomJSON '[OmitNothingFields, FieldLabelModifier '[StripPrefix "segment", ToLower]] (Segment Covered f) instance (AllBF A.FromJSON f (Segment Covered)) => A.FromJSON (Segment Covered f)
deriving via CustomJSON '[OmitNothingFields, FieldLabelModifier '[StripPrefix "segment", ToLower]] (Segment Covered f) instance (AllBF A.ToJSON f (Segment Covered)) => A.ToJSON (Segment Covered f)

instance (Alternative f) => Semigroup (Segment Covered f) where
  <> :: Segment Covered f -> Segment Covered f -> Segment Covered f
(<>) = (forall a. f a -> f a -> f a)
-> Segment Covered f -> Segment Covered f -> Segment Covered f
forall {k} (b :: (k -> *) -> *) (f :: k -> *) (g :: k -> *)
       (h :: k -> *).
ApplicativeB b =>
(forall (a :: k). f a -> g a -> h a) -> b f -> b g -> b h
bzipWith f a -> f a -> f a
forall a. f a -> f a -> f a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>)

instance (Alternative f) => Monoid (Segment Covered f) where
  mempty :: Segment Covered f
mempty = (forall a. f a) -> Segment Covered f
forall k (b :: (k -> *) -> *) (f :: k -> *).
ApplicativeB b =>
(forall (a :: k). f a) -> b f
forall (f :: * -> *). (forall a. f a) -> Segment Covered f
bpure f a
forall a. f a
forall (f :: * -> *) a. Alternative f => f a
empty

type ToLower :: Type
data ToLower
instance StringModifier ToLower where
  getStringModifier :: ShowS
getStringModifier String
""       = String
""
  getStringModifier (Char
c : String
xs) = Char -> Char
toLower Char
c Char -> ShowS
forall a. a -> [a] -> [a]
: String
xs

type StateComplete :: Type
type StateComplete = State Bare Identity Identity

type StatePatch :: Type
type StatePatch = State Covered Maybe Maybe

type NightlightComplete :: Type
type NightlightComplete = Nightlight Bare Identity

type NightlightPatch :: Type
type NightlightPatch = Nightlight Covered Maybe

type SegmentComplete :: Type
type SegmentComplete = Segment Bare Identity

type SegmentPatch :: Type
type SegmentPatch = Segment Covered Maybe

append :: StateComplete -> StatePatch -> StateComplete
append :: StateComplete -> StatePatch -> StateComplete
append (State Wear Bare Identity Bool
aOn Wear Bare Identity Int
aBri Wear Bare Identity Int
aTransition Wear Bare Identity Int
aPs Wear Bare Identity Int
aPl Wear Bare Identity (Nightlight Bare Identity)
aNl Wear Bare Identity Int
aLor Wear Bare Identity Int
aMainseg Wear Bare Identity [Segment Bare Identity]
aSeg) (State Wear Covered Maybe Bool
bOn Wear Covered Maybe Int
bBri Wear Covered Maybe Int
bTransition Wear Covered Maybe Int
bPs Wear Covered Maybe Int
bPl Wear Covered Maybe (Nightlight Covered Maybe)
bNl Wear Covered Maybe Int
bLor Wear Covered Maybe Int
bMainseg Wear Covered Maybe [Segment Covered Maybe]
bSeg) =
  Wear Bare Identity Bool
-> Wear Bare Identity Int
-> Wear Bare Identity Int
-> Wear Bare Identity Int
-> Wear Bare Identity Int
-> Wear Bare Identity (Nightlight Bare Identity)
-> Wear Bare Identity Int
-> Wear Bare Identity Int
-> Wear Bare Identity [Segment Bare Identity]
-> StateComplete
forall t (f :: * -> *) (f' :: * -> *).
Wear t f Bool
-> Wear t f Int
-> Wear t f Int
-> Wear t f Int
-> Wear t f Int
-> Wear t f (Nightlight t f')
-> Wear t f Int
-> Wear t f Int
-> Wear t f [Segment t f']
-> State t f f'
State (Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
cb Bool
Wear Bare Identity Bool
aOn Maybe Bool
Wear Covered Maybe Bool
bOn) (Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
cb Int
Wear Bare Identity Int
aBri Maybe Int
Wear Covered Maybe Int
bBri) (Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
cb Int
Wear Bare Identity Int
aTransition Maybe Int
Wear Covered Maybe Int
bTransition) (Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
cb Int
Wear Bare Identity Int
aPs Maybe Int
Wear Covered Maybe Int
bPs) (Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
cb Int
Wear Bare Identity Int
aPl Maybe Int
Wear Covered Maybe Int
bPl) (Nightlight Bare Identity
-> Maybe (Nightlight Covered Maybe) -> Nightlight Bare Identity
forall (b :: * -> (* -> *) -> *).
(BareB b, ApplicativeB (b Covered)) =>
b Bare Identity -> Maybe (b Covered Maybe) -> b Bare Identity
cb' Wear Bare Identity (Nightlight Bare Identity)
Nightlight Bare Identity
aNl Maybe (Nightlight Covered Maybe)
Wear Covered Maybe (Nightlight Covered Maybe)
bNl) (Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
cb Int
Wear Bare Identity Int
aLor Maybe Int
Wear Covered Maybe Int
bLor) (Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
cb Int
Wear Bare Identity Int
aMainseg Maybe Int
Wear Covered Maybe Int
bMainseg) ([Segment Bare Identity]
-> Maybe [Segment Covered Maybe] -> [Segment Bare Identity]
forall (b :: * -> (* -> *) -> *).
(BareB b, ApplicativeB (b Covered)) =>
[b Bare Identity] -> Maybe [b Covered Maybe] -> [b Bare Identity]
cb'' [Segment Bare Identity]
Wear Bare Identity [Segment Bare Identity]
aSeg Maybe [Segment Covered Maybe]
Wear Covered Maybe [Segment Covered Maybe]
bSeg)
  where
    cb :: a -> Maybe a -> a
    cb :: forall a. a -> Maybe a -> a
cb a
x Maybe a
dx = Identity a -> a
forall a. Identity a -> a
runIdentity (Identity a -> a) -> Identity a -> a
forall a b. (a -> b) -> a -> b
$ Identity a -> Maybe a -> Identity a
forall a. Identity a -> Maybe a -> Identity a
fromMaybeI (a -> Identity a
forall a. a -> Identity a
Identity a
x) Maybe a
dx
    cb' :: (BareB b, ApplicativeB (b Covered)) => b Bare Identity -> Maybe (b Covered Maybe) -> b Bare Identity
    cb' :: forall (b :: * -> (* -> *) -> *).
(BareB b, ApplicativeB (b Covered)) =>
b Bare Identity -> Maybe (b Covered Maybe) -> b Bare Identity
cb' b Bare Identity
x = b Bare Identity
-> (b Covered Maybe -> b Bare Identity)
-> Maybe (b Covered Maybe)
-> b Bare Identity
forall b a. b -> (a -> b) -> Maybe a -> b
maybe b Bare Identity
x (b Bare Identity -> b Covered Maybe -> b Bare Identity
forall (b :: * -> (* -> *) -> *).
(BareB b, ApplicativeB (b Covered)) =>
b Bare Identity -> b Covered Maybe -> b Bare Identity
append' b Bare Identity
x)
    cb'' :: (BareB b, ApplicativeB (b Covered)) => [b Bare Identity] -> Maybe [b Covered Maybe] -> [b Bare Identity]
    cb'' :: forall (b :: * -> (* -> *) -> *).
(BareB b, ApplicativeB (b Covered)) =>
[b Bare Identity] -> Maybe [b Covered Maybe] -> [b Bare Identity]
cb'' [b Bare Identity]
x = [b Bare Identity]
-> ([b Covered Maybe] -> [b Bare Identity])
-> Maybe [b Covered Maybe]
-> [b Bare Identity]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [b Bare Identity]
x ((b Bare Identity -> b Covered Maybe -> b Bare Identity)
-> [b Bare Identity] -> [b Covered Maybe] -> [b Bare Identity]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith b Bare Identity -> b Covered Maybe -> b Bare Identity
forall (b :: * -> (* -> *) -> *).
(BareB b, ApplicativeB (b Covered)) =>
b Bare Identity -> b Covered Maybe -> b Bare Identity
append' [b Bare Identity]
x)

append' :: (BareB b, ApplicativeB (b Covered)) => b Bare Identity -> b Covered Maybe -> b Bare Identity
append' :: forall (b :: * -> (* -> *) -> *).
(BareB b, ApplicativeB (b Covered)) =>
b Bare Identity -> b Covered Maybe -> b Bare Identity
append' b Bare Identity
x b Covered Maybe
dx = b Covered Identity -> b Bare Identity
forall (b :: * -> (* -> *) -> *).
BareB b =>
b Covered Identity -> b Bare Identity
bstrip (b Covered Identity -> b Bare Identity)
-> b Covered Identity -> b Bare Identity
forall a b. (a -> b) -> a -> b
$ (forall a. Identity a -> Maybe a -> Identity a)
-> b Covered Identity -> b Covered Maybe -> b Covered Identity
forall {k} (b :: (k -> *) -> *) (f :: k -> *) (g :: k -> *)
       (h :: k -> *).
ApplicativeB b =>
(forall (a :: k). f a -> g a -> h a) -> b f -> b g -> b h
bzipWith Identity a -> Maybe a -> Identity a
forall a. Identity a -> Maybe a -> Identity a
fromMaybeI (b Bare Identity -> b Covered Identity
forall (b :: * -> (* -> *) -> *).
BareB b =>
b Bare Identity -> b Covered Identity
bcover b Bare Identity
x) b Covered Maybe
dx

diff :: StateComplete -> StateComplete -> StatePatch
diff :: StateComplete -> StateComplete -> StatePatch
diff (State Wear Bare Identity Bool
aOn Wear Bare Identity Int
aBri Wear Bare Identity Int
aTransition Wear Bare Identity Int
aPs Wear Bare Identity Int
aPl Wear Bare Identity (Nightlight Bare Identity)
aNl Wear Bare Identity Int
aLor Wear Bare Identity Int
aMainseg Wear Bare Identity [Segment Bare Identity]
aSeg) (State Wear Bare Identity Bool
bOn Wear Bare Identity Int
bBri Wear Bare Identity Int
bTransition Wear Bare Identity Int
bPs Wear Bare Identity Int
bPl Wear Bare Identity (Nightlight Bare Identity)
bNl Wear Bare Identity Int
bLor Wear Bare Identity Int
bMainseg Wear Bare Identity [Segment Bare Identity]
bSeg) =
  Wear Covered Maybe Bool
-> Wear Covered Maybe Int
-> Wear Covered Maybe Int
-> Wear Covered Maybe Int
-> Wear Covered Maybe Int
-> Wear Covered Maybe (Nightlight Covered Maybe)
-> Wear Covered Maybe Int
-> Wear Covered Maybe Int
-> Wear Covered Maybe [Segment Covered Maybe]
-> StatePatch
forall t (f :: * -> *) (f' :: * -> *).
Wear t f Bool
-> Wear t f Int
-> Wear t f Int
-> Wear t f Int
-> Wear t f Int
-> Wear t f (Nightlight t f')
-> Wear t f Int
-> Wear t f Int
-> Wear t f [Segment t f']
-> State t f f'
State (Bool -> Bool -> Maybe Bool
forall a. Eq a => a -> a -> Maybe a
d Bool
Wear Bare Identity Bool
aOn Bool
Wear Bare Identity Bool
bOn) (Int -> Int -> Maybe Int
forall a. Eq a => a -> a -> Maybe a
d Int
Wear Bare Identity Int
aBri Int
Wear Bare Identity Int
bBri) (Int -> Int -> Maybe Int
forall a. Eq a => a -> a -> Maybe a
d Int
Wear Bare Identity Int
aTransition Int
Wear Bare Identity Int
bTransition) (Int -> Int -> Maybe Int
forall a. Eq a => a -> a -> Maybe a
d Int
Wear Bare Identity Int
aPs Int
Wear Bare Identity Int
bPs) (Int -> Int -> Maybe Int
forall a. Eq a => a -> a -> Maybe a
d Int
Wear Bare Identity Int
aPl Int
Wear Bare Identity Int
bPl) (Nightlight Bare Identity
-> Nightlight Bare Identity -> Maybe (Nightlight Covered Maybe)
forall (b :: * -> (* -> *) -> *).
(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' Wear Bare Identity (Nightlight Bare Identity)
Nightlight Bare Identity
aNl Wear Bare Identity (Nightlight Bare Identity)
Nightlight Bare Identity
bNl) (Int -> Int -> Maybe Int
forall a. Eq a => a -> a -> Maybe a
d Int
Wear Bare Identity Int
aLor Int
Wear Bare Identity Int
bLor) (Int -> Int -> Maybe Int
forall a. Eq a => a -> a -> Maybe a
d Int
Wear Bare Identity Int
aMainseg Int
Wear Bare Identity Int
bMainseg) ([Segment Bare Identity]
-> [Segment Bare Identity] -> Maybe [Segment Covered Maybe]
d'' [Segment Bare Identity]
Wear Bare Identity [Segment Bare Identity]
aSeg [Segment Bare Identity]
Wear Bare Identity [Segment Bare Identity]
bSeg)
  where
    d :: Eq a => a -> a -> Maybe a
    d :: forall a. Eq a => a -> a -> Maybe a
d a
a a
b = if a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
b then Maybe a
forall a. Maybe a
Nothing else a -> Maybe a
forall a. a -> Maybe a
Just a
b
    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' :: forall (b :: * -> (* -> *) -> *).
(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' b Bare Identity
a b Bare Identity
b = if b Bare Identity
a b Bare Identity -> b Bare Identity -> Bool
forall a. Eq a => a -> a -> Bool
== b Bare Identity
b then Maybe (b Covered Maybe)
forall a. Maybe a
Nothing else b Covered Maybe -> Maybe (b Covered Maybe)
forall a. a -> Maybe a
Just (b Covered Maybe -> Maybe (b Covered Maybe))
-> b Covered Maybe -> Maybe (b Covered Maybe)
forall a b. (a -> b) -> a -> b
$ b Bare Identity -> b Bare Identity -> b Covered Maybe
forall (b :: * -> (* -> *) -> *).
(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 -> b Covered Maybe
diff' b Bare Identity
a b Bare Identity
b
    d'' :: [Segment Bare Identity] -> [Segment Bare Identity] -> Maybe [Segment Covered Maybe]
    d'' :: [Segment Bare Identity]
-> [Segment Bare Identity] -> Maybe [Segment Covered Maybe]
d'' [Segment Bare Identity]
a [Segment Bare Identity]
b = if [Segment Bare Identity]
a [Segment Bare Identity] -> [Segment Bare Identity] -> Bool
forall a. Eq a => a -> a -> Bool
== [Segment Bare Identity]
b then Maybe [Segment Covered Maybe]
forall a. Maybe a
Nothing else [Segment Covered Maybe] -> Maybe [Segment Covered Maybe]
forall a. a -> Maybe a
Just ([Segment Covered Maybe] -> Maybe [Segment Covered Maybe])
-> [Segment Covered Maybe] -> Maybe [Segment Covered Maybe]
forall a b. (a -> b) -> a -> b
$ (Int -> Segment Bare Identity -> Segment Covered Maybe)
-> [Int] -> [Segment Bare Identity] -> [Segment Covered Maybe]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Int
i Segment Bare Identity
bb -> Segment Covered Maybe
-> (Segment Bare Identity -> Segment Covered Maybe)
-> Maybe (Segment Bare Identity)
-> Segment Covered Maybe
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ((forall a. Identity a -> Maybe a)
-> Segment Covered Identity -> Segment Covered Maybe
forall k (b :: (k -> *) -> *) (f :: k -> *) (g :: k -> *).
FunctorB b =>
(forall (a :: k). f a -> g a) -> b f -> b g
forall (f :: * -> *) (g :: * -> *).
(forall a. f a -> g a) -> Segment Covered f -> Segment Covered g
bmap (a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> (Identity a -> a) -> Identity a -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity a -> a
forall a. Identity a -> a
runIdentity) (Segment Covered Identity -> Segment Covered Maybe)
-> Segment Covered Identity -> Segment Covered Maybe
forall a b. (a -> b) -> a -> b
$ Segment Bare Identity -> Segment Covered Identity
forall (b :: * -> (* -> *) -> *).
BareB b =>
b Bare Identity -> b Covered Identity
bcover Segment Bare Identity
bb) (Segment Bare Identity
-> Segment Bare Identity -> Segment Covered Maybe
forall (b :: * -> (* -> *) -> *).
(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 -> b Covered Maybe
`diff'` Segment Bare Identity
bb) ([Segment Bare Identity]
a [Segment Bare Identity] -> Int -> Maybe (Segment Bare Identity)
forall a. [a] -> Int -> Maybe a
!? Int
i)) [Int
0..] [Segment Bare Identity]
b [Segment Covered Maybe]
-> [Segment Covered Maybe] -> [Segment Covered Maybe]
forall a. [a] -> [a] -> [a]
++ Int -> Segment Covered Maybe -> [Segment Covered Maybe]
forall a. Int -> a -> [a]
replicate ([Segment Bare Identity] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Segment Bare Identity]
a Int -> Int -> Int
forall a. Num a => a -> a -> a
- [Segment Bare Identity] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Segment Bare Identity]
b) ((Segment Covered Maybe
forall a. Monoid a => a
mempty :: SegmentPatch) { segmentStop = Just 0 })

#if __GLASGOW_HASKELL__ <= 906
-- | A total variant of the list index function `(!!)`.
--
-- > [2,3,4] !? 1    == Just 3
-- > [2,3,4] !? (-1) == Nothing
-- > []      !? 0    == Nothing
(!?) :: [a] -> Int -> Maybe a
[a]
xs !? :: forall a. [a] -> Int -> Maybe a
!? Int
n
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0     = Maybe a
forall a. Maybe a
Nothing
             -- Definition adapted from GHC.List
  | Bool
otherwise = (a -> (Int -> Maybe a) -> Int -> Maybe a)
-> (Int -> Maybe a) -> [a] -> Int -> Maybe a
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\a
x Int -> Maybe a
r Int
k -> case Int
k of
                                   Int
0 -> a -> Maybe a
forall a. a -> Maybe a
Just a
x
                                   Int
_ -> Int -> Maybe a
r (Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)) (Maybe a -> Int -> Maybe a
forall a b. a -> b -> a
const Maybe a
forall a. Maybe a
Nothing) [a]
xs Int
n
{-# INLINABLE (!?) #-}
#endif

-- >>> diff' (Nightlight {nightlightOn = False, nightlightDur = 0, nightlightMode = 0, nightlightTbri = 0, nightlightRem = 0}) (Nightlight {nightlightOn = True, nightlightDur = 0, nightlightMode = 0, nightlightTbri = 0, nightlightRem = 0})
-- Nightlight {nightlightOn = Just True, nightlightDur = Nothing, nightlightMode = Nothing, nightlightTbri = Nothing, nightlightRem = Nothing}
diff' :: (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 -> b Covered Maybe
diff' :: forall (b :: * -> (* -> *) -> *).
(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 -> b Covered Maybe
diff' b Bare Identity
a b Bare Identity
b = if b Bare Identity
a b Bare Identity -> b Bare Identity -> Bool
forall a. Eq a => a -> a -> Bool
== b Bare Identity
b then b Covered Maybe
forall a. Monoid a => a
mempty else forall {k} (c :: k -> Constraint) (b :: (k -> *) -> *)
       (f :: k -> *) (g :: k -> *) (h :: k -> *).
(AllB c b, ConstraintsB b, ApplicativeB b) =>
(forall (a :: k). c a => f a -> g a -> h a) -> b f -> b g -> b h
forall (c :: * -> Constraint) (b :: (* -> *) -> *) (f :: * -> *)
       (g :: * -> *) (h :: * -> *).
(AllB c b, ConstraintsB b, ApplicativeB b) =>
(forall a. c a => f a -> g a -> h a) -> b f -> b g -> b h
bzipWithC @Eq (\Identity a
aa Identity a
bb -> if Identity a
aa Identity a -> Identity a -> Bool
forall a. Eq a => a -> a -> Bool
== Identity a
bb then Maybe a
forall a. Maybe a
Nothing else a -> Maybe a
forall a. a -> Maybe a
Just (Identity a -> a
forall a. Identity a -> a
runIdentity Identity a
bb)) (b Bare Identity -> b Covered Identity
forall (b :: * -> (* -> *) -> *).
BareB b =>
b Bare Identity -> b Covered Identity
bcover b Bare Identity
a) (b Bare Identity -> b Covered Identity
forall (b :: * -> (* -> *) -> *).
BareB b =>
b Bare Identity -> b Covered Identity
bcover b Bare Identity
b)

fromMaybeI :: Identity a -> Maybe a -> Identity a
fromMaybeI :: forall a. Identity a -> Maybe a -> Identity a
fromMaybeI (Identity a
a) Maybe a
Nothing  = a -> Identity a
forall a. a -> Identity a
Identity a
a
fromMaybeI Identity a
_            (Just a
a) = a -> Identity a
forall a. a -> Identity a
Identity a
a