polysemy-uncontrolled-0.1.0.0: src/Polysemy/Uncontrolled.hs

{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
{-# OPTIONS_GHC -fplugin=Polysemy.Plugin #-}

-- |
--   Module     : Polysemy.Uncontrolled
--   License    : MIT
--   Stability  : experimental
--
-- `Uncontrolled` is the evil dual of `Methodology`. Where a `Methodology b c`
-- represents a way to turn `b` into `c` in a controlled decomposition,
-- `Uncontrolled` represents a purely unknown side effect - that materialises
-- `b`s out of nowhere, and sends `c`s into the void where we have no knowledge
-- of what happens to them. This is equivalent to the combination of `Input`
-- and `Output` considered as a single unit.
--
-- This exists for symmetry with `Methodology` and out of curiosity, but should
-- be considered extremely dangerous. `Uncontrolled` can only ever be
-- reinterpreted as an equally or more severe side effect than the context in
-- which it's introduced. For experimentation though, this module might be fun
-- to see how much evil you can get away with.
--
-- There is a simple interpretation in the form of `runUncontrolledAsState`, as
-- well as ways of getting between `Uncontrolled` and `Input`/`Output`.
-- Combined with `teeMethodology` and `plugMethodology`, this may give you a
-- way to teleport state around your architecture.
module Polysemy.Uncontrolled
  ( -- * Definition
    Uncontrolled (..),
    send,
    receive,

    -- * Eliminators
    runUncontrolledAsState,
    runUncontrolledAsStateSem,
    runUncontrolledAsInputOutput,

    -- * Adapters
    adaptUncontrolledPure,
    adaptUncontrolledSem,

    -- * Coeliminators
    runInputAsUncontrolled,
    runOutputAsUncontrolled,
    runMethodologyAsUncontrolled,
  )
where

import Polysemy
import Polysemy.Input
import Polysemy.Methodology
import Polysemy.Output
import Polysemy.State

-- | An `Uncontrolled` generalises an unmanaged side effect.
data Uncontrolled c b m a where
  Send :: c -> Uncontrolled c b m ()
  Receive :: Uncontrolled c b m b

makeSem ''Uncontrolled

-- | Run an `Uncontrolled` as `State`, using a neutral element and accessors.
--
-- @since 0.1.0.0
runUncontrolledAsState :: forall s b c r a. Members '[State s] r => (c -> s) -> (s -> b) -> Sem (Uncontrolled c b ': r) a -> Sem r a
runUncontrolledAsState f g = runUncontrolledAsStateSem (pure . f) (pure . g)
{-# INLINE runUncontrolledAsState #-}

-- | Like `runUncontrolledAsState`, but uses monadic accessors. Using this would be completely insane. ;)
--
-- @since 0.1.0.0
runUncontrolledAsStateSem :: forall s b c r a. Members '[State s] r => (c -> Sem r s) -> (s -> Sem r b) -> Sem (Uncontrolled c b ': r) a -> Sem r a
runUncontrolledAsStateSem f g = interpret $ \case
  Send c -> f c >>= put
  Receive -> get >>= g
{-# INLINE runUncontrolledAsStateSem #-}

-- | Run an `Uncontrolled` as an `Input`/`Output` pair.
--
-- @since 0.1.0.0
runUncontrolledAsInputOutput :: Members '[Input b, Output c] r => Sem (Uncontrolled c b ': r) a -> Sem r a
runUncontrolledAsInputOutput = interpret $ \case
  Send c -> output c
  Receive -> input
{-# INLINE runUncontrolledAsInputOutput #-}

-- | Run an `Uncontrolled` as another kind of `Uncontrolled`, using pure functions to dimap from one to the other.
--
-- @since 0.1.0.0
adaptUncontrolledPure :: Members '[Uncontrolled c' b'] r => (c -> c') -> (b' -> b) -> Sem (Uncontrolled c b ': r) a -> Sem r a
adaptUncontrolledPure f g = adaptUncontrolledSem (pure . f) (pure . g)
{-# INLINE adaptUncontrolledPure #-}

-- | Like `adaptUncontrolledPure`, but with monadic adapters. If you use this I have no idea what you're trying to accomplish.
--
-- @since 0.1.0.0
adaptUncontrolledSem :: Members '[Uncontrolled c' b'] r => (c -> Sem r c') -> (b' -> Sem r b) -> Sem (Uncontrolled c b ': r) a -> Sem r a
adaptUncontrolledSem f g = interpret $ \case
  Send c -> f c >>= send
  Receive -> receive >>= g
{-# INLINE adaptUncontrolledSem #-}

-- | Run an `Input` as one side of an `Uncontrolled`.
--
-- @since 0.1.0.0
runInputAsUncontrolled :: Members '[Uncontrolled c b] r => Sem (Input b ': r) a -> Sem r a
runInputAsUncontrolled = interpret $ \case
  Input -> receive
{-# INLINE runInputAsUncontrolled #-}

-- | Run an `Output` as one side of an `Uncontrolled`.
--
-- @since 0.1.0.0
runOutputAsUncontrolled :: Members '[Uncontrolled c b] r => Sem (Output c ': r) a -> Sem r a
runOutputAsUncontrolled = interpret $ \case
  Output c -> send c
{-# INLINE runOutputAsUncontrolled #-}

-- | Run a `Methodology` as an `Uncontrolled` pure side effect.
--
-- @since 0.1.0.0
runMethodologyAsUncontrolled :: Members '[Uncontrolled b c] r => Sem (Methodology b c ': r) a -> Sem r a
runMethodologyAsUncontrolled = interpret $ \case
  Process b -> send b >> receive