{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeOperators    #-}
-----------------------------------------------------------------------------

-- |

-- Module      :  Control.Program.State

-- Copyright   :  (c) Michael Szvetits, 2021

-- License     :  BSD3 (see the file LICENSE)

-- Maintainer  :  typedbyte@qualified.name

-- Stability   :  stable

-- Portability :  portable

--

-- Types and functions for handling mutable state in the environment of a

-- 'Program'.

-----------------------------------------------------------------------------

module Control.Program.State
  ( -- * State Effect

    State(..)
    -- * Program-based State

  , get
  , put
  , modify
  , modify'
    -- * IO-based State

  , newState
  , modifyState
  , modifyState'
  ) where

-- base

import Data.IORef (newIORef, readIORef, writeIORef)

import Control.Program (Has, Program, pullWith)

-- | A record of functions which represents the operations on a mutable value.

data State s = State
  { State s -> IO s
readState  :: IO s       -- ^ Gets the current state.

  , State s -> s -> IO ()
writeState :: s -> IO () -- ^ Replaces the state with a new value.

  }

-- | Creates a new record of functions for mutable state, backed by an 'Data.IORef.IORef'.

newState :: s -> IO (State s)
newState :: s -> IO (State s)
newState s
s = do
  IORef s
ref <- s -> IO (IORef s)
forall a. a -> IO (IORef a)
newIORef s
s
  State s -> IO (State s)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (State s -> IO (State s)) -> State s -> IO (State s)
forall a b. (a -> b) -> a -> b
$
    State :: forall s. IO s -> (s -> IO ()) -> State s
State
      { readState :: IO s
readState  = IORef s -> IO s
forall a. IORef a -> IO a
readIORef IORef s
ref
      , writeState :: s -> IO ()
writeState = IORef s -> s -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef s
ref
      }

-- | Modifies the state, using the provided function.

modifyState :: State s -> (s -> s) -> IO ()
modifyState :: State s -> (s -> s) -> IO ()
modifyState State s
state s -> s
f =
  State s -> IO s
forall s. State s -> IO s
readState State s
state IO s -> (s -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= State s -> s -> IO ()
forall s. State s -> s -> IO ()
writeState State s
state (s -> IO ()) -> (s -> s) -> s -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> s
f

-- | A strict version of 'modifyState'.

modifyState' :: State s -> (s -> s) -> IO ()
modifyState' :: State s -> (s -> s) -> IO ()
modifyState' State s
state s -> s
f = do
  s
s <- State s -> IO s
forall s. State s -> IO s
readState State s
state
  let s' :: s
s' = s -> s
f s
s
  s
s' s -> IO () -> IO ()
`seq` State s -> s -> IO ()
forall s. State s -> s -> IO ()
writeState State s
state s
s'

-- | Gets the current state.

get :: e `Has` State s => Program e s
get :: Program e s
get = (State s -> IO s) -> Program e s
forall e t a. Has e t => (t -> IO a) -> Program e a
pullWith State s -> IO s
forall s. State s -> IO s
readState

-- | Replaces the state with a new value.

put :: e `Has` State s => s -> Program e ()
put :: s -> Program e ()
put = (State s -> IO ()) -> Program e ()
forall e t a. Has e t => (t -> IO a) -> Program e a
pullWith ((State s -> IO ()) -> Program e ())
-> (s -> State s -> IO ()) -> s -> Program e ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (State s -> s -> IO ()) -> s -> State s -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip State s -> s -> IO ()
forall s. State s -> s -> IO ()
writeState

-- | Modifies the state, using the provided function.

modify :: e `Has` State s => (s -> s) -> Program e ()
modify :: (s -> s) -> Program e ()
modify = (State s -> IO ()) -> Program e ()
forall e t a. Has e t => (t -> IO a) -> Program e a
pullWith ((State s -> IO ()) -> Program e ())
-> ((s -> s) -> State s -> IO ()) -> (s -> s) -> Program e ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (State s -> (s -> s) -> IO ()) -> (s -> s) -> State s -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip State s -> (s -> s) -> IO ()
forall s. State s -> (s -> s) -> IO ()
modifyState

-- | A strict version of 'modify'.

modify' :: e `Has` State s => (s -> s) -> Program e ()
modify' :: (s -> s) -> Program e ()
modify' = (State s -> IO ()) -> Program e ()
forall e t a. Has e t => (t -> IO a) -> Program e a
pullWith ((State s -> IO ()) -> Program e ())
-> ((s -> s) -> State s -> IO ()) -> (s -> s) -> Program e ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (State s -> (s -> s) -> IO ()) -> (s -> s) -> State s -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip State s -> (s -> s) -> IO ()
forall s. State s -> (s -> s) -> IO ()
modifyState'