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 (Pretty (..), fillSep)
import Options.Applicative.Help qualified as Help
import Prettyprinter.Util qualified as PP
import System.Exit (ExitCode, exitFailure)

import Clang.Version (clang_getClangVersion)

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 = do
    clangVersion <- Text.unpack <$> clang_getClangVersion
    let vers = List.intercalate "\n" [
            "hs-bindgen " ++ showVersion Package.version
          , "binding specification " ++ show BindingSpec.currentBindingSpecVersion
          , clangVersion
          ]
    customExecParser prefs' (opts vers)
  where
    prefs' :: ParserPrefs
    prefs' = prefs $ helpShowGlobals <> subparserInline

    opts :: String -> ParserInfo Cli
    opts vers = info (parseCli <**> simpleVersioner vers <**> helper) $
      mconcat [
          header "hs-bindgen - generate Haskell bindings from C headers"
        , footerDoc . Just . Help.vcat $ List.intersperse "" [
              envVarsFooter
            , clangArgsFooter
            , parsePredicateFooter
            , selectSliceFooter
            , exitCodeFooter
            ]
        ]

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

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

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

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

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

    -- truly unexpected exceptions
    | otherwise = do
      -- Note: displayException of internal exception; this will ensure uniform
      -- behavior while `base`/GHC figures out the ending of exceptions and
      -- backtrace story
      putStrLn $ "Uncaught exception: " ++ displayException e'
      putStrLn
        "Please report this at https://github.com/well-typed/hs-bindgen/issues"
      -- TODO: we could print exception context here, but it seems to be empty
      -- for IOExceptions anyway.
      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"
    ]

parsePredicateFooter :: Help.Doc
parsePredicateFooter = fillSep $ map pretty $ words $ unlines [
      "Parse predicates do not apply to all declarations."
    , "In particular, 'hs-bindgen' always parses declarations required for scoping;"
    , "these are, for example, type definitions."
    , "These declarations will be filtered out during selection."
    ]

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