From 6ae961ff1b5ffc07f7f048a6ead85a192d5ff8eb Mon Sep 17 00:00:00 2001
From: vrom911 <vrom911@gmail.com>
Date: Fri, 22 Dec 2017 01:27:58 +0300
Subject: [PATCH] [#100] Add bug

---
 CHANGES.md                 |  6 ++++++
 src/Universum/Exception.hs | 24 ++++++++++++++++++++++++
 universum.cabal            |  2 +-
 3 files changed, 31 insertions(+), 1 deletion(-)

diff --git a/CHANGES.md b/CHANGES.md
index 7c16f7f..f0f36da 100644
--- a/CHANGES.md
+++ b/CHANGES.md
@@ -1,3 +1,9 @@
+1.0.1
+=====
+
+* [#100](https://github.com/serokell/universum/issues/100):
+  Add `bug` function = `impureThrow`.
+
 1.0.0
 =====
 
diff --git a/src/Universum/Exception.hs b/src/Universum/Exception.hs
index 42a0d12..0fb7f9b 100644
--- a/src/Universum/Exception.hs
+++ b/src/Universum/Exception.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE CPP                   #-}
+{-# LANGUAGE ImplicitParams        #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE Safe                  #-}
 
@@ -7,6 +8,10 @@
 
 module Universum.Exception
        ( module Control.Exception.Safe
+#if ( __GLASGOW_HASKELL__ >= 800 )
+       , Bug (..)
+       , bug
+#endif
        , note
        ) where
 
@@ -19,6 +24,25 @@ import Control.Applicative (Applicative (pure))
 import Control.Monad.Except (MonadError, throwError)
 import Data.Maybe (Maybe, maybe)
 
+#if ( __GLASGOW_HASKELL__ >= 800 )
+import GHC.Show (Show)
+import GHC.Stack (CallStack, HasCallStack)
+
+import qualified Control.Exception.Safe as Safe (impureThrow, toException)
+
+-- | Type that represents exceptions used in cases when a particular codepath
+-- is not meant to be ever executed, but happens to be executed anyway.
+data Bug = Bug SomeException CallStack
+    deriving (Show)
+
+instance Exception Bug
+
+-- | Generate a pure value which, when forced, will synchronously
+-- throw the exception wrapped into 'Bug' data type.
+bug :: (HasCallStack, Exception e) => e -> a
+bug e = Safe.impureThrow (Bug (Safe.toException e) ?callStack)
+#endif
+
 -- To suppress redundant applicative constraint warning on GHC 8.0
 -- | Throws error for 'Maybe' if 'Data.Maybe.Nothing' is given.
 -- Operates over 'MonadError'.
diff --git a/universum.cabal b/universum.cabal
index 3d9ef82..a533059 100644
--- a/universum.cabal
+++ b/universum.cabal
@@ -1,5 +1,5 @@
 name:                universum
-version:             1.0.0
+version:             1.0.1
 synopsis:            Custom prelude used in Serokell
 description:         Custom prelude used in Serokell
 homepage:            https://github.com/serokell/universum