{-# LANGUAGE OverloadedStrings #-}

module Data.LLVM.BitCode (
    -- * Bitcode Parsing
    -- ** Without 'ParseWarning's
    parseBitCode,     parseBitCodeFromFile
  , parseBitCodeLazy, parseBitCodeLazyFromFile
    -- ** With 'ParseWarning's
  , parseBitCodeWithWarnings,     parseBitCodeFromFileWithWarnings
  , parseBitCodeLazyWithWarnings, parseBitCodeLazyFromFileWithWarnings

    -- * Re-exported
  , Error(..), formatError
  , ParseWarning(..), MetadataRecordSizeRange(..)
  , ppParseWarnings, ppParseWarning
  ) where

import Data.LLVM.BitCode.Bitstream
    (Bitstream,parseBitCodeBitstream,parseBitCodeBitstreamLazy)
import Data.LLVM.BitCode.IR (parseModule)
import Data.LLVM.BitCode.Parse (runParse,badRefError,Error(..),formatError,
                                MetadataRecordSizeRange(..),ParseWarning(..),
                                ParseState(..),ppParseWarning,ppParseWarnings)
import Text.LLVM.AST (Module)

import Control.Monad ((<=<))
import qualified Control.Exception as X
import qualified Data.ByteString as S
import qualified Data.ByteString.Lazy as L
import Data.Sequence (Seq)

-- | Parse the contents of an LLVM bitcode file as a strict 'S.ByteString'. If
-- parsing succeeds, return the parsed 'Module'. Otherwise, return an 'Error'
-- describing what went wrong.
--
-- See also 'parseBitCodeWithWarnings' for a version that also returns any
-- warnings that arise during parsing. This function will simply discard all
-- such warnings, which is why this function is deprecated.
parseBitCode :: S.ByteString -> IO (Either Error Module)
parseBitCode :: ByteString -> IO (Either Error Module)
parseBitCode =
  (Either Error (Module, Seq ParseWarning) -> Either Error Module)
-> IO (Either Error (Module, Seq ParseWarning))
-> IO (Either Error Module)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((Module, Seq ParseWarning) -> Module)
-> Either Error (Module, Seq ParseWarning) -> Either Error Module
forall a b. (a -> b) -> Either Error a -> Either Error b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Module, Seq ParseWarning) -> Module
forall a b. (a, b) -> a
fst) (IO (Either Error (Module, Seq ParseWarning))
 -> IO (Either Error Module))
-> (ByteString -> IO (Either Error (Module, Seq ParseWarning)))
-> ByteString
-> IO (Either Error Module)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either String Bitstream
-> IO (Either Error (Module, Seq ParseWarning))
parseBitstream (Either String Bitstream
 -> IO (Either Error (Module, Seq ParseWarning)))
-> (ByteString -> Either String Bitstream)
-> ByteString
-> IO (Either Error (Module, Seq ParseWarning))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String Bitstream
parseBitCodeBitstream
{-# DEPRECATED
      parseBitCode
      "Use parseBitCodeWithWarnings instead." #-}

-- | Load an LLVM bitcode file as a strict 'S.ByteString' and parse its
-- contents. If parsing succeeds, return the parsed 'Module'. Otherwise, return
-- an 'Error' describing what went wrong.
--
-- See also 'parseBitCodeFromFileWithWarnings' for a version that also returns
-- any warnings that arise during parsing. This function will simply discard all
-- such warnings, which is why this function is deprecated.
parseBitCodeFromFile :: FilePath -> IO (Either Error Module)
parseBitCodeFromFile :: String -> IO (Either Error Module)
parseBitCodeFromFile =
  ByteString -> IO (Either Error Module)
parseBitCode (ByteString -> IO (Either Error Module))
-> (String -> IO ByteString) -> String -> IO (Either Error Module)
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< String -> IO ByteString
S.readFile
{-# DEPRECATED
      parseBitCodeFromFile
      "Use parseBitCodeFromFileWithWarnings instead." #-}

-- | Parse the contents of an LLVM bitcode file as a lazy 'L.ByteString'. If
-- parsing succeeds, return the parsed 'Module'. Otherwise, return an 'Error'
-- describing what went wrong.
--
-- See also 'parseBitCodeLazyWithWarnings' for a version that also returns any
-- warnings that arise during parsing. This function will simply discard all
-- such warnings, which is why this function is deprecated.
parseBitCodeLazy :: L.ByteString -> IO (Either Error Module)
parseBitCodeLazy :: ByteString -> IO (Either Error Module)
parseBitCodeLazy =
  (Either Error (Module, Seq ParseWarning) -> Either Error Module)
-> IO (Either Error (Module, Seq ParseWarning))
-> IO (Either Error Module)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((Module, Seq ParseWarning) -> Module)
-> Either Error (Module, Seq ParseWarning) -> Either Error Module
forall a b. (a -> b) -> Either Error a -> Either Error b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Module, Seq ParseWarning) -> Module
forall a b. (a, b) -> a
fst) (IO (Either Error (Module, Seq ParseWarning))
 -> IO (Either Error Module))
