{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes            #-}
{-# LANGUAGE TypeOperators         #-}
-----------------------------------------------------------------------------

-- |

-- Module      :  Control.Program

-- Copyright   :  (c) Michael Szvetits, 2021

-- License     :  BSD3 (see the file LICENSE)

-- Maintainer  :  typedbyte@qualified.name

-- Stability   :  stable

-- Portability :  portable

--

-- Types and functions for representing programs which run in a specific

-- environment and are able to integrate bracket-like operations.

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

module Control.Program
  ( -- * Program Representation

    Program
  , runProgram
    -- * Resource Handling

  , bracket
  , bracketE
  , manage
  , local
    -- * Environment Handling

  , Has(from)
  , ask
  , pull
  , pullWith
  )
  where

-- base

import qualified Control.Exception as E
import Control.Monad.IO.Class (MonadIO, liftIO)

-- | Represents a program that produces a value of type @a@ when running in an

-- environment @e@. The required content of the environment is usually described

-- by declaring 'Has' constraints on @e@.

--

-- Turning an 'IO' action into a 'Program' is usually done by using 'liftIO'.

newtype Program e a = Program { Program e a -> e -> forall b. (a -> IO b) -> IO b
unProgram :: e -> forall b. (a -> IO b) -> IO b }

instance Functor (Program e) where
  fmap :: (a -> b) -> Program e a -> Program e b
fmap a -> b
f (Program e -> forall b. (a -> IO b) -> IO b
g) =
    (e -> forall b. (b -> IO b) -> IO b) -> Program e b
forall e a. (e -> forall b. (a -> IO b) -> IO b) -> Program e a
Program ((e -> forall b. (b -> IO b) -> IO b) -> Program e b)
-> (e -> forall b. (b -> IO b) -> IO b) -> Program e b
forall a b. (a -> b) -> a -> b
$ \e
env b -> IO b
cont ->
      e -> (a -> IO b) -> IO b
e -> forall b. (a -> IO b) -> IO b
g e
env (b -> IO b
cont (b -> IO b) -> (a -> b) -> a -> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)
  {-# INLINE fmap #-}

instance Applicative (Program e) where
  pure :: a -> Program e a
pure a
r =
    (e -> forall b. (a -> IO b) -> IO b) -> Program e a
forall e a. (e -> forall b. (a -> IO b) -> IO b) -> Program e a
Program ((e -> forall b. (a -> IO b) -> IO b) -> Program e a)
-> (e -> forall b. (a -> IO b) -> IO b) -> Program e a
forall a b. (a -> b) -> a -> b
$ \e
_ a -> IO b
cont ->
      a -> IO b
cont a
r
  {-# INLINE pure #-}
  
  Program e -> forall b. ((a -> b) -> IO b) -> IO b
f <*> :: Program e (a -> b) -> Program e a -> Program e b
<*> Program e -> forall b. (a -> IO b) -> IO b
g =
    (e -> forall b. (b -> IO b) -> IO b) -> Program e b
forall e a. (e -> forall b. (a -> IO b) -> IO b) -> Program e a
Program ((e -> forall b. (b -> IO b) -> IO b) -> Program e b)
-> (e -> forall b. (b -> IO b) -> IO b) -> Program e b
forall a b. (a -> b) -> a -> b
$ \e
env b -> IO b
cont ->
      e -> forall b. ((a -> b) -> IO b) -> IO b
f e
env (((a -> b) -> IO b) -> IO b) -> ((a -> b) -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \a -> b
h ->
        e -> (a -> IO b) -> IO b
e -> forall b. (a -> IO b) -> IO b
g e
env (b -> IO b
cont (b -> IO b) -> (a -> b) -> a -> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
h)
  {-# INLINE (<*>) #-}

instance Monad (Program e) where
  Program e -> forall b. (a -> IO b) -> IO b
f >>= :: Program e a -> (a -> Program e b) -> Program e b
>>= a -> Program e b
g =
    (e -> forall b. (b -> IO b) -> IO b) -> Program e b
forall e a. (e -> forall b. (a -> IO b) -> IO b) -> Program e a
Program ((e -> forall b. (b -> IO b) -> IO b) -> Program e b)
-> (e -> forall b. (b -> IO b) -> IO b) -> Program e b
forall a b. (a -> b) -> a -> b
$ \e
env b -> IO b
cont ->
      e -> forall b. (a -> IO b) -> IO b
f e
env ((a -> IO b) -> IO b) -> (a -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \a
a ->
        Program e b -> e -> (b -> IO b) -> IO b
forall e a. Program e a -> e -> forall b. (a -> IO b) -> IO b
unProgram (a -> Program e b
g a
a) e
env b -> IO b
cont
  {-# INLINE (>>=) #-}

instance MonadFail (Program e) where
  fail :: String -> Program e a
fail = IO a -> Program e a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> Program e a) -> (String -> IO a) -> String -> Program e a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail
  {-# INLINE fail #-}

instance MonadIO (Program e) where
  liftIO :: IO a -> Program e a
liftIO IO a
m =
    (e -> forall b. (a -> IO b) -> IO b) -> Program e a
forall e a. (e -> forall b. (a -> IO b) -> IO b) -> Program e a
Program ((e -> forall b. (a -> IO b) -> IO b) -> Program e a)
-> (e -> forall b. (a -> IO b) -> IO b) -> Program e a
forall a b. (a -> b) -> a -> b
$ \e
_ a -> IO b
cont ->
      IO a
m IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> IO b
cont
  {-# INLINE liftIO #-}

-- | Runs a program in a given environment @e@.

runProgram :: e -> Program e a -> IO a
runProgram :: e -> Program e a -> IO a
runProgram e
env (Program e -> forall b. (a -> IO b) -> IO b
f) = e -> (a -> IO a) -> IO a
e -> forall b. (a -> IO b) -> IO b
f e
env a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

-- | Acquire a resource, use it, and then release the resource automatically

-- after the program ends.

bracket
  :: IO a        -- ^ The computation which acquires the resource.

  -> (a -> IO b) -- ^ The computation which releases the resource.

  -> Program e a -- ^ The computation which uses the resource.

bracket :: IO a -> (a -> IO b) -> Program e a
bracket IO a
create a -> IO b
destroy =
  (e -> forall b. (a -> IO b) -> IO b) -> Program e a
forall e a. (e -> forall b. (a -> IO b) -> IO b) -> Program e a
Program ((e -> forall b. (a -> IO b) -> IO b) -> Program e a)
-> (e -> forall b. (a -> IO b) -> IO b) -> Program e a
forall a b. (a -> b) -> a -> b
$ \e
_ a -> IO b
cont ->
    IO a -> (a -> IO b) -> (a -> IO b) -> IO b
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
E.bracket IO a
create a -> IO b
destroy a -> IO b
cont
{-# INLINE bracket #-}

-- | A version of 'bracket' where the acquisition and release actions may

-- consult the environment @e@.

bracketE :: (e -> IO a) -> (e -> a -> IO b) -> Program e a
bracketE :: (e -> IO a) -> (e -> a -> IO b) -> Program e a
bracketE e -> IO a
create e -> a -> IO b
destroy =
  (e -> forall b. (a -> IO b) -> IO b) -> Program e a
forall e a. (e -> forall b. (a -> IO b) -> IO b) -> Program e a
Program ((e -> forall b. (a -> IO b) -> IO b) -> Program e a)
-> (e -> forall b. (a -> IO b) -> IO b) -> Program e a
forall a b. (a -> b) -> a -> b
$ \e
env a -> IO b
cont ->
    IO a -> (a -> IO b) -> (a -> IO b) -> IO b
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
E.bracket (e -> IO a
create e
env) (e -> a -> IO b
destroy e
env) a -> IO b
cont
{-# INLINE bracketE #-}

-- | Integrates a continuation into a 'Program', which is useful for integrating

-- existing bracket-like continuations (often named @with...@).

manage :: (forall b. (a -> IO b) -> IO b) -> Program e a
manage :: (forall b. (a -> IO b) -> IO b) -> Program e a
manage forall b. (a -> IO b) -> IO b
f =
  (e -> forall b. (a -> IO b) -> IO b) -> Program e a
forall e a. (e -> forall b. (a -> IO b) -> IO b) -> Program e a
Program ((e -> forall b. (a -> IO b) -> IO b) -> Program e a)
-> (e -> forall b. (a -> IO b) -> IO b) -> Program e a
forall a b. (a -> b) -> a -> b
$ \e
_ a -> IO b
cont ->
    (a -> IO b) -> IO b
forall b. (a -> IO b) -> IO b
f a -> IO b
cont
{-# INLINE manage #-}

-- | Runs a sub-program within a program, which is useful for fine-grained

-- resource handling (i.e., resources acquired by the sub-program are released

-- after the sub-program ends, not at the end of the whole program).

local :: Program e a -> Program e a
local :: Program e a -> Program e a
local Program e a
program =
  (e -> forall b. (a -> IO b) -> IO b) -> Program e a
forall e a. (e -> forall b. (a -> IO b) -> IO b) -> Program e a
Program ((e -> forall b. (a -> IO b) -> IO b) -> Program e a)
-> (e -> forall b. (a -> IO b) -> IO b) -> Program e a
forall a b. (a -> b) -> a -> b
$ \e
env a -> IO b
cont ->
    e -> Program e a -> IO a
forall e a. e -> Program e a -> IO a
runProgram e
env Program e a
program IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> IO b
cont
{-# INLINE local #-}

-- | Demands that a specific value of type @t@ must be present in the

-- environment @e@.

class e `Has` t where
  -- | Extracts a value of type @t@ from the environment @e@.

  from :: e -> t

instance {-# OVERLAPPABLE #-} e `Has` e where
  from :: e -> e
from = e -> e
forall e. e -> e
id
  {-# INLINE from #-}

-- | Gets the environment.

ask :: Program e e
ask :: Program e e
ask = (e -> forall b. (e -> IO b) -> IO b) -> Program e e
forall e a. (e -> forall b. (a -> IO b) -> IO b) -> Program e a
Program ((e -> forall b. (e -> IO b) -> IO b) -> Program e e)
-> (e -> forall b. (e -> IO b) -> IO b) -> Program e e
forall a b. (a -> b) -> a -> b
$ \e
env e -> IO b
cont -> e -> IO b
cont e
env
{-# INLINE ask #-}

-- | Extracts a specific value of type @t@ from the environment.

pull :: e `Has` t => Program e t
pull :: Program e t
pull = (e -> forall b. (t -> IO b) -> IO b) -> Program e t
forall e a. (e -> forall b. (a -> IO b) -> IO b) -> Program e a
Program ((e -> forall b. (t -> IO b) -> IO b) -> Program e t)
-> (e -> forall b. (t -> IO b) -> IO b) -> Program e t
forall a b. (a -> b) -> a -> b
$ \e
env t -> IO b
cont -> t -> IO b
cont (e -> t
forall e t. Has e t => e -> t
from e
env)
{-# INLINE pull #-}

-- | Extracts a specific value of type @t@ from the environment and extracts

-- some 'IO' action from it. This is useful if the environment contains a

-- record of 'IO' functions (e.g., a function which returns a handle).

pullWith :: e `Has` t => (t -> IO a) -> Program e a
pullWith :: (t -> IO a) -> Program e a
pullWith t -> IO a
f =
  (e -> forall b. (a -> IO b) -> IO b) -> Program e a
forall e a. (e -> forall b. (a -> IO b) -> IO b) -> Program e a
Program ((e -> forall b. (a -> IO b) -> IO b) -> Program e a)
-> (e -> forall b. (a -> IO b) -> IO b) -> Program e a
forall a b. (a -> b) -> a -> b
$ \e
env a -> IO b
cont ->
    t -> IO a
f (e -> t
forall e t. Has e t => e -> t
from e
env) IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> IO b
cont
{-# INLINE pullWith #-}