examples.hs

import Control.Applicative
import Control.Final
import Control.Monad
import Control.Monad.Trans.Writer.Strict
import Control.Monad.Trans.Class
import Control.Concurrent.STM
import Data.Monoid

simple = runFinal $ do
  print "line1"
  do return False  -- definitely a problem, we should fail
     return True   -- ok only if this is the last statement
  final True  -- this is definitely OK!

stmExample = do
  tv <- newTVarIO "xxx"
  atomicJoinFinal $ do
    val <- readTVar tv
    case val of
      "xxx" -> do
        writeTVar tv "foobar"
        final $ print "it was xxx"
      "yyy" -> do
        writeTVar tv "quux"
        final $ print "it was yyy"
    -- return $ print "end"

instance Monoid a => Monoid (IO a) where
  mempty = return mempty
  mappend = liftA2 mappend

-- alternative idea, do this with writer
stmExampleW = do
  tv <- newTVarIO "xxx"
  join $ atomically $ execWriterT $ do
    val <- lift $ readTVar tv
    case val of
      "xxx" -> do
        lift $ writeTVar tv "foobar"
        tell $ print "it was xxx"
      "yyy" -> do
        lift $ writeTVar tv "quux"
        tell $ print "it was yyy"
    tell $ print "I finished"

pureExample p =
  runFinalV $ case p of
    True -> finalV "quux"
    False -> finalV "foobar"

testMissiles radarTVar launchKeyTVar radarNegativeCounter radarPositiveCounter keyMissingCounter launchCounter launchMissiles = do
 atomicJoinFinal $ do
   radarPositive <- readTVar radarTVar
   launchKeyInserted <- readTVar launchKeyTVar
   case radarPositive of
     False -> do
       modifyTVar radarNegativeCounter (+1)
       final $ print "No need for missiles, it's peaceful"
     True -> do
       modifyTVar radarPositiveCounter (+1)
       case launchKeyInserted of
         False -> do
           modifyTVar keyMissingCounter (+1)
           final $ print "No launch key, ignoring radar"
         True -> do
           modifyTVar launchCounter (+1)
           final $ launchMissiles
   -- final $ print "extra debug: state checking finished"

-- call like this: maybeReturningIO [('x', "foobar")] [('y', "xxx")]
maybeReturningIO :: [(Char, String)] -> [(Char, String)] -> IO ()
maybeReturningIO list1 list2 = do
  let maybeOp = do
        val1 <- lookup 'x' list1
        val2 <- lookup 'y' list2
        final $ print $ val1 ++ val2
  case maybeOp of
    Nothing -> print "lookups failed"
    Just op -> runFinalV op