Cycle colours of a File label on OS X every half second.

FolderRave.hs

{-# LANGUAGE RankNTypes #-}
import Control.Concurrent
import Control.Monad.Fix
import Control.Monad.IO.Class
import Control.Wire.Core
import Control.Wire.Session
import Data.Functor.Identity
import System.IO
import Control.Wire
import Prelude hiding ((.), id)
import System.OSX.Labels

wire :: SimpleWire a LabelColor
wire =
    holdFor 0.5 . periodicList 0.5 (cycle [Red, Green, Blue])

main :: IO ()
main = testWire' clockSession_ wire

testWire' ::
    (MonadIO m, Show e)
    => Session m s
    -> (forall a. Wire s e Identity a LabelColor)
    -> m c
testWire' s0 w0 = loop s0 w0
    where
    loop s' w' = do
        (ds, s) <- stepSession s'
        let Identity (mx, w) = stepWire w' ds (Right ())
        liftIO $ do
            setColor "FolderRave.hs" $ either (const Colorless) id mx
            hFlush stdout
            threadDelay 500000
        loop s w