Completely redesign the API around explicit strategies

The API is much nicer. Type families in the `Eval` type class were
getting in the way of derivation (derivation isn't done yet). It just
created a lot of boiler place. Both at call sites where we had to wrap
random values in a newtype all the time, and when defining `Eval`
instances (which may be used just once, which was entirely
unnecessary), since the instances were almost entirely boilerplate.

This actually deletes lines of code, so even the implementation is
simpler really. I don't need some special support for the
`strict-wrapper` library: just use the `seq` strategy.

This is looking quite good.

Closes #7.
Closes #17.

Author: aspiwack

backends/katip/src/Benign/Katip.hs

@@ -21,33 +21,34 @@ katipNamespace = unsafePerformIO Benign.newField
 {-# NOINLINE katipNamespace #-}
 
 -- | See 'Katip.katipAddContext'.
-withKatipContext :: (Katip.LogItem i, Benign.Eval a) => i -> a -> Benign.Result a
+withKatipContext :: (Katip.LogItem i) => i -> Benign.Strat a -> a -> a
 withKatipContext item = Benign.withAltering katipContext addContext
   where
     addContext (Just st) = Just $ st <> Katip.liftPayload item
     addContext Nothing = error "todo"
 
 -- | See 'Katip.katipAddNamespace'.
-withKatipNamespace :: Benign.Eval a => Katip.Namespace -> a -> Benign.Result a
+withKatipNamespace :: Katip.Namespace -> Benign.Strat a -> a -> a
 withKatipNamespace namespace = Benign.withAltering katipNamespace addNamespace
   where
     addNamespace (Just st) = Just $ st <> namespace
     addNamespace Nothing = error "todo"
 
 -- | Within this computation, Katip is configured.
 withKatip ::
-  (Katip.LogItem c, Benign.EvalIO a) =>
+  (Katip.LogItem c) =>
   Katip.LogEnv ->
   c ->
   Katip.Namespace ->
-  a ->
-  IO (Benign.ResultIO a)
-withKatip env ctx namespace =
-  Benign.withSettingIO katipEnv env
-    . Benign.withSettingIO katipContext (Katip.liftPayload ctx)
-    . Benign.withSettingIO katipNamespace namespace
+  Benign.Strat a ->
+  IO a ->
+  IO a
+withKatip env ctx namespace strat =
+  Benign.withSettingIO' katipEnv env
+    . Benign.withSettingIO' katipContext (Katip.liftPayload ctx)
+    . Benign.withSettingIO katipNamespace namespace strat
 
-logLocM :: forall a. (Benign.Eval a, HasCallStack) => Katip.Severity -> Katip.LogStr -> a -> Benign.Result a
+logLocM :: forall a. (HasCallStack) => Katip.Severity -> Katip.LogStr -> Benign.Strat a -> a -> a
 logLocM severity str = withFrozenCallStack spanLog
   where
     -- The whole purpose of naming `span` is to freeze the call stack. It's
@@ -58,7 +59,7 @@ logLocM severity str = withFrozenCallStack spanLog
     -- scratch. This would be invisible. I tried to harden this function by
     -- declaring type signatures everywhere. I haven't tested it yet though. It
     -- may be wrong.
-    spanLog :: HasCallStack => a -> Benign.Result a
+    spanLog :: HasCallStack => Benign.Strat a -> a -> a
     spanLog = Benign.unsafeSpanBenign doLog (return ())
 
     doLog :: HasCallStack => IO ()

backends/timestats/src/Benign/TimeStats.hs

@@ -3,9 +3,10 @@
 module Benign.TimeStats where
 
 import Benign qualified
+import Control.Exception
 import Debug.TimeStats qualified as TimeStats
 import System.IO.Unsafe (unsafePerformIO)
 
-measure :: Benign.Eval a => String -> a -> Benign.Result a
-measure label thing = unsafePerformIO $ TimeStats.measureM label $ Benign.evalIO (Benign.PureEval thing)
+measure :: String -> Benign.Strat a -> a -> a
+measure label strat thing = unsafePerformIO $ TimeStats.measureM label $ do Benign.E <- evaluate (strat thing); return thing
 {-# NOINLINE measure #-}

benign.cabal

@@ -34,7 +34,6 @@ library
     , containers
     , deepseq
     , stm
-    , strict-wrapper
     , transformers
   default-language: Haskell2010
 
@@ -50,6 +49,5 @@ executable simple-print
     , containers
     , deepseq
     , stm
-    , strict-wrapper
     , transformers
   default-language: Haskell2010

examples/SimplePrint.hs

@@ -2,7 +2,6 @@
 
 module Main where
 
-import Benign (Seq (..))
 import Benign qualified
 import Data.Maybe
 import GHC.IO.Unsafe (unsafePerformIO)
@@ -30,15 +29,15 @@ context = unsafePerformIO Benign.newField
 {-# NOINLINE context #-}
 
 -- 'withContext' is called to extend the context in its scope.
-withContext :: Benign.Eval a => String -> a -> Benign.Result a
+withContext :: String -> Benign.Strat a -> a -> a
 withContext additional_ctx = Benign.withAltering context $ \ctx ->
   Just $
     fromMaybe "" ctx ++ " " ++ additional_ctx
 
 -- The 'log' function is the one performing the logging. It is a little
 -- degenerate, as far as benign effects go, as it doesn't do anything after the
 -- end of the evaluation.
-log :: Benign.Eval a => String -> a -> Benign.Result a
+log :: String -> Benign.Strat a -> a -> a
 log log_line = Benign.unsafeSpanBenign do_log (return ())
   where
     do_log :: IO ()
@@ -53,10 +52,10 @@ log log_line = Benign.unsafeSpanBenign do_log (return ())
 ------------------------------------------------------------------------------
 
 (+:) :: Int -> Int -> Int
-n +: p = (withContext "left:" (Seq n)) + (withContext "right:" (Seq p))
+n +: p = (withContext "left:" Benign.whnf n) + (withContext "right:" Benign.whnf p)
 
 incr :: Int -> Int
-incr n = log (show n) $ Seq $ n + 1
+incr n = log (show n) Benign.whnf $ n + 1
 
 myvalue :: Int
 myvalue = incr 18 +: incr 42 +: incr 57

package.yaml

@@ -13,7 +13,6 @@ dependencies:
   - containers
   - deepseq
   - stm
-  - strict-wrapper
   - transformers
 
 ghc-options: -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wnoncanonical-monad-instances -Wredundant-constraints