    {-# LANGUAGE CPP #-}
    {-# LANGUAGE QuasiQuotes #-}

    module Clash.GHC.Util
      ( module Clash.GHC.Util
    #if MIN_VERSION_ghc(9,2,0)
      , module X
    #endif
      )
    where

    #if MIN_VERSION_ghc(9,8,0)
    import GHC.Driver.Errors.Types (GhcMessage(GhcUnknownMessage))
    import GHC.Utils.Outputable as X (showPprUnsafe, showSDocUnsafe)
    import GHC.Utils.Outputable (SDoc, neverQualify)
    import GHC.Utils.Error (mkErrorMsgEnvelope, mkPlainError)
    import GHC.Plugins
      (DynFlags, SourceError, ($$), blankLine, empty, isGoodSrcSpan, liftIO,
       noSrcSpan, text, throwOneError)
    import GHC.Types.Error (mkSimpleUnknownDiagnostic)
    #elif MIN_VERSION_ghc(9,6,0)
    import GHC.Driver.Errors.Types (GhcMessage(GhcUnknownMessage))
    import GHC.Utils.Outputable as X (showPprUnsafe, showSDocUnsafe)
    import GHC.Utils.Outputable (SDoc, neverQualify)
    import GHC.Utils.Error (mkErrorMsgEnvelope, mkPlainError)
    import GHC.Plugins
      (DynFlags, SourceError, ($$), blankLine, empty, isGoodSrcSpan, liftIO,
       noSrcSpan, text, throwOneError)
    import GHC.Types.Error (UnknownDiagnostic(..))
    #elif MIN_VERSION_ghc(9,4,0)
    import GHC.Driver.Errors.Types (GhcMessage(GhcUnknownMessage))
    import GHC.Utils.Outputable as X (showPprUnsafe, showSDocUnsafe)
    import GHC.Utils.Outputable (SDoc, neverQualify)
    import GHC.Utils.Error (mkErrorMsgEnvelope, mkPlainError)
    import GHC.Plugins
      (DynFlags, SourceError, ($$), blankLine, empty, isGoodSrcSpan, liftIO,
       noSrcSpan, text, throwOneError)
    #elif MIN_VERSION_ghc(9,2,0)
    import GHC.Utils.Outputable as X (showPprUnsafe, showSDocUnsafe)
    import GHC.Utils.Outputable (SDoc, neverQualify)
    import GHC.Utils.Error (mkMsgEnvelope)
    import GHC.Plugins
      (DynFlags, SourceError, ($$), blankLine, empty, isGoodSrcSpan, liftIO,
       noSrcSpan, text, throwOneError)
    #elif MIN_VERSION_ghc(9,0,0)
    import GHC.Driver.Session (unsafeGlobalDynFlags)
    import GHC.Utils.Outputable (Outputable, SDoc, showPpr, showSDoc)
    import GHC.Utils.Error (mkPlainErrMsg)
    import GHC.Plugins
      (DynFlags, SourceError, ($$), blankLine, empty, isGoodSrcSpan, liftIO,
       noSrcSpan, text, throwOneError)
    #else
    import DynFlags           (unsafeGlobalDynFlags)
    import Outputable         (Outputable, SDoc, showPpr, showSDoc)
    import ErrUtils           (mkPlainErrMsg)
    import GhcPlugins         (DynFlags, SourceError, ($$), blankLine, empty, isGoodSrcSpan, liftIO, noSrcSpan, text, throwOneError)
    #endif
    import GHC                (GhcMonad(..), printException)

    import Control.Exception  (Exception(..), ErrorCall(..))
    import GHC.Exception      (SomeException)
    import System.Exit        (ExitCode(ExitFailure), exitWith)

    import Clash.Util         (ClashException(..))
    import Clash.Util.Interpolate (i)
    import Clash.Driver.Types (ClashOpts(..))

    -- | Like 'lines', but returning a horizontally spaced SDoc instead of a list:
    --
    -- >>> textLines "a\nb"
    -- a $$ b
    textLines :: String -> SDoc
    textLines :: String -> SDoc
    textLines String
    s = (SDoc -> SDoc -> SDoc) -> [SDoc] -> SDoc
    forall a. (a -> a -> a) -> [a] -> a
    forall (t :: Type -> Type) a.
    Foldable t =>
    (a -> a -> a) -> t a -> a
    foldl1 SDoc -> SDoc -> SDoc
    ($$) ((String -> SDoc) -> [String] -> [SDoc]
    forall a b. (a -> b) -> [a] -> [b]
    map String -> SDoc
    text (String -> [String]
    lines String
    s))

    handleClashException
      :: GhcMonad m
      => DynFlags
      -> ClashOpts
      -> SomeException
      -> m a
    #if MIN_VERSION_ghc(9,2,0)
    handleClashException :: forall (m :: Type -> Type) a.
    GhcMonad m =>
    DynFlags -> ClashOpts -> SomeException -> m a
    handleClashException DynFlags
    _df ClashOpts
    opts SomeException
    e = case SomeException -> Maybe ClashException
    forall e. Exception e => SomeException -> Maybe e
    fromException SomeException
    e of
    #else
    handleClashException df opts e = case fromException e of
    #endif
      Just (ClashException SrcSpan
    sp String
    s Maybe String
    eM) -> do
        let srcInfo' :: SDoc
    srcInfo' | SrcSpan -> Bool
    isGoodSrcSpan SrcSpan
    sp = SDoc
    srcInfo
                     | Bool
    otherwise = SDoc
    empty
        MsgEnvelope GhcMessage -> m a
    forall (io :: Type -> Type) a.
    MonadIO io =>
    MsgEnvelope GhcMessage -> io a
    throwOneError
    #if MIN_VERSION_ghc(9,8,0)
          (mkErrorMsgEnvelope sp neverQualify $ GhcUnknownMessage $ mkSimpleUnknownDiagnostic $ mkPlainError []
    #elif MIN_VERSION_ghc(9,6,0)
          (mkErrorMsgEnvelope sp neverQualify $ GhcUnknownMessage $ UnknownDiagnostic $ mkPlainError []
    #elif MIN_VERSION_ghc(9,4,0)
          (SrcSpan -> PrintUnqualified -> GhcMessage -> MsgEnvelope GhcMessage
    forall e.
    Diagnostic e =>
    SrcSpan -> PrintUnqualified -> e -> MsgEnvelope e
    mkErrorMsgEnvelope SrcSpan
    sp PrintUnqualified
    neverQualify (GhcMessage -> MsgEnvelope GhcMessage)
    -> GhcMessage -> MsgEnvelope GhcMessage
    forall a b. (a -> b) -> a -> b
    $ DiagnosticMessage -> GhcMessage
    forall a. (Diagnostic a, Typeable a) => a -> GhcMessage
    GhcUnknownMessage (DiagnosticMessage -> GhcMessage)
    -> DiagnosticMessage -> GhcMessage
    forall a b. (a -> b) -> a -> b
    $ [GhcHint] -> SDoc -> DiagnosticMessage
    mkPlainError []
    #elif MIN_VERSION_ghc(9,2,0)
          (mkMsgEnvelope sp neverQualify
    #else
          (mkPlainErrMsg df sp
    #endif
            (SDoc
    blankLine SDoc -> SDoc -> SDoc
    $$ String -> SDoc
    textLines String
    s SDoc -> SDoc -> SDoc
    $$ SDoc
    blankLine SDoc -> SDoc -> SDoc
    $$ SDoc
    srcInfo' SDoc -> SDoc -> SDoc
    $$ Bool -> Maybe String -> SDoc
    showExtra (ClashOpts -> Bool
    opt_errorExtra ClashOpts
    opts) Maybe String
    eM))
      Maybe ClashException
    _ -> case SomeException -> Maybe ErrorCall
    forall e. Exception e => SomeException -> Maybe e
    fromException SomeException
    e of
        Just (ErrorCallWithLocation String
    _ String
    _) ->
          MsgEnvelope GhcMessage -> m a
    forall (io :: Type -> Type) a.
    MonadIO io =>
    MsgEnvelope GhcMessage -> io a
    throwOneError
    #if MIN_VERSION_ghc(9,8,0)
            (mkErrorMsgEnvelope noSrcSpan neverQualify $ GhcUnknownMessage $ mkSimpleUnknownDiagnostic $ mkPlainError []
    #elif MIN_VERSION_ghc(9,6,0)
            (mkErrorMsgEnvelope noSrcSpan neverQualify $ GhcUnknownMessage $ UnknownDiagnostic $ mkPlainError []
    #elif MIN_VERSION_ghc(9,4,0)
            (SrcSpan -> PrintUnqualified -> GhcMessage -> MsgEnvelope GhcMessage
    forall e.
    Diagnostic e =>
    SrcSpan -> PrintUnqualified -> e -> MsgEnvelope e
    mkErrorMsgEnvelope SrcSpan
    noSrcSpan PrintUnqualified
    neverQualify (GhcMessage -> MsgEnvelope GhcMessage)
    -> GhcMessage -> MsgEnvelope GhcMessage
    forall a b. (a -> b) -> a -> b
    $ DiagnosticMessage -> GhcMessage
    forall a. (Diagnostic a, Typeable a) => a -> GhcMessage
    GhcUnknownMessage (DiagnosticMessage -> GhcMessage)
    -> DiagnosticMessage -> GhcMessage
    forall a b. (a -> b) -> a -> b
    $ [GhcHint] -> SDoc -> DiagnosticMessage
    mkPlainError []
    #elif MIN_VERSION_ghc(9,2,0)
            (mkMsgEnvelope noSrcSpan neverQualify
    #else
            (mkPlainErrMsg df noSrcSpan
    #endif
            (String -> SDoc
    text String
    "Clash error call:" SDoc -> SDoc -> SDoc
    $$ String -> SDoc
    textLines (SomeException -> String
    forall a. Show a => a -> String
    show SomeException
    e)))
        Maybe ErrorCall
    _ -> case SomeException -> Maybe SourceError
    forall e. Exception e => SomeException -> Maybe e
    fromException SomeException
    e of
          Just (SourceError
    e' :: SourceError) -> do
            SourceError -> m ()
    forall (m :: Type -> Type).
    (HasLogger m, MonadIO m, HasDynFlags m) =>
    SourceError -> m ()
    GHC.printException SourceError
    e'
            IO a -> m a
    forall a. IO a -> m a
    forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
    liftIO (IO a -> m a) -> IO a -> m a
    forall a b. (a -> b) -> a -> b
    $ ExitCode -> IO a
    forall a. ExitCode -> IO a
    exitWith (Int -> ExitCode
    ExitFailure Int
    1)
          Maybe SourceError
    _ -> MsgEnvelope GhcMessage -> m a
    forall (io :: Type -> Type) a.
    MonadIO io =>
    MsgEnvelope GhcMessage -> io a
    throwOneError
    #if MIN_VERSION_ghc(9,8,0)
                  (mkErrorMsgEnvelope noSrcSpan neverQualify $ GhcUnknownMessage $ mkSimpleUnknownDiagnostic $ mkPlainError []
    #elif MIN_VERSION_ghc(9,6,0)
                  (mkErrorMsgEnvelope noSrcSpan neverQualify $ GhcUnknownMessage $ UnknownDiagnostic $ mkPlainError []
    #elif MIN_VERSION_ghc(9,4,0)
                  (SrcSpan -> PrintUnqualified -> GhcMessage -> MsgEnvelope GhcMessage
    forall e.
    Diagnostic e =>
    SrcSpan -> PrintUnqualified -> e -> MsgEnvelope e
    mkErrorMsgEnvelope SrcSpan
    noSrcSpan PrintUnqualified
    neverQualify (GhcMessage -> MsgEnvelope GhcMessage)
    -> GhcMessage -> MsgEnvelope GhcMessage
    forall a b. (a -> b) -> a -> b
    $ DiagnosticMessage -> GhcMessage
    forall a. (Diagnostic a, Typeable a) => a -> GhcMessage
    GhcUnknownMessage  (DiagnosticMessage -> GhcMessage)
    -> DiagnosticMessage -> GhcMessage
    forall a b. (a -> b) -> a -> b
    $ [GhcHint] -> SDoc -> DiagnosticMessage
    mkPlainError []
    #elif MIN_VERSION_ghc(9,2,0)
                  (mkMsgEnvelope noSrcSpan neverQualify
    #else
                  (mkPlainErrMsg df noSrcSpan
    #endif
                  (String -> SDoc
    text String
    "Other error:" SDoc -> SDoc -> SDoc
    $$ String -> SDoc
    textLines (SomeException -> String
    forall e. Exception e => e -> String
    displayException SomeException
    e)))
      where
        srcInfo :: SDoc
    srcInfo = String -> SDoc
    textLines [i|
          The source location of the error is not exact, only indicative, as it
          is acquired after optimizations. The actual location of the error can be
          in a function that is inlined. To prevent inlining of those functions,
          annotate them with a NOINLINE pragma.
        |]

        showExtra :: Bool -> Maybe String -> SDoc
    showExtra Bool
    False (Just String
    _)   =
          SDoc
    blankLine SDoc -> SDoc -> SDoc
    $$
          String -> SDoc
    text String
    "This error contains additional information, rerun with '-fclash-error-extra' to show this information."
        showExtra Bool
    True  (Just String
    msg) =
          SDoc
    blankLine SDoc -> SDoc -> SDoc
    $$
          String -> SDoc
    text String
    "Additional information:" SDoc -> SDoc -> SDoc
    $$ SDoc
    blankLine SDoc -> SDoc -> SDoc
    $$
          String -> SDoc
    textLines String
    msg
        showExtra Bool
    _ Maybe String
    _ = SDoc
    empty

    #if !MIN_VERSION_ghc(9,2,0)
    showPprUnsafe :: Outputable a => a -> String
    showPprUnsafe = showPpr unsafeGlobalDynFlags

    showSDocUnsafe :: SDoc -> String
    showSDocUnsafe = showSDoc unsafeGlobalDynFlags
    #endif