Options.curry 6.5 KB
Newer Older
1 2 3 4
------------------------------------------------------------------------------
--- Option process for the `curry2cgi` script.
---
--- @author Michael Hanus
5
--- @version September 2020
6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26
------------------------------------------------------------------------------

module C2C.Options
 where

import Distribution ( installDir )
import GetOpt
import List         ( nub )
import ReadNumeric  ( readNat )
import System       ( exitWith, system )

import AbstractCurry.Types ( QName )
import System.CurryPath    ( stripCurrySuffix )

------------------------------------------------------------------------

--- The script banner.
banner :: String
banner = unlines [bannerLine,bannerText,bannerLine]
 where
  bannerText = "Compile Curry programs with HTML forms to CGI executables " ++
27
               "(Version of 02/09/20)"
28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90
  bannerLine = take (length bannerText) (repeat '=')

------------------------------------------------------------------------------
-- Option processing for the script.

data Options = Options
  { optVerb      :: Int   -- verbosity (0: quiet, 1: status, 2: interm, 3: all)
  , optHelp      :: Bool     -- if help info should be printed
  , optOutput    :: String   -- name of the cgi program file (with suffix .cgi)
  , optMain      :: String   -- the main expression
  , optForms     :: [QName]  -- qualified names of form operations
  , optFormMods  :: [String] -- names of modules containing form operations
  , optSystem    :: String   -- path to root of Curry system
  , optSysName   :: String   -- name of the Curry system ("pakcs", "kics2")
  , optCPM       :: String   -- command to invoke Curry Package Manager
  , optCurryRC   :: [String] -- curryrc options
  , optCurryOpts :: [String] -- options passed to the Curry compiler
  , optLimit     :: String   -- ulimit settings for the cgi program
  }

defaultOptions :: Options
defaultOptions =
  Options 1 False "" "" [] [] installDir "" "cypm exec"
          [] [":set -time", ":set -interactive"]
          "-t 120"

--- Process the actual command line argument and return the options
--- and the name of the main program.
processOptions :: [String] -> IO (Options,String)
processOptions argv = do
  let (funopts, args, opterrors) = getOpt Permute options argv
      opts = foldl (flip id) defaultOptions funopts
  unless (null opterrors)
         (putStr (unlines opterrors) >> printUsage >> exitWith 1)
  when (optHelp opts) (printUsage >> exitWith 0)
  case args of
    [p] -> let mname = stripCurrySuffix p
               opts1 = opts { optFormMods = nub (optFormMods opts ++ [mname])
                            , optMain = if null (optMain opts)
                                          then mname ++ ".main"
                                          else optMain opts }
           in return (opts1, mname)
    []  -> error $ "Name of main module missing!"
    _   -> error $ "Please provide only one main module!"
 where
  printUsage = putStrLn (banner ++ "\n" ++ usageText)

-- Usage text
usageText :: String
usageText =
  usageInfo ("Usage: curry2cgi [options] <module name>\n") options

-- Definition of actual command line options.
options :: [OptDescr (Options -> Options)]
options =
  [ Option "h?" ["help"]
           (NoArg (\opts -> opts { optHelp = True }))
           "print help and exit"
  , Option "q" ["quiet"]
           (NoArg (\opts -> opts { optVerb = 0 }))
           "run quietly (no output, only exit code)"
  , Option "v" ["verb"]
            (OptArg (maybe (checkVerb 2) (safeReadNat checkVerb)) "<n>")
91 92 93 94 95
            ("verbosity level:\n" ++
             "0: quiet (same as `-q')\n" ++
             "1: show status messages (default)\n" ++
             "2: show intermediate results (same as `-v')\n" ++
             "3: show all details")
96 97 98 99 100 101 102 103 104 105 106 107 108 109 110
  , Option "m" ["main"]
            (ReqArg (\s opts -> opts { optMain = s }) "<m>")
            ("Curry expression (of type IO HtmlPage) computing\n" ++
             "the HTML page\n(default: main)")
  , Option "o" ["output"]
            (ReqArg (\s opts -> opts { optOutput = s }) "<o>")
            ("name of the file (with suffix .cgi) where the cgi\n" ++
             "program should be stored (default: <curry>.cgi)")
  , Option "i" ["include"]
            (ReqArg (\s opts -> opts { optFormMods = optFormMods opts ++ [s] })
                    "<i>")
            ("Additional Curry module for which all public\n" ++
             "form handlers should be generated")
  , Option "s" ["system"]
            (ReqArg (\s opts -> opts { optSystem = s }) "<s>")
111 112 113
            ("set path to the root of Curry system so that\n" ++
             "'<s>/bin/curry' is invoked to compile script\n" ++
             "(default: '" ++ installDir ++ "')")
114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167
  , Option "" ["cpmexec"]
            (ReqArg (\s opts -> opts { optCPM = s }) "<c>")
            ("set the command to execute programs with the\n" ++
             "Curry Package Manager (default: 'cypm exec')")
  , Option "D" []
            (ReqArg (\s opts -> opts { optCurryRC = optCurryRC opts ++ [s] })
                    "name=val")
            "define (curry)rc property 'name' as 'val'"
  , Option "u" ["ulimit"]
            (ReqArg (\s opts -> opts { optLimit = s }) "<l>")
            ("set 'ulimit <l>' when executing the cgi program\n" ++
             "(default: '-t 120')")
  ]
 where
  safeReadNat opttrans s opts =
   let numError = error "Illegal number argument (try `-h' for help)"
   in maybe numError
            (\ (n,rs) -> if null rs then opttrans n opts else numError)
            (readNat s)

  checkVerb n opts = if n>=0 && n<4
                     then opts { optVerb = n }
                     else error "Illegal verbosity level (try `-h' for help)"

putStrLnInfo :: Options -> String -> IO ()
putStrLnInfo opts s = when (optVerb opts > 0) $ putStrLn s

putStrLnInter :: Options -> String -> IO ()
putStrLnInter opts s = when (optVerb opts > 1) $ putStrLn s

putStrLnDetail :: Options -> String -> IO ()
putStrLnDetail opts s = when (optVerb opts > 2) $ putStrLn s

line :: String
line = take 78 (repeat '-')

------------------------------------------------------------------------------
-- Some auxiliaries.

--- The name of the form definition type.
formDefTypeName :: (String,String)
formDefTypeName = ("HTML.Base","HtmlFormDef")

--- Shows a qualified name.
showQName :: (String,String) -> String
showQName (mn,fn) = mn ++ "." ++ fn

--- Executes a command and show the command if verbosity is detailed.
execVerbCommand :: Options -> String -> IO Int
execVerbCommand opts cmd = do
  when (optVerb opts > 2) $ putStrLn $ "EXECUTING: " ++ cmd
  system cmd

-------------------------------------------------------------------------