{-# 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
   }