-- |
-- Copyright: (C) 2013 Amgen, Inc.
--
-- Wrappers around 'error' that classify problems into whether these are bugs
-- internal to H, or whether they are due to a mistake by the user.
--
-- This module should only be imported by H modules and not reexported.

{-# LANGUAGE DeriveDataTypeable #-}

module Internal.Error
  ( failure
  , violation
  , impossible
  , unimplemented
  ) where

import Control.Exception
import Data.Typeable

data Violation = Violation String String deriving ( Typeable )
data Failure = Failure String String deriving ( Typeable )

instance Show Failure where
  show :: Failure -> String
show (Failure f :: String
f m :: String
m)   = String
f String -> ShowS
forall a. [a] -> [a] -> [a]
++ ":" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
m

instance Show Violation where
  show :: Violation -> String
show (Violation f :: String
f m :: String
m) = "Bug in " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
f String -> ShowS
forall a. [a] -> [a] -> [a]
++ ", please report: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
m

instance Exception Violation
instance Exception Failure

-- | User error.
failure :: String                                 -- ^ Function name
        -> String                                 -- ^ Error message
        -> a
failure :: String -> String -> a
failure f :: String
f msg :: String
msg = Failure -> a
forall a e. Exception e => e -> a
throw (Failure -> a) -> Failure -> a
forall a b. (a -> b) -> a -> b
$ String -> String -> Failure
Failure String
f String
msg

-- | An internal invariant has been violated. That's a bug.
violation :: String                               -- ^ Function name
          -> String                               -- ^ Error message
          -> a
violation :: String -> String -> a
violation f :: String
f msg :: String
msg = Violation -> a
forall a e. Exception e => e -> a
throw (Violation -> a) -> Violation -> a
forall a b. (a -> b) -> a -> b
$ String -> String -> Violation
Violation String
f String
msg

-- | A violation that should have been made impossible by the type system was
-- not.
impossible :: String                               -- ^ Function name
           -> a
impossible :: String -> a
impossible f :: String
f = String -> String -> a
forall a. String -> String -> a
violation String
f "The impossible happened."

-- | Feature not yet implemented.
unimplemented :: String
              -> a
unimplemented :: String -> a
unimplemented f :: String
f = String -> String -> a
forall a. String -> String -> a
failure String
f "Unimplemented."