-- Copyright 2022 Evan Laforge
-- This program is distributed under the terms of the GNU General Public
-- License 3.0, see COPYING or http://www.gnu.org/licenses/gpl-3.0.txt

-- | Put benchmark functions in a separate module, just in case cross-module
-- makes a difference.
module Derive.Deriver.DeriveMBench where
import           Control.Monad (when)

import qualified Util.Log as Log
import qualified Derive.Deriver.DeriveM as DeriveM


runRefCountdown :: Int -> (Int, Int)
runRefCountdown :: Int -> (Int, Int)
runRefCountdown = forall {t}. (Ord t, Num t) => t -> (t, t)
program
    where
    program :: t -> (t, t)
program t
n
        | t
n forall a. Ord a => a -> a -> Bool
<= t
0 = (t
n, t
n)
        | Bool
otherwise = t -> (t, t)
program (t
n forall a. Num a => a -> a -> a
- t
1)

newtype State = State { State -> Int
_val :: Int }
    deriving (State -> State -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: State -> State -> Bool
$c/= :: State -> State -> Bool
== :: State -> State -> Bool
$c== :: State -> State -> Bool
Eq, Int -> State -> ShowS
[State] -> ShowS
State -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [State] -> ShowS
$cshowList :: [State] -> ShowS
show :: State -> [Char]
$cshow :: State -> [Char]
showsPrec :: Int -> State -> ShowS
$cshowsPrec :: Int -> State -> ShowS
Show)
data Error = Error deriving (Int -> Error -> ShowS
[Error] -> ShowS
Error -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Error] -> ShowS
$cshowList :: [Error] -> ShowS
show :: Error -> [Char]
$cshow :: Error -> [Char]
showsPrec :: Int -> Error -> ShowS
$cshowsPrec :: Int -> Error -> ShowS
Show)

type Deriver = DeriveM.Deriver State Error

run :: Deriver Int -> Int -> (Int, Int)
run :: Deriver Int -> Int -> (Int, Int)
run Deriver Int
deriver Int
n = case forall st err a. st -> Deriver st err a -> RunResult st err a
DeriveM.run (Int -> State
State Int
n) Deriver Int
deriver of
    (Right Int
val, State Int
n, []) -> (Int
val, Int
n)
    (Left Error
Error, State Int
0, [Msg
_msg]) -> (Int
0, Int
0)
    RunResult State Error Int
r -> forall a. Stack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"unexpected result: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show RunResult State Error Int
r

countdown :: Deriver Int
countdown :: Deriver Int
countdown = do
    State Int
n <- forall st err. Deriver st err st
DeriveM.get
    if Int
n forall a. Ord a => a -> a -> Bool
<= Int
0 then forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
n else do
        forall st err. st -> Deriver st err ()
DeriveM.put forall a b. (a -> b) -> a -> b
$ Int -> State
State (Int
n forall a. Num a => a -> a -> a
- Int
1)
        Deriver Int
countdown

countdownThrow :: Deriver Int
countdownThrow :: Deriver Int
countdownThrow = do
    State Int
n <- forall st err. Deriver st err st
DeriveM.get
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
n forall a. Ord a => a -> a -> Bool
<= Int
0) forall a b. (a -> b) -> a -> b
$ do
        forall st err. Msg -> Deriver st err ()
DeriveM.write forall a b. (a -> b) -> a -> b
$ Stack => Priority -> Maybe Stack -> Text -> Msg
Log.msg Priority
Log.Debug forall a. Maybe a
Nothing Text
"hi"
        forall err st a. err -> Deriver st err a
DeriveM.throw Error
Error
    if Int
n forall a. Ord a => a -> a -> Bool
<= Int
0 then forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
n else do
        forall st err. st -> Deriver st err ()
DeriveM.put forall a b. (a -> b) -> a -> b
$ Int -> State
State (Int
n forall a. Num a => a -> a -> a
- Int
1)
        Deriver Int
countdownThrow