tests

README.md

@@ -1 +1,20 @@
 # too-fast-too-free
+
+## TODO
+
+* tests to prove fusion
+* benchmarks
+* pick a name dangit
+* rename core functions
+* error messages
+    * possible to get "you probably need a ty app"?
+* add commentary
+* more effects
+    * all the STANDARD ONES
+    * also `Input` and `Output`
+* readme
+* CI
+* launch!
+* blog post
+* talk
+

package.yaml

@@ -23,12 +23,11 @@ dependencies:
 - base >= 4.7 && < 5
 - transformers
 - mtl
-# - ghc-lib
 
 flags:
   dump-core:
     description: Dump HTML for the core generated by GHC during compilation
-    default:     True
+    default:     False
     manual:      True
 
 library:
@@ -66,7 +65,7 @@ executables:
 
 tests:
   too-fast-too-free-test:
-    main:                Spec.hs
+    main:                Main.hs
     source-dirs:         test
     ghc-options:
     - -threaded

test/FusionSpec.hs

@@ -0,0 +1,64 @@
+{-# LANGUAGE BlockArguments   #-}
+{-# LANGUAGE DataKinds        #-}
+{-# LANGUAGE TemplateHaskell  #-}
+{-# LANGUAGE TypeApplications #-}
+{-# OPTIONS_GHC -O2 #-}
+
+module FusionSpec where
+
+import Test.Inspection
+import Control.Monad.Discount
+import Data.OpenUnion
+import TRYAGAIN hiding (main)
+import qualified Control.Monad.Trans.State.Strict as S
+import qualified Control.Monad.Trans.Except as E
+import Test.Hspec
+
+
+isSuccess :: Result -> Bool
+isSuccess (Success _) = True
+isSuccess (Failure e) = error e
+
+shouldSucceed :: Result -> Expectation
+shouldSucceed r = r `shouldSatisfy` isSuccess
+
+
+spec :: Spec
+spec = do
+  describe "fusion" $ do
+    it "Union proofs should simplify" $ do
+      shouldSucceed $(inspectTest $ 'countDown `hasNoType` ''SNat)
+
+    it "internal uses of StateT should simplify" $ do
+      shouldSucceed $(inspectTest $ 'countDown `doesNotUse` ''S.StateT)
+      shouldSucceed $(inspectTest $ 'jank      `doesNotUse` ''S.StateT)
+
+    it "internal uses of ExceptT should simplify" $ do
+      shouldSucceed $(inspectTest $ 'tryIt `doesNotUse` ''E.ExceptT)
+
+    it "`runState . reinterpret` should fuse" $ do
+      shouldSucceed $(inspectTest $ 'jank      `doesNotUse` 'reinterpret)
+      shouldSucceed $(inspectTest $ 'jank      `doesNotUse` 'hoist)
+
+go :: Eff '[State Int] Int
+go = do
+  n <- send (Get id)
+  if n <= 0
+     then pure n
+     else do
+       send $ Put (n-1) ()
+       go
+
+tryIt :: Either Bool String
+tryIt = run . runError @Bool $ do
+  catch @Bool
+    do
+      throw False
+    \_ -> pure "hello"
+
+countDown :: Int -> Int
+countDown start = fst $ run $ runState start go
+
+jank :: Int -> Int
+jank start = fst $ run $ runState start $ reinterpret send $ go
+

test/Main.hs

@@ -0,0 +1 @@
+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}

test/Spec.hs

@@ -1,39 +0,0 @@
-{-# LANGUAGE BlockArguments   #-}
-{-# LANGUAGE DataKinds        #-}
-{-# LANGUAGE TemplateHaskell  #-}
-{-# LANGUAGE TypeApplications #-}
-
-import Test.Inspection
-import Control.Monad.Discount
-import Data.OpenUnion
-import TRYAGAIN hiding (main)
-import qualified Control.Monad.Trans.State.Strict as S
-import qualified Control.Monad.Trans.Except as E
-
-
-main :: IO ()
-main = pure ()
-
-go :: Eff '[State Int] Int
-go = do
-  n <- send (Get id)
-  if n <= 0
-     then pure n
-     else do
-       send $ Put (n-1) ()
-       go
-
-tryIt :: Either Bool String
-tryIt = run . runError @Bool $ do
-  catch @Bool
-    do
-      throw False
-    \_ -> pure "hello"
-
-countDown :: Int -> Int
-countDown start = fst $ run $ runState start go
-
-inspect $ 'countDown `hasNoType`  ''SNat
-inspect $ 'countDown `doesNotUse` ''S.StateT
-inspect $ 'tryIt     `doesNotUse` ''E.ExceptT
-