hs-bindgen-1.0.0.0: app/hs-bindgen-cli.hs

module Main (main) where

import Control.Exception (Exception (..), SomeException (..), handle)
import Data.List qualified as List
import Data.Text qualified as Text
import Data.Version (showVersion)
import Options.Applicative
import Options.Applicative.Help qualified as Help
import Prettyprinter.Util qualified as PP
import System.Exit (ExitCode, exitFailure)

import Clang.Version (compileTimeClangVersionString, runtimeClangVersionString)

import HsBindgen.App
import HsBindgen.BindingSpec qualified as BindingSpec
import HsBindgen.Cli qualified as Cli
import HsBindgen.Errors
import HsBindgen.Imports

import Paths_hs_bindgen qualified as Package

{-------------------------------------------------------------------------------
  CLI parser
-------------------------------------------------------------------------------}

data Cli = Cli {
      globalOpts :: GlobalOpts
    , cmd        :: Cli.Cmd
    }

parseCli :: Parser Cli
parseCli =
    Cli
      <$> parseGlobalOpts
      <*> Cli.parseCmd

execCliParser :: IO Cli
execCliParser = customExecParser prefs' opts
  where
    prefs' :: ParserPrefs
    -- 'multiSuffix' marks repeatable options and arguments in the usage
    -- synopsis; without it, @(HEADER | --hash-define NAME VALUE)@ reads as an
    -- exclusive choice of one.
    prefs' = prefs $ multiSuffix "..." <> helpShowGlobals <> subparserInline

    opts :: ParserInfo Cli
    opts = info (parseCli <**> simpleVersioner vers <**> helper) $
      mconcat [
          progDesc "Generate Haskell bindings from C headers"
        , failureCode 2
        , footerDoc . Just . Help.vcat $ List.intersperse "" [
              envVarsFooter
            , clangArgsFooter
            , selectSliceFooter
            , exitCodeFooter
            ]
        ]

    vers :: String
    vers = List.intercalate "\n" [
        "hs-bindgen " ++ showVersion Package.version
      , "binding specification " ++ show BindingSpec.currentBindingSpecVersion
      , "clang compile time version: "
          ++ Text.unpack compileTimeClangVersionString
      , "clang runtime version:      " ++ Text.unpack runtimeClangVersionString
      ]

{-------------------------------------------------------------------------------
  Execution
-------------------------------------------------------------------------------}

main :: IO ()
main = handle exceptionHandler $ do
    cli <- execCliParser
    Cli.exec cli.globalOpts cli.cmd

{-------------------------------------------------------------------------------
  Auxiliary functions: exception handling
-------------------------------------------------------------------------------}

exceptionHandler :: SomeException -> IO ()
exceptionHandler e
    | Just _ <- fromException e :: Maybe ExitCode
    = throwIO e

    | Just (HsBindgenException e'') <- fromException e = do
      putStrLn $ displayException e''
      exitFailure

    -- truly unexpected exceptions
    | otherwise = do
      putStrLn $ "Uncaught exception: " ++ displayException e
      putStrLn
        "Please report this at https://github.com/well-typed/hs-bindgen/issues"
      exitFailure

{-------------------------------------------------------------------------------
  Auxiliary functions: footers
-------------------------------------------------------------------------------}

envVarsFooter :: Help.Doc
envVarsFooter = Help.vcat [
      "Environment variables:"
    , li $ "BINDGEN_EXTRA_CLANG_ARGS: Arguments passed to Clang"
    ]

clangArgsFooter :: Help.Doc
clangArgsFooter = Help.vcat [
      "Options passed to Clang have the following order:"
    , "  1. --clang-option-before options"
    , "  2. Clang options managed by hs-bindgen (e.g., -I options)"
    , "  3. --clang-option options"
    , "  4. BINDGEN_EXTRA_CLANG_ARGS options"
    , "  5. --clang-option-after options"
    , "  6. Builtin include directory options"
    ]

selectSliceFooter :: Help.Doc
selectSliceFooter = Help.vcat [
      "Selection and program slicing:"
    , li $ mconcat [
          "Program slicing disabled (default):"
        , " only select declarations according to the selection predicate"
        ]
    , li $ mconcat [
          "Program slicing enabled ('--enable-program-slicing'):"
        , " select declarations using the selection predicate,"
        , " and also select their transitive dependencies;"
        , " program slicing can cause declarations to be included"
        , " even if they are explicitly deselected by a selection predicate"
        ]
    ]

exitCodeFooter :: Help.Doc
exitCodeFooter = Help.vcat [
      "Exit codes:"
    , "  0: Success"
    , "  1: Other errors (panics)"
    , "  2: Invocation of `libclang` has failed"
    , "  3: An `hs-bindgen`-specific error has happened"
    ]

li :: Text -> Help.Doc
li = ("  -" Help.<+>) . Help.align . PP.reflow