Ok.hs

{-# LANGUAGE BlockArguments #-}

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

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

-- |
-- The 'Ok' type is a simple error handler,  basically equivalent to
-- @Either [SomeException]@.
--
-- One of the primary reasons why this type  was introduced is that
-- @Either SomeException@ had not been provided an instance for 'Alternative',
-- and it would have been a bad idea to provide an orphaned instance for a
-- commonly-used type and typeclass included in @base@.
--
-- Extending the failure case to a list of 'SomeException's enables a
-- more sensible 'Alternative' instance definitions:   '<|>' concatinates
-- the list of exceptions when both cases fail,  and 'empty' is defined as
-- 'Errors []'.   Though '<|>' one could pick one of two exceptions, and
-- throw away the other,  and have 'empty' provide a generic exception,
-- this avoids cases where 'empty' overrides a more informative exception
-- and allows you to see all the different ways your computation has failed.
module Sqlite.Query.Ok where

import Control.Applicative
import Control.Exception
import Control.Monad (MonadPlus (..))

-- FIXME:   [SomeException] should probably be something else,  maybe
--          a difference list (or a tree?)

data Ok a = Errors [SomeException] | Ok !a
  deriving (Show, Functor)

-- | Two 'Errors' cases are considered equal, regardless of what the
--   list of exceptions looks like.
instance (Eq a) => Eq (Ok a) where
  Errors _ == Errors _ = True
  Ok a == Ok b = a == b
  _ == _ = False

instance Applicative Ok where
  pure = Ok

  Errors es <*> _ = Errors es
  _ <*> Errors es = Errors es
  Ok f <*> Ok a = Ok (f a)

instance Alternative Ok where
  empty = Errors []

  a@(Ok _) <|> _ = a
  Errors _ <|> b@(Ok _) = b
  Errors as <|> Errors bs = Errors (as ++ bs)

instance MonadPlus Ok where
  mzero = empty
  mplus = (<|>)

instance Monad Ok where
  return = pure

  Errors es >>= _ = Errors es
  Ok a >>= f = f a

instance MonadFail Ok where
  fail str = Errors [SomeException (ErrorCall str)]

-- | a way to reify a list of exceptions into a single exception
newtype ManyErrors = ManyErrors [SomeException]
  deriving (Show)

instance Exception ManyErrors