-- |
-- Module      :  Disco.Effects.Input
-- Copyright   :  disco team and contributors
-- Maintainer  :  byorgey@gmail.com
--
-- SPDX-License-Identifier: BSD-3-Clause
--
-- Utility functions for input effect.
module Disco.Effects.Input (
  module Polysemy.Input,
  inputToState,
  mapInput,
)
where

import Polysemy
import Polysemy.Input
import Polysemy.State

-- | Run an input effect in terms of an ambient state effect.
inputToState :: forall s r a. Member (State s) r => Sem (Input s ': r) a -> Sem r a
inputToState :: forall s (r :: EffectRow) a.
Member (State s) r =>
Sem (Input s : r) a -> Sem r a
inputToState = (forall (rInitial :: EffectRow) x.
 Input s (Sem rInitial) x -> Sem r x)
-> Sem (Input s : r) a -> Sem r a
forall (e :: (* -> *) -> * -> *) (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 (\case Input s (Sem rInitial) x
Input -> forall s (r :: EffectRow). Member (State s) r => Sem r s
get @s)

-- | Use a function to (contravariantly) transform the input value in
--   an input effect.
mapInput :: forall s t r a. Member (Input s) r => (s -> t) -> Sem (Input t ': r) a -> Sem r a
mapInput :: forall s t (r :: EffectRow) a.
Member (Input s) r =>
(s -> t) -> Sem (Input t : r) a -> Sem r a
mapInput s -> t
f = (forall (rInitial :: EffectRow) x.
 Input t (Sem rInitial) x -> Sem r x)
-> Sem (Input t : r) a -> Sem r a
forall (e :: (* -> *) -> * -> *) (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 (\case Input t (Sem rInitial) x
Input -> forall i j (r :: EffectRow).
Member (Input i) r =>
(i -> j) -> Sem r j
inputs @s s -> t
s -> x
f)