packages feed

hgen-1.4.0: src/Params.hs

module Params

where 

import System.Console.GetOpt ( OptDescr(..), ArgDescr(..), ArgOrder(..),
                               getOpt, usageInfo )
import Control.Monad.Error (MonadError(..))
import Control.Applicative ( (<$>) )
import System.Directory      ( getHomeDirectory, doesFileExist )
import System.FilePath       ( (</>) )
import System.Environment    ( getArgs )



getParams :: IO (Either ParsingErrMsg Params)
getParams =
    do let clp_0 = defaultParams
       m_rcfile <- findRc
       parse_clp_1 <- case m_rcfile of
                        Nothing -> return $ return clp_0
                        Just f  -> do rc_args <- words <$> readFile f
                                      return $  parseCmds rc_args clp_0
                                              `catchError`
                                                (\e -> fail $ f ++ ":\n" ++ e)
       --
       cmdline_args   <- getArgs
       --
       return $ do clp_1 <- parse_clp_1
                   parseCmds cmdline_args clp_1



rcfile :: FilePath
rcfile = ".hgenrc"


findRc :: IO (Maybe FilePath)
findRc =
    do existsInCurrent <- doesFileExist rcfile
       if existsInCurrent
         then return (Just rcfile)
         else do
             home <- getHomeDirectory
             let inHome = home </> rcfile
             --
             existsInHome <- doesFileExist inHome
             if existsInHome then return (Just inHome) else return Nothing


usage :: String -> String
usage header = unlines [
    usageInfo header options,
    "",
    "If a file called `" ++  "." </> rcfile ++ "' or `" ++ "~" </> rcfile
    ++ "' exists, it will be scanned for arguments first"
    ]


type ParamsModifier   = Params -> Either ParsingErrMsg Params
type ParsingErrMsg    = String

parseCmds :: [String] -> Params -> Either ParsingErrMsg Params
parseCmds argv params =
  case getOpt RequireOrder options argv of
    (pMods, [],  []) -> thread pMods params
    (   _, unk,  []) -> fail $ "Unknown option: " ++ unwords unk
    (   _,   _,errs) -> fail $ unlines errs


thread :: Monad m => [a -> m a] -> a -> m a
thread = foldr (\f g -> \a -> f a >>= g) return

