diff --git a/Graphics/UI/Sifflet/LittleGtk.hs b/Graphics/UI/Sifflet/LittleGtk.hs --- a/Graphics/UI/Sifflet/LittleGtk.hs +++ b/Graphics/UI/Sifflet/LittleGtk.hs @@ -75,7 +75,8 @@ , fileChooserDialogNew , fileChooserGetFilename - + , fileChooserSetCurrentFolder + , FileChooserAction(..) , frameNew diff --git a/Graphics/UI/Sifflet/Types.hs b/Graphics/UI/Sifflet/Types.hs --- a/Graphics/UI/Sifflet/Types.hs +++ b/Graphics/UI/Sifflet/Types.hs @@ -66,7 +66,9 @@ vpuiWindows :: Map WinId VPUIWindow, -- ^ all the windows of the program vpuiToolkits :: [(String, VPToolkit)], -- ^ ordered association list, -- collections of tools - vpuiFilePath :: Maybe FilePath, -- ^ the file opened or to save + vpuiInitialDir :: FilePath, -- where Sifflet started + vpuiCurrentDir :: FilePath, -- current working directory + vpuiCurrentFile :: Maybe FilePath, -- ^ the file opened or to save vpuiStyle :: Style, -- ^ for windows, canvases, editors vpuiInitialEnv :: Env, -- ^ initial value of global environment vpuiGlobalEnv :: Env, -- ^ the global environment diff --git a/Graphics/UI/Sifflet/Window.hs b/Graphics/UI/Sifflet/Window.hs --- a/Graphics/UI/Sifflet/Window.hs +++ b/Graphics/UI/Sifflet/Window.hs @@ -502,16 +502,28 @@ vpui'' <- getOrCreateFunctionPadWindow cbmgr False vpui' >>= updateFunctionPadIO title updatePad - return $ vpui'' {vpuiFilePath = Just filePath, + setWorkspaceTitleForFile vpui'' filePath + return $ vpui'' {vpuiCurrentFile = Just filePath, + vpuiCurrentDir = takeDirectory filePath, vpuiFileEnv = vpuiGlobalEnv vpui'} +setWorkspaceTitleForFile :: VPUI -> FilePath -> IO () +setWorkspaceTitleForFile vpui filePath = + case vpuiTryGetWindow vpui workspaceId of + Just (VPUIWorkWin _ window) -> + -- show file name in workspace window title + set window [windowTitle := + workspaceId ++ ": " ++ takeFileName filePath] + _ -> return () + showDialogFileOpen :: VPUI -> IO (Maybe FilePath) -showDialogFileOpen _vpui = do +showDialogFileOpen vpui = do chooser <- fileChooserDialogNew (Just "Open file ...") -- default title Nothing -- transient parent of the dialog FileChooserActionOpen [("Open", ResponseOk), ("Cancel", ResponseCancel)] -- buttons + _ <- fileChooserSetCurrentFolder chooser (vpuiCurrentDir vpui) result <- runDialogM (toDialog chooser) chooser fileChooserGetFilename return result @@ -539,7 +551,7 @@ menuFileSave :: VPUI -> IO VPUI menuFileSave vpui = - case vpuiFilePath vpui of + case vpuiCurrentFile vpui of Nothing -> menuFileSaveAs vpui Just filePath -> saveFile vpui filePath @@ -555,11 +567,13 @@ -- | Unconditionally save user functions in SiffML file. -- Called from menuFileSave and menuFileSaveAs. --- Updates vpuiFilePath and vpuiFileEnv. +-- Updates vpuiCurrentFile and vpuiFileEnv. saveFile :: VPUI -> FilePath -> IO VPUI saveFile vpui filePath = produceSiffMLFile (userFunctions vpui) filePath >> - return vpui {vpuiFilePath = Just filePath, + setWorkspaceTitleForFile vpui filePath >> + return vpui {vpuiCurrentFile = Just filePath, + vpuiCurrentDir = takeDirectory filePath, vpuiFileEnv = vpuiGlobalEnv vpui} -- | The user-defined functions of the environment @@ -577,7 +591,8 @@ case mpathOptions of Nothing -> return vpui Just (path, options) -> - export options (userFunctions vpui) path >> return vpui + export options (userFunctions vpui) path >> + return (vpui {vpuiCurrentDir = takeDirectory path}) -- | Export user functions to Haskell file menuFileExportHaskell :: VPUI -> IO VPUI @@ -591,7 +606,7 @@ menuFileExportPython vpui = chooseOutputFile "Export Python" vpui >>= maybeDefaultOptions defaultPythonOptions >>= - maybeExportUserFunctions vpui exportPython + maybeExportUserFunctions vpui (exportPython vpui) -- | Export user functions to Scheme file menuFileExportScheme :: VPUI -> IO VPUI @@ -599,16 +614,17 @@ chooseOutputFile "Export Scheme" vpui >>= maybeRunSchemeOptionsDialog >>= -- maybeExportUserFunctions vpui (exportScheme defaultSchemeOptions) - maybeExportUserFunctions vpui exportScheme + maybeExportUserFunctions vpui (exportScheme vpui) -- | Choose an output file, for file save, save as, and export commands chooseOutputFile :: String -> VPUI -> IO (Maybe FilePath) -chooseOutputFile verb _vpui = do +chooseOutputFile verb vpui = do chooser <- fileChooserDialogNew (Just (verb ++ " to file ...")) -- title Nothing -- transient parent of the dialog FileChooserActionSave [(verb, ResponseOk), ("Cancel", ResponseCancel)] -- buttons + _ <- fileChooserSetCurrentFolder chooser (vpuiCurrentDir vpui) result <- runDialogM (toDialog chooser) chooser fileChooserGetFilename return result @@ -695,11 +711,11 @@ path' = if takeExtension path == ext then path else addExtension path ext - + vpui' = vpui {vpuiCurrentDir = takeDirectory path} in case ext of - ".pdf" -> withPDFSurface path' width height render >> return vpui - ".ps" -> withPSSurface path' width height render >> return vpui - ".svg" -> withSVGSurface path' width height render >> return vpui + ".pdf" -> withPDFSurface path' width height render >> return vpui' + ".ps" -> withPSSurface path' width height render >> return vpui' + ".svg" -> withSVGSurface path' width height render >> return vpui' -- Cairo can do PNG too, but it is harder: -- surfaceWriteToPNG surface path' @@ -714,7 +730,7 @@ "(" ++ ext ++ ").\n" ++ "Please try a file extension of " ++ ".svg, .ps, or .pdf." - menuFileSaveImage vpui + menuFileSaveImage vpui' diff --git a/Graphics/UI/Sifflet/Workspace.hs b/Graphics/UI/Sifflet/Workspace.hs --- a/Graphics/UI/Sifflet/Workspace.hs +++ b/Graphics/UI/Sifflet/Workspace.hs @@ -29,6 +29,7 @@ -- import System.IO.Unsafe import Control.Monad +import System.Directory (getCurrentDirectory) import Data.IORef import Data.List @@ -80,10 +81,13 @@ vpuiNew :: Style -> Env -> Bool -> IO VPUI -vpuiNew style env debugging = +vpuiNew style env debugging = do + dir <- getCurrentDirectory return VPUI {vpuiWindows = Map.empty, vpuiToolkits = [], - vpuiFilePath = Nothing, + vpuiCurrentFile = Nothing, + vpuiInitialDir = dir, + vpuiCurrentDir = dir, vpuiStyle = style, vpuiInitialEnv = env, vpuiGlobalEnv = env, @@ -495,9 +499,14 @@ canv = vpuiWindowGetCanvas vw graph = vcGraph canv frameNode = cfFrameNode frame + friendlyTypeError msg = + "Sifflet cannot find any set of " ++ + "data types that will make this function work.\n" ++ + "Details from the type checker (may be obscure):\n" ++ + msg in case functoidToFunction fparts graph frameNode env of Fail errmsg -> - showErrorMessage errmsg >> + showErrorMessage (friendlyTypeError errmsg) >> return vpui Succ function -> let BBox x y _ _ = cfBox frame diff --git a/Language/Sifflet/Export/Exporter.hs b/Language/Sifflet/Export/Exporter.hs --- a/Language/Sifflet/Export/Exporter.hs +++ b/Language/Sifflet/Export/Exporter.hs @@ -11,16 +11,10 @@ , ruleRightToLeft , applyFirstMatch , findFixed - , copyLibFile - , readLibFile ) where -import Control.Monad (unless) -import System.Directory (doesFileExist, copyFile) - -import Graphics.UI.Sifflet.GtkUtil (showErrorMessage) import Language.Sifflet.Expr -- | The type of a function to export (user) functions to a file. @@ -195,33 +189,3 @@ EOp op left right -> EOp op (tdf left) (tdf right) EGroup e'' -> EGroup (tdf e'') _ -> e' - --- | Copy a library file (such as sifflet.py or Sifflet.java) to the same directory --- where an export file is being written, showing a warning message if --- the library file cannot be found. But don't copy it if it already --- exists in the destination location. -copyLibFile :: FilePath -> FilePath -> IO () -copyLibFile orig dest = do - origExists <- doesFileExist orig - destExists <- doesFileExist dest - unless destExists $ - if origExists - then copyFile orig dest - else showErrorMessage $ "Sifflet could not locate the file " ++ orig ++ "\n" ++ - "Please copy it from the Sifflet installation directory to " ++ - "the same directory in which you are saving the export file.\n" - --- | Get the contents of a library file (such as sifflet.scm) --- so you can insert it into the file being exported. --- If the file cannot be found, display an error message and --- return the empty string. -readLibFile :: FilePath -> FilePath -> IO String -readLibFile libFile exportFile = do - libExists <- doesFileExist libFile - if libExists - then readFile libFile - else do - showErrorMessage $ "Sifflet could not locate the file " ++ libFile ++ "\n" ++ - "Please find it in the Sifflet installation directory " ++ - "and insert its contents into " ++ exportFile ++ "\n" - return "" diff --git a/Language/Sifflet/Export/ToPython.hs b/Language/Sifflet/Export/ToPython.hs --- a/Language/Sifflet/Export/ToPython.hs +++ b/Language/Sifflet/Export/ToPython.hs @@ -21,13 +21,15 @@ import Data.Map ((!)) import System.FilePath (replaceFileName) +import Graphics.UI.Sifflet.Types (VPUI(..)) + import Language.Sifflet.Export.Exporter import Language.Sifflet.Export.Python import Language.Sifflet.Expr -- import Text.Sifflet.Pretty import Language.Sifflet.Util -import Paths_sifflet_lib -- Cabal-generated paths module +import System.Sifflet.Paths -- | Options for Python export. -- Should probably include choices like Python2 or Python3; @@ -145,19 +147,16 @@ functionsToPrettyPy :: Functions -> String functionsToPrettyPy = pyPretty . functionsToPyModule -exportPython :: PythonOptions -> Exporter -exportPython _options funcs path = - let header = "# File: " ++ path ++ "\n" ++ - "# Generated by the Sifflet->Python exporter.\n" ++ - "# You may need to copy the file sifflet.py to this directory\n" ++ - "# from the directory where Sifflet is installed.\n" ++ - "\n" ++ - "from sifflet import *\n\n" - libDest = replaceFileName path "sifflet.py" - in do - libSrc <- pythonLibSiffletPath - copyLibFile libSrc libDest - writeFile path (header ++ (functionsToPrettyPy funcs)) - -pythonLibSiffletPath :: IO FilePath -pythonLibSiffletPath = getDataFileName "sifflet.py" +exportPython :: VPUI -> PythonOptions -> Exporter +exportPython vpui _options funcs path = + let header = "# File: " ++ path ++ "\n" ++ + "# Generated by the Sifflet->Python exporter.\n" ++ + "\n" ++ + "# You may need to copy the file sifflet.py into " ++ + "this directory\n" ++ + "# from the directory where Sifflet is installed.\n" ++ + "\n" ++ + "from sifflet import *\n\n" + libDest = replaceFileName path "sifflet.py" + in do copyLibFile vpui "sifflet.py" libDest + writeFile path (header ++ functionsToPrettyPy funcs) diff --git a/Language/Sifflet/Export/ToScheme.hs b/Language/Sifflet/Export/ToScheme.hs --- a/Language/Sifflet/Export/ToScheme.hs +++ b/Language/Sifflet/Export/ToScheme.hs @@ -21,15 +21,18 @@ where -import Paths_sifflet_lib -- generated by Cabal +import System.Sifflet.Paths import Data.Number.Sifflet -import Language.Sifflet.Export.Exporter +import Graphics.UI.Sifflet.Types (VPUI(..)) + import Language.Sifflet.Expr -import Text.Sifflet.Repr -import Text.Sifflet.Pretty +import Language.Sifflet.Export.Exporter import Language.Sifflet.Util +import Text.Sifflet.Pretty +import Text.Sifflet.Repr + -- Scheme S-exprs -- -------------- @@ -302,25 +305,23 @@ -- This, too, could use an extra "explicit lambda" argument, -- like defToSExpr. -exportScheme :: SchemeOptions -> Exporter -exportScheme options functions path = - let header = ";;; File: " ++ path ++ "\n" ++ - ";;; Generated by the Sifflet->Scheme exporter.\n" ++ - "\n" - in do - -- Get contents of sifflet.scm. - -- It must be copied into the export file, - -- since there is no standard way in Scheme to "include" or "import" - -- a library. - libFile <- schemeLibSiffletPath - lib <- readLibFile libFile path - writeFile path - (sepLines2 [header, - functionsToPrettyScheme options functions, - lib]) - --- | The path to the "sifflet.scm" file. -schemeLibSiffletPath :: IO FilePath +exportScheme :: VPUI -> SchemeOptions -> Exporter +exportScheme vpui options functions path = + + let header = ";;; File: " ++ path ++ "\n" ++ + ";;; Generated by the Sifflet->Scheme exporter.\n" ++ + "\n" ++ + ";;; You may need to insert the contents of sifflet.scm,\n" ++ + ";;; from the Sifflet installation directory," ++ + " into this file\n" + in do + -- Get contents of sifflet.scm. + -- It must be copied into the export file, + -- since there is no standard way in Scheme to "include" or "import" + -- a library. + lib <- readLibFile vpui "sifflet.scm" path + writeFile path + (sepLines2 [header, + functionsToPrettyScheme options functions, + lib]) --- getDataFileName is provided by Cabal -schemeLibSiffletPath = getDataFileName "sifflet.scm" diff --git a/System/Sifflet/Paths.hs b/System/Sifflet/Paths.hs new file mode 100644 --- /dev/null +++ b/System/Sifflet/Paths.hs @@ -0,0 +1,77 @@ +module System.Sifflet.Paths + (findDataFile, copyLibFile, readLibFile) + where + +import Control.Monad (unless) +import System.Directory (doesFileExist, copyFile) +import System.FilePath (replaceDirectory) + +-- Cabal-generated paths module tells where a datafile +-- _should_ be, but not necessarily where it is, +-- if the installed files have been relocated. + +import Paths_sifflet_lib (getDataFileName) + +import Graphics.UI.Sifflet.Types (VPUI(..)) +import Graphics.UI.Sifflet.GtkUtil (showErrorMessage) + +-- | Try to find the original of a datafile that is part of the +-- sifflet library. +-- These are usually files like sifflet.scm or sifflet.py that provide +-- Sifflet support for the target language when exporting. +-- First try the directory where Cabal would have installed data files. +-- This may fail if Sifflet has been installed (or portably installed) +-- on Windows into a non-standard location; in that case, also try +-- the directory from which sifflet.exe was launched. + +findDataFile :: VPUI -> FilePath -> IO (Maybe FilePath) +findDataFile vpui fileBaseName = do + -- path1 is where it should be; + -- path2 is where it might be on Windows. + path1 <- getDataFileName fileBaseName + let path2 = replaceDirectory fileBaseName (vpuiInitialDir vpui) + -- There's surely a name for this type of search, + -- which simply returns the first item in the list + -- for which a predicate `returns` True (m True): + search [] = return Nothing + search (path:paths) = do + fileExists <- doesFileExist path + if fileExists + then return $ Just path + else search paths + search [path1, path2] + +-- | Try to copy a library file (such as sifflet.py or Sifflet.java) +-- to the same directory where an export file is being written, +-- if it doesn't already exist there. +-- Show a warning message if the library file cannot be found. +copyLibFile :: VPUI -> FilePath -> FilePath -> IO () +copyLibFile vpui libFileName dest = do + mLibFilePath <- findDataFile vpui libFileName + destExists <- doesFileExist dest + unless destExists $ do + case mLibFilePath of + Nothing -> + showErrorMessage $ "Sifflet could not locate the file " ++ + libFileName ++ "\n" ++ + "Please copy it from the Sifflet installation directory to " ++ + "the same directory into which you are saving the export file.\n" + Just libFileSource -> + copyFile libFileSource dest + +-- | Get the contents of a library file (such as sifflet.scm) +-- so you can insert it into the file being exported. +-- If the file cannot be found, display an error message and +-- return the empty string. +readLibFile :: VPUI -> FilePath -> FilePath -> IO String +readLibFile vpui libFileName exportFile = do + mLibFilePath <- findDataFile vpui libFileName + case mLibFilePath of + Nothing -> do + showErrorMessage $ "Sifflet could not locate the file " ++ + libFileName ++ "\n" ++ + "Please find it in the Sifflet installation directory " ++ + "and insert its contents into " ++ exportFile ++ "\n" + return "" + Just libFilePath -> + readFile libFilePath diff --git a/datafiles/sifflet.scm b/datafiles/sifflet.scm --- a/datafiles/sifflet.scm +++ b/datafiles/sifflet.scm @@ -1,4 +1,5 @@ -;;; Sifflet function library for Scheme +;;; File: sifflet.scm +;;; Scheme definitions for built-in Sifflet functions ;;; ;;; All symbols beginning with "sifflet-" or "*sifflet-" are ;;; reserved by Sifflet. diff --git a/sifflet-lib.cabal b/sifflet-lib.cabal --- a/sifflet-lib.cabal +++ b/sifflet-lib.cabal @@ -1,5 +1,5 @@ name: sifflet-lib -version: 2.1.0 +version: 2.2.0 cabal-version: >= 1.8 build-type: Simple license: BSD3 @@ -14,12 +14,10 @@ tests and its exporters. description: Supporting modules for the Sifflet visual, functional programming language (Hackage 'sifflet' package). - Version 2.0.0.0 adds partial support for higher-order functions, like map - and filter. category: Language , Visual Programming -tested-with: GHC == 7.4.2 +tested-with: GHC == 7.4.2, GHC == 7.6.3 data-files: sifflet.scm sifflet.py siffml-1.0.dtd siffml-1.0.rnc siffml-2.0.rnc data-dir: datafiles @@ -103,6 +101,8 @@ , Language.Sifflet.TypeCheck , Language.Sifflet.SiffML , Language.Sifflet.Util + + , System.Sifflet.Paths , Text.Sifflet.Pretty , Text.Sifflet.Repr