sifflet 1.0 → 1.1
raw patch · 3 files changed
+205/−30 lines, 3 filesdep −haskell-srcdep ~cairodep ~glibdep ~gtk
Dependencies removed: haskell-src
Dependency ranges changed: cairo, glib, gtk, sifflet-lib
Files
- Options.hs +92/−0
- sifflet.cabal +7/−8
- sifflet.hs +106/−22
+ Options.hs view
@@ -0,0 +1,92 @@+module Options (Options(..), processArgs, showHelp) where++-- ?? import Control.Monad (mapM_)++-- | Options are the interpretation of sifflet command-line arguments.+-- If a function call is requested, the remaining arguments are unparsed,+-- and just saved as strings to be fed into the parser when the+-- function's argument types are known.++data Options = Options { optionsShowFunPad :: Bool+ , optionsHelp :: Bool+ , optionsSourceFile :: Maybe FilePath+ , optionsShowFunction :: Maybe String+ , optionsCallFunction :: Maybe String+ , optionsAdditionalArgs :: [String]+ , optionsErrorMsg :: Maybe String+ }+ deriving (Eq, Show)++defaultOptions :: Options+defaultOptions = Options { optionsShowFunPad = True+ , optionsHelp = False+ , optionsSourceFile = Nothing+ , optionsShowFunction = Nothing+ , optionsCallFunction = Nothing+ , optionsAdditionalArgs = []+ , optionsErrorMsg = Nothing+ }++processArgs :: [String] -> Options+processArgs = processArgsLoop defaultOptions ++processArgsLoop :: Options -> [String] -> Options+processArgsLoop options args =+ case args of+ [] -> options+ arg:args' ->+ case arg of+ "--help" -> options {optionsHelp = True,+ optionsShowFunPad = False}+ "--file" ->+ case args' of+ [] -> options {optionsErrorMsg = + Just "--file: missing file name"}+ file:args'' ->+ processArgsLoop (options {optionsSourceFile = Just file,+ optionsShowFunPad = False})+ args''+ "--show" ->+ case args' of+ [] -> options {optionsErrorMsg =+ Just "--show: missing function name"}+ fname:args'' ->+ processArgsLoop (options {optionsShowFunction = + Just fname,+ optionsShowFunPad = False})+ args''+ "--call" ->+ case args' of+ [] -> options {optionsErrorMsg =+ Just "--call: missing function name"}+ fname:args'' ->+ options {optionsCallFunction = Just fname,+ optionsAdditionalArgs = args'',+ optionsShowFunPad = False}+ _ ->+ options {optionsErrorMsg = Just ("unexpected argument: " +++ arg)}++helpText :: [String]+helpText =+ ["Usage:",+ "sifflet [--file SIFFLET-FILE] --show FUNCTION-NAME",+ "sifflet [--file SIFFLET-FILE] --call FUNCTION-NAME [ARG ...]",+ "sifflet --help",+ "sifflet",+ "where",+ "1. If --file SIFFLET-FILE is given, then the function definition is",+ "read from that file; otherwise, it should be one of the Sifflet",+ "examples in the Function Pad.",+ "2. If --show FUNCTION-NAME is used, the function is merely",+ "displayed, ready to be called but not actually called.",+ "3. If --call FUNCTION-NAME [ARG ...] is used, the function",+ "is displayed and called (with the given arguments ARG ..., if any).",+ "4. --help displays this message.",+ "Any of these options suppresses the initial appearance of",+ "the Function Pad, though (except with --help) it can still be",+ "activated by the user."]++showHelp :: IO ()+showHelp = mapM_ putStrLn helpText+
sifflet.cabal view
@@ -1,5 +1,5 @@ name: sifflet-version: 1.0+version: 1.1 cabal-version: >= 1.6 build-type: Simple license: BSD3@@ -33,22 +33,21 @@ executable sifflet main-is: sifflet.hs+ other-modules: Options build-depends: base >= 4.0 && < 4.3,- -- begin GTK stuff, should have same version numbers- cairo == 0.11.0,- glib == 0.11.0,- gtk == 0.11.0,+ -- begin GTK stuff, no longer needing exactly the same version numbers+ cairo == 0.11.*,+ glib == 0.11.*,+ gtk == 0.11.*, -- end containers >= 0.2 && < 0.4, fgl >= 5.4 && < 5.5, haskell98 >= 1.0.1 && < 1.0.2,- haskell-src >= 1.0.1 && < 1.0.2, hxt >= 8.3 && < 8.6, mtl >= 1.1 && < 1.2, process >= 1.0 && < 1.1,- -- and of course our very own ...- sifflet-lib == 1.0+ sifflet-lib >= 1.1 if !os(windows) build-depends: unix >= 2.3 && < 2.5
sifflet.hs view
@@ -1,13 +1,49 @@ module Main (main) where +import Control.Monad (when) import Data.IORef+import System.Exit +import Sifflet.Data.Functoid import Sifflet.Data.TreeLayout import Sifflet.Examples import Sifflet.Language.Expr+import Sifflet.Language.Parser import Sifflet.UI+import Sifflet.Util --- ---------------------------------------------------------------------+import Options+++-- | Main function++main :: IO ()+main = do+ {+ -- scim-bridge causes many errors, so don't use it+ suppressScimBridge++ -- Initialize GTK, returning args unused by Gtk itself+ ; args <- initGUI+ -- Process remaining command-line arguments+ ; let commands = processArgs args++ -- create the user interface+ ; vpui <- vpuiNew wstyle initialEnv+ ; let vpui' = vpui {vpuiToolkits = defaultVPUIToolkitsWithExamples}+ ; uiref <- newIORef vpui'+ -- Create wome windows+ ; let cbmgr = mkCBMgr uiref+ ; vpui'' <- showWorkWin vpui' workspaceId cbmgr+ ; writeIORef uiref vpui''++ -- Obey command-line arguments, then let Gtk take over+ ; mExitCode <- performCommands commands cbmgr uiref+ ; case mExitCode of+ Nothing -> mainGUI >> return ()+ Just code -> exitWith code+ }+ -- | Environment initialEnv :: Env@@ -25,29 +61,77 @@ VPToolkit "My Functions" 500 (functionToolsFromLists [[]])] in zip (map toolkitName toolkits) toolkits --- | Main function+-- | Perform the things requested in command-line arguments.+-- Return an exit code if processing should continue. -main :: IO ()-main = do+performCommands :: Options -> CBMgr -> IORef VPUI -> IO (Maybe ExitCode)+performCommands options cbmgr uiref =+ -- Error?+ case optionsErrorMsg options of+ Just msg ->+ putStrLn ("sifflet: " ++ msg) >> return (Just (ExitFailure 1))+ Nothing ->+ -- Help requested?+ if optionsHelp options+ then showHelp >> return (Just ExitSuccess)+ else do+ {+ -- show function pad?+ when (optionsShowFunPad options)+ (modifyIORefIO uiref (showFunctionPadWindow cbmgr))++ -- source a file?+ -- What if no such file???+ ; case optionsSourceFile options of+ Nothing -> return ()+ Just file ->+ modifyIORefIO uiref (openFilePath cbmgr file)++ -- show or call a function?+ ; case (optionsShowFunction options, + optionsCallFunction options) of+ -- neither+ (Nothing, Nothing) -> return Nothing+ -- just show+ (Just fname, Nothing) -> + showFunctionFrame fname Nothing uiref >>+ return Nothing+ -- call, overrides show if both are given+ (_, Just fname) ->+ showFunctionFrame fname + (Just (optionsAdditionalArgs options))+ uiref+ }++showFunctionFrame :: String -- ^ function name+ -> Maybe [String] -- ^ Just args, to call with args+ -> IORef VPUI+ -> IO (Maybe ExitCode)+showFunctionFrame fname mArgStrs uiref = do {- -- scim-bridge causes many errors, so don't use it- suppressScimBridge+ vpui <- readIORef uiref+ ; let x = styleFramePad (vpuiStyle vpui)+ y = 150+ env = vpuiGlobalEnv vpui - -- Initialize GTK- ; _ <- initGUI+ showFun :: Function -> Maybe [Value] -> IO ()+ showFun f mArgValues = + vpuiAddFrame vpui workspaceId (FunctoidFunc f)+ mArgValues CallFrame env x y 0 Nothing >>=+ writeIORef uiref - -- create the user interface- ; vpui <- vpuiNew wstyle initialEnv- ; let vpui' = vpui {vpuiToolkits = defaultVPUIToolkitsWithExamples}- workId = "Sifflet Workspace"- ; uiref <- newIORef vpui'- -- Create wome windows- ; let cbmgr = mkCBMgr uiref- ; vpui'' <- showWorkWin vpui' workId cbmgr- ; writeIORef uiref vpui''+ ; case envLookup env fname of+ Just (VFun f@(Function _fname argTypes _retType (Compound _ _))) ->+ case mArgStrs of+ Nothing -> showFun f Nothing >> return Nothing+ Just argStrs ->+ case parseTypedInputs2 argStrs argTypes of+ Fail msg ->+ putStrLn ("sifflet: " ++ msg) >>+ return (Just (ExitFailure 1))+ Succ argValues ->+ showFun f (Just argValues) >> return Nothing - ; showFunctionPadWindow cbmgr vpui'' >>= writeIORef uiref- -- run GTK- ; mainGUI- ; return ()-}+ _ -> putStrLn ("sifflet: function not found or not compound") >>+ return (Just (ExitFailure 2))+ }