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

-- |

-- Module      :  Control.Program.Writer

-- Copyright   :  (c) Michael Szvetits, 2021

-- License     :  BSD3 (see the file LICENSE)

-- Maintainer  :  typedbyte@qualified.name

-- Stability   :  stable

-- Portability :  portable

--

-- Types and functions for handling appendable output in the environment of a

-- 'Program'.

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

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

    Writer(..)
    -- * Program-based Writer

  , newWriter
  , tell
  ) where

-- base

import Data.IORef (modifyIORef', newIORef, readIORef)

import Control.Program (Has, Program, pullWith)

-- | A record of functions which represents the operations on an appendable output.

newtype Writer w = Writer { Writer w -> w -> IO ()
writeValue :: w -> IO () }

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

--

-- Returns the record of functions and an action which reads the accumulated

-- output, usually used after running a corresponding 'Program' with the 'Writer'

-- in its environment.

newWriter :: Monoid w => IO (Writer w, IO w)
newWriter :: IO (Writer w, IO w)
newWriter = do
  IORef w
ref <- w -> IO (IORef w)
forall a. a -> IO (IORef a)
newIORef w
forall a. Monoid a => a
mempty
  let writer :: Writer w
writer = Writer :: forall w. (w -> IO ()) -> Writer w
Writer
        { writeValue :: w -> IO ()
writeValue = \w
w -> IORef w -> (w -> w) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' IORef w
ref (w -> w -> w
forall a. Semigroup a => a -> a -> a
<> w
w) }
  (Writer w, IO w) -> IO (Writer w, IO w)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Writer w
writer, IORef w -> IO w
forall a. IORef a -> IO a
readIORef IORef w
ref)

-- | Produces the output @w@. In other words, @w@ is appended to the accumulated output.

tell :: e `Has` Writer w => w -> Program e ()
tell :: w -> Program e ()
tell = (Writer w -> IO ()) -> Program e ()
forall e t a. Has e t => (t -> IO a) -> Program e a
pullWith ((Writer w -> IO ()) -> Program e ())
-> (w -> Writer w -> IO ()) -> w -> Program e ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Writer w -> w -> IO ()) -> w -> Writer w -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Writer w -> w -> IO ()
forall w. Writer w -> w -> IO ()
writeValue