{-# LANGUAGE RecursiveDo #-}
{-# OPTIONS_GHC -fplugin UIO.Plugin #-}
module Test.UIO where

import Data.IORef
import Control.Monad

import UIO

testBoth :: IO ()
testBoth = do
  putStrLn "testUIOFix"
  testUIOFix
  putStrLn "testUIOUnique"
  testUIOUnique
  putStrLn "testUIOReplicate"
  testUIOReplicate
  putStrLn "testUIOBadTimeless"
  testUIOBadTimeless
  putStrLn "testUIOMany"
  testUIOMany
  putStrLn "testIO"
  testIO

{-# NOINLINE testUIOUnique #-}
testUIOUnique :: IO ()
testUIOUnique = do
  r <- runUIO2 $ do
    -- The following two lines can be merged by common subexpression elimination (CSE), which is very bad
    r <- timeless $ newIORef 2
    r2 <- timeless $ newIORef 2
    -- Note that the following two lines must be different, otherwise they will *also* be merged by CSE, which will make the test appear to succeed!
    unordered $ atomicModifyIORef' r $ \v -> (v + 5, ())
    unordered $ atomicModifyIORef' r2 $ \v -> (v + 10, ())
    pure r
  print =<< readIORef r

{-# NOINLINE testUIOFix #-}
testUIOFix :: IO ()
testUIOFix = do
  r <- runUIO2 $ mdo
    unordered $ atomicModifyIORef' r $ \v -> (v + 5, ())
    r <- timeless $ newIORef 2
    pure r
  print =<< readIORef r

{-# NOINLINE testUIOBadTimeless #-}
testUIOBadTimeless :: IO ()
testUIOBadTimeless = do
  r <- runUIO2 $ mdo
    timeless $ atomicModifyIORef' r $ \v -> (v + 5, ())
    r <- timeless $ newIORef 2
    pure r
  print =<< readIORef r

{-# NOINLINE testUIOMany #-}
testUIOMany :: IO ()
testUIOMany = do
  r <- runUIO2 $ do
    r <- timeless $ newIORef 0
    unordered $ atomicModifyIORef' r $ \v -> (v + 1, ())
    unordered $ atomicModifyIORef' r $ \v -> (v + 2, ())
    unordered $ atomicModifyIORef' r $ \v -> (v + 3, ())
    unordered $ atomicModifyIORef' r $ \v -> (v + 4, ())
    unordered $ atomicModifyIORef' r $ \v -> (v + 5, ())
    unordered $ atomicModifyIORef' r $ \v -> (v + 6, ())
    unordered $ atomicModifyIORef' r $ \v -> (v + 7, ())
    unordered $ atomicModifyIORef' r $ \v -> (v + 8, ())
    unordered $ atomicModifyIORef' r $ \v -> (v + 9, ())
    unordered $ atomicModifyIORef' r $ \v -> (v + 10, ())
    pure r
  print =<< readIORef r

{-# NOINLINE testUIOReplicate #-}
testUIOReplicate :: IO ()
testUIOReplicate = do
  rs <- runUIO2 $ do
    rs <- replicateM 10 $ timeless $ newIORef 2
    forM_ rs $ \r ->
      unordered $ atomicModifyIORef' r $ \v -> (v + 5, ())
    pure rs
  vs <- mapM readIORef rs
  print $ sum vs

{-# NOINLINE testBoth #-}
testIO :: IO ()
testIO = do
  r <- newIORef 2
  atomicModifyIORef' r $ \v -> (v + 5, ())
  print =<< readIORef r