{-# LANGUAGE DeriveDataTypeable #-}
{-
	Copyright (C) 2018 Dr. Alistair Ward

	This file is part of BishBosh.

	BishBosh is free software: you can redistribute it and/or modify
	it under the terms of the GNU General Public License as published by
	the Free Software Foundation, either version 3 of the License, or
	(at your option) any later version.

	BishBosh is distributed in the hope that it will be useful,
	but WITHOUT ANY WARRANTY; without even the implied warranty of
	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
	GNU General Public License for more details.

	You should have received a copy of the GNU General Public License
	along with BishBosh.  If not, see <http://www.gnu.org/licenses/>.
-}
{- |
 [@AUTHOR@]	Dr. Alistair Ward

 [@DESCRIPTION@]

	* Exceptions used by this application.

	* CAVEAT: though intended to be orthogonal, there's some inevitable overlap.
-}

module BishBosh.Data.Exception(
-- * Types
-- ** Data-types
	BadData(),
	BadRequest(),
	Exception(
--		MkException,
		getType
--		getDetails
	),
-- * Functions
-- ** Constructors
	mkDuplicateData,
	mkIncompatibleData,
	mkInsufficientData,
	mkInvalidDatum,
	mkNullDatum,
	mkOutOfBounds,
	mkRedundantData,
	mkParseFailure,
	mkRequestFailure,
	mkResultUndefined,
	mkSearchFailure,
-- ** Predicates
	isBadData,
	isBadRequest
) where

import			Control.Arrow((|||))
import qualified	Control.Exception
import qualified	Data.Typeable

-- | This sum-type of exceptions may be thrown by any function which checks its parameters; typically either constructors or mutators.
data BadData
	= DuplicateData		-- ^ Some data is duplicated.
	| IncompatibleData	-- ^ Two or more data with valid values, are incompatible. cf. InvalidDatum.
	| InsufficientData	-- ^ More data is required to fulfill the request. cf. 'NullDatum'.
	| InvalidDatum		-- ^ A datum's value is invalid.
	| NullDatum		-- ^ An empty collection was unexpectedly received; a specialisation of either 'InsufficientData' or 'InvalidDatum'.
	| OutOfBounds		-- ^ Either underflow or overflow of numeric data; a specialisation of 'InvalidDatum'.
	| RedundantData		-- ^ Data superflous to requirements was provided; a specialisation of 'InvalidDatum'.
	deriving Int -> BadData -> ShowS
[BadData] -> ShowS
BadData -> String
(Int -> BadData -> ShowS)
-> (BadData -> String) -> ([BadData] -> ShowS) -> Show BadData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BadData] -> ShowS
$cshowList :: [BadData] -> ShowS
show :: BadData -> String
$cshow :: BadData -> String
showsPrec :: Int -> BadData -> ShowS
$cshowsPrec :: Int -> BadData -> ShowS
Show

-- | This sum-type of exceptions may be thrown by any function which is unable to comply with a correctly formed request.
data BadRequest
	= ParseFailure		-- ^ An attempt to parse data failed.
	| RequestFailure	-- ^ A well-formed request couldn't be completed.
	| ResultUndefined	-- ^ More than one correct result is possible.
	| SearchFailure		-- ^ An attempt to find data failed.
	deriving Int -> BadRequest -> ShowS
[BadRequest] -> ShowS
BadRequest -> String
(Int -> BadRequest -> ShowS)
-> (BadRequest -> String)
-> ([BadRequest] -> ShowS)
-> Show BadRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BadRequest] -> ShowS
$cshowList :: [BadRequest] -> ShowS
show :: BadRequest -> String
$cshow :: BadRequest -> String
showsPrec :: Int -> BadRequest -> ShowS
$cshowsPrec :: Int -> BadRequest -> ShowS
Show

-- | Each exception includes both a type & arbitrary details.
data Exception	= MkException {
	Exception -> Either BadData BadRequest
getType		:: Either BadData BadRequest,
	Exception -> String
getDetails	:: String
} deriving Data.Typeable.Typeable

instance Control.Exception.Exception Exception

instance Show Exception where
	showsPrec :: Int -> Exception -> ShowS
showsPrec Int
precedence MkException {
		getType :: Exception -> Either BadData BadRequest
getType		= Either BadData BadRequest
eitherBadDataOrBadRequest,
		getDetails :: Exception -> String
getDetails	= String
details
	} = (Int -> BadData -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
precedence (BadData -> ShowS)
-> (BadRequest -> ShowS) -> Either BadData BadRequest -> ShowS
forall (a :: * -> * -> *) b d c.
ArrowChoice a =>
a b d -> a c d -> a (Either b c) d
||| Int -> BadRequest -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
precedence) Either BadData BadRequest
eitherBadDataOrBadRequest ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"; " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
details

-- | Constructor.
mkDuplicateData :: String -> Exception
mkDuplicateData :: String -> Exception
mkDuplicateData	= Either BadData BadRequest -> String -> Exception
MkException (Either BadData BadRequest -> String -> Exception)
-> Either BadData BadRequest -> String -> Exception
forall a b. (a -> b) -> a -> b
$ BadData -> Either BadData BadRequest
forall a b. a -> Either a b
Left BadData
DuplicateData

