leksah 0.8 → 0.8.0.1
raw patch · 10 files changed
+199/−163 lines, 10 files
Files
- Readme +3/−5
- leksah.cabal +1/−1
- src/IDE/Command.hs +5/−9
- src/IDE/Core/Types.hs +5/−8
- src/IDE/ImportTool.hs +22/−15
- src/IDE/Package.hs +42/−47
- src/IDE/Pane/PackageEditor.hs +7/−7
- src/IDE/Pane/SourceBuffer.hs +11/−18
- src/IDE/Pane/Workspace.hs +28/−20
- src/IDE/Workspaces.hs +75/−33
Readme view
@@ -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.
leksah.cabal view
@@ -1,5 +1,5 @@ name: leksah-version: 0.8+version: 0.8.0.1 cabal-version: >=1.6 build-type: Simple license: GPL
src/IDE/Command.hs view
@@ -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 ()
src/IDE/Core/Types.hs view
@@ -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
src/IDE/ImportTool.hs view
@@ -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
src/IDE/Package.hs view
@@ -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
src/IDE/Pane/PackageEditor.hs view
@@ -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
src/IDE/Pane/SourceBuffer.hs view
@@ -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
src/IDE/Pane/Workspace.hs view
@@ -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
src/IDE/Workspaces.hs view
@@ -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