-> (ByteString -> IO (Either Error (Module, Seq ParseWarning)))
-> ByteString
-> IO (Either Error Module)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either String Bitstream
-> IO (Either Error (Module, Seq ParseWarning))
parseBitstream (Either String Bitstream
 -> IO (Either Error (Module, Seq ParseWarning)))
-> (ByteString -> Either String Bitstream)
-> ByteString
-> IO (Either Error (Module, Seq ParseWarning))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String Bitstream
parseBitCodeBitstreamLazy
{-# DEPRECATED
      parseBitCodeLazy
      "Use parseBitCodeLazyWithWarnings instead." #-}

-- | Load an LLVM bitcode file as a lazy 'L.ByteString' and parse its contents.
-- If parsing succeeds, return the parsed 'Module'. Otherwise, return an 'Error'
-- describing what went wrong in a 'Left' value.
--
-- See also 'parseBitCodeLazyFromFileWithWarnings' for a version that also
-- returns any warnings that arise during parsing. This function will simply
-- discard all such warnings, which is why this function is deprecated.
parseBitCodeLazyFromFile :: FilePath -> IO (Either Error Module)
parseBitCodeLazyFromFile :: String -> IO (Either Error Module)
parseBitCodeLazyFromFile =
  ByteString -> IO (Either Error Module)
parseBitCodeLazy (ByteString -> IO (Either Error Module))
-> (String -> IO ByteString) -> String -> IO (Either Error Module)
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< String -> IO ByteString
L.readFile
{-# DEPRECATED
      parseBitCodeLazyFromFile
      "Use parseBitCodeLazyFromFileWithWarnings instead." #-}

-- | Parse the contents of an LLVM bitcode file as a strict 'S.ByteString'. If
-- parsing succeeds, return the parsed 'Module' and any 'ParseWarning's that
-- were emitted. Otherwise, return an 'Error' describing what went wrong.
--
-- See also 'parseBitCode' for a version that discards any warnings that arise
-- during parsing.
parseBitCodeWithWarnings ::
  S.ByteString -> IO (Either Error (Module, Seq ParseWarning))
parseBitCodeWithWarnings :: ByteString -> IO (Either Error (Module, Seq ParseWarning))
parseBitCodeWithWarnings =
  Either String Bitstream
-> IO (Either Error (Module, Seq ParseWarning))
parseBitstream (Either String Bitstream
 -> IO (Either Error (Module, Seq ParseWarning)))
-> (ByteString -> Either String Bitstream)
-> ByteString
-> IO (Either Error (Module, Seq ParseWarning))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String Bitstream
parseBitCodeBitstream

-- | Load an LLVM bitcode file as a strict 'S.ByteString' and parse its
-- contents. If parsing succeeds, return the parsed 'Module' and any
-- 'ParseWarnings' that were emitted. Otherwise, return an 'Error' describing
-- what went wrong.
--
-- See also 'parseBitCodeFromFile' for a version that discards any warnings that
-- arise during parsing.
parseBitCodeFromFileWithWarnings ::
  FilePath -> IO (Either Error (Module, Seq ParseWarning))
parseBitCodeFromFileWithWarnings :: String -> IO (Either Error (Module, Seq ParseWarning))
parseBitCodeFromFileWithWarnings =
  ByteString -> IO (Either Error (Module, Seq ParseWarning))
parseBitCodeWithWarnings (ByteString -> IO (Either Error (Module, Seq ParseWarning)))
-> (String -> IO ByteString)
-> String
-> IO (Either Error (Module, Seq ParseWarning))
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< String -> IO ByteString
S.readFile

-- | Parse the contents of an LLVM bitcode file as a lazy 'L.ByteString'. If
-- parsing succeeds, return the parsed 'Module' and any 'ParseWarning's that
-- were emitted. Otherwise, return an 'Error' describing what went wrong.
--
-- See also 'parseBitCodeLazy' for a version that discards any warnings that
-- arise during parsing.
parseBitCodeLazyWithWarnings ::
  L.ByteString -> IO (Either Error (Module, Seq ParseWarning))
parseBitCodeLazyWithWarnings :: ByteString -> IO (Either Error (Module, Seq ParseWarning))
parseBitCodeLazyWithWarnings =
  Either String Bitstream
-> IO (Either Error (Module, Seq ParseWarning))
parseBitstream (Either String Bitstream
 -> IO (Either Error (Module, Seq ParseWarning)))
-> (ByteString -> Either String Bitstream)
-> ByteString
-> IO (Either Error (Module, Seq ParseWarning))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String Bitstream
parseBitCodeBitstreamLazy

-- | Load an LLVM bitcode file as a lazy 'L.ByteString' and parse its contents.
-- If parsing succeeds, return the parsed 'Module' and any 'ParseWarnings' that
-- were emitted. Otherwise, return an 'Error' describing what went wrong.
--
-- See also 'parseBitCodeLazyFromFile' for a version that discards any warnings
-- that arise during parsing.
parseBitCodeLazyFromFileWithWarnings ::
  FilePath -> IO (Either Error (Module, Seq ParseWarning))
parseBitCodeLazyFromFileWithWarnings :: String -> IO (Either Error (Module, Seq ParseWarning))
parseBitCodeLazyFromFileWithWarnings =
  ByteString -> IO (Either Error (Module, Seq ParseWarning))
parseBitCodeLazyWithWarnings (ByteString -> IO (Either Error (Module, Seq ParseWarning)))
-> (String -> IO ByteString)
-> String
-> IO (Either Error (Module, Seq ParseWarning))
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< String -> IO ByteString
L.readFile

parseBitstream ::
  Either String Bitstream -> IO (Either Error (Module, Seq ParseWarning))
parseBitstream :: Either String Bitstream
-> IO (Either Error (Module, Seq ParseWarning))
parseBitstream Either String Bitstream
e = case Either String Bitstream
e of
  Left String
err   -> [String] -> String -> IO (Either Error (Module, Seq ParseWarning))
forall {m :: * -> *} {b}.
Monad m =>
[String] -> String -> m (Either Error b)
mkError [String
"Bitstream"] String
err
  Right Bitstream
bits -> do
    Either Error (Module, ParseState)
res <- (BadForwardRef -> IO (Either Error (Module, ParseState)))
-> IO (Either Error (Module, ParseState))
-> IO (Either Error (Module, ParseState))
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
X.handle (Either Error (Module, ParseState)
-> IO (Either Error (Module, ParseState))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Error (Module, ParseState)
 -> IO (Either Error (Module, ParseState)))
-> (BadForwardRef -> Either Error (Module, ParseState))
-> BadForwardRef
-> IO (Either Error (Module, ParseState))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Error -> Either Error (Module, ParseState)
forall a b. a -> Either a b
Left (Error -> Either Error (Module, ParseState))
-> (BadForwardRef -> Error)
-> BadForwardRef
-> Either Error (Module, ParseState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BadForwardRef -> Error
badRefError)
                    (Either Error (Module, ParseState)
-> IO (Either Error (Module, ParseState))
forall a. a -> IO a
X.evaluate (Parse Module -> Either Error (Module, ParseState)
forall a. Parse a -> Either Error (a, ParseState)
runParse (Bitstream -> Parse Module
parseModule Bitstream
bits)))
    Either Error (Module, Seq ParseWarning)
-> IO (Either Error (Module, Seq ParseWarning))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Error (Module, Seq ParseWarning)
 -> IO (Either Error (Module, Seq ParseWarning)))
-> Either Error (Module, Seq ParseWarning)
-> IO (Either Error (Module, Seq ParseWarning))
forall a b. (a -> b) -> a -> b
$ ((Module, ParseState) -> (Module, Seq ParseWarning))
-> Either Error (Module, ParseState)
-> Either Error (Module, Seq ParseWarning)
forall a b. (a -> b) -> Either Error a -> Either Error b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Module
m, ParseState
st) -> (Module
m, ParseState -> Seq ParseWarning
psWarnings ParseState
st)) Either Error (Module, ParseState)
res
  where
  mkError :: [String] -> String -> m (Either Error b)
mkError [String]
cxt String
msg = Either Error b -> m (Either Error b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Error b -> m (Either Error b))
-> Either Error b -> m (Either Error b)
forall a b. (a -> b) -> a -> b
$ Error -> Either Error b
forall a b. a -> Either a b
Left Error
    { errMessage :: String
errMessage = String
msg
    , errContext :: [String]
errContext = [String]
cxt
    }