fused-effects-1.1.1.1: test/Fusion.hs

{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# OPTIONS_GHC -O2 -fplugin Test.Inspection.Plugin #-}
module Fusion
( tests
) where

import Control.Algebra
import Control.Carrier.Error.Either
import Control.Carrier.State.Strict
import Gen
import Hedgehog
import Test.Inspection as Inspection hiding (property, (===))

tests :: TestTree
tests = testGroup "fusion"
  [ testProperty "eliminates StateCs" . property $
    failureOf $(inspectTest $ 'countDown `doesNotUse` ''StateC)
    === Nothing
  , testProperty "eliminates nested StateCs" . property $
    failureOf $(inspectTest $ 'countBoth `doesNotUse` ''StateC)
    === Nothing
  , testProperty "eliminates catch and throw" . property $
    failureOf $(inspectTest $ 'throwing `doesNotUse` ''ErrorC)
    === Nothing
  , testProperty "eliminates calls to alg" . property $
    failureOf $(inspectTest $ 'countDown `doesNotUse` 'alg)
    === Nothing
  ]


failureOf :: Inspection.Result -> Maybe String
failureOf (Success _) = Nothing
failureOf (Failure f) = Just f


countDown :: Int -> (Int, Int)
countDown start = run . runState start $ go
  where go = get >>= \n -> if n <= 0 then pure n else modify @Int pred *> go

countBoth :: Int -> (Int, (Float, ()))
countBoth n = run . runState n . runState (fromIntegral n) $ go where
  go = do
    n <- get @Int
    if
      | n == 0         -> pure ()
      | n `mod` 2 == 0 -> modify @Float (+ 1) *> modify @Int pred *> go
      | otherwise      -> modify @Int pred    *> go

throwing :: Int -> Either Int String
throwing n = run $ runError go
  where go = if n > 10 then throwError @Int 42 else pure "fine"