{-# LANGUAGE TemplateHaskell, MultiParamTypeClasses #-} module LLVM.Internal.Diagnostic where import LLVM.Prelude import qualified LLVM.Internal.FFI.LLVMCTypes as FFI import qualified LLVM.Internal.FFI.SMDiagnostic as FFI import Control.Exception import Foreign.Ptr import LLVM.Diagnostic import LLVM.Internal.Coding import LLVM.Internal.String () genCodingInstance [t| DiagnosticKind |] ''FFI.DiagnosticKind [ (FFI.diagnosticKindError, ErrorKind), (FFI.diagnosticKindWarning, WarningKind), (FFI.diagnosticKindNote, NoteKind) ] withSMDiagnostic :: (Ptr FFI.SMDiagnostic -> IO a) -> IO a withSMDiagnostic :: (Ptr SMDiagnostic -> IO a) -> IO a withSMDiagnostic = IO (Ptr SMDiagnostic) -> (Ptr SMDiagnostic -> IO ()) -> (Ptr SMDiagnostic -> IO a) -> IO a forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c bracket IO (Ptr SMDiagnostic) FFI.createSMDiagnostic Ptr SMDiagnostic -> IO () FFI.disposeSMDiagnostic getDiagnostic :: Ptr FFI.SMDiagnostic -> IO Diagnostic getDiagnostic :: Ptr SMDiagnostic -> IO Diagnostic getDiagnostic p :: Ptr SMDiagnostic p = do Int l <- CInt -> IO Int forall (d :: * -> *) h c. DecodeM d h c => c -> d h decodeM (CInt -> IO Int) -> IO CInt -> IO Int forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b =<< Ptr SMDiagnostic -> IO CInt FFI.getSMDiagnosticLineNo Ptr SMDiagnostic p Int c <- CInt -> IO Int forall (d :: * -> *) h c. DecodeM d h c => c -> d h decodeM (CInt -> IO Int) -> IO CInt -> IO Int forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b =<< Ptr SMDiagnostic -> IO CInt FFI.getSMDiagnosticColumnNo Ptr SMDiagnostic p DiagnosticKind k <- DiagnosticKind -> IO DiagnosticKind forall (d :: * -> *) h c. DecodeM d h c => c -> d h decodeM (DiagnosticKind -> IO DiagnosticKind) -> IO DiagnosticKind -> IO DiagnosticKind forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b =<< Ptr SMDiagnostic -> IO DiagnosticKind FFI.getSMDiagnosticKind Ptr SMDiagnostic p String f <- (Ptr CUInt -> IO CString) -> IO String forall (d :: * -> *) h c. DecodeM d h c => c -> d h decodeM ((Ptr CUInt -> IO CString) -> IO String) -> (Ptr CUInt -> IO CString) -> IO String forall a b. (a -> b) -> a -> b $ Ptr SMDiagnostic -> Ptr CUInt -> IO CString FFI.getSMDiagnosticFilename Ptr SMDiagnostic p String m <- (Ptr CUInt -> IO CString) -> IO String forall (d :: * -> *) h c. DecodeM d h c => c -> d h decodeM ((Ptr CUInt -> IO CString) -> IO String) -> (Ptr CUInt -> IO CString) -> IO String forall a b. (a -> b) -> a -> b $ Ptr SMDiagnostic -> Ptr CUInt -> IO CString FFI.getSMDiagnosticMessage Ptr SMDiagnostic p String lc <- (Ptr CUInt -> IO CString) -> IO String forall (d :: * -> *) h c. DecodeM d h c => c -> d h decodeM ((Ptr CUInt -> IO CString) -> IO String) -> (Ptr CUInt -> IO CString) -> IO String forall a b. (a -> b) -> a -> b $ Ptr SMDiagnostic -> Ptr CUInt -> IO CString FFI.getSMDiagnosticLineContents Ptr SMDiagnostic p Diagnostic -> IO Diagnostic forall (m :: * -> *) a. Monad m => a -> m a return (Diagnostic -> IO Diagnostic) -> Diagnostic -> IO Diagnostic forall a b. (a -> b) -> a -> b $ Diagnostic :: Int -> Int -> DiagnosticKind -> String -> String -> String -> Diagnostic Diagnostic { lineNumber :: Int lineNumber = Int l, columnNumber :: Int columnNumber = Int c, diagnosticKind :: DiagnosticKind diagnosticKind = DiagnosticKind k, filename :: String filename = String f, message :: String message = String m, lineContents :: String lineContents = String lc }