A silly clock using Frege STM

SillyClock.fr

module SillyClock where

import STM
import Control.Concurrent

type Counter = TVar Int

newCounter :: STM Counter
newCounter = TVar.new 0

reset :: Counter -> STM ()
reset counter = counter.write 0

tick :: Counter -> STM ()
tick counter = do
    value <- counter.read
    counter.write (value + 1)

maxTick :: Counter -> Int -> STM ()
maxTick counter max = do
    tick counter
    value <- counter.read
    check (value <= max)

onOverflow :: Counter -> Counter -> Int -> STM ()
onOverflow counter overflowCounter max = do
    value <- counter.read
    check (value == max)
    tick  overflowCounter
    reset counter

report :: Counter -> Counter -> IO ()
report millis secs = do
    (millisValue, secsValue) <- atomically $ do
        a <- millis.read
        b <- secs.read
        return (a, b)
    println $ show secsValue ++ " " ++ show millisValue

main _ = do
    millis <- atomically newCounter 
    secs   <- atomically newCounter
    
    milliOverflow = 1000
    runTicker = maxTick    millis milliOverflow 
    runSec    = onOverflow millis secs milliOverflow 

    forkOS $ forever (atomically runTicker >> Thread.sleep 1 )
    forkOS $ forever (atomically runSec )
    
    forever (report millis secs >> Thread.sleep 100)