-- |
-- 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 String
f String
m)   = String
f forall a. [a] -> [a] -> [a]
++ String
":" forall a. [a] -> [a] -> [a]
++ String
m

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

instance Exception Violation
instance Exception Failure

-- | User error.
failure :: String                                 -- ^ Function name
        -> String                                 -- ^ Error message
        -> a
failure :: forall a. String -> String -> a
failure String
f String
msg = forall a e. Exception e => e -> a
throw 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 :: forall a. String -> String -> a
violation String
f String
msg = forall a e. Exception e => e -> a
throw 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 :: forall a. String -> a
impossible String
f = forall a. String -> String -> a
violation String
f String
"The impossible happened."

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