Skip to content

Instantly share code, notes, and snippets.

@roman
Last active August 29, 2015 14:23
Show Gist options
  • Save roman/a0992d930cae91b510c6 to your computer and use it in GitHub Desktop.
Save roman/a0992d930cae91b510c6 to your computer and use it in GitHub Desktop.
Prototype of CircuitBreaker interface using Type Families to compile valid transations of a CircuitBreaker state
{-# 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 ()
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment