Example for https://github.com/JordanMartinez/purescript-jordans-reference/pull/565

Main.purs

module Main where

import Effect (Effect)
import Effect.Console (logShow)
import TryPureScript (render, withConsole)

import Prelude (class Applicative, class Apply, class Bind, class Functor, class Monad, apply, bind, map, pure, (=<<), (<>))
import Data.Eq ((==))
import Data.Show

data Box a = Box a

instance functorBox :: Functor Box where
  map :: forall a b. (a -> b) -> Box a -> Box  b
  map f (Box a) = Box (f a)

instance applyBox :: Apply Box where
  apply :: forall a b. Box (a -> b) -> Box a -> Box  b
  apply (Box f) (Box a) = Box (f a)

instance applicativeBox :: Applicative Box where
  pure :: forall a. a -> Box a
  pure a = Box a

instance bindBox :: Bind Box where
  bind :: forall a b. Box a -> (a -> Box b) -> Box b
  bind (Box a) f = f a

instance monadBox :: Monad Box

instance showBox :: (Show a) => Show (Box a) where
  show (Box a) = "Box " <> show a

newtype OutputBox a b = OutputBox (a -> Box b)

instance functorOutputBox :: Functor (OutputBox input) where
  map :: forall originalOutput newOutput.
         (originalOutput -> newOutput) ->
         OutputBox input originalOutput ->
         OutputBox input newOutput
  map originalToNew (OutputBox f) = OutputBox (\input ->
      map originalToNew (f input)
    )

instance applyOutputbox :: Apply (OutputBox input) where
  apply :: forall originalOutput newOutput.
           OutputBox input (originalOutput -> newOutput) ->
           OutputBox input originalOutput ->
           OutputBox input newOutput
  apply (OutputBox inputToFunction) (OutputBox f) = OutputBox (\input ->
      let
        boxStoringOriginalOutput = f input
        boxStoringOriginalToNew = inputToFunction input
      in apply boxStoringOriginalToNew boxStoringOriginalOutput
    )

instance applicativeOutputBox :: Applicative (OutputBox input) where
  pure :: forall a. a -> (OutputBox input) a
  pure value = OutputBox (\_ -> pure value)

instance bindOutputBox :: Bind (OutputBox input) where
  bind :: forall originalOutput newOutput.
          OutputBox input originalOutput ->
          (originalOutput -> OutputBox input newOutput) ->
          OutputBox input newOutput
  bind (OutputBox inputToOriginal) originalToFunction =
    OutputBox (\input -> do
      originalOutput <- inputToOriginal input
      let (OutputBox inputToNew) = originalToFunction originalOutput
      inputToNew input
    )

runOutputBox :: forall a b. OutputBox a b -> a -> Box b
runOutputBox (OutputBox function) argument = function argument

produceComputation :: Box Boolean
produceComputation = runOutputBox someComputation 4
  where
  someComputation :: OutputBox Int Boolean
  someComputation = do
    four <- OutputBox (\four -> Box four)
    pure (four == 4)

main = render =<< withConsole do
  logShow produceComputation