{-# LANGUAGE TemplateHaskell #-}

-- | This module defines primitives that offer quality of life features when
-- operating a mockchain without interacting with the mockchain state itself.
module Cooked.MockChain.Misc
  ( -- * Misc effect
    MockChainMisc (..),
    runMockChainMisc,

    -- * Storing aliases for hashable elements
    define,
    defineM,

    -- * Taking notes in the notebook
    note,
    noteP,
    noteL,
    noteW,
    noteS,

    -- * Asserting properties
    assert,
    assert',
  )
where

import Cooked.Pretty.Class
import Cooked.Pretty.Hashable
import Cooked.Pretty.Options
import PlutusLedgerApi.V3 qualified as Api
import Polysemy
import Polysemy.Writer
import Prettyprinter qualified as PP

-- | An effect that corresponds to extra QOL capabilities of the MockChain
data MockChainMisc :: Effect where
  Define :: (ToHash a) => String -> a -> MockChainMisc m a
  Note :: (PrettyCookedOpts -> DocCooked) -> MockChainMisc m ()
  Assert :: String -> Bool -> MockChainMisc m ()

makeSem_ ''MockChainMisc

-- | Interpreting a `MockChainMisc` in terms of a writer of @Map
-- BuiltinByteString String@
runMockChainMisc ::
  forall effs a j.
  (Member (Writer j) effs) =>
  (String -> Api.BuiltinByteString -> j) ->
  ((PrettyCookedOpts -> DocCooked) -> j) ->
  (String -> Bool -> j) ->
  Sem (MockChainMisc : effs) a ->
  Sem effs a
runMockChainMisc :: forall (effs :: EffectRow) a j.
Member (Writer j) effs =>
(String -> BuiltinByteString -> j)
-> ((PrettyCookedOpts -> DocCooked) -> j)
-> (String -> Bool -> j)
-> Sem (MockChainMisc : effs) a
-> Sem effs a
runMockChainMisc String -> BuiltinByteString -> j
injectAlias (PrettyCookedOpts -> DocCooked) -> j
injectNote String -> Bool -> j
injectPred = (forall (rInitial :: EffectRow) x.
 MockChainMisc (Sem rInitial) x -> Sem effs x)
-> Sem (MockChainMisc : effs) a -> Sem effs a
forall (e :: Effect) (r :: EffectRow) a.
FirstOrder e "interpret" =>
(forall (rInitial :: EffectRow) x. e (Sem rInitial) x -> Sem r x)
-> Sem (e : r) a -> Sem r a
interpret ((forall (rInitial :: EffectRow) x.
  MockChainMisc (Sem rInitial) x -> Sem effs x)
 -> Sem (MockChainMisc : effs) a -> Sem effs a)
-> (forall (rInitial :: EffectRow) x.
    MockChainMisc (Sem rInitial) x -> Sem effs x)
-> Sem (MockChainMisc : effs) a
-> Sem effs a
forall a b. (a -> b) -> a -> b
$ \case
  (Define String
name x
hashable) -> j -> Sem effs ()
forall o (r :: EffectRow). Member (Writer o) r => o -> Sem r ()
tell (String -> BuiltinByteString -> j
injectAlias String
name (BuiltinByteString -> j) -> BuiltinByteString -> j
forall a b. (a -> b) -> a -> b
$ x -> BuiltinByteString
forall a. ToHash a => a -> BuiltinByteString
toHash x
hashable) Sem effs () -> Sem effs x -> Sem effs x
forall a b. Sem effs a -> Sem effs b -> Sem effs b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> x -> Sem effs x
forall a. a -> Sem effs a
forall (m :: * -> *) a. Monad m => a -> m a
return x
hashable
  (Note PrettyCookedOpts -> DocCooked
s) -> j -> Sem effs ()
forall o (r :: EffectRow). Member (Writer o) r => o -> Sem r ()
tell (j -> Sem effs ()) -> j -> Sem effs ()
forall a b. (a -> b) -> a -> b
$ (PrettyCookedOpts -> DocCooked) -> j
injectNote PrettyCookedOpts -> DocCooked
s
  (Assert String
s Bool
b) -> j -> Sem effs ()
forall o (r :: EffectRow). Member (Writer o) r => o -> Sem r ()
tell (j -> Sem effs ()) -> j -> Sem effs ()
forall a b. (a -> b) -> a -> b
$ String -> Bool -> j
injectPred String
s Bool
b

-- | Stores an alias matching a hashable data for pretty printing purpose
define :: forall effs a. (Member MockChainMisc effs, ToHash a) => String -> a -> Sem effs a

-- | Like `define`, but binds the result of a monadic computation instead
defineM :: (Member MockChainMisc effs, ToHash a) => String -> Sem effs a -> Sem effs a
defineM :: forall (effs :: EffectRow) a.
(Member MockChainMisc effs, ToHash a) =>
String -> Sem effs a -> Sem effs a
defineM String
name = (String -> a -> Sem effs a
forall (effs :: EffectRow) a.
(Member MockChainMisc effs, ToHash a) =>
String -> a -> Sem effs a
define String
name (a -> Sem effs a) -> Sem effs a -> Sem effs a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<)

-- | Takes note of an element represented as its rendering function to trace at
-- the end of the run
note :: forall effs. (Member MockChainMisc effs) => (PrettyCookedOpts -> DocCooked) -> Sem effs ()

-- | Takes note of a pretty-printable element to trace at the end of the run
noteP :: forall effs s. (Member MockChainMisc effs, PrettyCooked s) => s -> Sem effs ()
noteP :: forall (effs :: EffectRow) s.
(Member MockChainMisc effs, PrettyCooked s) =>
s -> Sem effs ()
noteP s
doc = (PrettyCookedOpts -> DocCooked) -> Sem effs ()
forall (effs :: EffectRow).
Member MockChainMisc effs =>
(PrettyCookedOpts -> DocCooked) -> Sem effs ()
note (PrettyCookedOpts -> s -> DocCooked
forall a. PrettyCooked a => PrettyCookedOpts -> a -> DocCooked
`prettyCookedOpt` s
doc)

-- | Takes note of a pretty-printable element as list with a title, to trace at
-- the end of the run
noteL :: forall effs l. (Member MockChainMisc effs, PrettyCookedList l) => String -> l -> Sem effs ()
noteL :: forall (effs :: EffectRow) l.
(Member MockChainMisc effs, PrettyCookedList l) =>
String -> l -> Sem effs ()
noteL String
title l
docs = (PrettyCookedOpts -> DocCooked) -> Sem effs ()
forall (effs :: EffectRow).
Member MockChainMisc effs =>
(PrettyCookedOpts -> DocCooked) -> Sem effs ()
note ((PrettyCookedOpts -> DocCooked) -> Sem effs ())
-> (PrettyCookedOpts -> DocCooked) -> Sem effs ()
forall a b. (a -> b) -> a -> b
$ \PrettyCookedOpts
opts -> PrettyCookedOpts -> DocCooked -> DocCooked -> l -> DocCooked
forall a.
PrettyCookedList a =>
PrettyCookedOpts -> DocCooked -> DocCooked -> a -> DocCooked
prettyItemize PrettyCookedOpts
opts (String -> DocCooked
forall a. PrettyCooked a => a -> DocCooked
prettyCooked String
title) DocCooked
"-" l
docs

-- | Takes note of a showable element to trace at the end of the run
noteW :: forall effs s. (Member MockChainMisc effs, Show s) => s -> Sem effs ()
noteW :: forall (effs :: EffectRow) s.
(Member MockChainMisc effs, Show s) =>
s -> Sem effs ()
noteW = (PrettyCookedOpts -> DocCooked) -> Sem effs ()
forall (effs :: EffectRow).
Member MockChainMisc effs =>
(PrettyCookedOpts -> DocCooked) -> Sem effs ()
note ((PrettyCookedOpts -> DocCooked) -> Sem effs ())
-> (s -> PrettyCookedOpts -> DocCooked) -> s -> Sem effs ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DocCooked -> PrettyCookedOpts -> DocCooked
forall a b. a -> b -> a
const (DocCooked -> PrettyCookedOpts -> DocCooked)
-> (s -> DocCooked) -> s -> PrettyCookedOpts -> DocCooked
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> DocCooked
forall a ann. Show a => a -> Doc ann
PP.viaShow

-- | Takes note of a String to trace at the end of the run
noteS :: forall effs. (Member MockChainMisc effs) => String -> Sem effs ()
noteS :: forall (effs :: EffectRow).
Member MockChainMisc effs =>
String -> Sem effs ()
noteS = String -> Sem effs ()
forall (effs :: EffectRow) s.
(Member MockChainMisc effs, PrettyCooked s) =>
s -> Sem effs ()
noteP

-- | Ensures a specific property holds, sending the provided error message otherwise
assert :: forall effs. (Member MockChainMisc effs) => String -> Bool -> Sem effs ()

-- | Ensures a specific property holds, with a default error message otherwise
assert' :: forall effs. (Member MockChainMisc effs) => Bool -> Sem effs ()
assert' :: forall (effs :: EffectRow).
Member MockChainMisc effs =>
Bool -> Sem effs ()
assert' = String -> Bool -> Sem effs ()
forall (effs :: EffectRow).
Member MockChainMisc effs =>
String -> Bool -> Sem effs ()
assert String
"Assertion"