    {-# LANGUAGE QuasiQuotes #-}

    -- | This module defines a generator for @getopt_long@ based command
    -- line argument parsing.  Each option is associated with arbitrary C
    -- code that will perform side effects, usually by setting some global
    -- variables.
    module Futhark.CodeGen.Backends.GenericC.Options
      ( Option (..),
        OptionArgument (..),
        generateOptionParser,
      )
    where

    import Data.Char (isSpace)
    import Data.Function ((&))
    import Data.List (intercalate)
    import Data.Maybe
    import Language.C.Quote.C qualified as C
    import Language.C.Syntax qualified as C

    -- | Specification if a single command line option.  The option must
    -- have a long name, and may also have a short name.
    --
    -- In the action, the option argument (if any) is stored as in the
    -- @char*@-typed variable @optarg@.
    data Option = Option
      { Option -> [Char]
    optionLongName :: String,
        Option -> Maybe Char
    optionShortName :: Maybe Char,
        Option -> OptionArgument
    optionArgument :: OptionArgument,
        Option -> [Char]
    optionDescription :: String,
        Option -> Stm
    optionAction :: C.Stm
      }

    -- | Whether an option accepts an argument.
    data OptionArgument
      = NoArgument
      | -- | The 'String' becomes part of the help pretty.
        RequiredArgument String
      | OptionalArgument

    -- | Generate an option parser as a function of the given name, that
    -- accepts the given command line options.  The result is a function
    -- that should be called with @argc@ and @argv@.  The function returns
    -- the number of @argv@ elements that have been processed.
    --
    -- If option parsing fails for any reason, the entire process will
    -- terminate with error code 1.
    generateOptionParser :: String -> [Option] -> C.Func
    generateOptionParser :: [Char] -> [Option] -> Func
    generateOptionParser [Char]
    fname [Option]
    options =
      [C.cfun|int $id:fname(struct futhark_context_config *cfg, int argc, char* const argv[]) {
           int $id:chosen_option;

           static struct option long_options[] = { $inits:option_fields, {0, 0, 0, 0} };

           static char* option_descriptions = $string:option_descriptions;

           while (($id:chosen_option =
                     getopt_long(argc, argv, $string:option_string, long_options, NULL)) != -1) {
             $stms:option_applications
             if ($id:chosen_option == ':') {
               futhark_panic(-1, "Missing argument for option %s\n", argv[optind-1]);
             }
             if ($id:chosen_option == '?') {
               fprintf(stderr, "Usage: %s [OPTIONS]...\nOptions:\n\n%s\n", fut_progname, $string:option_descriptions);
               futhark_panic(1, "Unknown option: %s\n", argv[optind-1]);
             }
           }
           return optind;
         }
             |]
      where
        chosen_option :: [Char]
    chosen_option = [Char]
    "ch"
        option_string :: [Char]
    option_string = Char
    ':' Char -> [Char] -> [Char]
    forall a. a -> [a] -> [a]
    : [Option] -> [Char]
    optionString [Option]
    options
        option_applications :: [Stm]
    option_applications = [Char] -> [Option] -> [Stm]
    optionApplications [Char]
    chosen_option [Option]
    options
        option_fields :: [Initializer]
    option_fields = [Option] -> [Initializer]
    optionFields [Option]
    options
        option_descriptions :: [Char]
    option_descriptions = [Option] -> [Char]
    describeOptions [Option]
    options

    trim :: String -> String
    trim :: [Char] -> [Char]
    trim = [Char] -> [Char]
    f ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Char] -> [Char]
    f
      where
        f :: [Char] -> [Char]
    f = [Char] -> [Char]
    forall a. [a] -> [a]
    reverse ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Char -> Bool) -> [Char] -> [Char]
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile Char -> Bool
    isSpace

    describeOptions :: [Option] -> String
    describeOptions :: [Option] -> [Char]
    describeOptions [Option]
    opts =
      let
       in [[Char]] -> [Char]
    unlines ([[Char]] -> [Char]) -> [[Char]] -> [Char]
    forall a b. (a -> b) -> a -> b
    $ ((Option, [Char]) -> [Char]) -> [(Option, [Char])] -> [[Char]]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (Option, [Char]) -> [Char]
    extendDesc [(Option, [Char])]
    with_short_descs
      where
        with_short_descs :: [(Option, [Char])]
    with_short_descs = (Option -> (Option, [Char])) -> [Option] -> [(Option, [Char])]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (\Option
    opt -> (Option
    opt, Option -> [Char]
    shortDesc Option
    opt)) [Option]
    opts
        max_short_desc_len :: Int
    max_short_desc_len = [Int] -> Int
    forall a. Ord a => [a] -> a
    forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
    maximum ([Int] -> Int) -> [Int] -> Int
    forall a b. (a -> b) -> a -> b
    $ ((Option, [Char]) -> Int) -> [(Option, [Char])] -> [Int]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ([Char] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length ([Char] -> Int)
    -> ((Option, [Char]) -> [Char]) -> (Option, [Char]) -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Option, [Char]) -> [Char]
    forall a b. (a, b) -> b
    snd) [(Option, [Char])]
    with_short_descs
        extendDesc :: (Option, String) -> String
        extendDesc :: (Option, [Char]) -> [Char]
    extendDesc (Option
    opt, [Char]
    short) =
          Int -> [Char] -> [Char]
    forall a. Int -> [a] -> [a]
    take (Int
    max_short_desc_len Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1) ([Char]
    short [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Char -> [Char]
    forall a. a -> [a]
    repeat Char
    ' ')
            [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ ( Option -> [Char]
    optionDescription Option
    opt
                   [Char] -> ([Char] -> [[Char]]) -> [[Char]]
    forall a b. a -> (a -> b) -> b
    & [Char] -> [[Char]]
    lines
                   [[Char]] -> ([[Char]] -> [[Char]]) -> [[Char]]
    forall a b. a -> (a -> b) -> b
    & ([Char] -> [Char]) -> [[Char]] -> [[Char]]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap [Char] -> [Char]
    trim
                   [[Char]] -> ([[Char]] -> [Char]) -> [Char]
    forall a b. a -> (a -> b) -> b
    & [Char] -> [[Char]] -> [Char]
    forall a. [a] -> [[a]] -> [a]
    intercalate (Char
    '\n' Char -> [Char] -> [Char]
    forall a. a -> [a] -> [a]
    : Int -> Char -> [Char]
    forall a. Int -> a -> [a]
    replicate (Int
    max_short_desc_len Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1) Char
    ' ')
               )
        shortDesc :: Option -> String
        shortDesc :: Option -> [Char]
    shortDesc Option
    opt =
          [[Char]] -> [Char]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat
            [ [Char]
    "  ",
              [Char] -> (Char -> [Char]) -> Maybe Char -> [Char]
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe [Char]
    "" (\Char
    c -> [Char]
    "-" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char
    c] [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "/") (Maybe Char -> [Char]) -> Maybe Char -> [Char]
    forall a b. (a -> b) -> a -> b
    $ Option -> Maybe Char
    optionShortName Option
    opt,
              [Char]
    "--" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Option -> [Char]
    optionLongName Option
    opt,
              case Option -> OptionArgument
    optionArgument Option
    opt of
                OptionArgument
    NoArgument -> [Char]
    ""
                RequiredArgument [Char]
    what -> [Char]
    " " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    what
                OptionArgument
    OptionalArgument -> [Char]
    " [ARG]"
            ]

    optionFields :: [Option] -> [C.Initializer]
    optionFields :: [Option] -> [Initializer]
    optionFields = (Int -> Option -> Initializer)
    -> [Int] -> [Option] -> [Initializer]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith Int -> Option -> Initializer
    forall {a}. (Show a, Integral a) => a -> Option -> Initializer
    field [(Int
    1 :: Int) ..]
      where
        field :: a -> Option -> Initializer
    field a
    i Option
    option =
          [C.cinit| { $string:(optionLongName option), $id:arg, NULL, $int:i } |]
          where
            arg :: [Char]
    arg = case Option -> OptionArgument
    optionArgument Option
    option of
              OptionArgument
    NoArgument -> [Char]
    "no_argument" :: String
              RequiredArgument [Char]
    _ -> [Char]
    "required_argument"
              OptionArgument
    OptionalArgument -> [Char]
    "optional_argument"

    optionApplications :: String -> [Option] -> [C.Stm]
    optionApplications :: [Char] -> [Option] -> [Stm]
    optionApplications [Char]
    chosen_option = (Int -> Option -> Stm) -> [Int] -> [Option] -> [Stm]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith Int -> Option -> Stm
    forall {p}. (Show p, Integral p) => p -> Option -> Stm
    check [(Int
    1 :: Int) ..]
      where
        check :: p -> Option -> Stm
    check p
    i Option
    option =
          [C.cstm|if ($exp:cond) $stm:(optionAction option)|]
          where
            cond :: Exp
    cond = case Option -> Maybe Char
    optionShortName Option
    option of
              Maybe Char
    Nothing -> [C.cexp|$id:chosen_option == $int:i|]
              Just Char
    c ->
                [C.cexp|($id:chosen_option == $int:i) ||
                                                ($id:chosen_option == $char:c)|]

    optionString :: [Option] -> String
    optionString :: [Option] -> [Char]
    optionString = [[Char]] -> [Char]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat ([[Char]] -> [Char])
    -> ([Option] -> [[Char]]) -> [Option] -> [Char]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Option -> Maybe [Char]) -> [Option] -> [[Char]]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe Option -> Maybe [Char]
    optionStringChunk
      where
        optionStringChunk :: Option -> Maybe [Char]
    optionStringChunk Option
    option = do
          short <- Option -> Maybe Char
    optionShortName Option
    option
          pure $
            short
              : case optionArgument option of
                OptionArgument
    NoArgument -> [Char]
    ""
                RequiredArgument [Char]
    _ -> [Char]
    ":"
                OptionArgument
    OptionalArgument -> [Char]
    "::"