-- | Constructor.
mkIncompatibleData :: String -> Exception
mkIncompatibleData :: String -> Exception
mkIncompatibleData	= Either BadData BadRequest -> String -> Exception
MkException (Either BadData BadRequest -> String -> Exception)
-> Either BadData BadRequest -> String -> Exception
forall a b. (a -> b) -> a -> b
$ BadData -> Either BadData BadRequest
forall a b. a -> Either a b
Left BadData
IncompatibleData

-- | Constructor.
mkInsufficientData :: String -> Exception
mkInsufficientData :: String -> Exception
mkInsufficientData	= Either BadData BadRequest -> String -> Exception
MkException (Either BadData BadRequest -> String -> Exception)
-> Either BadData BadRequest -> String -> Exception
forall a b. (a -> b) -> a -> b
$ BadData -> Either BadData BadRequest
forall a b. a -> Either a b
Left BadData
InsufficientData

-- | Constructor.
mkInvalidDatum :: String -> Exception
mkInvalidDatum :: String -> Exception
mkInvalidDatum	= Either BadData BadRequest -> String -> Exception
MkException (Either BadData BadRequest -> String -> Exception)
-> Either BadData BadRequest -> String -> Exception
forall a b. (a -> b) -> a -> b
$ BadData -> Either BadData BadRequest
forall a b. a -> Either a b
Left BadData
InvalidDatum

-- | Constructor.
mkNullDatum :: String -> Exception
mkNullDatum :: String -> Exception
mkNullDatum	= Either BadData BadRequest -> String -> Exception
MkException (Either BadData BadRequest -> String -> Exception)
-> Either BadData BadRequest -> String -> Exception
forall a b. (a -> b) -> a -> b
$ BadData -> Either BadData BadRequest
forall a b. a -> Either a b
Left BadData
NullDatum

-- | Constructor.
mkOutOfBounds :: String -> Exception
mkOutOfBounds :: String -> Exception
mkOutOfBounds	= Either BadData BadRequest -> String -> Exception
MkException (Either BadData BadRequest -> String -> Exception)
-> Either BadData BadRequest -> String -> Exception
forall a b. (a -> b) -> a -> b
$ BadData -> Either BadData BadRequest
forall a b. a -> Either a b
Left BadData
OutOfBounds

-- | Constructor.
mkRedundantData :: String -> Exception
mkRedundantData :: String -> Exception
mkRedundantData	= Either BadData BadRequest -> String -> Exception
MkException (Either BadData BadRequest -> String -> Exception)
-> Either BadData BadRequest -> String -> Exception
forall a b. (a -> b) -> a -> b
$ BadData -> Either BadData BadRequest
forall a b. a -> Either a b
Left BadData
RedundantData

-- | Constructor.
mkParseFailure :: String -> Exception
mkParseFailure :: String -> Exception
mkParseFailure	= Either BadData BadRequest -> String -> Exception
MkException (Either BadData BadRequest -> String -> Exception)
-> Either BadData BadRequest -> String -> Exception
forall a b. (a -> b) -> a -> b
$ BadRequest -> Either BadData BadRequest
forall a b. b -> Either a b
Right BadRequest
ParseFailure

-- | Constructor.
mkRequestFailure :: String -> Exception
mkRequestFailure :: String -> Exception
mkRequestFailure	= Either BadData BadRequest -> String -> Exception
MkException (Either BadData BadRequest -> String -> Exception)
-> Either BadData BadRequest -> String -> Exception
forall a b. (a -> b) -> a -> b
$ BadRequest -> Either BadData BadRequest
forall a b. b -> Either a b
Right BadRequest
RequestFailure

-- | Constructor.
mkResultUndefined :: String -> Exception
mkResultUndefined :: String -> Exception
mkResultUndefined	= Either BadData BadRequest -> String -> Exception
MkException (Either BadData BadRequest -> String -> Exception)
-> Either BadData BadRequest -> String -> Exception
forall a b. (a -> b) -> a -> b
$ BadRequest -> Either BadData BadRequest
forall a b. b -> Either a b
Right BadRequest
ResultUndefined

-- | Constructor.
mkSearchFailure :: String -> Exception
mkSearchFailure :: String -> Exception
mkSearchFailure	= Either BadData BadRequest -> String -> Exception
MkException (Either BadData BadRequest -> String -> Exception)
-> Either BadData BadRequest -> String -> Exception
forall a b. (a -> b) -> a -> b
$ BadRequest -> Either BadData BadRequest
forall a b. b -> Either a b
Right BadRequest
SearchFailure

-- | Predicate.
isBadData :: Exception -> Bool
isBadData :: Exception -> Bool
isBadData MkException { getType :: Exception -> Either BadData BadRequest
getType = Left BadData
_ }	= Bool
True
isBadData Exception
_					= Bool
False

-- | Predicate.
isBadRequest :: Exception -> Bool
isBadRequest :: Exception -> Bool
isBadRequest MkException { getType :: Exception -> Either BadData BadRequest
getType = Right BadRequest
_ }	= Bool
True
isBadRequest Exception
_					= Bool
False