module Lang.Crucible.LLVM.MalformedLLVMModule where

import qualified Control.Exception as X
import           Data.Void

import           Prettyprinter

------------------------------------------------------------------------
-- MalformedLLVMModule

-- | This datatype represents an exception that occurs when an LLVM module
--   is broken in some way; for example, if the types of expressions do
--   not match up in some way.  The first argument is a short description
--   of the error, and the remaining arguments are any additional details
--   describing the error.
data MalformedLLVMModule
  = MalformedLLVMModule (Doc Void) [Doc Void]

instance X.Exception MalformedLLVMModule

instance Show MalformedLLVMModule where
  show :: MalformedLLVMModule -> String
show = Doc Void -> String
forall a. Show a => a -> String
show (Doc Void -> String)
-> (MalformedLLVMModule -> Doc Void)
-> MalformedLLVMModule
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MalformedLLVMModule -> Doc Void
renderMalformedLLVMModule

-- Throw a @MalformedLLVMModule@ exception
malformedLLVMModule :: Doc Void -> [Doc Void] -> a
malformedLLVMModule :: forall a. Doc Void -> [Doc Void] -> a
malformedLLVMModule Doc Void
short [Doc Void]
details = MalformedLLVMModule -> a
forall a e. Exception e => e -> a
X.throw (Doc Void -> [Doc Void] -> MalformedLLVMModule
MalformedLLVMModule Doc Void
short [Doc Void]
details)

-- Render a @MalformedLLVMModule@ exception as a pretty printer document
renderMalformedLLVMModule :: MalformedLLVMModule -> Doc Void
renderMalformedLLVMModule :: MalformedLLVMModule -> Doc Void
renderMalformedLLVMModule (MalformedLLVMModule Doc Void
short [Doc Void]
details) =
  [Doc Void] -> Doc Void
forall ann. [Doc ann] -> Doc ann
vcat [Doc Void
short, Int -> Doc Void -> Doc Void
forall ann. Int -> Doc ann -> Doc ann
indent Int
2 ([Doc Void] -> Doc Void
forall ann. [Doc ann] -> Doc ann
vcat [Doc Void]
details)]