{-# LANGUAGE ForeignFunctionInterface, ScopedTypeVariables #-}
module Util.WBFiles (
getWishPath,
getDaVinciPath,
getGnuClientPath,
getToolTimeOut,
getTOP,
getTOPPath,
getEditorString,
getMMiSSDTD,
getMMiSSAPIDTD,
getHosts,
getPort,
getXMLPort,
getCouplingPort,
getWorkingDir,
getCouplingDir,
getDebugFileName,
getDaVinciIcons,
getServer,
getUser,
getPassword,
getServerFile,
getServerDir,
getServerId,
getArgString,
getArgBool,
getArgInt,
parseArguments,
parseArgumentsRequiring,
ArgType(..),
ArgValue(..),
ProgramArgument(..),
usualProgramArguments,
parseTheseArguments,
parseTheseArgumentsRequiring,
setAlternateArgs
) where
import Data.Char
import Util.CompileFlags
import System.IO
import Data.List
import Control.Monad
import qualified System.Environment as System
import System.Exit(exitWith,ExitCode(..))
import qualified Control.Exception as Exception
import Control.Concurrent
import qualified Data.Map as Map
import System.IO.Unsafe
import Foreign.C.String
import Util.FileNames
valOf :: String -> IO (Maybe a) -> IO a
valOf :: String -> IO (Maybe a) -> IO a
valOf String
optionName IO (Maybe a)
action =
do
Maybe a
valueOpt <- IO (Maybe a)
action
case Maybe a
valueOpt of
Just a
a -> a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
Maybe a
Nothing ->
String -> IO a
forall a. HasCallStack => String -> a
error (String
"option --uni-" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
optionName String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" is surprisingly unset")
getWishPath :: IO String
getWishPath :: IO String
getWishPath = String -> IO (Maybe String) -> IO String
forall a. String -> IO (Maybe a) -> IO a
valOf String
"wish" (String -> IO (Maybe String)
getArgString String
"wish")
getEditorString :: IO (Maybe String)
getEditorString :: IO (Maybe String)
getEditorString = String -> IO (Maybe String)
getArgString String
"editor"
getMMiSSDTD :: IO (Maybe String)
getMMiSSDTD :: IO (Maybe String)
getMMiSSDTD =
do
Maybe String
mmissDTDOpt <- String -> IO (Maybe String)
getArgString String
"MMiSSDTD"
case Maybe String
mmissDTDOpt of
Just String
mmissDTD -> Maybe String -> IO (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
mmissDTDOpt
Maybe String
Nothing ->
do
String
path <- [String] -> IO String
getTOPPath [String
"mmiss",String
"MMiSS.dtd"]
Maybe String -> IO (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Maybe String
forall a. a -> Maybe a
Just String
path)
getMMiSSAPIDTD :: IO (Maybe String)
getMMiSSAPIDTD :: IO (Maybe String)
getMMiSSAPIDTD =
do
String
path <- [String] -> IO String
getTOPPath [String
"mmiss",String
"api",String
"MMiSSRequest.dtd"]
Maybe String -> IO (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Maybe String
forall a. a -> Maybe a
Just String
path)
getHosts :: IO String
getHosts :: IO String
getHosts =
do
Maybe String
hostsOpt <- String -> IO (Maybe String)
getArgString String
"Hosts"
case Maybe String
hostsOpt of
Just String
hosts -> String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
hosts
Maybe String
Nothing ->
[String] -> IO String
getTOPPath [String
"server",String
"Hosts.xml"]
getDaVinciPath :: IO String
getDaVinciPath :: IO String
getDaVinciPath = String -> IO (Maybe String) -> IO String
forall a. String -> IO (Maybe a) -> IO a
valOf String
"daVinci" (String -> IO (Maybe String)
getArgString String
"daVinci")
getGnuClientPath :: IO String
getGnuClientPath :: IO String
getGnuClientPath = String -> IO (Maybe String) -> IO String
forall a. String -> IO (Maybe a) -> IO a
valOf String
"gnuclient" (String -> IO (Maybe String)
getArgString String
"gnuclient")
getToolTimeOut :: IO Int
getToolTimeOut :: IO Int
getToolTimeOut = String -> IO (Maybe Int) -> IO Int
forall a. String -> IO (Maybe a) -> IO a
valOf String
"toolTimeOut" (String -> IO (Maybe Int)
getArgInt String
"toolTimeOut")
getTOP :: IO String
getTOP :: IO String
getTOP = String -> IO (Maybe String) -> IO String
forall a. String -> IO (Maybe a) -> IO a
valOf String
"top" (String -> IO (Maybe String)
getArgString String
"top")
getTOPPath :: [String] -> IO String
getTOPPath :: [String] -> IO String
getTOPPath [String]
names =
do
String
top <- IO String
getTOP
String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return ([String] -> String
unbreakName (String -> String
trimDir String
topString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
names))
getPort :: IO Int
getPort :: IO Int
getPort = String -> IO (Maybe Int) -> IO Int
forall a. String -> IO (Maybe a) -> IO a
valOf String
"port" (String -> IO (Maybe Int)
getArgInt String
"port")
getXMLPort :: IO Int
getXMLPort :: IO Int
getXMLPort = String -> IO (Maybe Int) -> IO Int
forall a. String -> IO (Maybe a) -> IO a
valOf String
"xmlPort" (String -> IO (Maybe Int)
getArgInt String
"xmlPort")
getWorkingDir :: IO String
getWorkingDir :: IO String
getWorkingDir =
do
String
workingDir' <- String -> IO (Maybe String) -> IO String
forall a. String -> IO (Maybe a) -> IO a
valOf String
"workingDir" (String -> IO (Maybe String)
getArgString String
"workingDir")
String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> String
trimDir String
workingDir')
getDebugFileName :: IO String
getDebugFileName :: IO String
getDebugFileName = String -> IO (Maybe String) -> IO String
forall a. String -> IO (Maybe a) -> IO a
valOf String
"debug" (String -> IO (Maybe String)
getArgString String
"debug")
getServerFile :: String -> IO String
getServerFile :: String -> IO String
getServerFile String
innerName =
do
String
serverDir <- IO String
getServerDir
String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> String -> String
combineNames (String -> String
trimDir String
serverDir) String
innerName)
getServerDir :: IO String
getServerDir :: IO String
getServerDir =
do
Maybe String
serverDirOpt <- String -> IO (Maybe String)
getArgString String
"serverDir"
case Maybe String
serverDirOpt of
Maybe String
Nothing ->
String -> IO String
forall a. HasCallStack => String -> a
error (
String
"UNISERVERDIR environment variable or --uni-serverDir"
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" must be set for server programs")
Just String
serverDir -> String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
serverDir
getServerId :: IO (Maybe String)
getServerId :: IO (Maybe String)
getServerId = String -> IO (Maybe String)
getArgString String
"serverId"
getDaVinciIcons :: IO (Maybe String)
getDaVinciIcons :: IO (Maybe String)
getDaVinciIcons = String -> IO (Maybe String)
getArgString String
"daVinciIcons"
getServer :: IO (Maybe String)
getServer :: IO (Maybe String)
getServer = String -> IO (Maybe String)
getArgString String
"server"
getUser :: IO (Maybe String)
getUser :: IO (Maybe String)
getUser = String -> IO (Maybe String)
getArgString String
"user"
getPassword :: IO (Maybe String)
getPassword :: IO (Maybe String)
getPassword = String -> IO (Maybe String)
getArgString String
"password"
getCouplingPort :: IO Int
getCouplingPort :: IO Int
getCouplingPort = String -> IO (Maybe Int) -> IO Int
forall a. String -> IO (Maybe a) -> IO a
valOf String
"couplingPort" (String -> IO (Maybe Int)
getArgInt String
"couplingPort")
getCouplingDir :: IO String
getCouplingDir :: IO String
getCouplingDir = String -> IO (Maybe String) -> IO String
forall a. String -> IO (Maybe a) -> IO a
valOf String
"couplingDir" (String -> IO (Maybe String)
getArgString String
"couplingDir")
data ProgramArgument = ProgramArgument {
ProgramArgument -> String
optionName :: String,
ProgramArgument -> String
optionHelp :: String,
ProgramArgument -> Maybe ArgValue
defaultVal :: Maybe ArgValue,
ProgramArgument -> ArgType
argType :: ArgType
}
usualProgramArguments :: [ProgramArgument]
usualProgramArguments :: [ProgramArgument]
usualProgramArguments = [
ProgramArgument :: String -> String -> Maybe ArgValue -> ArgType -> ProgramArgument
ProgramArgument{
optionName :: String
optionName = String
"wish",
optionHelp :: String
optionHelp = String
"path to the wish program",
defaultVal :: Maybe ArgValue
defaultVal = ArgValue -> Maybe ArgValue
forall a. a -> Maybe a
Just (String -> ArgValue
StringValue String
"/usr/bin/wish"),
argType :: ArgType
argType = ArgType
STRING
},
ProgramArgument :: String -> String -> Maybe ArgValue -> ArgType -> ProgramArgument
ProgramArgument{
optionName :: String
optionName = String
"daVinci",
optionHelp :: String
optionHelp = String
"path to the daVinci program",
defaultVal :: Maybe ArgValue
defaultVal = Maybe ArgValue
forall a. Maybe a
Nothing,
argType :: ArgType
argType = ArgType
STRING
},
ProgramArgument :: String -> String -> Maybe ArgValue -> ArgType -> ProgramArgument
ProgramArgument{
optionName :: String
optionName = String
"daVinciIcons",
optionHelp :: String
optionHelp = String
"directory containing daVinci icons",
defaultVal :: Maybe ArgValue
defaultVal = Maybe ArgValue
forall a. Maybe a
Nothing,
argType :: ArgType
argType = ArgType
STRING
},
ProgramArgument :: String -> String -> Maybe ArgValue -> ArgType -> ProgramArgument
ProgramArgument{
optionName :: String
optionName = String
"gnuclient",
optionHelp :: String
optionHelp = String
"path to the gnuclient program",
defaultVal :: Maybe ArgValue
defaultVal = ArgValue -> Maybe ArgValue
forall a. a -> Maybe a
Just (String -> ArgValue
StringValue String
"gnuclient"),
argType :: ArgType
argType = ArgType
STRING
},
ProgramArgument :: String -> String -> Maybe ArgValue -> ArgType -> ProgramArgument
ProgramArgument{
optionName :: String
optionName = String
"toolTimeOut",
optionHelp :: String
optionHelp = String
"time-out when tools start up in milliseconds",
defaultVal :: Maybe ArgValue
defaultVal = ArgValue -> Maybe ArgValue
forall a. a -> Maybe a
Just (Int -> ArgValue
IntValue Int
10000),
argType :: ArgType
argType = ArgType
INT
},
ProgramArgument :: String -> String -> Maybe ArgValue -> ArgType -> ProgramArgument
ProgramArgument{
optionName :: String
optionName = String
"windowsTick",
optionHelp :: String
optionHelp = String
"interval in microseconds for polling wish (Windows only).",
defaultVal :: Maybe ArgValue
defaultVal = ArgValue -> Maybe ArgValue
forall a. a -> Maybe a
Just (Int -> ArgValue
IntValue Int
10000),
argType :: ArgType
argType = ArgType
INT
},
ProgramArgument :: String -> String -> Maybe ArgValue -> ArgType -> ProgramArgument
ProgramArgument{
optionName :: String
optionName = String
"editor",
optionHelp :: String
optionHelp = String
"text editor cmd; %F => filename; %N => user-visible name",
defaultVal :: Maybe ArgValue
defaultVal = Maybe ArgValue
forall a. Maybe a
Nothing,
argType :: ArgType
argType = ArgType
STRING
},
ProgramArgument :: String -> String -> Maybe ArgValue -> ArgType -> ProgramArgument
ProgramArgument{
optionName :: String
optionName = String
"MMiSSDTD",
optionHelp :: String
optionHelp = String
"Filename for MMiSS's DTD",
defaultVal :: Maybe ArgValue
defaultVal = Maybe ArgValue
forall a. Maybe a
Nothing,
argType :: ArgType
argType = ArgType
STRING
},
ProgramArgument :: String -> String -> Maybe ArgValue -> ArgType -> ProgramArgument
ProgramArgument{
optionName :: String
optionName = String
"Hosts",
optionHelp :: String
optionHelp = String
"File containing list of hosts",
defaultVal :: Maybe ArgValue
defaultVal = Maybe ArgValue
forall a. Maybe a
Nothing,
argType :: ArgType
argType = ArgType
STRING
},
ProgramArgument :: String -> String -> Maybe ArgValue -> ArgType -> ProgramArgument
ProgramArgument{
optionName :: String
optionName = String
"top",
optionHelp :: String
optionHelp = String
"path where UniForM was installed",
defaultVal :: Maybe ArgValue
defaultVal = Maybe ArgValue
forall a. Maybe a
Nothing,
argType :: ArgType
argType = ArgType
STRING
},
ProgramArgument :: String -> String -> Maybe ArgValue -> ArgType -> ProgramArgument
ProgramArgument{
optionName :: String
optionName = String
"serverDir",
optionHelp :: String
optionHelp = String
"where server stores its files",
defaultVal :: Maybe ArgValue
defaultVal = Maybe ArgValue
forall a. Maybe a
Nothing,
argType :: ArgType
argType = ArgType
STRING
},
ProgramArgument :: String -> String -> Maybe ArgValue -> ArgType -> ProgramArgument
ProgramArgument{
optionName :: String
optionName = String
"serverId",
optionHelp :: String
optionHelp = String
"globally unique server identifier (EXPERTS ONLY)",
defaultVal :: Maybe ArgValue
defaultVal = Maybe ArgValue
forall a. Maybe a
Nothing,
argType :: ArgType
argType = ArgType
STRING
},
ProgramArgument :: String -> String -> Maybe ArgValue -> ArgType -> ProgramArgument
ProgramArgument{
optionName :: String
optionName = String
"workingDir",
optionHelp :: String
optionHelp = String
"directory used for temporary files",
defaultVal :: Maybe ArgValue
defaultVal = ArgValue -> Maybe ArgValue
forall a. a -> Maybe a
Just (String -> ArgValue
StringValue String
"/tmp"),
argType :: ArgType
argType = ArgType
STRING
},
ProgramArgument :: String -> String -> Maybe ArgValue -> ArgType -> ProgramArgument
ProgramArgument{
optionName :: String
optionName = String
"server",
optionHelp :: String
optionHelp = String
"machine where the server runs",
defaultVal :: Maybe ArgValue
defaultVal = Maybe ArgValue
forall a. Maybe a
Nothing,
argType :: ArgType
argType = ArgType
STRING
},
ProgramArgument :: String -> String -> Maybe ArgValue -> ArgType -> ProgramArgument
ProgramArgument{
optionName :: String
optionName = String
"user",
optionHelp :: String
optionHelp = String
"Your identifier on the server",
defaultVal :: Maybe ArgValue
defaultVal = Maybe ArgValue
forall a. Maybe a
Nothing,
argType :: ArgType
argType = ArgType
STRING
},
ProgramArgument :: String -> String -> Maybe ArgValue -> ArgType -> ProgramArgument
ProgramArgument{
optionName :: String
optionName = String
"password",
optionHelp :: String
optionHelp = String
"Your password on the server",
defaultVal :: Maybe ArgValue
defaultVal = Maybe ArgValue
forall a. Maybe a
Nothing,
argType :: ArgType
argType = ArgType
STRING
},
ProgramArgument :: String -> String -> Maybe ArgValue -> ArgType -> ProgramArgument
ProgramArgument{
optionName :: String
optionName = String
"port",
optionHelp :: String
optionHelp = String
"port for the server",
defaultVal :: Maybe ArgValue
defaultVal = ArgValue -> Maybe ArgValue
forall a. a -> Maybe a
Just (Int -> ArgValue
IntValue Int
defaultPort),
argType :: ArgType
argType = ArgType
INT
},
ProgramArgument :: String -> String -> Maybe ArgValue -> ArgType -> ProgramArgument
ProgramArgument{
optionName :: String
optionName = String
"xmlPort",
optionHelp :: String
optionHelp = String
"port for the MMiSS-XML server",
defaultVal :: Maybe ArgValue
defaultVal = ArgValue -> Maybe ArgValue
forall a. a -> Maybe a
Just (Int -> ArgValue
IntValue Int
defaultXMLPort),
argType :: ArgType
argType = ArgType
INT
},
ProgramArgument :: String -> String -> Maybe ArgValue -> ArgType -> ProgramArgument
ProgramArgument{
optionName :: String
optionName = String
"couplingPort",
optionHelp :: String
optionHelp = String
"port for the coupling server",
defaultVal :: Maybe ArgValue
defaultVal = ArgValue -> Maybe ArgValue
forall a. a -> Maybe a
Just (Int -> ArgValue
IntValue Int
defaultCouplingPort),
argType :: ArgType
argType = ArgType
INT
},
ProgramArgument :: String -> String -> Maybe ArgValue -> ArgType -> ProgramArgument
ProgramArgument{
optionName :: String
optionName = String
"couplingDir",
optionHelp :: String
optionHelp = String
"directory where the coupling server finds the working copy of foreign repository",
defaultVal :: Maybe ArgValue
defaultVal = Maybe ArgValue
forall a. Maybe a
Nothing,
argType :: ArgType
argType = ArgType
STRING
},
ProgramArgument :: String -> String -> Maybe ArgValue -> ArgType -> ProgramArgument
ProgramArgument{
optionName :: String
optionName = String
"debug",
optionHelp :: String
optionHelp = String
"file for debug output",
defaultVal :: Maybe ArgValue
defaultVal = ArgValue -> Maybe ArgValue
forall a. a -> Maybe a
Just (String -> ArgValue
StringValue String
"/tmp/uniform.DEBUG"),
argType :: ArgType
argType = ArgType
STRING
}
]
defaultPort :: Int
defaultPort :: Int
defaultPort = Int
11393
defaultXMLPort :: Int
defaultXMLPort :: Int
defaultXMLPort = Int
11396
defaultCouplingPort :: Int
defaultCouplingPort :: Int
defaultCouplingPort = Int
11391
data ArgType = STRING | INT | BOOL
showArgType :: ArgType -> String
showArgType :: ArgType -> String
showArgType ArgType
STRING = String
"string"
showArgType ArgType
INT = String
"int"
showArgType ArgType
BOOL = String
"bool"
data ArgValue = StringValue String | IntValue Int | BoolValue Bool
parseArgValue :: ArgType -> String -> Maybe ArgValue
parseArgValue :: ArgType -> String -> Maybe ArgValue
parseArgValue ArgType
STRING String
str = ArgValue -> Maybe ArgValue
forall a. a -> Maybe a
Just (String -> ArgValue
StringValue String
str)
parseArgValue ArgType
INT String
str =
case Int -> ReadS Int
forall a. Read a => Int -> ReadS a
readsPrec Int
0 String
str of
[(Int
val,String
"")] -> ArgValue -> Maybe ArgValue
forall a. a -> Maybe a
Just (Int -> ArgValue
IntValue Int
val)
[(Int, String)]
_ -> Maybe ArgValue
forall a. Maybe a
Nothing
parseArgValue ArgType
BOOL String
str =
let
true :: Maybe ArgValue
true = ArgValue -> Maybe ArgValue
forall a. a -> Maybe a
Just (Bool -> ArgValue
BoolValue Bool
True)
false :: Maybe ArgValue
false = ArgValue -> Maybe ArgValue
forall a. a -> Maybe a
Just (Bool -> ArgValue
BoolValue Bool
False)
in
case String
str of
String
"" -> Maybe ArgValue
true
String
"True" -> Maybe ArgValue
true
String
"False" -> Maybe ArgValue
false
String
"+" -> Maybe ArgValue
true
String
"-" -> Maybe ArgValue
false
String
"yes" -> Maybe ArgValue
true
String
"no" -> Maybe ArgValue
false
String
_ -> Maybe ArgValue
forall a. Maybe a
Nothing
showArgValue :: ArgValue -> String
showArgValue :: ArgValue -> String
showArgValue (StringValue String
str) = String
str
showArgValue (IntValue Int
i) = Int -> String
forall a. Show a => a -> String
show Int
i
showArgValue (BoolValue Bool
b) = if Bool
b then String
"+" else String
"-"
newtype ParsedArguments =
ParsedArguments (MVar (Maybe (Map.Map String ArgValue)))
makeParsedArguments :: IO ParsedArguments
makeParsedArguments :: IO ParsedArguments
makeParsedArguments =
do
MVar (Maybe (Map String ArgValue))
mVar <- Maybe (Map String ArgValue)
-> IO (MVar (Maybe (Map String ArgValue)))
forall a. a -> IO (MVar a)
newMVar Maybe (Map String ArgValue)
forall a. Maybe a
Nothing
ParsedArguments -> IO ParsedArguments
forall (m :: * -> *) a. Monad m => a -> m a
return (MVar (Maybe (Map String ArgValue)) -> ParsedArguments
ParsedArguments MVar (Maybe (Map String ArgValue))
mVar)
{-# NOINLINE makeParsedArguments #-}
parsedArguments :: ParsedArguments
parsedArguments :: ParsedArguments
parsedArguments = IO ParsedArguments -> ParsedArguments
forall a. IO a -> a
unsafePerformIO IO ParsedArguments
makeParsedArguments
{-# NOINLINE parsedArguments #-}
getArgValue :: String -> IO (Maybe ArgValue)
getArgValue :: String -> IO (Maybe ArgValue)
getArgValue String
optionName =
do
Map String ArgValue
map <- IO (Map String ArgValue)
forceParseArguments
Maybe ArgValue -> IO (Maybe ArgValue)
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Map String ArgValue -> Maybe ArgValue
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
optionName Map String ArgValue
map)
mismatch :: String -> a
mismatch :: String -> a
mismatch String
optionName =
String -> a
forall a. HasCallStack => String -> a
error (String
"WBFiles.mismatch - type mismatch for "String -> String -> String
forall a. [a] -> [a] -> [a]
++String
optionName)
{-# NOINLINE mismatch #-}
getArgString :: String -> IO (Maybe String)
getArgString :: String -> IO (Maybe String)
getArgString String
optionName =
do
Maybe ArgValue
valOpt <- String -> IO (Maybe ArgValue)
getArgValue String
optionName
case Maybe ArgValue
valOpt of
Just (StringValue String
str) -> Maybe String -> IO (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Maybe String
forall a. a -> Maybe a
Just String
str)
Just ArgValue
_ -> String -> IO (Maybe String)
forall a. String -> a
mismatch String
optionName
Maybe ArgValue
Nothing -> Maybe String -> IO (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
forall a. Maybe a
Nothing
getArgInt :: String -> IO (Maybe Int)
getArgInt :: String -> IO (Maybe Int)
getArgInt String
optionName =
do
Maybe ArgValue
valOpt <- String -> IO (Maybe ArgValue)
getArgValue String
optionName
case Maybe ArgValue
valOpt of
Just (IntValue Int
i) -> Maybe Int -> IO (Maybe Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
i)
Just ArgValue
_ -> String -> IO (Maybe Int)
forall a. String -> a
mismatch String
optionName
Maybe ArgValue
Nothing -> Maybe Int -> IO (Maybe Int)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Int
forall a. Maybe a
Nothing
getArgBool :: String -> IO (Maybe Bool)
getArgBool :: String -> IO (Maybe Bool)
getArgBool String
optionName =
do
Maybe ArgValue
valOpt <- String -> IO (Maybe ArgValue)
getArgValue String
optionName
case Maybe ArgValue
valOpt of
Just (BoolValue Bool
b) -> Maybe Bool -> IO (Maybe Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
b)
Just ArgValue
_ -> String -> IO (Maybe Bool)
forall a. String -> a
mismatch String
optionName
Maybe ArgValue
Nothing -> Maybe Bool -> IO (Maybe Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Bool
forall a. Maybe a
Nothing
forceParseArguments :: IO (Map.Map String ArgValue)
forceParseArguments :: IO (Map String ArgValue)
forceParseArguments =
do
let ParsedArguments MVar (Maybe (Map String ArgValue))
mVar = ParsedArguments
parsedArguments
Maybe (Map String ArgValue)
mapOpt <- MVar (Maybe (Map String ArgValue))
-> IO (Maybe (Map String ArgValue))
forall a. MVar a -> IO a
takeMVar MVar (Maybe (Map String ArgValue))
mVar
case Maybe (Map String ArgValue)
mapOpt of
Maybe (Map String ArgValue)
Nothing ->
do
(Maybe ExitCode
exitCode,Map String ArgValue
newMap) <-
[ProgramArgument]
-> [String] -> IO (Maybe ExitCode, Map String ArgValue)
parseTheseArgumentsRequiring' [ProgramArgument]
usualProgramArguments []
MVar (Maybe (Map String ArgValue))
-> Maybe (Map String ArgValue) -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar (Maybe (Map String ArgValue))
mVar (Map String ArgValue -> Maybe (Map String ArgValue)
forall a. a -> Maybe a
Just Map String ArgValue
newMap)
Map String ArgValue -> IO (Map String ArgValue)
forall (m :: * -> *) a. Monad m => a -> m a
return Map String ArgValue
newMap
Just Map String ArgValue
map ->
do
MVar (Maybe (Map String ArgValue))
-> Maybe (Map String ArgValue) -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar (Maybe (Map String ArgValue))
mVar (Map String ArgValue -> Maybe (Map String ArgValue)
forall a. a -> Maybe a
Just Map String ArgValue
map)
Map String ArgValue -> IO (Map String ArgValue)
forall (m :: * -> *) a. Monad m => a -> m a
return Map String ArgValue
map
alternateArgs :: MVar [String]
newAlternateArgs :: IO (MVar [String])
newAlternateArgs :: IO (MVar [String])
newAlternateArgs = IO (MVar [String])
forall a. IO (MVar a)
newEmptyMVar
{-# NOINLINE newAlternateArgs #-}
alternateArgs :: MVar [String]
alternateArgs = IO (MVar [String]) -> MVar [String]
forall a. IO a -> a
unsafePerformIO IO (MVar [String])
newAlternateArgs
setAlternateArgs :: [String] -> IO ()
setAlternateArgs :: [String] -> IO ()
setAlternateArgs [String]
newArgs =
do
Bool
isEmpty <- MVar [String] -> IO Bool
forall a. MVar a -> IO Bool
isEmptyMVar MVar [String]
alternateArgs
if Bool
isEmpty
then
MVar [String] -> [String] -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar [String]
alternateArgs [String]
newArgs
else
String -> IO ()
forall a. HasCallStack => String -> a
error String
"setAlternateArgs called twice or after getArgs"
getArgs :: IO [String]
getArgs :: IO [String]
getArgs =
do
Bool
isEmpty <- MVar [String] -> IO Bool
forall a. MVar a -> IO Bool
isEmptyMVar MVar [String]
alternateArgs
[String]
args <- if Bool
isEmpty
then
IO [String]
System.getArgs
else
MVar [String] -> IO [String]
forall a. MVar a -> IO a
takeMVar MVar [String]
alternateArgs
MVar [String] -> [String] -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar [String]
alternateArgs [String]
args
[String] -> IO [String]
forall (m :: * -> *) a. Monad m => a -> m a
return [String]
args
parseArguments :: IO ()
parseArguments :: IO ()
parseArguments = [ProgramArgument] -> IO ()
parseTheseArguments [ProgramArgument]
usualProgramArguments
parseArgumentsRequiring :: [String] -> IO ()
parseArgumentsRequiring :: [String] -> IO ()
parseArgumentsRequiring [String]
required =
[ProgramArgument] -> [String] -> IO ()
parseTheseArgumentsRequiring [ProgramArgument]
usualProgramArguments [String]
required
parseTheseArguments :: [ProgramArgument] -> IO ()
parseTheseArguments :: [ProgramArgument] -> IO ()
parseTheseArguments [ProgramArgument]
arguments = [ProgramArgument] -> [String] -> IO ()
parseTheseArgumentsRequiring [ProgramArgument]
arguments []
parseTheseArgumentsRequiring :: [ProgramArgument] -> [String] -> IO ()
parseTheseArgumentsRequiring :: [ProgramArgument] -> [String] -> IO ()
parseTheseArgumentsRequiring [ProgramArgument]
arguments [String]
required =
do
let ParsedArguments MVar (Maybe (Map String ArgValue))
mVar = ParsedArguments
parsedArguments
Maybe (Map String ArgValue)
mapOpt <- MVar (Maybe (Map String ArgValue))
-> IO (Maybe (Map String ArgValue))
forall a. MVar a -> IO a
takeMVar MVar (Maybe (Map String ArgValue))
mVar
case Maybe (Map String ArgValue)
mapOpt of
Just Map String ArgValue
_ ->
do
MVar (Maybe (Map String ArgValue))
-> Maybe (Map String ArgValue) -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar (Maybe (Map String ArgValue))
mVar Maybe (Map String ArgValue)
mapOpt
String -> IO ()
printToErr
(String
"WBFiles.parseTheseArgumentsRequiring: " String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"attempt to parse arguments too late")
Maybe (Map String ArgValue)
Nothing ->
do
(Maybe ExitCode
result,Map String ArgValue
newMap) <-
[ProgramArgument]
-> [String] -> IO (Maybe ExitCode, Map String ArgValue)
parseTheseArgumentsRequiring' [ProgramArgument]
arguments [String]
required
MVar (Maybe (Map String ArgValue))
-> Maybe (Map String ArgValue) -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar (Maybe (Map String ArgValue))
mVar (Map String ArgValue -> Maybe (Map String ArgValue)
forall a. a -> Maybe a
Just Map String ArgValue
newMap)
case Maybe ExitCode
result of
Maybe ExitCode
Nothing -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just ExitCode
exitCode -> ExitCode -> IO ()
forall a. ExitCode -> IO a
exitWith ExitCode
exitCode
type ParseState = (Maybe ExitCode,Map.Map String ArgValue)
parseTheseArgumentsRequiring' :: [ProgramArgument] -> [String] ->
IO ParseState
parseTheseArgumentsRequiring' :: [ProgramArgument]
-> [String] -> IO (Maybe ExitCode, Map String ArgValue)
parseTheseArgumentsRequiring' [ProgramArgument]
arguments [String]
required =
do
let
initialMap :: Map String ArgValue
initialMap =
(Map String ArgValue -> ProgramArgument -> Map String ArgValue)
-> Map String ArgValue -> [ProgramArgument] -> Map String ArgValue
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl
(\ Map String ArgValue
map ProgramArgument
argument ->
case (ProgramArgument -> Maybe ArgValue
defaultVal ProgramArgument
argument) of
Maybe ArgValue
Nothing -> Map String ArgValue
map
Just ArgValue
value -> String -> ArgValue -> Map String ArgValue -> Map String ArgValue
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (ProgramArgument -> String
optionName ProgramArgument
argument) ArgValue
value Map String ArgValue
map
)
Map String ArgValue
forall k a. Map k a
Map.empty
[ProgramArgument]
arguments
initial :: (Maybe ExitCode, Map String ArgValue)
initial = (Maybe ExitCode
forall a. Maybe a
Nothing, Map String ArgValue
initialMap) :: ParseState
String
defaultOptionsStr <- CString -> IO String
peekCString CString
defaultOptions
(Maybe ExitCode, Map String ArgValue)
afterDefault <- ((Maybe ExitCode, Map String ArgValue)
-> String -> IO (Maybe ExitCode, Map String ArgValue))
-> (Maybe ExitCode, Map String ArgValue)
-> [String]
-> IO (Maybe ExitCode, Map String ArgValue)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (Bool
-> (Maybe ExitCode, Map String ArgValue)
-> String
-> IO (Maybe ExitCode, Map String ArgValue)
handleParameter Bool
False) (Maybe ExitCode, Map String ArgValue)
initial
(String -> [String]
words String
defaultOptionsStr)
[String]
parameters <- IO [String]
getArgs
(Maybe ExitCode, Map String ArgValue)
afterParms <- ((Maybe ExitCode, Map String ArgValue)
-> String -> IO (Maybe ExitCode, Map String ArgValue))
-> (Maybe ExitCode, Map String ArgValue)
-> [String]
-> IO (Maybe ExitCode, Map String ArgValue)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (Bool
-> (Maybe ExitCode, Map String ArgValue)
-> String
-> IO (Maybe ExitCode, Map String ArgValue)
handleParameter Bool
True) (Maybe ExitCode, Map String ArgValue)
afterDefault [String]
parameters
(Maybe ExitCode, Map String ArgValue)
afterEnvs <- ((Maybe ExitCode, Map String ArgValue)
-> ProgramArgument -> IO (Maybe ExitCode, Map String ArgValue))
-> (Maybe ExitCode, Map String ArgValue)
-> [ProgramArgument]
-> IO (Maybe ExitCode, Map String ArgValue)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (Maybe ExitCode, Map String ArgValue)
-> ProgramArgument -> IO (Maybe ExitCode, Map String ArgValue)
handleEnv (Maybe ExitCode, Map String ArgValue)
afterParms [ProgramArgument]
arguments
((Maybe ExitCode, Map String ArgValue)
-> String -> IO (Maybe ExitCode, Map String ArgValue))
-> (Maybe ExitCode, Map String ArgValue)
-> [String]
-> IO (Maybe ExitCode, Map String ArgValue)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (Maybe ExitCode, Map String ArgValue)
-> String -> IO (Maybe ExitCode, Map String ArgValue)
checkReq (Maybe ExitCode, Map String ArgValue)
afterEnvs [String]
required
where
handleParameter :: Bool -> ParseState -> String -> IO ParseState
handleParameter :: Bool
-> (Maybe ExitCode, Map String ArgValue)
-> String
-> IO (Maybe ExitCode, Map String ArgValue)
handleParameter Bool
noticeErrors prev :: (Maybe ExitCode, Map String ArgValue)
prev@(Maybe ExitCode
prevExit,Map String ArgValue
prevMap) String
parameter =
let
newExit :: ExitCode -> Maybe ExitCode
newExit ExitCode
exitCode = Bool -> ExitCode -> Maybe ExitCode -> Maybe ExitCode
upgradeError Bool
noticeErrors ExitCode
exitCode Maybe ExitCode
prevExit
cantParse :: IO (Maybe ExitCode, Map String ArgValue)
cantParse =
do
String -> IO ()
printToErr (String
"Can't parse "String -> String -> String
forall a. [a] -> [a] -> [a]
++String
parameter)
IO ()
displayHelp
(Maybe ExitCode, Map String ArgValue)
-> IO (Maybe ExitCode, Map String ArgValue)
forall (m :: * -> *) a. Monad m => a -> m a
return (ExitCode -> Maybe ExitCode
newExit (Int -> ExitCode
ExitFailure Int
4),Map String ArgValue
prevMap)
in
case String
parameter of
String
"--uni" ->
do
IO ()
displayHelp
(Maybe ExitCode, Map String ArgValue)
-> IO (Maybe ExitCode, Map String ArgValue)
forall (m :: * -> *) a. Monad m => a -> m a
return (ExitCode -> Maybe ExitCode
newExit ExitCode
ExitSuccess,Map String ArgValue
prevMap)
String
"--uni-version" ->
do
String -> IO ()
printToErr (String
"uni's version is "String -> String -> String
forall a. [a] -> [a] -> [a]
++String
uniVersion)
(Maybe ExitCode, Map String ArgValue)
-> IO (Maybe ExitCode, Map String ArgValue)
forall (m :: * -> *) a. Monad m => a -> m a
return (ExitCode -> Maybe ExitCode
newExit ExitCode
ExitSuccess,Map String ArgValue
prevMap)
String
"--uni-parameters" ->
do
Map String ArgValue -> IO ()
displayState Map String ArgValue
prevMap
(Maybe ExitCode, Map String ArgValue)
-> IO (Maybe ExitCode, Map String ArgValue)
forall (m :: * -> *) a. Monad m => a -> m a
return (ExitCode -> Maybe ExitCode
newExit ExitCode
ExitSuccess,Map String ArgValue
prevMap)
Char
'-':Char
'-':Char
'u':Char
'n':Char
'i':Char
'-':String
setParm ->
case String -> Maybe (String, String)
splitSetPart String
setParm of
Maybe (String, String)
Nothing -> IO (Maybe ExitCode, Map String ArgValue)
cantParse
Just (String
option,String
value) ->
case (ProgramArgument -> Bool)
-> [ProgramArgument] -> Maybe ProgramArgument
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\ ProgramArgument
arg -> ProgramArgument -> String
optionName ProgramArgument
arg String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
option)
[ProgramArgument]
arguments of
Maybe ProgramArgument
Nothing ->
do
if Bool
noticeErrors
then
do
IO ()
displayHelp
String -> IO ()
printToErr (String
"Option '"String -> String -> String
forall a. [a] -> [a] -> [a]
++String
optionString -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"' not recognised")
else
() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
(Maybe ExitCode, Map String ArgValue)
-> IO (Maybe ExitCode, Map String ArgValue)
forall (m :: * -> *) a. Monad m => a -> m a
return (ExitCode -> Maybe ExitCode
newExit (Int -> ExitCode
ExitFailure Int
4),Map String ArgValue
prevMap)
Just ProgramArgument
arg ->
ArgType
-> String
-> String
-> (Maybe ExitCode, Map String ArgValue)
-> IO (Maybe ExitCode, Map String ArgValue)
tryToAddValue (ProgramArgument -> ArgType
argType ProgramArgument
arg) String
option String
value (Maybe ExitCode, Map String ArgValue)
prev
Char
'-':Char
'-':Char
'u':Char
'n':Char
'i':String
_ -> IO (Maybe ExitCode, Map String ArgValue)
cantParse
String
_ -> (Maybe ExitCode, Map String ArgValue)
-> IO (Maybe ExitCode, Map String ArgValue)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ExitCode, Map String ArgValue)
prev
tryToAddValue :: ArgType -> String -> String -> ParseState ->
IO ParseState
tryToAddValue :: ArgType
-> String
-> String
-> (Maybe ExitCode, Map String ArgValue)
-> IO (Maybe ExitCode, Map String ArgValue)
tryToAddValue ArgType
argType String
option String
value prev :: (Maybe ExitCode, Map String ArgValue)
prev@(Maybe ExitCode
prevExit,Map String ArgValue
prevMap) =
case ArgType -> String -> Maybe ArgValue
parseArgValue ArgType
argType String
value of
Maybe ArgValue
Nothing ->
do
String -> IO ()
printToErr(String
"For --uni-"String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
option String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", "String -> String -> String
forall a. [a] -> [a] -> [a]
++(String -> String
forall a. Show a => a -> String
show String
value)String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
" isn't "String -> String -> String
forall a. [a] -> [a] -> [a]
++ (ArgType -> String
showArgType ArgType
argType))
(Maybe ExitCode, Map String ArgValue)
-> IO (Maybe ExitCode, Map String ArgValue)
forall (m :: * -> *) a. Monad m => a -> m a
return
(Bool -> ExitCode -> Maybe ExitCode -> Maybe ExitCode
upgradeError Bool
True (Int -> ExitCode
ExitFailure Int
4) Maybe ExitCode
prevExit,Map String ArgValue
prevMap)
Just ArgValue
argValue ->
(Maybe ExitCode, Map String ArgValue)
-> IO (Maybe ExitCode, Map String ArgValue)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ExitCode
prevExit,String -> ArgValue -> Map String ArgValue -> Map String ArgValue
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert String
option ArgValue
argValue Map String ArgValue
prevMap)
splitSetPart :: String -> Maybe (String,String)
splitSetPart :: String -> Maybe (String, String)
splitSetPart String
"" = Maybe (String, String)
forall a. Maybe a
Nothing
splitSetPart (Char
':':String
rest) = (String, String) -> Maybe (String, String)
forall a. a -> Maybe a
Just (String
"",String
rest)
splitSetPart (Char
'=':String
rest) = (String, String) -> Maybe (String, String)
forall a. a -> Maybe a
Just (String
"",String
rest)
splitSetPart (Char
first:String
rest) =
case String -> Maybe (String, String)
splitSetPart String
rest of
Maybe (String, String)
Nothing -> Maybe (String, String)
forall a. Maybe a
Nothing
Just (String
left,String
right) -> (String, String) -> Maybe (String, String)
forall a. a -> Maybe a
Just (Char
firstChar -> String -> String
forall a. a -> [a] -> [a]
:String
left,String
right)
displayHelp :: IO ()
displayHelp :: IO ()
displayHelp =
do
String -> IO ()
printToErr String
"Command-line options:"
String -> IO ()
printToErr String
"--uni displays this message"
String -> IO ()
printToErr String
"--uni-version displays the current version"
String -> IO ()
printToErr String
"--uni-parameters displays option settings"
[IO ()] -> IO ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_
((ProgramArgument -> IO ()) -> [ProgramArgument] -> [IO ()]
forall a b. (a -> b) -> [a] -> [b]
map
(\ (ProgramArgument{optionName :: ProgramArgument -> String
optionName = String
optionName,
optionHelp :: ProgramArgument -> String
optionHelp = String
optionHelp,argType :: ProgramArgument -> ArgType
argType = ArgType
argType}) ->
String -> IO ()
printToErr (
String
"--uni-"String -> String -> String
forall a. [a] -> [a] -> [a]
++String
optionNameString -> String -> String
forall a. [a] -> [a] -> [a]
++String
"=["String -> String -> String
forall a. [a] -> [a] -> [a]
++ArgType -> String
showArgType ArgType
argType String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"] sets "String -> String -> String
forall a. [a] -> [a] -> [a]
++String
optionHelp
)
)
[ProgramArgument]
arguments
)
displayState :: Map.Map String ArgValue -> IO ()
displayState :: Map String ArgValue -> IO ()
displayState Map String ArgValue
fmap =
do
let optionValues :: [(String, ArgValue)]
optionValues = Map String ArgValue -> [(String, ArgValue)]
forall k a. Map k a -> [(k, a)]
Map.toList Map String ArgValue
fmap
String -> IO ()
printToErr String
"Parameter settings:"
[IO ()] -> IO ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_
(((String, ArgValue) -> IO ()) -> [(String, ArgValue)] -> [IO ()]
forall a b. (a -> b) -> [a] -> [b]
map
(\ (String
option,ArgValue
argValue) ->
String -> IO ()
printToErr (String
"--uni-"String -> String -> String
forall a. [a] -> [a] -> [a]
++String
optionString -> String -> String
forall a. [a] -> [a] -> [a]
++String
"="String -> String -> String
forall a. [a] -> [a] -> [a]
++
(ArgValue -> String
showArgValue ArgValue
argValue))
)
[(String, ArgValue)]
optionValues
)
handleEnv :: ParseState -> ProgramArgument -> IO ParseState
handleEnv :: (Maybe ExitCode, Map String ArgValue)
-> ProgramArgument -> IO (Maybe ExitCode, Map String ArgValue)
handleEnv prev :: (Maybe ExitCode, Map String ArgValue)
prev@(Maybe ExitCode
prevExit,Map String ArgValue
prevMap) ProgramArgument
arg =
do
let
option :: String
option = ProgramArgument -> String
optionName ProgramArgument
arg
envVar :: String
envVar = String
"UNI"String -> String -> String
forall a. [a] -> [a] -> [a]
++((Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper String
option)
Either IOException String
valueOpt <- IO String -> IO (Either IOException String)
forall e a. Exception e => IO a -> IO (Either e a)
Exception.try (String -> IO String
System.getEnv String
envVar)
case Either IOException String
valueOpt of
Left (IOException
_ :: Exception.IOException) -> (Maybe ExitCode, Map String ArgValue)
-> IO (Maybe ExitCode, Map String ArgValue)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ExitCode, Map String ArgValue)
prev
Right String
newValue ->
ArgType
-> String
-> String
-> (Maybe ExitCode, Map String ArgValue)
-> IO (Maybe ExitCode, Map String ArgValue)
tryToAddValue (ProgramArgument -> ArgType
argType ProgramArgument
arg) String
option String
newValue (Maybe ExitCode, Map String ArgValue)
prev
checkReq :: ParseState -> String -> IO ParseState
checkReq :: (Maybe ExitCode, Map String ArgValue)
-> String -> IO (Maybe ExitCode, Map String ArgValue)
checkReq prev :: (Maybe ExitCode, Map String ArgValue)
prev@(Maybe ExitCode
prevExit,Map String ArgValue
prevMap) String
option =
case String -> Map String ArgValue -> Maybe ArgValue
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
option Map String ArgValue
prevMap of
Just ArgValue
_ -> (Maybe ExitCode, Map String ArgValue)
-> IO (Maybe ExitCode, Map String ArgValue)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ExitCode, Map String ArgValue)
prev
Maybe ArgValue
Nothing ->
do
String -> IO ()
printToErr (String
"Option "String -> String -> String
forall a. [a] -> [a] -> [a]
++String
optionString -> String -> String
forall a. [a] -> [a] -> [a]
++String
" is not set.")
(Maybe ExitCode, Map String ArgValue)
-> IO (Maybe ExitCode, Map String ArgValue)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> ExitCode -> Maybe ExitCode -> Maybe ExitCode
upgradeError Bool
True (Int -> ExitCode
ExitFailure Int
4) Maybe ExitCode
prevExit,Map String ArgValue
prevMap)
upgradeError :: Bool -> ExitCode -> Maybe ExitCode -> Maybe ExitCode
upgradeError :: Bool -> ExitCode -> Maybe ExitCode -> Maybe ExitCode
upgradeError Bool
False ExitCode
_ Maybe ExitCode
soFar = Maybe ExitCode
soFar
upgradeError Bool
True ExitCode
exitCode Maybe ExitCode
Nothing = ExitCode -> Maybe ExitCode
forall a. a -> Maybe a
Just ExitCode
exitCode
upgradeError Bool
True ExitCode
exitCode (Just ExitCode
ExitSuccess) = ExitCode -> Maybe ExitCode
forall a. a -> Maybe a
Just ExitCode
exitCode
upgradeError Bool
True ExitCode
ExitSuccess (Just ExitCode
exitCode) = ExitCode -> Maybe ExitCode
forall a. a -> Maybe a
Just ExitCode
exitCode
upgradeError Bool
True (ExitFailure Int
level1) (Just (ExitFailure Int
level2)) =
ExitCode -> Maybe ExitCode
forall a. a -> Maybe a
Just (Int -> ExitCode
ExitFailure (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
level1 Int
level2))
foreign import ccall "default_options.h & default_options"
defaultOptions :: CString
printToErr :: String -> IO ()
printToErr :: String -> IO ()
printToErr String
message =
do
Handle -> String -> IO ()
hPutStrLn Handle
stderr String
message