module IO.Effects
  ( -- * Welcome!
    -- $welcome

    -- * The Core of @io-effects@
    Program
  , programToIO
  , interpret
  , Member( send )

    -- * Other Types
  , ProgramWithHandler
  , Handled
  ) where

import IO.Effects.Internal

{- $welcome

Welcome to @io-effects@, a light-weight yet high performance effect library with
the aim of /taming the 'IO' monad/. The 'IO' monad is the workhorse of any
Haskell program - the entry point of our program is @main :: IO ()@, and there
is no way to "leave" @IO@ once you're there. However, the @IO@ monad has a huge
amount of power - it can open files, perform network requests, and - as they
saying goes - launch the missiles. All of these are important functions, but
as our programs grow it becomes increasingly difficult to reason about /what/
IO is being performed. For example, asking the question "does this program
access my database?" is a difficult question to answer - with only @IO@, we have
no option other than reading all of the source code.

Enter @io-effects@. Programs written using @io-effects@ are just like the  'IO'
programs we're familiar with, but exactly what IO is being performed is
explicitly described in the types of our programs. A program that has access to
a database may have a type such as @Member Database es => Program es a@.
In fact, if @es@ is truly polymorphic, this program can do nothing /but/ access
a database. These constraints can be combined as well, so a program with the
type @( Member Database es, Member HTTP es ) => Program es a@ is a program that
may access a database or may make HTTP requests.

== Defining Effects

To define an effect, we need to write three things:

1. A GADT for the /signature/ of our effect. This is a list of all possible
   methods.

2. Helper functions to define your effects DSL.

3. One or more intpreretations of your effect.

We will consider this with the familiar example an effect that provides input
and output against the terminal.

First, our effect signature:

@
data Teletype m a where
  ReadLine :: Teletype m String
  WriteLine :: String -> Teletype m ()
@

Next, some helper functions to provide a nicer API to users of our effect:

@
readLine :: 'Member' Teletype es => 'Program' es String
readLine = 'send' ReadLine

writeLine :: 'Member' Teletype es => String -> 'Program' es ()
writeLine = 'send' . WriteLine
@

Finally, we need to provide an interpretation for this effect. In this example,
we will /reinterpret/ the @Teletype@ effect into general 'IO':

@
teletypeToIO
  :: 'Member' ( 'Lift' IO ) es
  => 'ProgramWithHandler' Teletype es a
  -> 'Program' es a
teletypeToIO =
  'interpret' \\case
    ReadLine -> liftIO getLine
    WriteLine l -> liftIO ( putStrLn l )
@

And that's it! With this, we can now write some basic programs:

@
greeter :: 'Member' Teletype es => 'Program' es ()
greeter = do
  writeLine "Hello! What is your name?"
  name <- readLine
  writeLine ( "Hi, " ++ name ++ " - thanks for trying out io-effects!" )

main :: IO ()
main =
  'programToIO' ( teletypeToIO greeter )
@

-}