options :: [OptDescr ParamsModifier]
options =
  [Option ['h','?']
          ["help"]
          (NoArg $ \p -> return p{showHelp = True})
          "display this help and exit",
   Option ['H']
          ["hide-summary"]
          (NoArg $ \p -> return p{hidesummary = True})
           "hide summary of the options used",
   Option ['#']
          ["num-inst"]
          (ReqArg ((not . null) ?-> \s p -> return p{numinst = read s}) "INT")
          "number of formulas to generate",
   Option ['c']
          ["num-clauses"]
          (ReqArg ((not . null) ?-> \s p -> return p{numclauses = read s}) "INT")
          "number of clauses per formula",
   Option []
          ["clause-size"]
          (ReqArg ((not . null) ?-> \s p -> return p{csize = read s}) "[INT]")
          "size of a clause (ie [1,1,1] means same chance for length 1,2 or 3)",
   Option []
          ["mods"]
          (ReqArg ((not . null) ?-> \s p -> return p{mods = read s}) "INT")
          "number of modalities",
   Option []
          ["global-depth"]
          (ReqArg ((not .null) ?-> \s p -> return p{gdepth = read s}) "INT")
          "global (maximum) depth",
   Option []
          ["force-depths"]
          (NoArg $ \p -> return p{forceDepths = True})
          "wether or not to impose strict maximum depth per operator",
   Option []
          ["modal-depth"]
          (ReqArg ((not . null) ?-> \s p -> return p{mdepth = read s}) "INT")
          "modal depth",
   Option []
          ["at-depth"]
          (ReqArg ((not . null) ?-> \s p -> return p{atdepth = read s}) "INT")
           "@ depth",
   Option []
          ["down-arrow-depth"]
          (ReqArg ((not . null) ?-> \s p -> return p{dwdepth = read s}) "INT")
           "down arrow depth",
   Option []
          ["univ-mod-depth"]
          (ReqArg ((not . null) ?-> \s p -> return p{umdepth = read s}) "INT")
           "universal modality depth",
   Option []
          ["diff-univ-mod-depth"]
          (ReqArg ((not . null) ?-> \s p -> return p{dumdepth = read s}) "INT")
           "difference universal modality depth",
   Option []
          ["inv-mod-depth"]
          (ReqArg ((not . null) ?-> \s p -> return p{invdepth = read s}) "INT")
           "inverse modality depth",
   Option []
          ["prop-vars"]
          (ReqArg ((not . null) ?-> \s p -> return p{pvars = read s}) "INT")
           "number of propositional variables",
   Option []
          ["nom-vars"]
          (ReqArg ((not . null) ?-> \s p -> return p{nomvars = read s}) "INT")
           "number of nominal variables",
   Option []
          ["state-vars"]
          (ReqArg ((not . null) ?-> \s p -> return p{stvars = read s}) "INT")
           "number of state variables",
   Option []
          ["proba-mod"]
          (ReqArg ((not . null) ?-> \s p -> return p{pmod = read s}) "INT")
           "probability of a modal operator",
   Option []
          ["proba-at"]
          (ReqArg ((not . null) ?-> \s p -> return p{pat = read s}) "INT")
           "probability of a @ operator",
   Option []
          ["proba-down"]
          (ReqArg ((not . null) ?-> \s p -> return p{pdown = read s}) "INT")
           "probability of a down arrow operator",
   Option []
          ["proba-univ"]
          (ReqArg ((not . null) ?-> \s p -> return p{puniv = read s}) "INT")
           "probability of a universal modality",
   Option []
          ["proba-diff-univ"]
          (ReqArg ((not . null) ?-> \s p -> return p{pduniv = read s}) "INT")
           "probability of a difference universal modality",
   Option []
          ["proba-inv"]
          (ReqArg ((not . null) ?-> \s p -> return p{pinv = read s}) "INT")
           "probability of an inverse modality",
   Option []
          ["proba-prop"]
          (ReqArg ((not . null) ?-> \s p -> return p{pprop = read s}) "INT")
           "probability of a proposition",
   Option []
          ["proba-nom"]
          (ReqArg ((not . null) ?-> \s p -> return p{pnom = read s}) "INT")
           "probability of a nominal",
   Option []
          ["proba-state"]
          (ReqArg ((not . null) ?-> \s p -> return p{psvar = read s}) "INT")
           "probability of a state variable",
   Option []
          ["proba-neg"]
          (ReqArg ((not . null) ?-> \s p -> return p{pneg = read s}) "INT")
           "probability of a negation",
   Option []
          ["proba-op"]
          (ReqArg ((not . null) ?-> \s p -> return p{pop = read s}) "INT")
           "probability of an operator"
  ]


(?->) :: (String -> Bool) -> (String -> ParamsModifier) -> String -> ParamsModifier
p ?-> m = \s -> if not (null s) && p s
                  then m s
                  else \_ -> throwError ("Invalid argument: '" ++ s ++ "'")


defaultParams :: Params
defaultParams
       = Prms {numinst       = 1, -- Number of Instances to Generate.
               numclauses    = 5, -- Number of Clauses to Generate per Instance.
               csize         = [0,0,1], -- Size of a Clause. (ie [1,1,1] means same chance for length 1,2 or 3)
               mods          = 1, -- Number of Modalities.
               gdepth        = 6, -- Global (maximum) depth
               forceDepths   = False, -- Force global max depth (ignore max depth per operator)
               mdepth        = 2, -- Modal Depth.
               atdepth       = 2, -- @ Depth.
               dwdepth       = 0, -- Downarrow Depth.
               umdepth       = 0, -- Universal Modality Depth.
               dumdepth      = 0, -- Difference Universal Modality Depth.
               invdepth      = 0, -- Inverse Modality Depth.
               pvars         = 5, -- Number of prop vars.
               nomvars       = 5, -- Number of nominals.
               stvars        = 0, -- Number of state variables.
               pmod          = 1, -- Probability of a modal operator.
               pat           = 1, -- Probability of an @ operator
               pdown         = 0, -- Probability of a downarrow operator
               puniv         = 0, -- Probability of an univ. modality
               pduniv        = 0, -- Probability of an diff. univ. modality
               pinv          = 0, -- Probability of an inv. modality
               pprop         = 1, -- Probability of a proposition
               pnom          = 1, -- Probability of a nominal
               psvar         = 0,  -- Probability of a state variable
               pneg          = 50, -- Probability of a negation
               pop           = 50,  -- Probability of an operator
               simpleFormat  = False,
               stdout        = False, -- Wether to save formulas in file or just display the first one on stdout
               hidesummary   = False, -- Wether to hide or not the summary of parameters used
               showHelp      = False -- Wether to display help instead of running
 }


