diff --git a/Readme b/Readme --- a/Readme +++ b/Readme @@ -5,7 +5,7 @@ Leksah uses GTK+ as GUI Toolkit with the gtk2hs binding. It is plattform independend and should run on any plattform where GTK+, gtk2hs and ghc can be installed. -It is currently been tested on Linux, Mac and Windows. It uses the Cabal package management +It is currently been tested on Linux, Mac OS X and Windows. It uses the Cabal package management and build system for Package Management. It currently only supports the Glasgow Haskell Compiler (ghc). Documentation can be found on leksah.org. @@ -14,11 +14,9 @@ =================== Leksah currently requires: - GHC version 6.10.x - gtk2hs 0.10.x + GHC version 6.10.x-6.12 + gtk2hs 0.10.x- other dependencies see cabal file - -Leksah works better if you install GHC and additional packages with sources If you are a user or just test Leksah, we would appreciate to here from you. diff --git a/leksah.cabal b/leksah.cabal --- a/leksah.cabal +++ b/leksah.cabal @@ -1,5 +1,5 @@ name: leksah -version: 0.8 +version: 0.8.0.1 cabal-version: >=1.6 build-type: Simple license: GPL diff --git a/src/IDE/Command.hs b/src/IDE/Command.hs --- a/src/IDE/Command.hs +++ b/src/IDE/Command.hs @@ -176,9 +176,7 @@ ,AD "Package" "_Package" Nothing Nothing (return ()) [] False ,AD "NewPackage" "_New Package" Nothing Nothing - packageNew [] False - ,AD "OpenPackage" "_Open Package" Nothing Nothing - packageOpen [] False + workspacePackageNew [] False -- ,AD "RecentPackages" "_Recent Packages" Nothing Nothing (return ()) [] False ,AD "EditPackage" "_Edit Package" Nothing Nothing packageEdit [] False @@ -769,10 +767,11 @@ (Left (\ e@(SelectIdent id) -> selectIdentifier id >> return e)) registerEvent stRef "InfoChanged" (Left (\ e@(InfoChanged b) -> reloadKeepSelection b >> return e)) - registerEvent stRef "ActivePack" - (Left (\ e@(ActivePack _) -> updateWorkspaceInfo >> return e)) + registerEvent stRef "UpdateWorkspaceInfo" + (Left (\ e@UpdateWorkspaceInfo -> updateWorkspaceInfo >> return e)) registerEvent stRef "WorkspaceChanged" - (Left (\ e@WorkspaceChanged -> updateWorkspace >> return e)) + (Left (\ e@(WorkspaceChanged showPane updateFileCache) + -> updateWorkspace showPane updateFileCache >> return e)) registerEvent stRef "RecordHistory" (Left (\ rh@(RecordHistory h) -> recordHistory h >> return rh)) registerEvent stRef "Sensitivity" @@ -806,9 +805,6 @@ registerEvent stRef "StatusbarChanged" (Left (\ e@(StatusbarChanged args) -> changeStatusbar args >> return e)) - registerEvent stRef "WorkspaceAddPackage" - (Left (\ e@(WorkspaceAddPackage fp) - -> workspaceAddPackage' fp >> return e)) return () diff --git a/src/IDE/Core/Types.hs b/src/IDE/Core/Types.hs --- a/src/IDE/Core/Types.hs +++ b/src/IDE/Core/Types.hs @@ -175,7 +175,7 @@ data IDEEvent = InfoChanged Bool-- is it the initial = True else False - | ActivePack (Maybe IDEPackage) + | UpdateWorkspaceInfo | SelectInfo String | SelectIdent Descr | LogMessage String LogTag @@ -193,12 +193,11 @@ | TraceChanged | GetTextPopup (Maybe (IDERef -> Menu -> IO ())) | StatusbarChanged [StatusbarCompartment] - | WorkspaceChanged - | WorkspaceAddPackage FilePath + | WorkspaceChanged Bool Bool -- ^ showPane updateFileCache instance Event IDEEvent String where getSelector (InfoChanged _) = "InfoChanged" - getSelector (ActivePack _) = "ActivePack" + getSelector UpdateWorkspaceInfo = "UpdateWorkspaceInfo" getSelector (LogMessage _ _) = "LogMessage" getSelector (SelectInfo _) = "SelectInfo" getSelector (SelectIdent _) = "SelectIdent" @@ -216,12 +215,11 @@ getSelector TraceChanged = "TraceChanged" getSelector (GetTextPopup _) = "GetTextPopup" getSelector (StatusbarChanged _) = "StatusbarChanged" - getSelector WorkspaceChanged = "WorkspaceChanged" - getSelector (WorkspaceAddPackage _) = "WorkspaceAddPackage" + getSelector (WorkspaceChanged _ _) = "WorkspaceChanged" instance EventSource IDERef IDEEvent IDEM String where canTriggerEvent _ "InfoChanged" = True - canTriggerEvent _ "ActivePack" = True + canTriggerEvent _ "UpdateWorkspaceInfo" = True canTriggerEvent _ "LogMessage" = True canTriggerEvent _ "SelectInfo" = True canTriggerEvent _ "SelectIdent" = True @@ -241,7 +239,6 @@ canTriggerEvent _ "GetTextPopup" = True canTriggerEvent _ "StatusbarChanged" = True canTriggerEvent _ "WorkspaceChanged" = True - canTriggerEvent _ "WorkspaceAddPackage" = True canTriggerEvent _ _ = False getHandlers ideRef = do ide <- liftIO $ readIORef ideRef diff --git a/src/IDE/ImportTool.hs b/src/IDE/ImportTool.hs --- a/src/IDE/ImportTool.hs +++ b/src/IDE/ImportTool.hs @@ -31,18 +31,14 @@ import Graphics.UI.Gtk import Text.ParserCombinators.Parsec.Language (haskellStyle) import Graphics.UI.Editor.MakeEditor - (FieldDescription(..), buildEditor, mkField) + (getRealWidget, FieldDescription(..), buildEditor, mkField) import Graphics.UI.Editor.Parameters ((<<<-), paraMinSize, emptyParams, Parameter(..), paraMultiSel, paraName) -import Graphics.UI.Editor.Basics - (GUIEventSelector(..), eventPaneName) import Data.Maybe (fromJust) import Text.ParserCombinators.Parsec hiding (parse) import qualified Text.ParserCombinators.Parsec as Parsec (parse) -import Graphics.UI.Editor.Simple (okCancelFields, staticListEditor) -import Control.Event (registerEvent) -import Control.Monad.Trans (liftIO) +import Graphics.UI.Editor.Simple (staticListEditor) import Control.Monad (when) import Distribution.Text (display) import Data.List (sort, nub, nubBy) @@ -54,10 +50,12 @@ (operator, dot, identifier, symbol, lexeme, whiteSpace, makeTokenParser) import Debug.Trace (trace) ---import Debug.Trace +import Graphics.UI.Gtk.Gdk.Events (Event(..)) +import Control.Monad.Trans (liftIO) + -- | Add all imports which gave error messages ... addAllImports :: IDEAction addAllImports = do @@ -323,17 +321,26 @@ dia <- dialogNew windowSetTransientFor dia parentWindow upper <- dialogGetUpper dia - lower <- dialogGetActionArea dia + dialogAddButton dia "Ok" ResponseOk + dialogAddButton dia "Cancel" ResponseCancel (widget,inj,ext,_) <- buildEditor (moduleFields selectionList qualId) realSelectionString - (widget2,_,_,notifier) <- buildEditor okCancelFields () - registerEvent notifier Clicked (Left (\e -> do - case eventPaneName e of - "Ok" -> dialogResponse dia ResponseOk - _ -> dialogResponse dia ResponseCancel - return e)) boxPackStart upper widget PackGrow 7 - boxPackStart lower widget2 PackNatural 7 + dialogSetDefaultResponse dia ResponseOk --does not work for the tree view widgetShowAll dia + rw <- getRealWidget widget +-- case rw of +-- Nothing -> return () +-- Just r -> do +-- r `onKeyPress` \ event -> do +-- case event of +-- Key { eventKeyName = name} -> +-- case name of +-- "Return" -> do +-- dialogResponse dia ResponseOk +-- return True +-- _ -> return False +-- _ -> return False +-- return () resp <- dialogRun dia value <- ext ([]) widgetDestroy dia diff --git a/src/IDE/Package.hs b/src/IDE/Package.hs --- a/src/IDE/Package.hs +++ b/src/IDE/Package.hs @@ -17,10 +17,7 @@ module IDE.Package ( - packageOpen -, packageOpenThis -, packageNew -, packageConfig + packageConfig , buildPackage , packageDoc @@ -82,8 +79,8 @@ import Data.List (isInfixOf, nub, foldl') import qualified System.IO.UTF8 as UTF8 (readFile) import IDE.Utils.Tool (ToolOutput(..), runTool, newGhci, ToolState(..)) -import Debug.Trace (trace) + #if defined(mingw32_HOST_OS) || defined(__MINGW32__) import Data.Maybe (isNothing) import System.Win32 @@ -125,11 +122,6 @@ myExeModules pd = exeModules pd #endif -packageNew :: IDEAction -packageNew = packageNew' (\fp -> do - triggerEventIDE (WorkspaceAddPackage fp) - mbPack <- idePackageFromPath fp - activatePackage mbPack) packageOpen :: IDEAction packageOpen = packageOpenThis Nothing @@ -150,7 +142,7 @@ selectActivePackage mbFilePath' = do window <- getMainWindow mbFilePath <- case mbFilePath' of - Nothing -> liftIO $ choosePackageFile window + Nothing -> liftIO $ choosePackageFile window Nothing Just fp -> return (Just fp) case mbFilePath of Nothing -> return Nothing @@ -160,7 +152,6 @@ activatePackage mbPack@(Just pack) = do modifyIDE_ (\ide -> ide{activePack = mbPack}) liftIO $ setCurrentDirectory (dropFileName (ipdCabalFile pack)) - triggerEventIDE (ActivePack mbPack) triggerEventIDE (Sensitivity [(SensitivityProjectActive,True)]) mbWs <- readIDE workspace let wsStr = case mbWs of @@ -175,7 +166,6 @@ deactivatePackage = do oldActivePack <- readIDE activePack modifyIDE_ (\ide -> ide{activePack = Nothing}) - triggerEventIDE (ActivePack Nothing) when (isJust oldActivePack) $ do triggerEventIDE (Sensitivity [(SensitivityProjectActive,False)]) return () @@ -192,34 +182,44 @@ mbPackage <- getActivePackage case mbPackage of Nothing -> return () - Just package -> packageConfig' package (return ()) + Just package -> packageConfig' package (\ _ -> return ()) -packageConfig' :: IDEPackage -> IDEAction -> IDEAction -packageConfig' package continuation = catchIDE (do - mbPackageD <- reifyIDE (\ideR -> catch (do - let dir = dropFileName (ipdCabalFile package) - reflectIDE (runExternalTool "Configuring" "runhaskell" (["Setup","configure"] - ++ (ipdConfigFlags package)) (Just dir) logOutput) ideR - pd <- readPackageDescription normal (ipdCabalFile package) - return (Just (flattenPackageDescription pd))) - (\(e :: SomeException) -> do - reflectIDE (ideMessage Normal (show e)) ideR - return Nothing)) - case mbPackageD of - Just packageD -> - let modules = Set.fromList $ myLibModules packageD ++ myExeModules packageD - files = Set.fromList $ extraSrcFiles packageD ++ map modulePath (executables packageD) - ipdSrcDirs = nub $ concatMap hsSourceDirs (allBuildInfo packageD) - pack = Just package{ipdDepends=buildDepends packageD, ipdModules = modules, - ipdExtraSrcs = files, ipdSrcDirs = ipdSrcDirs} - in trace ("packageD :" ++ show packageD) $ do - modifyIDE_ (\ide -> ide{activePack = pack, bufferProjCache = Map.empty}) - triggerEventIDE (ActivePack pack) - continuation +packageConfig' :: IDEPackage -> (Bool -> IDEAction) -> IDEAction +packageConfig' package continuation = do + let dir = dropFileName (ipdCabalFile package) + runExternalTool "Configuring" "runhaskell" (["Setup","configure"] + ++ (ipdConfigFlags package)) (Just dir) $ \output -> do + logOutput output + mbPack <- idePackageFromPath (ipdCabalFile package) + case mbPack of + Just pack -> do + changeWorkspacePackage pack + modifyIDE_ (\ide -> ide{activePack = Just pack, bufferProjCache = Map.empty}) + triggerEventIDE UpdateWorkspaceInfo + triggerEventIDE (WorkspaceChanged False True) + errs <- readIDE errorRefs + continuation (last output == ToolExit ExitSuccess && not (any isError errs)) return () - Nothing -> return()) -- Does not continue if config fails? - (\(e :: SomeException) -> putStrLn (show e)) + Nothing -> do + ideMessage Normal "Can't read package file" + continuation False + return() +changeWorkspacePackage :: IDEPackage -> IDEAction +changeWorkspacePackage ideP@IDEPackage{ipdCabalFile = file} = do + oldWorkspace <- readIDE workspace + case oldWorkspace of + Nothing -> return () + Just ws -> + let ap = if isJust (wsActivePack ws) && ipdCabalFile (fromJust $ wsActivePack ws) == file + then Just ideP + else wsActivePack ws + ps = map exchange (wsPackages ws) + in modifyIDE_ (\ide -> ide{workspace = Just ws {wsPackages = ps, wsActivePack = ap}}) + where + exchange p | ipdCabalFile p == file = ideP + | otherwise = p + runCabalBuild :: Bool -> IDEPackage -> Bool -> (Bool -> IDEAction) -> IDEAction runCabalBuild backgroundBuild package shallConfigure continuation = do prefs <- readIDE prefs @@ -234,7 +234,8 @@ errs <- readIDE errorRefs if shallConfigure && isConfigError output then - packageConfig' package (runCabalBuild backgroundBuild package False continuation) + packageConfig' package (\ b -> + when b $ runCabalBuild backgroundBuild package False continuation) else do continuation (last output == ToolExit ExitSuccess && not (any isError errs)) return () @@ -247,9 +248,6 @@ str1 = "Run the 'configure' command first" str2 = "please re-configure" - --- TODO Care for metadata - buildPackage :: Bool -> IDEPackage -> (Bool -> IDEAction) -> IDEAction buildPackage backgroundBuild package continuation = catchIDE (do ideR <- ask @@ -276,9 +274,6 @@ ) (\(e :: SomeException) -> sysMessage Normal (show e)) ---buildAndConfigPackage :: Bool -> IDEPackage -> (Bool -> IDEAction) -> IDEAction ---buildAndConfigPackage backgroundBuild package continuation = buildPackage backgroundBuild package continuation - packageDoc :: IDEAction packageDoc = catchIDE (do mbPackage <- getActivePackage @@ -504,7 +499,7 @@ active <- readIDE activePack case active of Nothing -> do - ideMessage Normal "No active packjage" + ideMessage Normal "No active package" return Nothing Just p -> do ideR <- ask @@ -532,7 +527,7 @@ active <- readIDE activePack case active of Nothing -> do - ideMessage Normal "No active packjage" + ideMessage Normal "No active package" return () Just p -> do ideR <- ask diff --git a/src/IDE/Pane/PackageEditor.hs b/src/IDE/Pane/PackageEditor.hs --- a/src/IDE/Pane/PackageEditor.hs +++ b/src/IDE/Pane/PackageEditor.hs @@ -97,11 +97,11 @@ -- The exported stuff goes here -- -choosePackageDir :: Window -> IO (Maybe FilePath) -choosePackageDir window = chooseDir window "Select root folder for project" Nothing +choosePackageDir :: Window -> Maybe FilePath -> IO (Maybe FilePath) +choosePackageDir window mbDir = chooseDir window "Select root folder for project" mbDir -choosePackageFile :: Window -> IO (Maybe FilePath) -choosePackageFile window = chooseFile window "Select cabal package file (.cabal)" Nothing +choosePackageFile :: Window -> Maybe FilePath -> IO (Maybe FilePath) +choosePackageFile window mbDir = chooseFile window "Select cabal package file (.cabal)" mbDir packageEdit :: IDEAction packageEdit = do @@ -134,10 +134,10 @@ in libConds || exeConds -packageNew' :: (FilePath -> IDEAction) -> IDEAction -packageNew' activateAction = do +packageNew' :: Maybe FilePath -> (FilePath -> IDEAction) -> IDEAction +packageNew' mbDir activateAction = do windows <- getWindows - mbDirName <- liftIO $ choosePackageDir (head windows) + mbDirName <- liftIO $ choosePackageDir (head windows) mbDir case mbDirName of Nothing -> return () Just dirName -> do diff --git a/src/IDE/Pane/SourceBuffer.hs b/src/IDE/Pane/SourceBuffer.hs --- a/src/IDE/Pane/SourceBuffer.hs +++ b/src/IDE/Pane/SourceBuffer.hs @@ -742,22 +742,12 @@ fileCheckBuffer :: Notebook -> EditorBuffer -> IDEBuffer -> Int -> IDEM Bool fileCheckBuffer nb ebuf ideBuf i = do - ideR <- ask - window <- getMainWindow - prefs <- readIDE prefs - bs <- getCandyState - candy <- readIDE candy - (panePath,connects) <- guiPropertiesFromName (paneName ideBuf) let mbfn = fileName ideBuf - mbpage <- liftIO $ notebookGetNthPage nb i - case mbpage of - Nothing -> throwIDE "fileCheck: Page not found" - Just page -> - if isJust mbfn - then do modifiedOnDisk <- checkModTime ideBuf -- The user is given option to reload - modifiedInBuffer <- getModified ebuf - return (modifiedOnDisk || modifiedInBuffer) - else return False + if isJust mbfn + then do modifiedOnDisk <- checkModTime ideBuf -- The user is given option to reload + modifiedInBuffer <- getModified ebuf + return (modifiedOnDisk || modifiedInBuffer) + else return False fileCheckAll :: (IDEBuffer -> IDEM (Maybe alpha)) -> IDEM [alpha] fileCheckAll filterFunc = do @@ -1203,18 +1193,21 @@ Just p -> return p Nothing -> case ws of Nothing -> return Nothing - Just workspace -> do + Just workspace -> trace ("bufferToProject unknown " ++ show fp) $ do mbMn <- liftIO $ moduleNameFromFilePath fp let mbMn2 = case mbMn of Nothing -> Nothing Just mn -> simpleParse mn let res = foldl (belongsToPackage' fp mbMn2) Nothing (wsPackages workspace) - modifyIDE_ (\ide -> ide{bufferProjCache = Map.insert fp res bufferToProject'}) + trace ("bufferToProject " ++ case res of + Nothing -> "Nothing" + Just pack -> show (ipdPackageId pack)) + $ modifyIDE_ (\ide -> ide{bufferProjCache = Map.insert fp res bufferToProject'}) return res belongsToPackage' :: FilePath -> Maybe ModuleName -> Maybe IDEPackage -> IDEPackage -> Maybe IDEPackage belongsToPackage' _ _ r@(Just pack) _ = r -belongsToPackage' fp mbModuleName Nothing pack = +belongsToPackage' fp mbModuleName Nothing pack = trace ("belongsToPackage' " ++ show mbModuleName) $ let basePath = dropFileName $ ipdCabalFile pack in if isSubPath basePath fp then diff --git a/src/IDE/Pane/Workspace.hs b/src/IDE/Pane/Workspace.hs --- a/src/IDE/Pane/Workspace.hs +++ b/src/IDE/Pane/Workspace.hs @@ -27,6 +27,8 @@ import Data.Typeable import IDE.Core.State import IDE.Workspaces +import qualified Data.Map as Map (empty) +import Data.List (sortBy) import Debug.Trace (trace) @@ -60,7 +62,7 @@ buildPane pp nb builder buildPane pp nb builder = do res <- buildThisPane pp nb builder - when (isJust res) updateWorkspace + when (isJust res) $ updateWorkspace True False return res builder pp nb windows = reifyIDE $ \ideR -> do listStore <- listStoreNew [] @@ -149,8 +151,6 @@ item1 <- menuItemNewWithLabel "Activate Package" item2 <- menuItemNewWithLabel "Add Package" item3 <- menuItemNewWithLabel "Remove Package" - item4 <- menuItemNewWithLabel "Build Package" - item1 `onActivateLeaf` do sel <- getSelectionTree (treeViewC workspacePane) (workspaceStore workspacePane) @@ -165,11 +165,9 @@ case sel of Just (_,ideP) -> reflectIDE (workspaceRemovePackage ideP) ideR otherwise -> return () - -- TODO ... menuShellAppend theMenu item1 menuShellAppend theMenu item2 menuShellAppend theMenu item3 - -- TODO ... menuPopup theMenu Nothing widgetShowAll theMenu return True @@ -183,20 +181,30 @@ else return False treeViewPopup _ _ _ = throwIDE "treeViewPopup wrong event type" -updateWorkspace :: IDEAction -updateWorkspace = do - mbMod <- trace "update workspace called" getPane - case mbMod of - Nothing -> return () - Just (p :: IDEWorkspace) -> do - mbWs <- readIDE workspace - case mbWs of - Nothing -> liftIO $ do - listStoreClear (workspaceStore p) - entrySetText (wsEntry p) "" - Just ws -> liftIO $ do - entrySetText (wsEntry p) (wsName ws) - listStoreClear (workspaceStore p) +updateWorkspace :: Bool -> Bool -> IDEAction +updateWorkspace showPane updateFileCache = trace "updateWorkspace" $ do + mbWs <- readIDE workspace + case mbWs of + Nothing -> do + when updateFileCache $ modifyIDE_ (\ide -> ide{bufferProjCache = Map.empty}) + mbMod <- getOrBuildPane (Right ("*Workspace")) + case mbMod of + Nothing -> return () + Just (p :: IDEWorkspace) -> do + liftIO $ listStoreClear (workspaceStore p) + liftIO $ entrySetText (wsEntry p) "" + when showPane $ displayPane p False + Just ws -> do + when updateFileCache $ modifyIDE_ (\ide -> ide{bufferProjCache = Map.empty, + workspace = Just ws{wsReverseDeps = calculateReverseDependencies ws}}) + mbMod <- getOrBuildPane (Right ("*Workspace")) + case mbMod of + Nothing -> return () + Just (p :: IDEWorkspace) -> do + liftIO $ entrySetText (wsEntry p) (wsName ws) + liftIO $ listStoreClear (workspaceStore p) let objs = map (\ ideP -> (Just ideP == wsActivePack ws, ideP)) (wsPackages ws) - mapM_ (listStoreAppend (workspaceStore p)) objs + let sorted = sortBy (\ (_,f) (_,s) -> compare (ipdPackageId f) (ipdPackageId s)) objs + liftIO $ mapM_ (listStoreAppend (workspaceStore p)) sorted + when showPane $ displayPane p False diff --git a/src/IDE/Workspaces.hs b/src/IDE/Workspaces.hs --- a/src/IDE/Workspaces.hs +++ b/src/IDE/Workspaces.hs @@ -24,9 +24,11 @@ , workspaceAddPackage , workspaceAddPackage' , workspaceRemovePackage +, workspacePackageNew , makePackage , backgroundMake +, calculateReverseDependencies ) where import IDE.Core.State @@ -51,16 +53,14 @@ import qualified Text.PrettyPrint as PP (text) import Graphics.UI.Gtk (widgetDestroy, dialogRun, messageDialogNew, Window(..)) -import IDE.Pane.PackageEditor (choosePackageFile) +import IDE.Pane.PackageEditor (packageNew', choosePackageFile) import Data.List ((\\), foldl', nub, delete) import IDE.Package - (buildPackage, - packageInstall', - packageClean, - activatePackage, - deactivatePackage, - idePackageFromPath) -import System.Directory (doesFileExist, canonicalizePath) + (getModuleTemplate, getPackageDescriptionAndPath, buildPackage, + packageInstall', packageClean, activatePackage, deactivatePackage, + idePackageFromPath) +import System.Directory + (createDirectoryIfMissing, doesFileExist, canonicalizePath) import System.Time (getClockTime) import Graphics.UI.Gtk.Windows.MessageDialog (ButtonsType(..), MessageType(..)) @@ -73,19 +73,18 @@ import Distribution.Package (pkgVersion, pkgName, Dependency(..)) import Distribution.Version (withinRange) import qualified GHC.List as List (or) -import IDE.Pane.SourceBuffer (belongsToPackage, fileCheckAll) +import IDE.Pane.SourceBuffer + (fileOpenThis, belongsToPackage, fileCheckAll) +import qualified System.IO.UTF8 as UTF8 (writeFile) +import Debug.Trace (trace) setWorkspace :: Maybe Workspace -> IDEAction -setWorkspace mbWs = do +setWorkspace mbWs = trace "setWorkspace" $ do let mbRealWs = case mbWs of Nothing -> Nothing Just ws -> Just ws{wsReverseDeps = calculateReverseDependencies ws} mbOldWs <- readIDE workspace --- trace ("deps " ++ case mbRealWs of --- Nothing -> "empty ws" --- Just ws -> show $ map (\ (k,v) -> (packageId k, map packageId v)) --- (Map.toList (wsReverseDeps ws))) modifyIDE_ (\ide -> ide{workspace = mbRealWs}) let pack = case mbRealWs of Nothing -> Nothing @@ -98,7 +97,6 @@ Nothing -> deactivatePackage Just p -> activatePackage pack >> return () mbPack <- readIDE activePack - triggerEventIDE WorkspaceChanged let wsStr = case mbRealWs of Nothing -> "" Just ws -> wsName ws @@ -107,6 +105,8 @@ Nothing -> "" Just p -> packageIdentifierToString (ipdPackageId p)) triggerEventIDE (StatusbarChanged [CompartmentPackage txt]) + triggerEventIDE (WorkspaceChanged True True) + triggerEventIDE UpdateWorkspaceInfo return () @@ -142,7 +142,9 @@ window <- getMainWindow mbFilePath <- liftIO $ chooseWorkspaceFile window workspaceOpenThis True mbFilePath + return () + chooseWorkspaceFile :: Window -> IO (Maybe FilePath) chooseWorkspaceFile window = chooseFile window "Select leksah workspace file (.lkshw)" Nothing @@ -171,9 +173,9 @@ ideR <- ask catchIDE (do workspace <- readWorkspace filePath - setWorkspace (Just workspace {wsFile = filePath, - wsReverseDeps = calculateReverseDependencies workspace})) - (\ (e :: SomeException) -> reflectIDE + setWorkspace (Just workspace {wsFile = filePath}) + return ()) + (\ (e :: SomeException) -> reflectIDE (ideMessage Normal ("Can't load workspace file " ++ filePath ++ "\n" ++ show e)) ideR) @@ -189,7 +191,6 @@ ++ leksahSessionFileExtension)) addRecentlyUsedWorkspace (wsFile ws) setWorkspace Nothing - triggerEventIDE (ActivePack Nothing) when (isJust oldActivePack) $ do triggerEventIDE (Sensitivity [(SensitivityProjectActive, False), (SensitivityWorkspaceOpen, False)]) @@ -197,29 +198,68 @@ return () return () +workspacePackageNew :: IDEAction +workspacePackageNew = do + mbWs <- readIDE workspace + case mbWs of + Nothing -> ideMessage Normal "Needs an open workspace" + Just ws -> do + let path = dropFileName (wsFile ws) + packageNew' (Just path) (\fp -> do + window <- getMainWindow + workspaceAddPackage' fp >> return () + mbPack <- idePackageFromPath fp + constructAndOpenMainModule mbPack + triggerEventIDE UpdateWorkspaceInfo >> return ()) +constructAndOpenMainModule :: Maybe IDEPackage -> IDEAction +constructAndOpenMainModule Nothing = return () +constructAndOpenMainModule (Just idePackage) = + case (ipdMain idePackage, ipdSrcDirs idePackage) of + ([target],[path]) -> do + mbPD <- getPackageDescriptionAndPath + case mbPD of + Just (pd,_) -> do + liftIO $ createDirectoryIfMissing True path + alreadyExists <- liftIO $ doesFileExist (path target) + if alreadyExists + then ideMessage Normal "Main file already exists" + else do + template <- liftIO $ getModuleTemplate pd (dropExtension target) + liftIO $ UTF8.writeFile (path target) template + fileOpenThis (path target) + Nothing -> ideMessage Normal "No package description" + _ -> return () + + workspaceAddPackage :: IDEAction workspaceAddPackage = do - window <- getMainWindow - mbFilePath <- liftIO $ choosePackageFile window - case mbFilePath of - Nothing -> return () - Just fp -> workspaceAddPackage' fp + mbWs <- readIDE workspace + case mbWs of + Nothing -> ideMessage Normal "Needs an open workspace" + Just ws -> do + let path = dropFileName (wsFile ws) + window <- getMainWindow + mbFilePath <- liftIO $ choosePackageFile window (Just path) + case mbFilePath of + Nothing -> return () + Just fp -> workspaceAddPackage' fp >> return () -workspaceAddPackage' :: FilePath -> IDEAction +workspaceAddPackage' :: FilePath -> IDEM (Maybe IDEPackage) workspaceAddPackage' fp = do mbWs <- readIDE workspace cfp <- liftIO $ canonicalizePath fp case mbWs of - Nothing -> return () + Nothing -> return Nothing Just ws -> do mbPack <- idePackageFromPath cfp case mbPack of Just pack -> do unless (elem cfp (map ipdCabalFile (wsPackages ws))) $ - writeWorkspace $ ws {wsPackages = pack : wsPackages ws} - return () - Nothing -> return () + writeWorkspace $ ws {wsPackages = pack : wsPackages ws, + wsActivePack = Just pack} + return (Just pack) + Nothing -> return Nothing workspaceRemovePackage :: IDEPackage -> IDEAction @@ -234,6 +274,7 @@ workspaceActivatePackage :: IDEPackage -> IDEAction workspaceActivatePackage pack = do + activatePackage (Just pack) mbWs <- readIDE workspace case mbWs of Nothing -> return () @@ -417,11 +458,12 @@ let deps = case Map.lookup package (wsReverseDeps ws) of Nothing -> [] Just list -> list - -- install if either + -- install if backgroundLink is set or it is not a background build and either -- AlwaysInstall is set or - -- deps are not empty and - when ((not (null deps) && autoInstall prefs' == InstallLibs) - || autoInstall prefs' == InstallAlways) + -- deps are not empty + when ((not isBackgroundBuild || backgroundLink prefs') && + ((not (null deps) && autoInstall prefs' == InstallLibs) + || autoInstall prefs' == InstallAlways)) $ packageInstall' package (cont2 deps package) else return () -- don't continue, when their was an error cont2 deps package res = do