Prototype of CircuitBreaker interface using Type Families to compile valid transations of a CircuitBreaker state

CircuitBreaker.hs

{-# LANGUAGE GADTs #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE TypeFamilies #-}
module Main where

import Data.Time (UTCTime, getCurrentTime)

data CircuitData = CircuitData {}

data BreakerState
  = Open
  | Close
  | HalfOpen

data SBreakerState (st :: BreakerState) where
  SOpen     :: SBreakerState 'Open
  SClose    :: SBreakerState 'Close
  SHalfOpen :: SBreakerState 'HalfOpen

data CircuitBreaker (st :: BreakerState)
  = CircuitBreaker (SBreakerState st) CircuitData

type family ToOpen (st :: BreakerState) :: BreakerState where
  ToOpen 'Close    = 'Open
  ToOpen 'HalfOpen = 'Open

toOpen :: SBreakerState st -> SBreakerState (ToOpen st)
toOpen SClose = SOpen
toOpen SHalfOpen = SOpen

--------------------------------------------------------------------------------

-- probably input parameters needed here
newCircuitBreaker :: UTCTime -> CircuitBreaker 'Close
newCircuitBreaker _ = CircuitBreaker SClose CircuitData

openCircuit :: UTCTime -> CircuitBreaker st -> CircuitBreaker (ToOpen st)
openCircuit _ (CircuitBreaker st d) = CircuitBreaker (toOpen st) d

closeCircuit :: UTCTime -> CircuitBreaker 'HalfOpen -> CircuitBreaker 'Close
closeCircuit _ (CircuitBreaker _ d) = CircuitBreaker SClose CircuitData

halfOpenCircuit :: UTCTime -> CircuitBreaker 'Open -> CircuitBreaker 'HalfOpen
halfOpenCircuit _ (CircuitBreaker _ d) = CircuitBreaker SHalfOpen CircuitData

main = do
  time <- getCurrentTime
  let circuitClosed   = newCircuitBreaker time
      circuitOpen     = openCircuit time circuitClosed     -- <- Works
      -- circuitHalfOpen = halfOpenCircuit time circuitOpen   -- <- Works
      -- circuitOpen1    = openCircuit time circuitHalfOpen   -- <- Works
      -- circuitClosed1  = closeCircuit time circuitHalfOpen  -- <- Works

      -- circuitHalfOpen = halfOpenCircuit time circuitClosed -- <- Compile Error
      -- circuitClosed1  = closeCircuit time circuitOpen      -- <- Compile Error
      -- circuitClosed2  = closeCircuit time circuitClosed    -- <- Compile Error
  return ()