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

import Futhark.CodeGen.Backends.GenericCSharp.AST

-- | Specification if a single command line option.  The option must
-- have a long name, and may also have a short name.
--
-- When the statement is being executed, the argument (if any) will be
-- stored in the variable @optarg@.
data Option = Option { Option -> String
optionLongName :: String
                     , Option -> Maybe Char
optionShortName :: Maybe Char
                     , Option -> OptionArgument
optionArgument :: OptionArgument
                     , Option -> [CSStmt]
optionAction :: [CSStmt]
                     }

-- | Whether an option accepts an argument.
data OptionArgument = NoArgument
                    | RequiredArgument
                    | OptionalArgument

-- | Generate option parsing code that accepts the given command line options.  Will read from @sys.argv@.
--
-- If option parsing fails for any reason, the entire process will
-- terminate with error code 1.
generateOptionParser :: [Option] -> [CSStmt]
generateOptionParser :: [Option] -> [CSStmt]
generateOptionParser [Option]
options =
  [ CSExp -> CSExp -> CSStmt
Assign (String -> CSExp
Var String
"options") (String -> [CSExp] -> CSExp
Collection String
"OptionSet" ([CSExp] -> CSExp) -> [CSExp] -> CSExp
forall a b. (a -> b) -> a -> b
$ (Option -> CSExp) -> [Option] -> [CSExp]
forall a b. (a -> b) -> [a] -> [b]
map Option -> CSExp
parseOption [Option]
options)
  , CSExp -> CSExp -> CSStmt
Assign (String -> CSExp
Var String
"extra") (CSExp -> [CSArg] -> CSExp
Call (String -> CSExp
Var String
"options.Parse") [Maybe ArgMemType -> CSExp -> CSArg
Arg Maybe ArgMemType
forall a. Maybe a
Nothing (String -> CSExp
Var String
"args")])
  ]
  where parseOption :: Option -> CSExp
parseOption Option
option = [CSExp] -> CSExp
Array [ String -> CSExp
String (String -> CSExp) -> String -> CSExp
forall a b. (a -> b) -> a -> b
$ Option -> String
option_string Option
option
                                   , CSExp -> [CSStmt] -> CSExp
Lambda (String -> CSExp
Var String
"optarg") ([CSStmt] -> CSExp) -> [CSStmt] -> CSExp
forall a b. (a -> b) -> a -> b
$ Option -> [CSStmt]
optionAction Option
option ]
        option_string :: Option -> String
option_string Option
option = case Option -> OptionArgument
optionArgument Option
option of
          OptionArgument
RequiredArgument ->
            [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String -> (Char -> String) -> Maybe Char -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" Char -> String
prefix (Maybe Char -> String) -> Maybe Char -> String
forall a b. (a -> b) -> a -> b
$ Option -> Maybe Char
optionShortName Option
option,Option -> String
optionLongName Option
option,String
"="]
          OptionArgument
_ ->
            String -> (Char -> String) -> Maybe Char -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" Char -> String
prefix (Option -> Maybe Char
optionShortName Option
option) String -> String -> String
forall a. [a] -> [a] -> [a]
++ Option -> String
optionLongName Option
option
        prefix :: Char -> String
prefix = (Char -> String -> String) -> String -> Char -> String
forall a b c. (a -> b -> c) -> b -> a -> c
flip (:) String
"|"