content: {-# LANGUAGE Rank2Types #-}
  
  module Reporting.Task
    ( Task,
      run,
      throw,
      mapError,
      --
      io,
      mio,
      eio,
    )
  where
  
  -- TASKS
  
  newtype Task x a
    = Task
        ( forall result. (a -> IO result) -> (x -> IO result) -> IO result
        )
  
  run :: Task x a -> IO (Either x a)
  run (Task task) =
    task (return . Right) (return . Left)
  
  throw :: x -> Task x a
  throw x =
    Task $ \_ err -> err x
  
  mapError :: (x -> y) -> Task x a -> Task y a
  mapError func (Task task) =
    Task $ \ok err ->
      task ok (err . func)
  
  -- IO
  
  io :: IO a -> Task x a
  io work =
    Task $ \ok _ -> work >>= ok
  
  mio :: x -> IO (Maybe a) -> Task x a
  mio x work =
    Task $ \ok err ->
      do
        result <- work
        case result of
          Just a -> ok a
          Nothing -> err x
  
  eio :: (x -> y) -> IO (Either x a) -> Task y a
  eio func work =
    Task $ \ok err ->
      do
        result <- work
        case result of
          Right a -> ok a
          Left x -> err (func x)
  
  -- INSTANCES
  
  instance Functor (Task x) where
    fmap func (Task taskA) =
      Task $ \ok err ->
        let okA arg = ok (func arg)
         in taskA okA err
  
  instance Applicative (Task x) where
    pure a =
      Task $ \ok _ -> ok a
  
    (<*>) (Task taskFunc) (Task taskArg) =
      Task $ \ok err ->
        let okFunc func =
              let okArg arg = ok (func arg)
               in taskArg okArg err
         in taskFunc okFunc err
  
  instance Monad (Task x) where
    return = pure
  
    (>>=) (Task taskA) callback =
      Task $ \ok err ->
        let okA a =
              case callback a of
                Task taskB -> taskB ok err
         in taskA okA err
  