{-# LANGUAGE LambdaCase #-}

module Midair.Examples.HotswapCount (
     hotswapCount
   ) where

import Midair

import Control.Arrow
import Control.Concurrent

startWith :: SFlow a Int
startWith = sFold 0 $ \_ -> (+3)

swapIn :: SFlow a Int
swapIn = sFold 0 $ \_ -> (+2)

printVal :: SFlow Int (Fx ())
printVal = sMap $ \n -> Fx_Void . putStrLn $
   if n `rem` 3 /= 0 && n `rem` 2 /= 0
      then "\nCool! Value only possible with hotswap: " ++ show n
      else "\nValue: " ++ show n

hotswapCount :: IO ()
hotswapCount = do
   nr <- mkNodeRef startWith

   putStrLn "Ok, old style -- start typing"
   (tid, tid2, _thingThing) <- runGetChar $ printVal <<< nr
   threadDelay $ 10^7

   putStrLn "Ok new style now! -- type more!"
   hotSwap nr swapIn
   threadDelay $ 10 ^ 7

   killThread tid
   killThread tid2