{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}

-- |
--   Module     : Polysemy.Uncontrolled
--   License    : MIT
--   Stability  : experimental
--
-- `Uncontrolled` is the 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.
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.
--
-- @since 0.1.0.0
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.
--
-- @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.
--
-- @since 0.1.0.0
adaptUncontrolledSem :: forall c b c' b' r a. 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 @c' @b'
  Receive -> receive @c' @b' >>= g
{-# INLINE adaptUncontrolledSem #-}

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

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

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