content: module Tests.Loop (tests) where
  
  import Control.Concurrent (forkIO, killThread)
  import Control.Concurrent.QSemN (newQSemN, signalQSemN, waitQSemN)
  import Control.Monad (forever)
  import Data.Function (fix)
  
  import Test.Tasty (TestTree, localOption, mkTimeout, testGroup)
  import Test.Tasty.HUnit (testCase)
  
  import Control.Monad.Freer (Eff, Member, runM, send)
  
  tests :: TestTree
  tests = localOption timeout $ testGroup "Loop tests"
      [ testCase "fix loop" $ testLoop fixLoop
      , testCase "tail loop" $ testLoop tailLoop
      , testCase "forever loop" $ testLoop foreverLoop
      ]
    where
      timeout = mkTimeout 1000000
  
  testLoop :: (IO () -> Eff '[IO] ()) -> IO ()
  testLoop loop = do
    s <- newQSemN 0
    t <- forkIO . runM . loop $ signalQSemN s 1
    waitQSemN s 5
    killThread t
  
  fixLoop :: Member IO r => IO () -> Eff r ()
  fixLoop action = fix $ \fxLoop -> do
    send action
    fxLoop
  
  tailLoop :: Member IO r => IO () -> Eff r ()
  tailLoop action = let loop = send action *> loop in loop
  
  foreverLoop :: Member IO r => IO () -> Eff r ()
  foreverLoop action = forever $ send action
  