leksah 0.15.1.3 → 0.15.1.4
raw patch · 28 files changed
+595/−274 lines, 28 filesdep ~gtk3dep ~jsaddledep ~leksahPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
Dependency ranges changed: gtk3, jsaddle, leksah, leksah-server, ltk
API changes (from Hackage documentation)
- IDE.Pane.SourceBuffer: fileOpen :: IDEAction
+ IDE.Pane.SourceBuffer: belongsToPackages' :: MonadIDE m => IDEBuffer -> m [IDEPackage]
+ IDE.Pane.SourceBuffer: belongsToWorkspace' :: MonadIDE m => IDEBuffer -> m Bool
+ IDE.Workspaces: fileOpen :: IDEAction
+ IDE.Workspaces: fileOpen' :: FilePath -> IDEAction
- IDE.Pane.SourceBuffer: belongsToPackages :: MonadIDE m => IDEBuffer -> m [IDEPackage]
+ IDE.Pane.SourceBuffer: belongsToPackages :: MonadIDE m => FilePath -> m [IDEPackage]
- IDE.Pane.SourceBuffer: belongsToWorkspace :: MonadIDE m => IDEBuffer -> m Bool
+ IDE.Pane.SourceBuffer: belongsToWorkspace :: MonadIDE m => FilePath -> m Bool
Files
- data/main.lksht +7/−3
- data/testmain.lksht +1/−0
- leksah.cabal +12/−12
- osx/launcher.sh +1/−1
- osx/makedmg.sh +1/−3
- osx/makedmgs.sh +3/−3
- scripts/clean.sh +10/−0
- src/IDE/Command.hs +2/−2
- src/IDE/Completion.hs +40/−39
- src/IDE/Core/State.hs +3/−0
- src/IDE/Core/Types.hs +4/−1
- src/IDE/Find.hs +3/−12
- src/IDE/ImportTool.hs +44/−39
- src/IDE/Package.hs +5/−4
- src/IDE/Pane/Breakpoints.hs +24/−6
- src/IDE/Pane/Errors.hs +46/−9
- src/IDE/Pane/Files.hs +26/−22
- src/IDE/Pane/Grep.hs +28/−5
- src/IDE/Pane/Info.hs +33/−5
- src/IDE/Pane/PackageEditor.hs +8/−2
- src/IDE/Pane/PackageFlags.hs +26/−1
- src/IDE/Pane/Preferences.hs +14/−4
- src/IDE/Pane/SourceBuffer.hs +21/−46
- src/IDE/Pane/Variables.hs +43/−4
- src/IDE/Pane/Workspace.hs +45/−15
- src/IDE/PaneGroups.hs +23/−16
- src/IDE/Workspaces.hs +119/−17
- win32/makeinstaller.sh +3/−3
data/main.lksht view
@@ -16,12 +16,16 @@ main ) where -import Data.List (stripPrefix)+-- This strang looking comment adds code only needed when running the+-- doctest tests embedded in the comments+-- $setup+-- >>> import Data.List (stripPrefix) -- | Simple function to create a hello message. -- prop> stripPrefix "Hello " (hello s) == Just s+hello :: String -> String hello s = "Hello " ++ s -main = do- putStrLn (hello "World")+main :: IO ()+main = putStrLn (hello "World")
data/testmain.lksht view
@@ -18,6 +18,7 @@ import Test.DocTest +main :: IO () main = doctest ["-isrc", "src/Main.hs"]
leksah.cabal view
@@ -1,5 +1,5 @@ name: leksah-version: 0.15.1.3+version: 0.15.1.4 cabal-version: >=1.18 build-type: Simple license: GPL@@ -305,11 +305,11 @@ IDE.TextEditor.GtkSourceView IDE.Utils.ExternalTool build-depends:- gtk3 >=0.13.9 && <0.15,+ gtk3 >=0.14.1 && <0.15, gtksourceview3 >=0.13.1.5 && <0.14, webkitgtk3 >=0.13 && <0.15, webkitgtk3-javascriptcore -any,- jsaddle -any,+ jsaddle >=0.2.1.0 && <0.3, ghcjs-codemirror -any, blaze-html -any, lens -any,@@ -332,11 +332,11 @@ utf8-string >=0.3.1.1 && <1.1, array >=0.2.0.0 && <0.6, time >=0.1 && <1.6,- ltk >=0.15.0.2 && <0.16,+ ltk >=0.15.0.4 && <0.16, binary-shared >=0.8 && <0.9, deepseq >=1.1.0.0 && <1.5, hslogger >=1.0.7 && <1.3,- leksah-server >=0.15.0.6 && <0.16,+ leksah-server >=0.15.0.8 && <0.16, ghc >=6.10.1 && <7.11, strict >=0.3.2 && <0.4, conduit >=1.0.8 && <1.3,@@ -389,9 +389,9 @@ ghc-options: -optl-headerpad_max_install_names main-is: Main.hs build-depends:- leksah ==0.15.1.3,+ leksah ==0.15.1.4, base >=4.0.0.0 && <=4.9,- gtk3 >=0.13.9 && <0.15,+ gtk3 >=0.14.1 && <0.15, stm >=2.4.4 && <2.5 default-language: Haskell2010 hs-source-dirs: main@@ -400,11 +400,11 @@ executable bewleksah main-is: Main.hs build-depends:- leksah ==0.15.1.3,+ leksah ==0.15.1.4, base >=4.0.0.0 && <=4.9, jsaddle -any,- ghcjs-dom -any,- gtk3 >=0.13.9 && <0.15,+ ghcjs-dom >=0.2.1.0 && <0.3,+ gtk3 >=0.14.1 && <0.15, gtksourceview3 >=0.13.1.5 && <0.14, webkitgtk3 >=0.13 && <0.15, webkitgtk3-javascriptcore -any,@@ -423,7 +423,7 @@ base >=4.0.0.0 && <4.9, Cabal >=1.10.2.0 && <1.23, QuickCheck >=2.4.2 && <2.9,- leksah ==0.15.1.3,+ leksah ==0.15.1.4, containers -any, ltk -any, leksah-server -any,@@ -432,7 +432,7 @@ glib -any, monad-loops -any, text -any,- gtk3 >=0.13.9 && <0.15,+ gtk3 >=0.14.1 && <0.15, gtksourceview3 >=0.13.1.5 && <0.14, webkitgtk3 -any, stm >=2.4.4 && <2.5
osx/launcher.sh view
@@ -1,4 +1,4 @@-#!/bin/sh+#!/bin/bash if test -e ~/.bash_profile; then . ~/.bash_profile
osx/makedmg.sh view
@@ -27,9 +27,7 @@ sed -e 's|\<ctrl\>|\<meta\>|' \ -e 's|\<alt\>|\<control\>|' \- -e 's|^--\<meta\>x |\<meta\>x |' \- -e 's|^--\<meta\>c |\<meta\>c |' \- -e 's|^--\<meta\>v |\<meta\>v |' \+ -e 's|^\<meta\>q |--\<meta\>q |' \ <data/keymap.lkshk >osx/keymap.lkshk cat osx/osxkeymap.lkshk >>osx/keymap.lkshk
osx/makedmgs.sh view
@@ -1,8 +1,8 @@ #!/bin/sh -ex -#export GHCVERSION=-7.8.3-#scripts/clean.sh-#osx/makedmg.sh+export GHCVERSION=-7.8.3+scripts/clean.sh+osx/makedmg.sh export GHCVERSION=-7.10.1 scripts/clean.sh osx/makedmg.sh
scripts/clean.sh view
@@ -10,8 +10,18 @@ ghc-pkg$GHCVERSION unregister --force jsaddle || true ghc-pkg$GHCVERSION unregister --force gtksourceview2 || true ghc-pkg$GHCVERSION unregister --force gtksourceview3 || true+ghc-pkg$GHCVERSION unregister --force webkit-javascriptcore || true+ghc-pkg$GHCVERSION unregister --force webkitgtk3-javascriptcore || true+ghc-pkg$GHCVERSION unregister --force webkit || true+ghc-pkg$GHCVERSION unregister --force webkitgtk3 || true ghc-pkg$GHCVERSION unregister --force gtk-mac-integration || true ghc-pkg$GHCVERSION unregister --force gtk3-mac-integration || true+ghc-pkg$GHCVERSION unregister --force gtk || true+ghc-pkg$GHCVERSION unregister --force gtk3 || true+ghc-pkg$GHCVERSION unregister --force pango || true+ghc-pkg$GHCVERSION unregister --force cairo || true+ghc-pkg$GHCVERSION unregister --force gio || true+ghc-pkg$GHCVERSION unregister --force glib || true ghc-pkg$GHCVERSION unregister --force hlint || true rm -rf vendor/*/dist \
src/IDE/Command.hs view
@@ -516,7 +516,7 @@ fe <- doesFileExist s when fe $ do mi <- menuItemNewWithLabel $ T.pack s- mi `on` menuItemActivate $ reflectIDE (fileOpenThis s) ideR+ mi `on` menuItemActivate $ reflectIDE (fileOpen' s) ideR menuShellAppend recentFilesMenu mi) recentFiles' oldSubmenu <- menuItemGetSubmenu recentFilesItem when (isJust oldSubmenu) $ do@@ -721,7 +721,7 @@ getActionsFor SensitivityError = getActionsFor' ["NextError", "PreviousError"] getActionsFor SensitivityEditor = getActionsFor' ["EditUndo", "EditRedo", "EditGotoLine","EditComment", "EditUncomment",- "EditShiftLeft", "EditShiftRight","FileClose","ResolveErrors",+ "EditShiftLeft", "EditShiftRight","FileClose", "OpenDocu" ] getActionsFor SensitivityInterpreting = getActionsFor' ["QuitDebugger"]
src/IDE/Completion.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE ScopedTypeVariables, OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables, OverloadedStrings, LambdaCase #-} ----------------------------------------------------------------------------- -- -- Module : IDE.Completion@@ -36,6 +36,7 @@ import qualified Data.Text as T (empty, commonPrefixes, pack, unpack, null, stripPrefix, isPrefixOf)+import System.Log.Logger (debugM) complete :: TextEditor editor => EditorView editor -> Bool -> IDEAction complete sourceView always = do@@ -181,47 +182,47 @@ selection <- liftIO $ treeViewGetSelection tree count <- liftIO $ treeModelIterNChildren model Nothing Just column <- liftIO $ treeViewGetColumn tree 0+ let whenVisible f = liftIO (get tree widgetVisible) >>= \case+ True -> f+ False -> return False+ down = whenVisible $ do+ maybeRow <- liftIO $ getRow tree+ let newRow = maybe 0 (+ 1) maybeRow+ when (newRow < count) . liftIO $ do+ treeSelectionSelectPath selection [newRow]+ treeViewScrollToCell tree (Just [newRow]) Nothing Nothing+ return True+ up = whenVisible $ do+ maybeRow <- liftIO $ getRow tree+ let newRow = maybe 0 (\ row -> row - 1) maybeRow+ when (newRow >= 0) . liftIO $ do+ treeSelectionSelectPath selection [newRow]+ treeViewScrollToCell tree (Just [newRow]) Nothing Nothing+ return True case (name, modifier, char) of- ("Tab", _, _) -> do visible <- liftIO $ get tree widgetVisible- if visible then- (do liftIDE $- tryToUpdateOptions window tree store sourceView True isWordChar- always- return True)- else return False- ("Return", _, _) -> do visible <- liftIO $ get tree widgetVisible- if visible then- (do maybeRow <- liftIO $ getRow tree- case maybeRow of- Just row -> do liftIO $ treeViewRowActivated tree [row] column- return True- Nothing -> do liftIDE cancel- return False)- else return False- ("Down", _, _) -> do visible <- liftIO $ get tree widgetVisible- if visible then- (do maybeRow <- liftIO $ getRow tree- let newRow = maybe 0 (+ 1) maybeRow- when (newRow < count) $- liftIO $- do treeSelectionSelectPath selection [newRow]- treeViewScrollToCell tree (Just [newRow]) Nothing Nothing- return True)- else return False- ("Up", _, _) -> do visible <- liftIO $ get tree widgetVisible- if visible then- (do maybeRow <- liftIO $ getRow tree- let newRow = maybe 0 (\ row -> row - 1) maybeRow- when (newRow >= 0) $- liftIO $- do treeSelectionSelectPath selection [newRow]- treeViewScrollToCell tree (Just [newRow]) Nothing Nothing- return True)- else return False+ ("Tab", _, _) -> whenVisible . liftIDE $ do+ tryToUpdateOptions window tree store sourceView True isWordChar always+ return True+ ("Return", _, _) -> whenVisible $ do+ maybeRow <- liftIO $ getRow tree+ case maybeRow of+ Just row -> do+ liftIO $ treeViewRowActivated tree [row] column+ return True+ Nothing -> do+ liftIDE cancel+ return False+ ("Down", _, _) -> down+ ("Up", _, _) -> up+ (super, _, Just 'a') | super `elem` ["Super_L", "Super_R"] -> do+ liftIO $ debugM "leksah" "Completion - Super 'a' key press"+ down+ (super, _, Just 'l') | super `elem` ["Super_L", "Super_R"] -> do+ liftIO $ debugM "leksah" "Completion - Super 'l' key press"+ up (_, _, Just c) | isWordChar c -> return False ("BackSpace", _, _) -> return False- (shift, _, _) | (shift == "Shift_L") || (shift == "Shift_R") ->- return False+ (key, _, _) | key `elem` ["Shift_L", "Shift_R", "Super_L", "Super_R"] -> return False _ -> do liftIDE cancel return False
src/IDE/Core/State.hs view
@@ -427,6 +427,9 @@ Nothing -> return () Just (n,_) -> when (n == paneName pane) deactivatePane +-- | Replaces an 'IDEPackage' in the workspace by the given 'IDEPackage' and+-- replaces the current package if it matches.+-- Comparison is done based on the package's build directory. changePackage :: IDEPackage -> IDEAction changePackage ideP = do oldWorkspace <- readIDE workspace
src/IDE/Core/Types.hs view
@@ -156,7 +156,7 @@ , workspace :: Maybe Workspace -- ^ may be a workspace (set of packages) , activePack :: Maybe IDEPackage , activeExe :: Maybe Text-, bufferProjCache :: Map FilePath [IDEPackage]+, bufferProjCache :: Map FilePath [IDEPackage] -- ^ cache the associated packages for a file , allLogRefs :: Seq LogRef , currentEBC :: (Maybe LogRef, Maybe LogRef, Maybe LogRef) , currentHist :: Int@@ -561,10 +561,13 @@ logBuffer :: TextBuffer } deriving Typeable + -- Order determines priority of the icons in the gutter data LogRefType = ContextRef | BreakpointRef | ErrorRef | TestFailureRef | WarningRef | LintRef deriving (Eq, Ord, Show, Enum, Bounded) ++-- | Represents a message about a part of the source code data LogRef = LogRef { logRefSrcSpan :: SrcSpan , logRefPackage :: IDEPackage
src/IDE/Find.hs view
@@ -86,6 +86,7 @@ import qualified Data.Text as T (pack, unpack, singleton, isPrefixOf, length, null, toLower) import Data.Monoid ((<>))+import Graphics.UI.Gtk.Entry.Entry (entrySetPlaceholderText) foreign import ccall safe "gtk_toolbar_set_icon_size" gtk_toolbar_set_icon_size :: Ptr Toolbar -> CInt -> IO ()@@ -240,15 +241,11 @@ replaceTool <- toolItemNew rentry <- entryNew widgetSetName rentry ("replaceEntry" :: Text)+ entrySetPlaceholderText rentry $ Just ("Replace with" :: Text) containerAdd replaceTool rentry widgetSetName replaceTool ("replaceTool" :: Text) toolbarInsert toolbar replaceTool 0 - labelTool2 <- toolItemNew- label2 <- labelNew (Just (__"Replace: "))- containerAdd labelTool2 label2- toolbarInsert toolbar labelTool2 0- sep2 <- separatorToolItemNew toolbarInsert toolbar sep2 0 @@ -271,6 +268,7 @@ entryTool <- toolItemNew entry <- entryNew widgetSetName entry ("searchEntry" :: Text)+ entrySetPlaceholderText entry $ Just ("Find" :: Text) containerAdd entryTool entry widgetSetName entryTool ("searchEntryTool" :: Text) toolItemSetExpand entryTool True@@ -317,11 +315,6 @@ doSearch toolbar Insert ideR set caseSensitiveButton [widgetTooltipText := Just (__"When selected the search is case sensitive")] - labelTool <- toolItemNew- label <- labelNew (Just (__"Find: "))- containerAdd labelTool label- toolbarInsert toolbar labelTool 0- after entry insertText (\ (t::Text) i -> do doSearch toolbar Insert ideR return i)@@ -407,8 +400,6 @@ set toolbar [toolbarChildHomogeneous caseSensitiveButton := False] set toolbar [toolbarChildHomogeneous regexButton := False] set toolbar [toolbarChildHomogeneous replaceAllButton := False]- set toolbar [toolbarChildHomogeneous labelTool := False]- set toolbar [toolbarChildHomogeneous labelTool2 := False] set toolbar [toolbarChildHomogeneous labelTool3 := False] reflectIDE (modifyIDE_ (\ ide -> ide{findbar = (False, Just (toolbar, store))})) ideR
src/IDE/ImportTool.hs view
@@ -41,7 +41,8 @@ import Text.ParserCombinators.Parsec hiding (parse) import qualified Text.ParserCombinators.Parsec as Parsec (parse) import Graphics.UI.Editor.Simple (staticListEditor)-import Control.Monad (void, MonadPlus(..), unless, forM, when)+import Control.Monad+ (forM_, void, MonadPlus(..), unless, forM, when) import Control.Applicative ((<$>)) import Data.List (stripPrefix, sort, nub, nubBy) import IDE.Utils.ServerConnection@@ -92,19 +93,19 @@ let buildInBackground = backgroundBuild prefs' when buildInBackground $ modifyIDE_ (\ide -> ide{prefs = prefs'{backgroundBuild = False}})- errors <- readIDE errorRefs- addPackageResults <- Tr.forM errors addPackage+ errors <- F.toList <$> readIDE errorRefs+ addPackageResult <- addPackages errors let notInScopes = [ y | (x,y) <- nubBy (\ (p1,_) (p2,_) -> p1 == p2)- [(x,y) | (x,y) <- [((parseNotInScope . refDescription) e, e) | e <- F.toList errors]],+ [(x,y) | (x,y) <- [((parseNotInScope . refDescription) e, e) | e <- errors]], isJust x] let extensions = [ y | (x,y) <- nubBy (\ (p1,_) (p2,_) -> p1 == p2)- [(x,y) | (x,y) <- [((parsePerhapsYouIntendedToUse . refDescription) e, e) | e <- F.toList errors]],+ [(x,y) | (x,y) <- [((parsePerhapsYouIntendedToUse . refDescription) e, e) | e <- errors]], length x == 1]- addAll addPackageResults buildInBackground notInScopes extensions+ addAll addPackageResult buildInBackground notInScopes extensions where- addAll addPackageResults buildInBackground notInScopes extensions = addAllImports notInScopes (True,[])+ addAll addPackageResult buildInBackground notInScopes extensions = addAllImports notInScopes (True,[]) where addAllImports :: [LogRef] -> (Bool,[Descr]) -> IDEM () addAllImports (errorSpec:rest) (True,descrList) = addImport errorSpec descrList (addAllImports rest)@@ -118,7 +119,7 @@ when buildInBackground $ do prefs' <- readIDE prefs modifyIDE_ (\ide -> ide{prefs = prefs'{backgroundBuild = True}})- when (not (F.or addPackageResults) && null notInScopes && null extensions) $ do+ when (not addPackageResult && null notInScopes && null extensions) $ do hlintResolved <- resolveActiveHLint unless hlintResolved $ ideMessage Normal "No errors, warnings or selected hlints that can be auto resolved" @@ -182,45 +183,49 @@ else addImport' nis (logRefFullFilePath error) descr descrList continuation -addPackage :: LogRef -> IDEM Bool-addPackage error =- case parseHiddenModule $ refDescription error of- Nothing -> return False- Just (HiddenModuleResult mod pack) -> do- let idePackage = logRefPackage error- gpd <- liftIO $ readPackageDescription normal (ipdCabalFile idePackage)- ideMessage Normal $ "addPackage " <> (T.pack . display $ pkgName pack)- liftIO $ writeGenericPackageDescription (ipdCabalFile idePackage)- gpd { condLibrary = addDepToLib pack (condLibrary gpd),- condExecutables = map (addDepToExe pack)- (condExecutables gpd),- condTestSuites = map (addDepToTest pack)- (condTestSuites gpd),- condBenchmarks = map (addDepToBenchmark pack)- (condBenchmarks gpd)}- return True+addPackages :: [LogRef] -> IDEM Bool+addPackages errors = do+ let packs = nub $ mapMaybe (\error ->+ case parseHiddenModule $ refDescription error of+ Nothing -> Nothing+ Just (HiddenModuleResult _ pack) -> Just (ipdCabalFile (logRefPackage error), dep pack)) errors++ forM_ packs $ \(cabalFile, d) -> do+ gpd <- liftIO $ readPackageDescription normal cabalFile+ ideMessage Normal $ "Adding build-depends " <> T.pack (display d <> " to " <> cabalFile)+ liftIO $ writeGenericPackageDescription cabalFile+ gpd { condLibrary = addDepToLib d (condLibrary gpd),+ condExecutables = map (addDepToExe d)+ (condExecutables gpd),+ condTestSuites = map (addDepToTest d)+ (condTestSuites gpd),+ condBenchmarks = map (addDepToBenchmark d)+ (condBenchmarks gpd)}+ return True++ return . not $ null packs where addDepToLib _ Nothing = Nothing- addDepToLib p (Just cn@CondNode{+ addDepToLib d (Just cn@CondNode{ condTreeConstraints = deps, condTreeData = lib@Library{libBuildInfo = bi}}) = Just (cn{- condTreeConstraints = deps <> [dep p],- condTreeData = lib {libBuildInfo = bi {targetBuildDepends = targetBuildDepends bi <> [dep p]}}})- addDepToExe p (str,cn@CondNode{+ condTreeConstraints = deps <> [d],+ condTreeData = lib {libBuildInfo = bi {targetBuildDepends = targetBuildDepends bi <> [d]}}})+ addDepToExe d (str,cn@CondNode{ condTreeConstraints = deps, condTreeData = exe@Executable{buildInfo = bi}}) = (str,cn{- condTreeConstraints = deps <> [dep p],- condTreeData = exe { buildInfo = bi {targetBuildDepends = targetBuildDepends bi <> [dep p]}}})- addDepToTest p (str,cn@CondNode{+ condTreeConstraints = deps <> [d],+ condTreeData = exe { buildInfo = bi {targetBuildDepends = targetBuildDepends bi <> [d]}}})+ addDepToTest d (str,cn@CondNode{ condTreeConstraints = deps, condTreeData = test@TestSuite{testBuildInfo = bi}}) = (str,cn{- condTreeConstraints = deps <> [dep p],- condTreeData = test { testBuildInfo = bi {targetBuildDepends = targetBuildDepends bi <> [dep p]}}})- addDepToBenchmark p (str,cn@CondNode{+ condTreeConstraints = deps <> [d],+ condTreeData = test { testBuildInfo = bi {targetBuildDepends = targetBuildDepends bi <> [d]}}})+ addDepToBenchmark d (str,cn@CondNode{ condTreeConstraints = deps, condTreeData = bm@Benchmark{benchmarkBuildInfo = bi}}) = (str,cn{- condTreeConstraints = deps <> [dep p],- condTreeData = bm { benchmarkBuildInfo = bi {targetBuildDepends = targetBuildDepends bi <> [dep p]}}})+ condTreeConstraints = deps <> [d],+ condTreeData = bm { benchmarkBuildInfo = bi {targetBuildDepends = targetBuildDepends bi <> [d]}}}) -- Empty version is probably only going to happen for ghc-prim dep p | null . versionBranch $ packageVersion p = Dependency (packageName p) anyVersion dep p = Dependency (packageName p) (@@ -238,7 +243,7 @@ case mbActiveBuf of Nothing -> return Nothing Just buf -> do- packages <- belongsToPackages buf+ packages <- belongsToPackages' buf case packages of [] -> return Nothing pack:_ -> getPackageImportInfo pack@@ -547,7 +552,7 @@ when (isJust $ parseNotInScope msg) $ addFixMenuItem (__"Add Import") $ addImport logRef [] (\ _ -> return ()) when (isJust $ parseHiddenModule msg) $- addFixMenuItem (__"Add Package") $ addPackage logRef+ addFixMenuItem (__"Add Package") $ addPackages [logRef] when (length (parsePerhapsYouIntendedToUse msg) == 1) $ addFixMenuItem (__"Add Extension") $ addExtension logRef (\ _ -> return ()) where
src/IDE/Package.hs view
@@ -184,7 +184,7 @@ where run = do prefs <- readIDE prefs- when (saveAllBeforeBuild prefs) . liftIDE . void $ fileSaveAll belongsToWorkspace+ when (saveAllBeforeBuild prefs) . liftIDE . void $ fileSaveAll belongsToWorkspace' action packageConfig :: PackageAction@@ -269,7 +269,7 @@ return False) priorityDefault 100 return () else do- when (saveAllBeforeBuild prefs) . liftIDE . void $ fileSaveAll belongsToWorkspace+ when (saveAllBeforeBuild prefs) . liftIDE . void $ fileSaveAll belongsToWorkspace' runCabalBuild backgroundBuild jumpToWarnings withoutLinking package True $ \f -> do when f $ do mbURI <- readIDE autoURI@@ -282,7 +282,7 @@ ready <- liftIO $ isEmptyMVar (currentToolCommand ghci) when ready $ do let dir = ipdBuildDir package- when (saveAllBeforeBuild prefs) (do fileSaveAll belongsToWorkspace; return ())+ when (saveAllBeforeBuild prefs) (do fileSaveAll belongsToWorkspace'; return ()) (`runDebug` debug) . executeDebugCommand ":reload" $ do errs <- logOutputForBuild package backgroundBuild jumpToWarnings unless (any isError errs) $ do@@ -416,6 +416,7 @@ let defaultLogName = T.pack . display . pkgName $ ipdPackageId package logName = fromMaybe defaultLogName . listToMaybe $ map (T.pack . exeName) exe (logLaunch,logName) <- buildLogLaunchByName logName+ showLog case maybeDebug of Nothing -> do let dir = ipdBuildDir package@@ -800,7 +801,7 @@ modifyIDE_ (\ide -> ide {debugState = Nothing, autoCommand = return ()}) triggerEventIDE (Sensitivity [(SensitivityInterpreting, False)]) -- Kick of a build if one is not already due- modifiedPacks <- fileCheckAll belongsToPackages+ modifiedPacks <- fileCheckAll belongsToPackages' let modified = not (null modifiedPacks) prefs <- readIDE prefs when (not modified && backgroundBuild prefs) $ do
src/IDE/Pane/Breakpoints.hs view
@@ -13,7 +13,7 @@ -- Stability : provisional -- Portability : ----- |+-- | A pane to display the set breakpoints -- ----------------------------------------------------------------------------- @@ -44,18 +44,19 @@ import qualified Data.Sequence as Seq (elemIndexL) --- | A breakpoints pane description---+-- | Represents the Breakpoints pane data IDEBreakpoints = IDEBreakpoints { scrolledView :: ScrolledWindow , treeView :: TreeView , breakpoints :: TreeStore LogRef } deriving Typeable -data BreakpointsState = BreakpointsState {-} deriving(Eq,Ord,Read,Show,Typeable) +-- | The additional state used when recovering the pane+data BreakpointsState = BreakpointsState+ deriving(Eq,Ord,Read,Show,Typeable) + instance Pane IDEBreakpoints IDEM where primPaneName _ = __ "Breakpoints"@@ -63,6 +64,7 @@ getTopWidget = castToWidget . scrolledView paneId b = "*Breakpoints" + instance RecoverablePane IDEBreakpoints BreakpointsState IDEM where saveState p = return (Just BreakpointsState) recoverState pp BreakpointsState = do@@ -110,14 +112,20 @@ cid4 <- treeView `on` rowActivated $ breakpointsSelect ideR breakpoints return (Just pane, map ConnectC [cid1, cid2, cid3, cid4]) ++-- | Get the Breakpoints pane getBreakpoints :: IDEM IDEBreakpoints getBreakpoints = forceGetPane (Right "*Breakpoints") ++-- | Display the Breakpoints pane showBreakpoints :: IDEAction showBreakpoints = do pane <- getBreakpoints displayPane pane False ++-- | Fill the pane with the breakpoint 'LogRef's from the IDE state fillBreakpointList :: IDEAction fillBreakpointList = do mbBreakpoints <- getPane@@ -130,6 +138,8 @@ mapM_ (\ (lr,index) -> treeStoreInsert (breakpoints b) [] index lr) (zip (F.toList refs) [0..]) ++-- | Try to get the currently selected breakpoint getSelectedBreakpoint :: TreeView -> TreeStore LogRef -> IO (Maybe LogRef)@@ -142,7 +152,10 @@ return (Just val) _ -> return Nothing -selectBreak :: Maybe LogRef -> IDEAction++-- | Select a specific 'LogRef' or none at all+selectBreak :: Maybe LogRef -- If @Nothing@, no breakpoints are selected+ -> IDEAction selectBreak mbLogRef = do breakRefs' <- readIDE breakpointRefs breaks <- forceGetPane (Right "*Breakpoints")@@ -154,6 +167,8 @@ Nothing -> return () Just ind -> treeSelectionSelectPath selection [ind] ++-- | Constructs the context menu for the breakpoint breakpointsContextMenu :: IDERef -> TreeStore LogRef -> TreeView@@ -175,6 +190,8 @@ castToMenuItem item2, castToMenuItem item3] +-- | Set the current breakpoint to a specific entry+-- pointed to by the supplied 'TreePath' breakpointsSelect :: IDERef -> TreeStore LogRef -> TreePath@@ -185,6 +202,7 @@ reflectIDE (setCurrentBreak (Just ref)) ideR +-- | Remove a breakpoint from the pane deleteBreakpoint :: LogRef -> IDEAction deleteBreakpoint logRef = case logRefType logRef of
src/IDE/Pane/Errors.hs view
@@ -44,34 +44,42 @@ import qualified Data.Foldable as F (toList) import qualified Data.Sequence as Seq (null, elemIndexL) --- | A breakpoints pane description---++-- | The representation of the Errors pane data IDEErrors = IDEErrors { scrolledView :: ScrolledWindow , treeView :: TreeView , errorStore :: ListStore ErrColumn-, autoClose :: IORef Bool -- If the pane was only displayed to show current error+, autoClose :: IORef Bool -- ^ If the pane was only displayed to show current error } deriving Typeable ++-- | The data for a single row in the Errors pane data ErrColumn = ErrColumn { logRef :: LogRef, background :: Text} -data ErrorsState = ErrorsState {-} deriving(Eq,Ord,Read,Show,Typeable) +-- | The additional state used when recovering the pane+data ErrorsState = ErrorsState+ deriving (Eq,Ord,Read,Show,Typeable)++ instance Pane IDEErrors IDEM where primPaneName _ = __ "Errors" getTopWidget = castToWidget . scrolledView paneId _b = "*Errors" + instance RecoverablePane IDEErrors ErrorsState IDEM where saveState _p = return (Just ErrorsState) recoverState pp ErrorsState = do nb <- getNotebook pp buildPane pp nb builder builder = builder' +-- | Builds an 'IDEErrors' pane together with a list of+-- event 'Connections' builder' :: PanePath -> Notebook -> Window ->@@ -120,19 +128,29 @@ reflectIDE (fillErrorList' pane) ideR return (Just pane, map ConnectC [cid1, cid2, cid3, cid4]) ++-- | Removes the unnecessary indentation+removeIndentation :: Text -> Text removeIndentation t = T.intercalate "\n" $ map (T.drop minIndent) l where l = T.lines t minIndent = minimum $ map (T.length . T.takeWhile (== ' ')) l ++-- | Get the Errors pane getErrors :: Maybe PanePath -> IDEM IDEErrors getErrors Nothing = forceGetPane (Right "*Errors") getErrors (Just pp) = forceGetPane (Left pp) -fillErrorList :: Bool -> IDEAction++-- | Repopulates the Errors pane+fillErrorList :: Bool -- ^ Whether to display the Errors pane+ -> IDEAction fillErrorList False = getPane >>= maybe (return ()) fillErrorList' fillErrorList True = getErrors Nothing >>= \ p -> fillErrorList' p >> displayPane p False ++-- | Fills the pane with the error list from the IDE state fillErrorList' :: IDEErrors -> IDEAction fillErrorList' pane = do refs <- readIDE errorRefs@@ -151,10 +169,17 @@ LintRef -> (("#003000", "#002800"), ("#DBFFDB", "#EDFFED")) _ -> (("#380000", "#280000"), ("#FFDEDE", "#FFEBEB"))) -addErrorToList :: Bool -> Int -> LogRef -> IDEAction++-- | Add any LogRef to the Errors pane at a given index+addErrorToList :: Bool -- ^ Whether to display the pane+ -> Int -- ^ The index to insert at+ -> LogRef + -> IDEAction addErrorToList False index lr = getPane >>= maybe (return ()) (addErrorToList' index lr) addErrorToList True index lr = getErrors Nothing >>= \ p -> addErrorToList' index lr p >> displayPane p False ++-- | Add a 'LogRef' at a specific index to the Errors pane addErrorToList' :: Int -> LogRef -> IDEErrors -> IDEAction addErrorToList' index lr pane = do -- refs <- readIDE errorRefs@@ -173,6 +198,8 @@ LintRef -> (("#003000", "#002800"), ("#DBFFDB", "#EDFFED")) _ -> (("#380000", "#280000"), ("#FFDEDE", "#FFEBEB"))) ++-- | Get the currently selected error getSelectedError :: TreeView -> ListStore ErrColumn -> IO (Maybe LogRef)@@ -185,7 +212,9 @@ return (Just (logRef val)) _ -> return Nothing -selectError :: Maybe LogRef -> IDEAction+-- | Select an error in the Errors pane+selectError :: Maybe LogRef -- ^ When @Nothing@, the first error in the list is selected+ -> IDEAction selectError mbLogRef = do (mbPane :: Maybe IDEErrors) <- getPane errorRefs' <- readIDE errorRefs@@ -207,6 +236,8 @@ treeViewScrollToCell (treeView errors) (Just [ind]) Nothing Nothing treeSelectionSelectPath selection [ind] ++-- | Constructs the context menu for the Errors pane errorsContextMenu :: IDERef -> ListStore ErrColumn -> TreeView@@ -221,6 +252,8 @@ Just sel -> addResolveMenuItems ideR theMenu sel Nothing -> return () ++-- | Highlight an error refered to by the 'TreePath' in the given 'TreeViewColumn' errorsSelect :: IDERef -> ListStore ErrColumn -> TreePath@@ -231,7 +264,11 @@ reflectIDE (setCurrentError (Just (logRef ref))) ideR errorsSelect _ _ _ _ = return () -selectMatchingErrors :: Maybe SrcSpan -> IDEM ()++-- | Select the matching errors for a 'SrcSpan' in the Errors +-- pane, or none at all+selectMatchingErrors :: Maybe SrcSpan -- ^ When @Nothing@, unselects any errors in the pane + -> IDEM () selectMatchingErrors mbSpan = do mbErrors <- getPane case mbErrors of
src/IDE/Pane/Files.hs view
@@ -78,12 +78,20 @@ import Data.Tree (Tree(..)) import System.Log.Logger (debugM) +++-- * A record in the Files Pane++-- | The data for a single cell in the file tree data FileRecord = FileRecord FilePath | DirRecord FilePath | PackageRecord IDEPackage- | PlaceHolder deriving(Eq)+ | PlaceHolder -- ^ Used as child node of directories that are not yet expanded,+ -- so that the expansion arrow becomes visible+ deriving (Eq) + instance Ord FileRecord where -- | The ordering used for displaying the records in the filetree compare (DirRecord _) (FileRecord _) = LT@@ -92,26 +100,32 @@ compare (DirRecord p1) (DirRecord p2) = comparing (map toLower) p1 p2 compare _ _ = LT -file :: FileRecord -> Text-file (FileRecord f) = T.pack $ takeFileName f-file (DirRecord f) = T.pack $ takeFileName f-file (PackageRecord p) = packageIdentifierToString (ipdPackageId p) <> " " <> T.pack (ipdBuildDir p)-file PlaceHolder = ""+-- | The text to show in the file tree for a file record+displayText :: FileRecord -> Text+displayText (FileRecord f) = T.pack $ takeFileName f+displayText (DirRecord f) = T.pack $ takeFileName f+displayText (PackageRecord p) = packageIdentifierToString (ipdPackageId p) <> " " <> T.pack (ipdBuildDir p)+displayText PlaceHolder = "" --- | A files pane description--- +++-- * The Files pane++-- | The representation of the Files pane data IDEFiles = IDEFiles { scrolledView :: ScrolledWindow , treeView :: TreeView , fileStore :: TreeStore FileRecord } deriving Typeable ++-- | The additional state used when recovering the pane+-- (none, the package directories come from the IDE state) data FilesState = FilesState deriving(Eq,Ord,Read,Show,Typeable) -instance Pane IDEFiles IDEM- where+instance Pane IDEFiles IDEM where primPaneName _ = __ "Files" getAddedIndex _ = 0 getTopWidget = castToWidget . scrolledView@@ -138,7 +152,7 @@ cellLayoutPackStart col1 renderer10 False cellLayoutPackStart col1 renderer1 True cellLayoutSetAttributes col1 renderer1 fileStore- $ \row -> [ cellText := file row]+ $ \row -> [ cellText := displayText row] treeViewSetHeadersVisible treeView False sel <- treeViewGetSelection treeView@@ -182,20 +196,10 @@ return (Just files,[ConnectC cid1]) +-- | Get the Files pane getFiles :: Maybe PanePath -> IDEM IDEFiles getFiles Nothing = forceGetPane (Right "*Files") getFiles (Just pp) = forceGetPane (Left pp)---- | Tries to get the 'FileRecord' of the selected node in the 'TreeView'-getSelectionFileRecord :: TreeView- -> TreeStore FileRecord- -> IO (Maybe FileRecord)-getSelectionFileRecord treeView fileStore = do- treeSelection <- treeViewGetSelection treeView- paths <- treeSelectionGetSelectedRows treeSelection- case paths of- p:_ -> Just <$> treeStoreGetValue fileStore p- _ -> return Nothing -- | Refreshes the Files pane, lists all package directories and synchronizes the expanded
src/IDE/Pane/Grep.hs view
@@ -15,7 +15,7 @@ -- Stability : provisional -- Portability : portable -- --- | The pane of ide where grep results are displayed +-- | The pane of the ide where grep results are displayed -- ------------------------------------------------------------------------------- @@ -65,6 +65,7 @@ import Control.Exception (SomeException, catch) import Data.Text (Text) +-- | Represents a single search result data GrepRecord = GrepRecord { file :: FilePath , line :: Int @@ -72,12 +73,14 @@ , parDir :: Maybe FilePath } + +-- | Determines whether a 'GrepRecord' is a directory +isDir :: GrepRecord -> Bool isDir GrepRecord{parDir = Nothing} = True isDir otherwies = False --- | A grep pane description --- +-- | The representation of the Grep result pane data IDEGrep = IDEGrep { scrolledView :: ScrolledWindow , treeView :: TreeView @@ -86,9 +89,12 @@ , activeGrep :: MVar Bool } deriving Typeable + +-- | The additional state used when recovering the pane data GrepState = GrepState deriving(Eq,Ord,Read,Show,Typeable) + instance Pane IDEGrep IDEM where primPaneName _ = __ "Grep" @@ -96,6 +102,7 @@ getTopWidget = castToWidget . scrolledView paneId b = "*Grep" + instance RecoverablePane IDEGrep GrepState IDEM where saveState p = return (Just GrepState) recoverState pp GrepState = do @@ -187,10 +194,13 @@ return (Just grep,[ConnectC cid1]) +-- | Get the Grep panel getGrep :: Maybe PanePath -> IDEM IDEGrep getGrep Nothing = forceGetPane (Right "*Grep") getGrep (Just pp) = forceGetPane (Left pp) + +-- | Parses a result line of grep output into a 'GrepRecord' grepLineParser :: CharParser () GrepRecord grepLineParser = try (do file <- many (noneOf ":") @@ -211,6 +221,8 @@ colon = P.colon lexer int = fromInteger <$> P.integer lexer + +-- | Tries to get the currently selected record in the pane getSelectionGrepRecord :: TreeView -> TreeStore GrepRecord -> IO (Maybe GrepRecord) @@ -221,8 +233,12 @@ p:_ -> Just <$> treeStoreGetValue grepStore p _ -> return Nothing + --TODO srp use default loglaunch probably -grepWorkspace :: Text -> Bool -> WorkspaceAction +-- | Greps the current workspace +grepWorkspace :: Text -- ^ The regex string + -> Bool -- ^ Case sensitive + -> WorkspaceAction grepWorkspace "" caseSensitive = return () grepWorkspace regexString caseSensitive = do ws <- ask @@ -233,7 +249,12 @@ lift $ grepDirectories regexString caseSensitive $ map (dropFileName . ipdCabalFile) packages -grepDirectories :: Text -> Bool -> [FilePath] -> IDEAction + +-- | Greps a list of directories +grepDirectories :: Text -- ^ The regex string + -> Bool -- ^ Case sensitive + -> [FilePath] + -> IDEAction grepDirectories regexString caseSensitive dirs = do grep <- getGrep Nothing let store = grepStore grep @@ -287,6 +308,8 @@ void $ takeMVar (activeGrep grep) return () + +-- | A Sink for processing lines of grep output and counting them setGrepResults :: FilePath -> C.Sink ToolOutput IDEM Int setGrepResults dir = do ideRef <- lift ask
src/IDE/Pane/Info.hs view
@@ -16,7 +16,7 @@ -- Stability : provisional -- Portability : portable ----- | The GUI stuff for infos+-- | The info Pane to show symbol information -- ------------------------------------------------------------------------------- @@ -53,17 +53,20 @@ import qualified Data.Text as T (unpack, pack, null) import Data.Monoid ((<>)) --- | An info pane description---++-- | Represents the Info pane data IDEInfo = forall editor. TextEditor editor => IDEInfo { sw :: ScrolledWindow , currentDescr :: IORef (Maybe Descr) , descriptionView :: EditorView editor } deriving Typeable ++-- | The additional state used when recovering the pane data InfoState = InfoState (Maybe Descr) deriving(Eq,Ord,Read,Show,Typeable) + instance Pane IDEInfo IDEM where primPaneName _ = __ "Info"@@ -71,6 +74,7 @@ getTopWidget = castToWidget . sw paneId b = "*Info" + instance RecoverablePane IDEInfo InfoState IDEM where saveState p = do currentDescr' <- liftIO $ readIORef (currentDescr p)@@ -110,14 +114,20 @@ cids2 <- descriptionView `afterFocusIn` makeActive info return (Just info, cids1 ++ cids2) ++-- | Get the Info pane getInfo :: IDEM IDEInfo getInfo = forceGetPane (Right "*Info") ++-- | Display the Info pane showInfo :: IDEAction showInfo = do pane <- getInfo displayPane pane False ++-- | Open the source of the current symbol description gotoSource :: IDEAction gotoSource = do mbInfo <- getInfoCont@@ -126,6 +136,8 @@ return () Just info -> void (goToDefinition info) ++-- | Select the symbol description in the module pane gotoModule' :: IDEAction gotoModule' = do mbInfo <- getInfoCont@@ -134,6 +146,7 @@ Just info -> void (triggerEventIDE (SelectIdent info)) +-- | Replaces the symbol description and displays the info pane setInfo :: Descr -> IDEAction setInfo identifierDescr = do info <- getInfo@@ -147,12 +160,16 @@ setText tb (T.pack $ show (Present identifierDescr) ++ "\n") -- EOL for text iters to work recordInfoHistory (Just identifierDescr) oldDescr ++-- | Updates the style of the text buffer if it is opened setInfoStyle :: IDEAction setInfoStyle = getPane >>= setInfoStyle' where setInfoStyle' Nothing = return () setInfoStyle' (Just IDEInfo{..}) = getBuffer descriptionView >>= updateStyle ++-- | Try to get the symbol description of the Info pane getInfoCont :: IDEM (Maybe Descr) getInfoCont = do mbPane <- getPane@@ -163,15 +180,24 @@ -- * GUI History -recordInfoHistory :: Maybe Descr -> Maybe Descr -> IDEAction++-- | Record the transition to the new description from the old+recordInfoHistory :: Maybe Descr -- ^ The new description+ -> Maybe Descr -- ^ The old description+ -> IDEAction recordInfoHistory descr oldDescr = do triggerEventIDE (RecordHistory (InfoElementSelected descr, InfoElementSelected oldDescr)) return () -replayInfoHistory :: Maybe Descr -> IDEAction++-- | Replace the symbol description+replayInfoHistory :: Maybe Descr -- ^ If @Nothing@, the description is not replaced+ -> IDEAction replayInfoHistory mbDescr = forM_ mbDescr setInfo ++-- | Open the documentation for the current symbol description openDocu :: IDEAction openDocu = do mbDescr <- getInfoCont@@ -181,6 +207,8 @@ prefs' <- readIDE prefs openBrowser $ docuSearchURL prefs' <> T.pack (escapeURIString isAlphaNum (T.unpack $ dscName descr)) ++-- | Builds the context menu of the Info pane populatePopupMenu :: IDERef -> IORef (Maybe Descr) -> Menu -> IO () populatePopupMenu ideR currentDescr' menu = do items <- containerGetChildren menu
src/IDE/Pane/PackageEditor.hs view
@@ -334,13 +334,18 @@ , buildType = Just Simple , specVersionRaw = Right (orLaterVersion (Version [1,12] [])) , license = AllRightsReserved+ , buildDepends = [+ Dependency (PackageName "base") anyVersion+ , Dependency (PackageName "QuickCheck") anyVersion+ , Dependency (PackageName "doctest") anyVersion] , executables = [emptyExecutable { exeName = T.unpack newPackageName , modulePath = "Main.hs" , buildInfo = emptyBuildInfo {- hsSourceDirs = ["src"]+ hsSourceDirs = ["src"] , targetBuildDepends = [Dependency (PackageName "base") anyVersion]- , defaultLanguage = Just Haskell2010}}]+ , options = [(GHC, ["-ferror-spans"])]+ , defaultLanguage = Just Haskell2010}}] , testSuites = [emptyTestSuite { testName = "test-" ++ T.unpack newPackageName , testInterface = TestSuiteExeV10 (Version [1,0] []) "Main.hs"@@ -350,6 +355,7 @@ Dependency (PackageName "base") anyVersion , Dependency (PackageName "QuickCheck") anyVersion , Dependency (PackageName "doctest") anyVersion]+ , options = [(GHC, ["-ferror-spans"])] , defaultLanguage = Just Haskell2010}}] , benchmarks = [] } dirName modules (activateAction True)
src/IDE/Pane/PackageFlags.hs view
@@ -15,7 +15,8 @@ -- Portability : portable -- ----- | Module for saving, restoring and editing projectFlags+-- | Pane for saving, restoring and editing flags for specific cabal+-- commands. -- --------------------------------------------------------------------------------- @@ -91,6 +92,8 @@ Nothing -> return (Nothing,[]) Just p -> reifyIDE $ \ideR -> builder' p flagsDesc flatflagsDesc pp nb window ideR ++-- | Builds the Flags pane builder' idePackage flagsDesc flatflagsDesc pp nb window ideR = do vb <- vBoxNew False 0 let flagsPane = IDEFlags vb@@ -136,16 +139,23 @@ boxPackEnd vb bb PackNatural 6 return (Just flagsPane,[]) ++-- | Gets the Flags pane getFlags :: Maybe PanePath -> IDEM IDEFlags getFlags Nothing = forceGetPane (Right "*Flags") getFlags (Just pp) = forceGetPane (Left pp) ++-- | Quote the string if it contains spaces and escape+-- any other quotes. quoteArg :: String -> String quoteArg s | ' ' `elem` s = "\"" <> escapeQuotes s <> "\"" quoteArg s = s escapeQuotes = foldr (\c s -> if c == '"' then '\\':c:s else c:s) "" ++-- | Parse any (escaped) character (ignoring a prefixed @\@) quotedArgCharParser :: CharParser () Char quotedArgCharParser = try (do char '\\'@@ -154,6 +164,9 @@ noneOf "\"") <?> "argsParser" ++-- | Parse an argument that is either quoted or does not+-- contain spaces argParser :: CharParser () Text argParser = try (do char '"'@@ -164,6 +177,8 @@ T.pack <$> many1 (noneOf " ")) <?> "argParser" ++-- | Parse many arguments, possibly seperated by spaces argsParser :: CharParser () [Text] argsParser = try ( many (do@@ -171,17 +186,25 @@ argParser)) <?> "argsParser" ++-- | Quote all arguments and concatenate them unargs :: [Text] -> Text unargs = T.unwords . map (T.pack . quoteArg . T.unpack) ++-- | Parse a list of arguments from a given string args :: Text -> [Text] args s = case parse argsParser "" $ T.unpack s of Right result -> result _ -> [s] ++-- | The flattened description of the fields in the pane flatFlagsDescription :: [FieldDescriptionS IDEPackage] flatFlagsDescription = flattenFieldDescriptionPPToS flagsDescription ++-- | The description of the fields in the pane flagsDescription :: FieldDescriptionPP IDEPackage IDEM flagsDescription = VFDPP emptyParams [ mkFieldPP@@ -261,6 +284,7 @@ -- * Parsing -- ------------------------------------------------------------ +-- | Read all the field values from the given 'FilePath' readFlags :: FilePath -> IDEPackage -> IO IDEPackage readFlags fn = readFields fn flatFlagsDescription @@ -268,6 +292,7 @@ -- * Printing -- ------------------------------------------------------------ +-- | Write all field values to the given 'FilePath' writeFlags :: FilePath -> IDEPackage -> IO () writeFlags fpath flags = writeFields fpath flags flatFlagsDescription
src/IDE/Pane/Preferences.hs view
@@ -94,17 +94,18 @@ prefsVersion :: Int prefsVersion = 3 ------ | The Preferences Pane--- +-- | Represents the Preferences pane data IDEPrefs = IDEPrefs { prefsBox :: VBox } deriving Typeable ++-- | The additional state used when recovering the pane data PrefsState = PrefsState deriving(Eq,Ord,Read,Show,Typeable) + instance Pane IDEPrefs IDEM where primPaneName _ = __ "Prefs"@@ -112,6 +113,7 @@ getTopWidget = castToWidget . prefsBox paneId b = "*Prefs" + instance RecoverablePane IDEPrefs PrefsState IDEM where saveState p = return Nothing recoverState pp st = return Nothing@@ -224,14 +226,19 @@ return e) return (Just prefsPane,[]) ++-- | Get the Preferences pane getPrefs :: Maybe PanePath -> IDEM IDEPrefs getPrefs Nothing = forceGetPane (Right "*Prefs") getPrefs (Just pp) = forceGetPane (Left pp) ++ -- ------------------------------------------------------------ -- * Dialog definition -- ------------------------------------------------------------ +-- | Description of the preference options prefsDescription :: FilePath -> [PackageIdentifier] -> FieldDescriptionPP Prefs IDEM prefsDescription configDir packages = NFDPP [ (__ "Editor", VFDPP emptyParams [@@ -808,7 +815,7 @@ (\i -> return ()) ])] -+-- | Editor for enabling a different syntax stylesheet styleEditor :: Editor (Bool, Text) styleEditor p n = do styleManager <- sourceStyleSchemeManagerNew@@ -819,6 +826,7 @@ disableEditor (comboSelectionEditor notDarkIds id, p) True (__ "Select a special style?") p n +-- | The default preferences defaultPrefs = Prefs { prefsFormat = prefsVersion , prefsSaveTime = ""@@ -905,6 +913,7 @@ -- * Parsing -- ------------------------------------------------------------ +-- | Read the preference file readPrefs :: FilePath -> IO Prefs readPrefs fn = catch (do configDir <- getConfigDir@@ -916,6 +925,7 @@ -- * Printing -- ------------------------------------------------------------ +-- | Write the preference file writePrefs :: FilePath -> Prefs -> IO () writePrefs fpath prefs = do timeNow <- liftIO getClockTime
src/IDE/Pane/SourceBuffer.hs view
@@ -35,7 +35,6 @@ , fileNew , fileOpenThis-, fileOpen , filePrint , fileRevert , fileClose@@ -86,8 +85,10 @@ , recentSourceBuffers , newTextBuffer , belongsToPackages+, belongsToPackages' , belongsToPackage , belongsToWorkspace+, belongsToWorkspace' , getIdentifierUnderCursorFromIter , useCandyFor @@ -120,7 +121,7 @@ notebookGetNthPage, notebookPageNum, widgetHide, dialogRun, messageDialogNew, scrolledWindowSetShadowType, scrolledWindowSetPolicy, dialogSetDefaultResponse,- fileChooserSetCurrentFolder, fileChooserSelectFilename,+ fileChooserSelectFilename, TextSearchFlags(..)) import qualified Graphics.UI.Gtk as Gtk hiding (eventKeyName) import Graphics.UI.Gtk.Windows.Window@@ -1127,40 +1128,6 @@ in any (`isSubPath` fileName) paths -fileOpen :: IDEAction-fileOpen = do- window <- getMainWindow- prefs <- readIDE prefs- mbBuf <- maybeActiveBuf- mbFileName <- liftIO $ do- dialog <- fileChooserDialogNew- (Just $ __ "Open File")- (Just window)- FileChooserActionOpen- [("gtk-cancel"- ,ResponseCancel)- ,("gtk-open"- ,ResponseAccept)]- case mbBuf >>= fileName of- Just fn -> void (fileChooserSetCurrentFolder dialog (dropFileName fn))- Nothing -> return ()- widgetShow dialog- response <- dialogRun dialog- case response of- ResponseAccept -> do- f <- fileChooserGetFilename dialog- widgetDestroy dialog- return f- ResponseCancel -> do- widgetDestroy dialog- return Nothing- ResponseDeleteEvent-> do- widgetDestroy dialog- return Nothing- _ -> return Nothing- F.forM_ mbFileName fileOpenThis-- fileOpenThis :: FilePath -> IDEAction fileOpenThis fp = do liftIO . debugM "leksah" $ "fileOpenThis " ++ fp@@ -1431,9 +1398,10 @@ i2 <- forwardCharsC i1 (T.length realString) selectRange ebuf i1 i2 --- | Returns the package, to which this buffer belongs, if possible-belongsToPackages :: MonadIDE m => IDEBuffer -> m [IDEPackage]-belongsToPackages IDEBuffer{fileName = Just fp}= do+-- | Returns the packages to which this file belongs+-- uses the 'bufferProjCache' and might extend it+belongsToPackages :: MonadIDE m => FilePath -> m [IDEPackage]+belongsToPackages fp = do bufferToProject' <- readIDE bufferProjCache ws <- readIDE workspace case Map.lookup fp bufferToProject' of@@ -1441,20 +1409,27 @@ Nothing -> case ws of Nothing -> return [] Just workspace -> do--- mbMn <- liftIO $ moduleNameFromFilePath fp--- let mbMn2 = case mbMn of--- Nothing -> Nothing--- Just mn -> simpleParse mn let res = filter (belongsToPackage fp) (wsPackages workspace) modifyIDE_ (\ide -> ide{bufferProjCache = Map.insert fp res bufferToProject'}) return res-belongsToPackages _ = return [] --- | Including files in sandbox source dirs+-- | Returns the packages to which this buffer belongs+-- uses the 'bufferProjCache' and might extend it+belongsToPackages' :: MonadIDE m => IDEBuffer -> m [IDEPackage]+belongsToPackages' = maybe (return []) belongsToPackages . fileName++-- | Checks whether a file belongs to a package (includes files in+-- sandbox source dirs) belongsToPackage :: FilePath -> IDEPackage -> Bool belongsToPackage f = any (`isSubPath` f) . ipdAllDirs -belongsToWorkspace b = liftM (not . null) (belongsToPackages b)+-- | Checks whether a file belongs to the workspace+belongsToWorkspace :: MonadIDE m => FilePath -> m Bool+belongsToWorkspace fp = liftM (not . null) (belongsToPackages fp)++-- | Checks whether a file belongs to the workspace+belongsToWorkspace' :: MonadIDE m => IDEBuffer -> m Bool+belongsToWorkspace' = maybe (return False) belongsToWorkspace . fileName useCandyFor :: MonadIDE m => IDEBuffer -> m Bool useCandyFor aBuffer = do
src/IDE/Pane/Variables.hs view
@@ -56,22 +56,26 @@ import qualified Data.Text as T (pack, unpack) import Control.Applicative ((<$>)) --- | A variables pane description---+-- | Represents the Variables pane data IDEVariables = IDEVariables { scrolledView :: ScrolledWindow , treeView :: TreeView , variables :: TreeStore VarDescription } deriving Typeable ++-- | The data for a single entry in the pane data VarDescription = VarDescription { varName :: Text , varType :: Text , varValue :: Text} -data VariablesState = VariablesState {-} deriving(Eq,Ord,Read,Show,Typeable) +-- | The additional state used when recovering the pane+data VariablesState = VariablesState+ deriving(Eq,Ord,Read,Show,Typeable)++ instance Pane IDEVariables IDEM where primPaneName _ = __ "Variables"@@ -79,6 +83,7 @@ getTopWidget = castToWidget . scrolledView paneId b = "*Variables" + instance RecoverablePane IDEVariables VariablesState IDEM where saveState p = return (Just VariablesState) recoverState pp VariablesState = do@@ -86,14 +91,21 @@ buildPane pp nb builder builder = builder' ++-- | Get the Variables pane getVariables :: IDEM IDEVariables getVariables = forceGetPane (Right "*Variables") ++-- | Display the Variables pane showVariables :: IDEAction showVariables = do pane <- getVariables displayPane pane False ++-- | Builds the Variables pane, together with a list+-- of connections of events builder' :: PanePath -> Notebook -> Window ->@@ -154,6 +166,7 @@ return (Just pane, map ConnectC [cid1, cid2, cid3, cid4]) +-- | Quietly list the variable bindings of the current debug session fillVariablesListQuiet :: IDEAction fillVariablesListQuiet = packageTryQuiet $ do mbVariables <- liftIDE getPane@@ -171,6 +184,8 @@ where insertBreak treeStore (v,index) = treeStoreInsert treeStore [] index v ++-- | List the variable bindings of the current debug session fillVariablesList :: IDEAction fillVariablesList = packageTry $ do mbVariables <- liftIDE getPane@@ -188,11 +203,16 @@ where insertBreak treeStore (v,index) = treeStoreInsert treeStore [] index v ++-- | Concatenates the tool output lines with newlines selectString :: [ToolOutput] -> Text selectString (ToolOutput str:r) = "\n" <> str <> selectString r selectString (_:r) = selectString r selectString [] = "" ++-- | Tries to get the selected variable in the Pane,+-- together with the 'TreePath' getSelectedVariable :: TreeView -> TreeStore VarDescription -> IO (Maybe (VarDescription,TreePath))@@ -205,6 +225,8 @@ return (Just (val,a)) _ -> return Nothing ++-- | Parses multiple 'VarDescription's variablesParser :: CharParser () [VarDescription] variablesParser = do whiteSpace@@ -212,6 +234,8 @@ eof return r ++-- | Parses a 'VarDescription' from a line of ghci output variableParser :: CharParser () VarDescription variableParser = do whiteSpace@@ -229,6 +253,9 @@ return (VarDescription varName typeStr value) <?> "variableParser" ++-- | Parses only the value of a variable binding from a line of+-- ghci output valueParser :: CharParser () Text valueParser = do whiteSpace@@ -237,6 +264,8 @@ T.pack <$> many anyChar <?> "valueParser" +-- | Parses only the type of a variable binding from a line of+-- ghci output typeParser :: CharParser () Text typeParser = do whiteSpace@@ -251,6 +280,7 @@ whiteSpace = P.whiteSpace lexer +-- | Constructs the context menu of the Variables pane variablesContextMenu :: IDERef -> TreeStore VarDescription -> TreeView@@ -275,6 +305,9 @@ mapM_ (menuShellAppend theMenu) [castToMenuItem item1, castToMenuItem item2, castToMenuItem sep1, castToMenuItem item3] ++-- | Called when a variable is selected in the Variables pane.+-- Forces the variable and updates the entry in the pane, variablesSelect :: IDERef -> TreeStore VarDescription -> TreePath@@ -284,6 +317,9 @@ varDescr <- treeStoreGetValue store path reflectIDE (forceVariable varDescr path store) ideR ++-- | Force the value of the given 'VarDescription', retrieve its type+-- and update the appropriate entry in the Variables pane forceVariable :: VarDescription -> TreePath -> TreeStore VarDescription -> IDEAction forceVariable varDescr path treeStore = packageTry $ tryDebug $ do debugCommand' (":force " <> varName varDescr) $ do@@ -303,6 +339,9 @@ var <- treeStoreGetValue treeStore path treeStoreSetValue treeStore path var{varType = typ} ++-- | Print the value of the given 'VarDescription', retrieve its type+-- and update the appropriate entry in the Variables pane printVariable :: VarDescription -> TreePath -> TreeStore VarDescription -> IDEAction printVariable varDescr path treeStore = packageTry $ tryDebug $ do debugCommand' (":print " <> varName varDescr) $ do
src/IDE/Pane/Workspace.hs view
@@ -14,7 +14,8 @@ -- Stability : provisional -- Portability : ----- |+-- | The pane of the IDE that shows the cabal packages in the workspace+-- and their build targets -- ----------------------------------------------------------------------------- @@ -49,8 +50,13 @@ -- | Workspace pane state -- +-- | The data in a row displays a package or an+-- executable of that package (in the first case+-- the path to the package is also stored) type WorkspaceRecord = (IDEPackage, Maybe Text) ++-- | The representation of the workspace pane data IDEWorkspace = IDEWorkspace { scrolledView :: ScrolledWindow , treeViewC :: TreeView@@ -65,7 +71,8 @@ getTopWidget = castToWidget . topBox paneId b = "*Workspace" --- | Nothing to remember here, everything comes from the IDE state+-- | The additional state used when recovering the pane+-- (none, the packages and their targets come from the IDE state) data WorkspaceState = WorkspaceState deriving(Eq,Ord,Read,Show,Typeable) @@ -138,15 +145,19 @@ file (_, (_, Just _)) = "" file (_, (pack, _)) = ipdCabalFile pack +-- | Get the workspace pane getWorkspace :: Maybe PanePath -> IDEM IDEWorkspace getWorkspace Nothing = forceGetPane (Right "*Workspace") getWorkspace (Just pp) = forceGetPane (Left pp) +-- | Show the workspace pane showWorkspace :: IDEAction showWorkspace = do l <- getWorkspace Nothing displayPane l False +-- | Try to get the current selected record and whether+-- it is selected getSelectionTree :: TreeView -> TreeStore (Bool, WorkspaceRecord) -> IO (Maybe (Bool, IDEPackage, Maybe Text))@@ -161,6 +172,8 @@ (active, (p, exe)) -> return $ Just (active, p, exe) _ -> return Nothing ++-- | Construct the context menu for the pane workspaceContextMenu :: IDERef -> IDEWorkspace -> Menu@@ -186,6 +199,9 @@ menuShellAppend theMenu item2 menuShellAppend theMenu item3 ++-- | Try to activate the package pointed to by the given 'TreePath'+-- by modifying the given IDE state workspaceSelect :: IDERef -> IDEWorkspace -> TreePath@@ -196,7 +212,12 @@ (_,(ideP,mbExe)) <- treeStoreGetValue (workspaceStore workspacePane) path reflectIDE (workspaceTry $ workspaceActivatePackage ideP mbExe) ideR -updateWorkspace :: Bool -> Bool -> IDEAction++-- | Repopulates the workspace pane with the current packages+-- (if the pane is open)+updateWorkspace :: Bool -- ^ Show the pane if it is open and a workspace is loaded+ -> Bool -- ^ Empty the 'bufferProjCache'+ -> IDEAction updateWorkspace showPane updateFileCache = do liftIO $ debugM "leksah" "updateWorkspace" mbWs <- readIDE workspace@@ -214,18 +235,27 @@ case mbMod of Nothing -> return () Just (p :: IDEWorkspace) -> do- liftIO $ treeStoreClear (workspaceStore p)- let sorted = sortBy (compare `F.on` ipdPackageId) $ wsPackages ws- forest = map (\ ideP -> Node (- Just (ipdCabalFile ideP) == wsActivePackFile ws,- (ideP, Nothing))- (map (\ pack -> Node (False, (pack, Nothing)) []) (ipdSandboxSources ideP) ++- map (\ test -> Node (- Just (ipdCabalFile ideP) == wsActivePackFile ws &&- Just test == wsActiveExe ws, (ideP, Just test)) [])- (ipdExes ideP ++ ipdTests ideP ++ ipdBenchmarks ideP)))- sorted- liftIO $ treeStoreInsertForest (workspaceStore p) [] 0 forest+ liftIO $ do+ treeStoreClear (workspaceStore p)+ treeStoreInsertForest (workspaceStore p) [] 0 (buildForest ws) when showPane $ displayPane p False refreshFiles+ where+ -- | Given a workspace, constructs the forest of+ -- packages and their targets+ buildForest ws =+ let sorted = sortBy (compare `F.on` ipdPackageId) $ wsPackages ws+ in map (buildPackageTree ws) sorted + -- | Given an ide package, constructs the tree with the+ -- package as root node, and its targets as children+ buildPackageTree ws ideP =+ let isActive = Just (ipdCabalFile ideP) == wsActivePackFile ws+ sandboxChildren = map (\pack -> Node (False, (pack, Nothing)) [])+ (ipdSandboxSources ideP)+ targetsChildren = map (\test -> Node (+ Just (ipdCabalFile ideP) == wsActivePackFile ws &&+ Just test == wsActiveExe ws, (ideP, Just test)) [])+ (ipdExes ideP ++ ipdTests ideP ++ ipdBenchmarks ideP)+ in Node (isActive, (ideP, Nothing))+ (sandboxChildren ++ targetsChildren)
src/IDE/PaneGroups.hs view
@@ -1,5 +1,6 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE LambdaCase #-} ----------------------------------------------------------------------------- -- -- Module : IDE.PaneGroups@@ -24,15 +25,11 @@ import IDE.Core.State (IDEM(..), readIDE, IDEAction(..)) import Graphics.UI.Frame.Panes- (getTopWidget,- getPane,- getOrBuildPane,- PaneDirection(..),- PanePathElement(..),- layout,- panePathForGroup)+ (RecoverablePane, PanePath, getTopWidget, getPane, getOrBuildPane,+ PaneDirection(..), PanePathElement(..), layout, panePathForGroup) import Graphics.UI.Frame.ViewFrame- (getBestPanePath, getNotebook, viewSplit', newGroupOrBringToFront)+ (viewMoveTo, getBestPanePath, getNotebook, viewSplit',+ newGroupOrBringToFront) import Control.Monad (void, unless, when, liftM) import IDE.Core.Types (frameState) import Graphics.UI.Editor.Parameters (Direction(..))@@ -50,6 +47,14 @@ import Control.Monad.IO.Class (MonadIO(..)) import IDE.Pane.WebKit.Output (IDEOutput(..)) +moveOrBuildPane :: RecoverablePane alpha beta delta => PanePath -> delta (Maybe alpha)+moveOrBuildPane path = do+ mbPane <- getOrBuildPane (Left path)+ case mbPane of+ Just pane -> viewMoveTo path pane+ Nothing -> return ()+ return mbPane+ showBrowser :: IDEAction showBrowser = do pp <- panePathForGroup "*Browser"@@ -81,9 +86,9 @@ _ -> return () where getOrBuildBrowserPanes upperP lowerP topP = do- getOrBuildPane (Left upperP) :: IDEM (Maybe IDEModules)- getOrBuildPane (Left lowerP) :: IDEM (Maybe IDEInfo)- getOrBuildPane (Left topP) :: IDEM (Maybe IDEWorkspace)+ moveOrBuildPane upperP :: IDEM (Maybe IDEModules)+ moveOrBuildPane lowerP :: IDEM (Maybe IDEInfo)+ moveOrBuildPane topP :: IDEM (Maybe IDEWorkspace) return () setSensitivityDebugger :: Bool -> IDEAction@@ -127,11 +132,13 @@ _ -> return () where getOrBuildDebugPanes upperP lowerP bufs = do- getOrBuildPane (Left lowerP) :: IDEM (Maybe IDEBreakpoints)- getOrBuildPane (Left lowerP) :: IDEM (Maybe IDEVariables)- getOrBuildPane (Left lowerP) :: IDEM (Maybe IDETrace)- getOrBuildPane (Left lowerP) :: IDEM (Maybe IDEOutput)+ moveOrBuildPane lowerP :: IDEM (Maybe IDEBreakpoints)+ moveOrBuildPane lowerP :: IDEM (Maybe IDEVariables)+ moveOrBuildPane lowerP :: IDEM (Maybe IDETrace)+ moveOrBuildPane lowerP :: IDEM (Maybe IDEOutput) unless (any (\ b -> bufferName b == "_Eval.hs") bufs) $- void (newTextBuffer upperP "_Eval.hs" Nothing)+ newTextBuffer upperP "_Eval.hs" Nothing >>= \case+ Nothing -> return ()+ Just pane -> viewMoveTo upperP pane return ()
src/IDE/Workspaces.hs view
@@ -1,5 +1,6 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE LambdaCase #-} ----------------------------------------------------------------------------- -- -- Module : IDE.Workspace@@ -34,6 +35,8 @@ , backgroundMake , makePackage+, fileOpen+, fileOpen' ) where import IDE.Core.State@@ -66,14 +69,17 @@ (getModuleTemplate, getPackageDescriptionAndPath, activatePackage, deactivatePackage, idePackageFromPath, idePackageFromPath) import System.Directory- (getHomeDirectory, createDirectoryIfMissing, doesFileExist)+ (getDirectoryContents, getHomeDirectory, createDirectoryIfMissing,+ doesFileExist) import System.Time (getClockTime) import Graphics.UI.Gtk.Windows.MessageDialog (ButtonsType(..), MessageType(..)) import Graphics.UI.Gtk.Windows.Dialog (ResponseId(..)) import qualified Control.Exception as Exc (SomeException(..), throw, Exception) import qualified Data.Map as Map (empty)-import IDE.Pane.SourceBuffer (fileOpenThis, fileCheckAll, belongsToPackages)+import IDE.Pane.SourceBuffer+ (belongsToWorkspace, IDEBuffer(..), maybeActiveBuf, fileOpenThis,+ fileCheckAll, belongsToPackages') import System.Glib.Attributes (AttrOp(..), set) import Graphics.UI.Gtk.General.Enums (WindowPosition(..)) import Control.Applicative ((<$>))@@ -98,6 +104,13 @@ import qualified Text.Printf as S (printf) import Text.Printf (PrintfType) import qualified Data.Text.IO as T (writeFile)+import Graphics.UI.Gtk.Selectors.FileChooserDialog+ (fileChooserDialogNew)+import Graphics.UI.Gtk.Selectors.FileChooser+ (fileChooserGetFilename, fileChooserSetCurrentFolder,+ FileChooserAction(..))+import Graphics.UI.Gtk.Abstract.Widget (widgetShow)+import Control.Exception (SomeException(..), catch) printf :: PrintfType r => Text -> r printf = S.printf . T.unpack@@ -456,22 +469,18 @@ backgroundMake = catchIDE (do ideR <- ask prefs <- readIDE prefs- mbPackage <- readIDE activePack debug <- isJust <$> readIDE debugState- case mbPackage of- Nothing -> return ()- Just package -> do- modifiedPacks <- if saveAllBeforeBuild prefs- then fileCheckAll belongsToPackages- else return []- let isModified = not (null modifiedPacks)- when isModified $ do- let settings = defaultMakeSettings prefs- steps <- buildSteps $ msRunUnitTests settings- workspaceTryQuiet $ if debug || msSingleBuildWithoutLinking settings && not (msMakeMode settings)- then makePackages settings modifiedPacks (MoComposed steps) (MoComposed []) moNoOp- else makePackages settings modifiedPacks (MoComposed steps)- (MoComposed (MoConfigure:steps)) MoMetaInfo+ modifiedPacks <- if saveAllBeforeBuild prefs+ then fileCheckAll belongsToPackages'+ else return []+ let isModified = not (null modifiedPacks)+ when isModified $ do+ let settings = defaultMakeSettings prefs+ steps <- buildSteps $ msRunUnitTests settings+ workspaceTryQuiet $ if debug || msSingleBuildWithoutLinking settings && not (msMakeMode settings)+ then makePackages settings modifiedPacks (MoComposed steps) (MoComposed []) moNoOp+ else makePackages settings modifiedPacks (MoComposed steps)+ (MoComposed (MoConfigure:steps)) MoMetaInfo ) (\(e :: Exc.SomeException) -> sysMessage Normal (T.pack $ show e)) @@ -498,3 +507,96 @@ (MoComposed steps) (MoComposed (MoConfigure:steps)) MoMetaInfo) ws++fileOpen :: IDEAction+fileOpen = do+ window <- getMainWindow+ prefs <- readIDE prefs+ mbBuf <- maybeActiveBuf+ mbFileName <- liftIO $ do+ dialog <- fileChooserDialogNew+ (Just $ __ "Open File")+ (Just window)+ FileChooserActionOpen+ [("gtk-cancel"+ ,ResponseCancel)+ ,("gtk-open"+ ,ResponseAccept)]+ case mbBuf >>= fileName of+ Just fn -> void (fileChooserSetCurrentFolder dialog (dropFileName fn))+ Nothing -> return ()+ widgetShow dialog+ response <- dialogRun dialog+ case response of+ ResponseAccept -> do+ f <- fileChooserGetFilename dialog+ widgetDestroy dialog+ return f+ ResponseCancel -> do+ widgetDestroy dialog+ return Nothing+ ResponseDeleteEvent-> do+ widgetDestroy dialog+ return Nothing+ _ -> return Nothing+ forM_ mbFileName fileOpen'++fileOpen' :: FilePath -> IDEAction+fileOpen' fp = do+ window <- getMainWindow+ knownFile <- belongsToWorkspace fp+ unless knownFile $+ if takeExtension fp == ".cabal"+ then do+ resp <- liftIO $ do+ md <- messageDialogNew+ (Just window) []+ MessageQuestion+ ButtonsNone+ (__ "Would you like to add the package " <> T.pack fp+ <> __ " to the workspace so that it can be built by Leksah?")+ dialogAddButton md (__ "_Add " <> T.pack (takeFileName fp)) (ResponseUser 1)+ dialogAddButton md (__ "Just _open " <> T.pack (takeFileName fp)) (ResponseUser 2)+ dialogSetDefaultResponse md (ResponseUser 1)+ resp <- dialogRun md+ widgetDestroy md+ return resp+ case resp of+ ResponseUser 1 -> workspaceTry $ do+ workspaceAddPackage' fp+ return ()+ _ -> return ()+ else liftIO (findCabalFile fp) >>= \case+ Nothing -> return ()+ Just cabalFile -> do+ resp <- liftIO $ do+ md <- messageDialogNew+ (Just window) []+ MessageQuestion+ ButtonsNone+ (__ "The file " <> T.pack fp+ <> __ " seems to belong to the package " <> T.pack cabalFile+ <> __ " would you like to add " <> T.pack (takeFileName cabalFile)+ <> __ " to your workspace?")+ dialogAddButton md (__ "_Add " <> T.pack (takeFileName cabalFile)) (ResponseUser 1)+ dialogAddButton md (__ "Just _open " <> T.pack (takeFileName fp)) (ResponseUser 2)+ dialogSetDefaultResponse md (ResponseUser 1)+ resp <- dialogRun md+ widgetDestroy md+ return resp+ case resp of+ ResponseUser 1 -> workspaceTry $ do+ workspaceAddPackage' cabalFile+ return ()+ _ -> return ()+ fileOpenThis fp+ where+ findCabalFile :: FilePath -> IO (Maybe FilePath)+ findCabalFile fp = (do+ let dir = takeDirectory fp+ cabal <- filter ((== ".cabal") . takeExtension) <$> getDirectoryContents dir+ case cabal of+ (c:_) -> return . Just $ dir </> c+ _ | fp == dir -> return Nothing+ | otherwise -> findCabalFile dir+ ) `catch` (\(_ :: SomeException) -> return Nothing)
win32/makeinstaller.sh view
@@ -83,7 +83,7 @@ $LN "$GTK_PREFIX_U"/bin/libglib-2.0-0.dll SourceDir/bin $LN "$GTK_PREFIX_U"/bin/libgmodule-2.0-0.dll SourceDir/bin $LN "$GTK_PREFIX_U"/bin/libgmp-10.dll SourceDir/bin-$LN "$GTK_PREFIX_U"/bin/libgnutls-28.dll SourceDir/bin+$LN "$GTK_PREFIX_U"/bin/libgnutls-*.dll SourceDir/bin $LN "$GTK_PREFIX_U"/bin/libgobject-2.0-0.dll SourceDir/bin $LN "$GTK_PREFIX_U"/bin/libgst*-1.0-0.dll SourceDir/bin $LN "$GTK_PREFIX_U"/bin/libgthread-2.0-0.dll SourceDir/bin@@ -91,11 +91,11 @@ $LN "$GTK_PREFIX_U"/bin/libgtksourceview-3.0-1.dll SourceDir/bin $LN "$GTK_PREFIX_U"/bin/libharfbuzz-0.dll SourceDir/bin $LN "$GTK_PREFIX_U"/bin/libharfbuzz-icu-0.dll SourceDir/bin-$LN "$GTK_PREFIX_U"/bin/libhogweed-2-5.dll SourceDir/bin+$LN "$GTK_PREFIX_U"/bin/libhogweed-*.dll SourceDir/bin $LN "$GTK_PREFIX_U"/bin/libintl-8.dll SourceDir/bin $LN "$GTK_PREFIX_U"/bin/libjavascriptcoregtk-3.0-0.dll SourceDir/bin $LN "$GTK_PREFIX_U"/bin/libjpeg-62.dll SourceDir/bin-$LN "$GTK_PREFIX_U"/bin/libnettle-4-7.dll SourceDir/bin+$LN "$GTK_PREFIX_U"/bin/libnettle-*.dll SourceDir/bin $LN "$GTK_PREFIX_U"/bin/libp11-kit-0.dll SourceDir/bin $LN "$GTK_PREFIX_U"/bin/libpango-1.0-0.dll SourceDir/bin $LN "$GTK_PREFIX_U"/bin/libpangocairo-1.0-0.dll SourceDir/bin