data Params = Prms{
	       numinst       ::Int, -- Number of Instances to Generate.
	       numclauses    ::Int, -- Number of Clauses to Generate per Instance.
	       csize         ::[Int], -- Size of a Clause. (ie [1,1,1] means same chance for length 1,2 or 3)
	       mods          ::Int, -- Number of Modalities.
	       gdepth        ::Int, -- Global (maximum) Depth
	       forceDepths   ::Bool, -- whether or not to impose strict maximum depths per operator
	       mdepth        ::Int, -- Modal Depth.
	       atdepth       ::Int, -- @ Depth.
	       dwdepth       ::Int, -- Downarrow Depth.
	       umdepth       ::Int, -- Universal Modality Depth.
               dumdepth      ::Int, -- Difference Universal Modality Depth.
               invdepth      ::Int, -- Inverse Modality Depth.
	       pvars         ::Int, -- Number of prop vars.
	       nomvars       ::Int, -- Number of nominals.
	       stvars        ::Int, -- Number of state variables.
	       pmod          ::Int, -- Probability of a modal operator.
	       pat           ::Int, -- Probability of an @ operator 
	       pdown         ::Int, -- Probability of a downarrow operator
	       puniv         ::Int, -- Probability of an universal modality
               pduniv        ::Int, -- Probability of an diff. univ. modality
               pinv          ::Int, -- Probability of an inverse modality
	       pprop         ::Int, -- Probability of a proposition
	       pnom          ::Int, -- Probability of a nominal
	       psvar         ::Int, -- Probability of a state variable
	       pneg          ::Int, -- Probability of a negation 
               pop           ::Int,  -- Probability of an operator
               simpleFormat  ::Bool,
               stdout        ::Bool, -- Wether to save formulas in file or just display the first one on stdout
               hidesummary   ::Bool, -- Wether to hide or not the summary of parameters used
               showHelp      ::Bool -- Wether to display help instead of running
           } 

instance Show Params where
  show p =
   unlines ["Number of Instances to Generate           : numinst = " ++ show (numinst p),
            "Number of Clauses to Generate per Instance: numclauses = " ++ show (numclauses p),
            "Size of a Clause                          : csize = " ++ show (csize p),
            "Number of Modalities                      : mods = " ++ show (mods p),
            "Global (maximum) Depth                    : gdepth = " ++ show (gdepth p),
            "Enformce maximum depths?                  : force-depths = " ++ show (forceDepths p),
            "Modal Depth                               : mdepth = " ++ show (mdepth p),
            "@ Depth                                   : atdepth = " ++ show (atdepth p),
            "Downarrow Depth                           : dwdepth = " ++ show (dwdepth p),
            "Universal Modality Depth                  : umdepth = " ++ show (umdepth p),
            "Difference Universal Modality Depth       : dumdepth = " ++ show (dumdepth p),
            "Inverse Modality Depth                    : invdepth = " ++ show (invdepth p),
            "Number of propositional variables         : pvars = " ++ show (pvars p),
            "Number of nominals                        : nomvars = " ++ show (nomvars p),
            "Number of state variables                 : stvars = " ++ show (stvars p),
            "Probability of a modal operator           : pmod = " ++ show (pmod p),
            "Probability of an @ operator              : pat = " ++ show (pat p),
            "Probability of a downarrow operator       : pdown = " ++ show (pdown p),
            "Probability of an universal modality      : puniv = " ++ show (puniv p),
            "Probability of a diff. universal modality : pduniv = " ++ show (pduniv p),
            "Probability of an inverse modality        : pinv = " ++ show (pinv p),
            "Probability of a propositional variable   : pprop = " ++ show (pprop p),
            "Probability of a nominal                  : pnom = " ++ show (pnom p),
            "Probability of a state variable           : psvar = " ++ show (psvar p),
            "Probability of a negation                 : pneg = " ++ show (pneg p),
            "Probability of an operator                : pop = " ++ show (pop p)]