module Parser (getArgParser, getArgParserExtra, Options(..)) where

import Options.Applicative

-- | Return parser results for command line arguments passed to the hMPC runtime.

getArgParser :: IO Options
getArgParser :: IO Options
getArgParser = ParserInfo Options -> IO Options
forall a. ParserInfo a -> IO a
execParser (ParserInfo Options -> IO Options)
-> ParserInfo Options -> IO Options
forall a b. (a -> b) -> a -> b
$ Parser Options -> InfoMod Options -> ParserInfo Options
forall a. Parser a -> InfoMod a -> ParserInfo a
info (Parser Options
sample Parser Options -> Parser (Options -> Options) -> Parser Options
forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> Parser (Options -> Options)
forall a. Parser (a -> a)
helper) InfoMod Options
forall a. InfoMod a
fullDesc

-- | Return parser for command line arguments passed to the hMPC runtime.

getArgParserExtra :: Parser a -- | include a user specified parser

    -> IO (Options, a)
getArgParserExtra :: forall a. Parser a -> IO (Options, a)
getArgParserExtra Parser a
pars = ParserInfo (Options, a) -> IO (Options, a)
forall a. ParserInfo a -> IO a
execParser (ParserInfo (Options, a) -> IO (Options, a))
-> ParserInfo (Options, a) -> IO (Options, a)
forall a b. (a -> b) -> a -> b
$ Parser (Options, a)
-> InfoMod (Options, a) -> ParserInfo (Options, a)
forall a. Parser a -> InfoMod a -> ParserInfo a
info (((,) (Options -> a -> (Options, a))
-> Parser Options -> Parser (a -> (Options, a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Options
sample Parser (a -> (Options, a)) -> Parser a -> Parser (Options, a)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser a
pars) Parser (Options, a)
-> Parser ((Options, a) -> (Options, a)) -> Parser (Options, a)
forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> Parser ((Options, a) -> (Options, a))
forall a. Parser (a -> a)
helper) InfoMod (Options, a)
forall a. InfoMod a
fullDesc

data Options = Options
  { Options -> [String]
parsParties :: [String], Options -> Integer
m :: Integer, Options -> Integer
myPid :: Integer, 
    Options -> Integer
threshold :: Integer, Options -> Integer
basePort :: Integer, Options -> Int
secParam :: Int, Options -> Bool
noAsync :: Bool, Options -> Maybe Int
nrThreads :: Maybe Int}

sample :: Parser Options
sample :: Parser Options
sample = [String]
-> Integer
-> Integer
-> Integer
-> Integer
-> Int
-> Bool
-> Maybe Int
-> Options
Options
      ([String]
 -> Integer
 -> Integer
 -> Integer
 -> Integer
 -> Int
 -> Bool
 -> Maybe Int
 -> Options)
-> Parser [String]
-> Parser
     (Integer
      -> Integer
      -> Integer
      -> Integer
      -> Int
      -> Bool
      -> Maybe Int
      -> Options)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser String -> Parser [String]
forall a. Parser a -> Parser [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
strOption
          ( Char -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'P' Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"addr"
         Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
help String
"use addr=host:port per party (repeat m times)" ))
      Parser
  (Integer
   -> Integer
   -> Integer
   -> Integer
   -> Int
   -> Bool
   -> Maybe Int
   -> Options)
-> Parser Integer
-> Parser
     (Integer
      -> Integer -> Integer -> Int -> Bool -> Maybe Int -> Options)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReadM Integer -> Mod OptionFields Integer -> Parser Integer
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM Integer
forall a. Read a => ReadM a
auto
          ( Char -> Mod OptionFields Integer
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'M' Mod OptionFields Integer
-> Mod OptionFields Integer -> Mod OptionFields Integer
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields Integer
forall a (f :: * -> *). Show a => Mod f a
showDefault Mod OptionFields Integer
-> Mod OptionFields Integer -> Mod OptionFields Integer
forall a. Semigroup a => a -> a -> a
<> Integer -> Mod OptionFields Integer
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value (-Integer
1)  Mod OptionFields Integer
-> Mod OptionFields Integer -> Mod OptionFields Integer
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Integer
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"INT"
         Mod OptionFields Integer
-> Mod OptionFields Integer -> Mod OptionFields Integer
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Integer
forall (f :: * -> *) a. String -> Mod f a
help String
"use m local parties (and run all m, if i is not set)" )
      Parser
  (Integer
   -> Integer -> Integer -> Int -> Bool -> Maybe Int -> Options)
-> Parser Integer
-> Parser
     (Integer -> Integer -> Int -> Bool -> Maybe Int -> Options)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReadM Integer -> Mod OptionFields Integer -> Parser Integer
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM Integer
forall a. Read a => ReadM a
auto
          ( Char -> Mod OptionFields Integer
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'I' Mod OptionFields Integer
-> Mod OptionFields Integer -> Mod OptionFields Integer
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Integer
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"index" Mod OptionFields Integer
-> Mod OptionFields Integer -> Mod OptionFields Integer
forall a. Semigroup a => a -> a -> a
<> Integer -> Mod OptionFields Integer
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value (-Integer
1) Mod OptionFields Integer
-> Mod OptionFields Integer -> Mod OptionFields Integer
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Integer
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"INT"
         Mod OptionFields Integer
-> Mod OptionFields Integer -> Mod OptionFields Integer
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Integer
forall (f :: * -> *) a. String -> Mod f a
help String
"set index of this local party to i, 0<=i<m" )
      Parser (Integer -> Integer -> Int -> Bool -> Maybe Int -> Options)
-> Parser Integer
-> Parser (Integer -> Int -> Bool -> Maybe Int -> Options)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReadM Integer -> Mod OptionFields Integer -> Parser Integer
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM Integer
forall a. Read a => ReadM a
auto
          ( Char -> Mod OptionFields Integer
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'T' Mod OptionFields Integer
-> Mod OptionFields Integer -> Mod OptionFields Integer
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Integer
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"threshold" Mod OptionFields Integer
-> Mod OptionFields Integer -> Mod OptionFields Integer
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields Integer
forall a (f :: * -> *). Show a => Mod f a
showDefault Mod OptionFields Integer
-> Mod OptionFields Integer -> Mod OptionFields Integer
forall a. Semigroup a => a -> a -> a
<> Integer -> Mod OptionFields Integer
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value (-Integer
1) Mod OptionFields Integer
-> Mod OptionFields Integer -> Mod OptionFields Integer
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Integer
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"INT"
         Mod OptionFields Integer
-> Mod OptionFields Integer -> Mod OptionFields Integer
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Integer
forall (f :: * -> *) a. String -> Mod f a
help String
"threshold t, 0<=t<m/2" )
      Parser (Integer -> Int -> Bool -> Maybe Int -> Options)
-> Parser Integer -> Parser (Int -> Bool -> Maybe Int -> Options)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReadM Integer -> Mod OptionFields Integer -> Parser Integer
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM Integer
forall a. Read a => ReadM a
auto
          ( Char -> Mod OptionFields Integer
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'B' Mod OptionFields Integer
-> Mod OptionFields Integer -> Mod OptionFields Integer
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Integer
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"base-port" Mod OptionFields Integer
-> Mod OptionFields Integer -> Mod OptionFields Integer
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields Integer
forall a (f :: * -> *). Show a => Mod f a
showDefault Mod OptionFields Integer
-> Mod OptionFields Integer -> Mod OptionFields Integer
forall a. Semigroup a => a -> a -> a
<> Integer -> Mod OptionFields Integer
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value Integer
4242 Mod OptionFields Integer
-> Mod OptionFields Integer -> Mod OptionFields Integer
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Integer
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"b"
         Mod OptionFields Integer
-> Mod OptionFields Integer -> Mod OptionFields Integer
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Integer
forall (f :: * -> *) a. String -> Mod f a
help String
"use port number b+i for party i" )
      Parser (Int -> Bool -> Maybe Int -> Options)
-> Parser Int -> Parser (Bool -> Maybe Int -> Options)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReadM Int -> Mod OptionFields Int -> Parser Int
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM Int
forall a. Read a => ReadM a
auto
          ( Char -> Mod OptionFields Int
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'K' Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Int
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"sec-param" Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields Int
forall a (f :: * -> *). Show a => Mod f a
showDefault Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> Int -> Mod OptionFields Int
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value Int
30 Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Int
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"INT"
         Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Int
forall (f :: * -> *) a. String -> Mod f a
help String
"security parameter k, leakage probability 2**-k" )
      Parser (Bool -> Maybe Int -> Options)
-> Parser Bool -> Parser (Maybe Int -> Options)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod FlagFields Bool -> Parser Bool
switch
          ( String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"no-async" 
            Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help String
"disable asynchronous evaluation" )
      Parser (Maybe Int -> Options)
-> Parser (Maybe Int) -> Parser Options
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Int -> Parser (Maybe Int)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ( ReadM Int -> Mod OptionFields Int -> Parser Int
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM Int
forall a. Read a => ReadM a
auto
          ( String -> Mod OptionFields Int
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"threads" Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Int
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"L"
            Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Int
forall (f :: * -> *) a. String -> Mod f a
help String
"Set the number of Haskell threads that can run truly simultaneously."))