never executed always true always false

    1 {-# OPTIONS_GHC -fno-warn-orphans #-}
    2 {-# LANGUAGE CPP #-}
    3 
    4 module Conjure.Bug
    5     ( bug
    6     , bugFail, bugFailT
    7     ) where
    8 
    9 import Conjure.Prelude
   10 import Conjure.RepositoryVersion ( repositoryVersion )
   11 import Conjure.Language.Pretty
   12 
   13 
   14 
   15 -- call this function instead of "error"
   16 bug :: HasCallStack => Doc -> a
   17 bug message = error $ unlines
   18     [ "This should never happen, sorry!"
   19     , ""
   20     , "However, it did happen, so it must be a bug. Please report it to us!"
   21     , ""
   22     , "Conjure is actively maintained, we will get back to you as soon as possible."
   23     , "You can help us by providing a minimal failing example."
   24     , ""
   25     , "Also include the repository version for this build: " ++ repositoryVersion
   26     , ""
   27     , "Issue tracker: http://github.com/conjure-cp/conjure/issues"
   28     , "", "" , renderNormal message
   29     ]
   30 
   31 bugFail :: Doc -> Either Doc a -> a
   32 bugFail loc (Left err) = bug (vcat ["BUGFAIL at" <+> loc, err])
   33 bugFail _   (Right x) = x
   34 
   35 bugFailT :: Monad m => Doc -> ExceptT m a -> m a
   36 bugFailT loc comp = do
   37     res <- runExceptT comp
   38     case res of
   39         Left err -> bug (vcat ["BUGFAIL at" <+> loc, err])
   40         Right x  -> return x
   41 
   42 instance MonadFailDoc IO where
   43     failDoc msg = bug (vcat ["IO Error", msg])