leksah 0.15.0.5 → 0.15.0.6

raw patch · 39 files changed

+2001/−1823 lines, 39 filesdep +cpphsdep ~hlintdep ~leksahdep ~leksah-serverPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: cpphs

Dependency ranges changed: hlint, leksah, leksah-server

API changes (from Hackage documentation)

Files

• Readme.md +1/−1
• data/leksah-welcome/src/Main.hs +11/−4
• data/leksah-welcome/test/Main.hs +1/−0
• data/styles/leksah-dark.xml +3/−0
• data/styles/leksah.xml +2/−2
• leksah.cabal +7/−6
• src/IDE/BufferMode.hs +24/−35
• src/IDE/Completion.hs +102/−130
• src/IDE/Core/State.hs +1/−1
• src/IDE/Core/Types.hs +38/−21
• src/IDE/Debug.hs +1/−1
• src/IDE/Find.hs +2/−0
• src/IDE/ImportTool.hs +76/−77
• src/IDE/Leksah.hs +35/−45
• src/IDE/LogRef.hs +234/−186
• src/IDE/Metainfo/Provider.hs +23/−13
• src/IDE/Package.hs +63/−69
• src/IDE/Pane/Errors.hs +4/−3
• src/IDE/Pane/Files.hs +6/−3
• src/IDE/Pane/HLint.hs +332/−349
• src/IDE/Pane/Info.hs +3/−13
• src/IDE/Pane/Log.hs +3/−4
• src/IDE/Pane/Modules.hs +216/−181
• src/IDE/Pane/PackageEditor.hs +135/−145
• src/IDE/Pane/Preferences.hs +7/−13
• src/IDE/Pane/Search.hs +4/−1
• src/IDE/Pane/SourceBuffer.hs +319/−196
• src/IDE/Pane/WebKit/Documentation.hs +19/−19
• src/IDE/Pane/WebKit/Inspect.hs +2/−2
• src/IDE/Pane/WebKit/Output.hs +31/−31
• src/IDE/Session.hs +87/−94
• src/IDE/SourceCandy.hs +45/−60
• src/IDE/SymbolNavigation.hs +31/−30
• src/IDE/TextEditor.hs +5/−8
• src/IDE/TextEditor/Class.hs +15/−4
• src/IDE/TextEditor/CodeMirror.hs +5/−3
• src/IDE/TextEditor/GtkSourceView.hs +93/−58
• src/IDE/Utils/GUIUtils.hs +13/−13
• src/IDE/Utils/ServerConnection.hs +2/−2

@@ -3,7 +3,7 @@ [![Build Status](https://secure.travis-ci.org/leksah/leksah.png?branch=vcs)](http://travis-ci.org/leksah/leksah)  [Leksah](http://leksah.org/) aims to integrate various Haskell development-tools to provide a practical and plesant development environment.+tools to provide a practical and pleasant development environment. The user interface is a mix of GTK+ and WebKit based components.  Documentation can be found on [leksah.org](http://leksah.org/).

@@ -18,8 +18,14 @@ -- Next we are importing some things from other modules. -- Leksah can normally addd these imports for you, just -- press Ctrl+R (OS X Command+R)-import Data.List (stripPrefix) +import Data.Monoid ((<>))++-- 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. -- -- The following tells doctest & QuickCheck that if you strip "Hello "@@ -35,7 +41,8 @@ -- The code that runs the tests is in the file test/Main.hs. -- -- prop> stripPrefix "Hello " (hello s) == Just s-hello s = "Hello " ++ s+hello :: String -> String+hello s = "Hello " <> s  -- | Executable Entry Point --@@ -45,6 +52,6 @@ --   * Select Leksah menu item Package -> Run (or the cogs on the toolbar) --   * Select "exeMain" and press Ctrl+Enter to run them in ghci --   * Run "leksah-wellcome" from the command line-main = do-    putStrLn (hello "World")+main :: IO ()+main = putStrLn (hello "World") 

@@ -7,4 +7,5 @@ -- To run these tests --   * Select Leksah menu item Package -> Test --   * Select the tick icon on the Leksah toolbar (to enable "cabal test" during builds)+main :: IO () main = doctest ["-isrc", "src/Main.hs"]

@@ -41,6 +41,9 @@   <!-- Global Settings -->   <style name="current-line"                background="#000000"/>   <style name="draw-spaces"                 foreground="#babdb6"/>+  <style name="text"                        background="#202020"/>+  <style name="selection"                   background="#3B73AE" foreground="#FFFFFF"/>+  <style name="selection-unfocused"         background="#3B73AE" foreground="#FFFFFF"/>    <!-- Bracket Matching -->   <style name="bracket-match"               foreground="white" background="gray" bold="true"/>

@@ -43,8 +43,8 @@   <style name="draw-spaces"                 foreground="#aaada6"/>   <style name="line-numbers"                background="#E8E8E8"/>   <style name="text"                        background="#FFFFFF"/>-  <style name="selection"                   background="#FFFFC0" foreground="#000000"/>-  <style name="selection-unfocused"         background="#FFFFD0" foreground="#000000"/>+  <style name="selection"                   background="#4A90D9" foreground="#FFFFFF"/>+  <style name="selection-unfocused"         background="#4A90D9" foreground="#FFFFFF"/>    <!-- Bracket Matching -->   <style name="bracket-match"               foreground="white" background="gray" bold="true"/>

@@ -1,5 +1,5 @@ name: leksah-version: 0.15.0.5+version: 0.15.0.6 cabal-version: >=1.18 build-type: Simple license: GPL@@ -246,13 +246,14 @@                        parsec >=2.1.0.1 && <3.2, pretty >=1.0.1.0 && <1.2,                        regex-tdfa >=1.1 && <1.3, regex-tdfa-text, regex-base ==0.93.*, utf8-string >=0.3.1.1 && <1.1, array >=0.2.0.0 && <0.6,                        time >=0.1 && <1.6, ltk >= 0.15.0.1 && <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.3 && <0.16,+                       hslogger >= 1.0.7 && <1.3, leksah-server >=0.15.0.4 && <0.16,                        ghc >=6.10.1 && <7.11, strict >= 0.3.2 && <0.4, conduit >= 1.0.8 && <1.3, text >= 0.11.1.5 && < 1.3,                        gio >=0.13.0.0 && <0.14, transformers >=0.2.2.0 && <0.5,                        executable-path >=0.0.3 && <0.1,                        vcsgui >=0.1.0 && < 0.2, vcswrapper >=0.1.0 && < 0.2,                        QuickCheck >=2.4.2 && <2.9, haskell-src-exts >=1.13.5 && <1.17,-                       hlint >=1.8.59 && <1.10, vado >=0.0.1 && <0.1, shakespeare >=2.0.0.1 && <2.1+                       hlint >=1.9.21 && <1.10, vado >=0.0.1 && <0.1, shakespeare >=2.0.0.1 && <2.1,+                       cpphs >=1.19 && <1.20     exposed-modules: IDE.Leksah IDE.Completion IDE.ImportTool IDE.Find                      IDE.Sandbox IDE.Session IDE.Command IDE.Keymap IDE.Utils.GUIUtils                      IDE.SymbolNavigation IDE.Package IDE.YiConfig IDE.OSX@@ -296,7 +297,7 @@         ghc-options: -threaded      hs-source-dirs: main-    build-depends: leksah == 0.15.0.5,+    build-depends: leksah == 0.15.0.6,                    base >= 4.0.0.0 && <=4.9,                    gtk3 >=0.13.2 && <0.14     if os(linux) && flag(loc)@@ -312,7 +313,7 @@     ghc-options: -rtsopts -fwarn-missing-fields -fwarn-incomplete-patterns -ferror-spans  executable bewleksah-    build-depends: leksah ==0.15.0.5,+    build-depends: leksah ==0.15.0.6,                    base >=4.0.0.0 && <=4.9,                    jsaddle -any,                    ghcjs-dom -any,@@ -331,7 +332,7 @@     build-depends: base >=4.0.0.0 && <4.9,                    Cabal >=1.10.2.0 && <1.23,                    QuickCheck >=2.4.2 && <2.9,-                   leksah ==0.15.0.5,+                   leksah ==0.15.0.6,                    containers,                    ltk,                    leksah-server,

@@ -1,4 +1,3 @@-{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleInstances #-}@@ -39,14 +38,12 @@         transformToCandy) import IDE.Utils.GUIUtils (getCandyState) import Control.Monad (when)-import Data.Maybe (catMaybes)+import Data.Maybe (mapMaybe, catMaybes) import IDE.Utils.FileUtils import Graphics.UI.Gtk        (Notebook, castToWidget, notebookPageNum, ScrolledWindow) import Control.Monad.IO.Class (MonadIO(..))-#if MIN_VERSION_directory(1,2,0) import Data.Time (UTCTime)-#endif import Data.Text (Text) import Data.Monoid ((<>)) import qualified Data.Text as T@@ -63,11 +60,7 @@ ,   addedIndex      ::  Int ,   sourceView      ::  EditorView editor ,   scrolledWindow  ::  ScrolledWindow-#if MIN_VERSION_directory(1,2,0)-,   modTime         ::  IORef (Maybe (UTCTime))-#else-,   modTime         ::  IORef (Maybe (ClockTime))-#endif+,   modTime         ::  IORef (Maybe UTCTime) ,   mode            ::  Mode } deriving (Typeable) @@ -104,7 +97,7 @@ recentSourceBuffers = do     recentPanes' <- readIDE recentPanes     mbBufs       <- mapM mbPaneFromName recentPanes'-    return $ map paneName ((catMaybes $ map (\ (PaneC p) -> cast p) $ catMaybes mbBufs) :: [IDEBuffer])+    return $ map paneName (mapMaybe (\ (PaneC p) -> cast p) (catMaybes mbBufs) :: [IDEBuffer])  getStartAndEndLineOfSelection :: TextEditor editor => EditorBuffer editor -> IDEM (Int,Int) getStartAndEndLineOfSelection ebuf = do@@ -139,7 +132,7 @@     mbBuf <- maybeActiveBuf     case mbBuf of         Nothing         -> return def-        Just ideBuf -> do+        Just ideBuf ->             inBufContext def ideBuf f  doForSelectedLines :: [a] -> (forall editor. TextEditor editor => EditorBuffer editor -> Int -> IDEM a) -> IDEM [a]@@ -166,10 +159,10 @@ -- | Assumes modFromFileName :: Maybe FilePath -> Mode modFromFileName Nothing = haskellMode-modFromFileName (Just fn) | isSuffixOf ".hs" fn    = haskellMode-                          | isSuffixOf ".lhs" fn   = literalHaskellMode-                          | isSuffixOf ".cabal" fn = cabalMode-                          | otherwise              = otherMode+modFromFileName (Just fn) | ".hs"    `isSuffixOf` fn = haskellMode+                          | ".lhs"   `isSuffixOf` fn = literalHaskellMode+                          | ".cabal" `isSuffixOf` fn = cabalMode+                          | otherwise                = otherMode  haskellMode = Mode {     modeName = "Haskell",@@ -183,12 +176,10 @@             sol <- getIterAtLine ebuf lineNr             sol2 <- forwardCharsC sol 2             str   <- getText ebuf sol sol2 True-            if str == "--"-                then do delete ebuf sol sol2-                else return ()+            when (str == "--") $ delete ebuf sol sol2         return (),-    modeSelectedModuleName = do-        inActiveBufContext Nothing $ \_ _ ebuf currentBuffer _ -> do+    modeSelectedModuleName =+        inActiveBufContext Nothing $ \_ _ ebuf currentBuffer _ ->             case fileName currentBuffer of                 Just filePath -> liftIO $ moduleNameFromFilePath filePath                 Nothing       -> return Nothing,@@ -197,20 +188,20 @@         transformToCandy ct ebuf inCommentOrString,     modeEditToCandy = \ inCommentOrString -> do         ct <- readIDE candy-        inActiveBufContext () $ \_ _ ebuf _ _ -> do+        inActiveBufContext () $ \_ _ ebuf _ _ ->             transformToCandy ct ebuf inCommentOrString,     modeEditFromCandy = do         ct      <-  readIDE candy-        inActiveBufContext () $ \_ _ ebuf _ _ -> do+        inActiveBufContext () $ \_ _ ebuf _ _ ->             transformFromCandy ct ebuf,     modeEditKeystrokeCandy = \c inCommentOrString -> do         ct <- readIDE candy-        inActiveBufContext () $ \_ _ ebuf _ _ -> do+        inActiveBufContext () $ \_ _ ebuf _ _ ->             keystrokeCandy ct c ebuf inCommentOrString,     modeEditInsertCode = \ str iter buf ->         insert buf iter str,     modeEditInCommentOrString = \ line -> ("--" `T.isInfixOf` line)-                                        || not (even $ T.count "\"" line)+                                        || odd (T.count "\"" line)     }  literalHaskellMode = Mode {@@ -232,8 +223,8 @@             when (str /= ">")                 (insert ebuf sol ">")         return (),-    modeSelectedModuleName = do-        inActiveBufContext Nothing $ \_ _ ebuf currentBuffer _ -> do+    modeSelectedModuleName =+        inActiveBufContext Nothing $ \_ _ ebuf currentBuffer _ ->             case fileName currentBuffer of                 Just filePath -> liftIO $ moduleNameFromFilePath filePath                 Nothing       -> return Nothing,@@ -242,20 +233,20 @@         transformToCandy ct ebuf inCommentOrString,     modeEditToCandy = \ inCommentOrString -> do         ct <- readIDE candy-        inActiveBufContext () $ \_ _ ebuf _ _ -> do+        inActiveBufContext () $ \_ _ ebuf _ _ ->             transformToCandy ct ebuf inCommentOrString,     modeEditFromCandy = do         ct      <-  readIDE candy-        inActiveBufContext () $ \_ _ ebuf _ _ -> do+        inActiveBufContext () $ \_ _ ebuf _ _ ->             transformFromCandy ct ebuf,     modeEditKeystrokeCandy = \c inCommentOrString -> do         ct <- readIDE candy-        inActiveBufContext () $ \_ _ ebuf _ _ -> do+        inActiveBufContext () $ \_ _ ebuf _ _ ->             keystrokeCandy ct c ebuf inCommentOrString,     modeEditInsertCode = \ str iter buf ->         insert buf iter (T.unlines $ map (\ s -> "> " <> s) $ T.lines str),     modeEditInCommentOrString = \ line -> not (T.isPrefixOf ">" line)-                                        || not (even $ T.count "\"" line)+                                        || odd (T.count "\"" line)     }  cabalMode = Mode {@@ -270,9 +261,7 @@             sol <- getIterAtLine ebuf lineNr             sol2 <- forwardCharsC sol 2             str   <- getText ebuf sol sol2 True-            if str == "--"-                then do delete ebuf sol sol2-                else return ()+            when (str == "--") $ delete ebuf sol sol2         return (),     modeSelectedModuleName   = return Nothing,     modeTransformToCandy     = \ _ _ -> return (),@@ -280,7 +269,7 @@     modeEditFromCandy        = return (),     modeEditKeystrokeCandy   = \ _ _ -> return (),     modeEditInsertCode       = \ str iter buf -> insert buf iter str,-    modeEditInCommentOrString = \ str -> T.isPrefixOf "--" str+    modeEditInCommentOrString = T.isPrefixOf "--"      } @@ -294,7 +283,7 @@     modeEditFromCandy        = return (),     modeEditKeystrokeCandy   = \_ _ -> return (),     modeEditInsertCode       = \str iter buf -> insert buf iter str,-    modeEditInCommentOrString = \ _ -> False+    modeEditInCommentOrString = const False     }  isHaskellMode mode = modeName mode == "Haskell" || modeName mode == "Literal Haskell"

@@ -55,7 +55,7 @@     currentState'    <- readIDE currentState     (_, completion') <- readIDE completion     case (currentState',completion') of-        (IsCompleting conn , Just (CompletionWindow window tv st)) -> do+        (IsCompleting conn , Just (CompletionWindow window tv st)) ->             cancelCompletion window tv st conn         _            -> return () @@ -110,17 +110,17 @@                          windowDefaultHeight := height,                          windowTransientFor  := head windows]             liftIO $ containerSetBorderWidth window 3-            paned      <- liftIO $ hPanedNew+            paned      <- liftIO hPanedNew             liftIO $ containerAdd window paned             nameScrolledWindow <- liftIO $ scrolledWindowNew Nothing Nothing             liftIO $ widgetSetSizeRequest nameScrolledWindow 250 40-            tree       <- liftIO $ treeViewNew+            tree       <- liftIO treeViewNew             liftIO $ containerAdd nameScrolledWindow tree             store      <- liftIO $ listStoreNew []             liftIO $ treeViewSetModel tree store              font <- liftIO $ case textviewFont prefs of-                Just str -> do+                Just str ->                     fontDescriptionFromString str                 Nothing -> do                     f <- fontDescriptionNew@@ -128,12 +128,12 @@                     return f             liftIO $ widgetModifyFont tree (Just font) -            column   <- liftIO $ treeViewColumnNew+            column   <- liftIO treeViewColumnNew             liftIO $ set column [                 treeViewColumnSizing   := TreeViewColumnFixed,                 treeViewColumnMinWidth := 800] -- OSX does not like it if there is no hscroll             liftIO $ treeViewAppendColumn tree column-            renderer <- liftIO $ cellRendererTextNew+            renderer <- liftIO cellRendererTextNew             liftIO $ treeViewColumnPackStart column renderer True             liftIO $ cellLayoutSetAttributes column renderer store (\name -> [ cellText := name ]) @@ -141,10 +141,7 @@              descriptionBuffer <- newDefaultBuffer Nothing ""             descriptionView   <- newView descriptionBuffer (textviewFont prefs)-            preferDark <- getDarkState-            setStyle preferDark descriptionBuffer $ case sourceStyle prefs of-                                            (False,_) -> Nothing-                                            (True,v) -> Just v+            updateStyle descriptionBuffer             descriptionScrolledWindow <- getScrolledWindow descriptionView              visible    <- liftIO $ newIORef False@@ -152,7 +149,7 @@              treeSelection <- liftIO $ treeViewGetSelection tree -            liftIO $ on treeSelection treeSelectionSelectionChanged $ do+            liftIO $ on treeSelection treeSelectionSelectionChanged $                 treeSelectionSelectedForeach treeSelection $ \treePath -> do                     rows <- treeSelectionGetSelectedRows treeSelection                     case rows of@@ -185,67 +182,48 @@         count       <- liftIO $ treeModelIterNChildren model Nothing         Just column <- liftIO $ treeViewGetColumn tree 0         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+            ("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+            (_, _, Just c) | isWordChar c -> return False+            ("BackSpace", _, _) -> return False+            (shift, _, _) | (shift == "Shift_L") || (shift == "Shift_R") ->                             return False-                            )-                    )-                    else return False-                )-            ("Down", _, _) -> (do-                visible <- liftIO $ get tree widgetVisible-                if visible then (do-                    maybeRow <- liftIO $ getRow tree-                    let newRow = maybe 0 (\row -> row + 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-                )-            (_, _, Just c) | isWordChar c -> (do-                return False-                )-            ("BackSpace", _, _) -> (do-                return False-                )-            (shift, _, _) | (shift == "Shift_L") || (shift == "Shift_R") -> (do-                return False-                )-            _ -> (do-                liftIDE cancel-                return False-                )+            _ -> do liftIDE cancel+                    return False      cidsRelease <- TE.onKeyRelease sourceView $ do         name     <- lift eventKeyName@@ -256,67 +234,66 @@                 return False             _ -> return False -    resizeHandler <- liftIO $ newIORef Nothing+    liftIO $ do+        resizeHandler <- newIORef Nothing -    idButtonPress <- liftIO $ window `on` buttonPressEvent $ do-        button     <- eventButton-        (x, y)     <- eventCoordinates-        time       <- eventTime+        idButtonPress <- window `on` buttonPressEvent $ do+            button     <- eventButton+            (x, y)     <- eventCoordinates+            time       <- eventTime  #ifdef MIN_VERSION_gtk3-        mbDrawWindow <- Gtk.liftIO $ widgetGetWindow window+            mbDrawWindow <- Gtk.liftIO $ widgetGetWindow window #else-        mbDrawWindow <- Gtk.liftIO $ Just <$> widgetGetDrawWindow window+            mbDrawWindow <- Gtk.liftIO $ Just <$> widgetGetDrawWindow window #endif-        case mbDrawWindow of-            Just drawWindow -> do-                status <- Gtk.liftIO $ pointerGrab-                    drawWindow-                    False-                    [PointerMotionMask, ButtonReleaseMask]-                    (Nothing:: Maybe DrawWindow)-                    Nothing-                    time-                when (status == GrabSuccess) $ Gtk.liftIO $ do-                    (width, height) <- windowGetSize window-                    writeIORef resizeHandler $ Just $ \(newX, newY) -> do-                        reflectIDE (-                            setCompletionSize ((width + (floor (newX - x))), (height + (floor (newY - y))))) ideR-            Nothing -> return ()+            case mbDrawWindow of+                Just drawWindow -> do+                    status <- Gtk.liftIO $ pointerGrab+                        drawWindow+                        False+                        [PointerMotionMask, ButtonReleaseMask]+                        (Nothing:: Maybe DrawWindow)+                        Nothing+                        time+                    when (status == GrabSuccess) $ Gtk.liftIO $ do+                        (width, height) <- windowGetSize window+                        writeIORef resizeHandler $ Just $ \(newX, newY) ->+                            reflectIDE (+                                setCompletionSize (width + floor (newX - x), height + floor (newY - y))) ideR+                Nothing -> return () -        return True+            return True -    idMotion <- liftIO $ window `on` motionNotifyEvent $ do-        mbResize <- Gtk.liftIO $ readIORef resizeHandler-        case mbResize of-            Just resize -> eventCoordinates >>= (Gtk.liftIO . resize) >> return True-            Nothing     -> return False+        idMotion <- window `on` motionNotifyEvent $ do+            mbResize <- Gtk.liftIO $ readIORef resizeHandler+            case mbResize of+                Just resize -> eventCoordinates >>= (Gtk.liftIO . resize) >> return True+                Nothing     -> return False -    idButtonRelease <- liftIO $ window `on` buttonReleaseEvent $ do-        mbResize <- Gtk.liftIO $ readIORef resizeHandler-        case mbResize of-            Just resize -> do-                eventCoordinates >>= (Gtk.liftIO . resize)-                eventTime >>= (Gtk.liftIO . pointerUngrab)-                Gtk.liftIO $ writeIORef resizeHandler Nothing-                return True-            Nothing     -> return False+        idButtonRelease <- window `on` buttonReleaseEvent $ do+            mbResize <- Gtk.liftIO $ readIORef resizeHandler+            case mbResize of+                Just resize -> do+                    eventCoordinates >>= (Gtk.liftIO . resize)+                    eventTime >>= (Gtk.liftIO . pointerUngrab)+                    Gtk.liftIO $ writeIORef resizeHandler Nothing+                    return True+                Nothing     -> return False -    idSelected <- liftIO $ on tree rowActivated $ \treePath column -> do-        reflectIDE (withWord store treePath (replaceWordStart sourceView isWordChar)) ideR-        liftIO $ postGUIAsync $ reflectIDE cancel ideR+        idSelected <- on tree rowActivated $ \treePath column -> do+            reflectIDE (withWord store treePath (replaceWordStart sourceView isWordChar)) ideR+            liftIO $ postGUIAsync $ reflectIDE cancel ideR -    return $ concat [cidsPress, cidsRelease, [ConnectC idButtonPress, ConnectC idMotion, ConnectC idButtonRelease, ConnectC idSelected]]+        return $ concat [cidsPress, cidsRelease, [ConnectC idButtonPress, ConnectC idMotion, ConnectC idButtonRelease, ConnectC idSelected]]  withWord :: ListStore Text -> TreePath -> (Text -> IDEM ()) -> IDEM ()-withWord store treePath f = (do+withWord store treePath f =    case treePath of-       [row] -> (do+       [row] -> do             value <- liftIO $ listStoreGetValue store row             f value-            )        _ -> return ()-   )  replaceWordStart :: TextEditor editor => EditorView editor -> (Char -> Bool) -> Text -> IDEM () replaceWordStart sourceView isWordChar name = do@@ -347,7 +324,7 @@ updateOptions :: forall editor. TextEditor editor => Window -> TreeView -> ListStore Text -> EditorView editor -> Connections -> (Char -> Bool) -> Bool -> IDEAction updateOptions window tree store sourceView connections isWordChar always = do     result <- tryToUpdateOptions window tree store sourceView False isWordChar always-    when (not result) $ cancelCompletion window tree store connections+    unless result $ cancelCompletion window tree store connections  tryToUpdateOptions :: TextEditor editor => Window -> TreeView -> ListStore Text -> EditorView editor -> Bool -> (Char -> Bool) -> Bool -> IDEM Bool tryToUpdateOptions window tree store sourceView selectLCP isWordChar always = do@@ -388,7 +365,7 @@  processResults :: TextEditor editor => Window -> TreeView -> ListStore Text -> EditorView editor -> Text -> [Text]                -> Bool -> (Char -> Bool) -> Bool -> IDEAction-processResults window tree store sourceView wordStart options selectLCP isWordChar always = do+processResults window tree store sourceView wordStart options selectLCP isWordChar always =     case options of         [] -> cancel         _ | not always && (not . null $ drop 200 options) -> cancel@@ -397,12 +374,9 @@             (selStart, end) <- getSelectionBounds buffer             start <- findWordStart selStart isWordChar             currentWordStart <- getText buffer start end True-            newWordStart <- do-                if selectLCP && currentWordStart == wordStart && (not $ null options)-                    then do-                        return $ foldl1 longestCommonPrefix options-                    else-                        return currentWordStart+            let newWordStart = if selectLCP && currentWordStart == wordStart && not (null options)+                                    then foldl1 longestCommonPrefix options+                                    else currentWordStart              when (T.isPrefixOf wordStart newWordStart) $ do                 liftIO $ listStoreClear store@@ -450,7 +424,7 @@                             panedAdd1 (castToPaned paned) second                             panedAdd2 (castToPaned paned) first                             panedSetPosition (castToPaned paned) (wWindow-pos)-                        when (not $ null newOptions) $ liftIO $ treeViewSetCursor tree [0] Nothing+                        unless (null newOptions) $ liftIO $ treeViewSetCursor tree [0] Nothing                         liftIO $ widgetShowAll window              when (newWordStart /= currentWordStart) $@@ -461,8 +435,6 @@     selection <- treeViewGetSelection tree     maybeIter <- treeSelectionGetSelected selection     case maybeIter of-        Just iter -> (do-            [row] <- treeModelGetPath model iter-            return $ Just row-            )-        Nothing -> return Nothing+        Just iter -> do [row] <- treeModelGetPath model iter+                        return $ Just row+        Nothing   -> return Nothing

@@ -255,7 +255,7 @@ window = head . windows  errorRefs :: IDE -> [LogRef]-errorRefs = filter ((\ t -> t == ErrorRef || t == WarningRef) . logRefType) .+errorRefs = filter ((\ t -> t == ErrorRef || t == WarningRef || t == LintRef || t == TestFailureRef) . logRefType) .                allLogRefs  breakpointRefs :: IDE -> [LogRef]

@@ -57,9 +57,12 @@  ,   Prefs(..) ,   cabalCommand+,   EditorStyle(..)+,   editorStyle  ,   LogRefType(..) ,   LogRef(..)+,   logRefRootPath ,   logRefFilePath ,   logRefFullFilePath ,   isError@@ -121,9 +124,7 @@ import Control.Monad.Trans.Class (lift) import Control.Monad.IO.Class (liftIO, MonadIO) import Control.Monad.Trans.Reader (ReaderT(..))-#if MIN_VERSION_directory(1,2,0) import Data.Time (UTCTime(..))-#endif  import qualified VCSWrapper.Common as VCS import qualified VCSGui.Common as VCSGUI@@ -133,6 +134,8 @@ import Control.Monad.Reader.Class (MonadReader(..)) import Data.Text (Text) import qualified Data.Text as T (unpack)+import Language.Haskell.HLint3 (Idea(..))+import Data.Function (on)  -- --------------------------------------------------------------------- -- IDE State@@ -155,9 +158,9 @@ ,   allLogRefs      ::   [LogRef] ,   currentEBC      ::   (Maybe LogRef, Maybe LogRef, Maybe LogRef) ,   currentHist     ::   Int-,   systemInfo      ::   (Maybe GenScope)              -- ^ the system scope-,   packageInfo     ::   (Maybe (GenScope, GenScope)) -- ^ the second are the imports-,   workspaceInfo   ::   (Maybe (GenScope, GenScope)) -- ^ the second are the imports+,   systemInfo      ::   Maybe GenScope              -- ^ the system scope+,   packageInfo     ::   Maybe (GenScope, GenScope) -- ^ the second are the imports+,   workspaceInfo   ::   Maybe (GenScope, GenScope) -- ^ the second are the imports ,   workspInfoCache ::   PackageDescrCache ,   handlers        ::   Map Text [(Unique, IDEEvent -> IDEM IDEEvent)] -- ^ event handling table ,   currentState    ::   IDEState@@ -170,7 +173,7 @@ ,   debugState      ::   Maybe (IDEPackage, ToolState) ,   completion      ::   ((Int, Int), Maybe CompletionWindow) ,   yiControl       ::   Yi.Control-,   serverQueue     ::   Maybe (MVar (ServerCommand, (ServerAnswer -> IDEM ())))+,   serverQueue     ::   Maybe (MVar (ServerCommand, ServerAnswer -> IDEM ())) ,   server          ::   Maybe Handle ,   vcsData         ::   (Map FilePath MenuItem, Maybe (Maybe Text)) -- menus for packages, password ,   logLaunches     ::   Map.Map Text LogLaunchData@@ -217,7 +220,7 @@ instance MonadIDE WorkspaceM where     liftIDE = lift -(?>>=) :: Monad m => (m (Maybe a)) -> (a -> m ()) -> m ()+(?>>=) :: Monad m => m (Maybe a) -> (a -> m ()) -> m () a ?>>= b = do     mA <- a     case mA of@@ -348,8 +351,8 @@     setHandlers ideRef nh = do         ide <- liftIO $ readIORef ideRef         liftIO $ writeIORef ideRef (ide {handlers= nh})-    myUnique _ = do-        liftIO $ newUnique+    myUnique _ =+        liftIO newUnique  instance EventSelector Text @@ -412,7 +415,7 @@  -- | Includes sandbox sources wsAllPackages :: Workspace -> [IDEPackage]-wsAllPackages w = nubBy (\ a b -> ipdCabalFile a == ipdCabalFile b) $ wsPackages w ++ (wsPackages w >>= ipdSandboxSources)+wsAllPackages w = nubBy ((==) `on` ipdCabalFile) $ wsPackages w ++ (wsPackages w >>= ipdSandboxSources)  -- --------------------------------------------------------------------- -- Other data structures which are used in the state@@ -495,6 +498,21 @@ cabalCommand :: Prefs -> FilePath cabalCommand p = if useCabalDev p then "cabal-dev" else "cabal" +data EditorStyle = EditorStyle { styleName    :: Maybe Text+                               , preferDark   :: Bool+                               , breakpointBG :: Color+                               , contextBG    :: Color+                               }++editorStyle :: Bool -> Prefs -> EditorStyle+editorStyle preferDark prefs = EditorStyle { styleName = case sourceStyle prefs of+                                                        (False,_) -> Nothing+                                                        (True,v)  -> Just v+                                           , preferDark = preferDark+                                           , breakpointBG = breakpointBackground prefs+                                           , contextBG = contextBackground prefs+                                           }+ data SearchHint = Forward | Backward | Insert | Delete | Initial     deriving (Eq) @@ -519,18 +537,21 @@     logBuffer   :: TextBuffer } deriving Typeable -data LogRefType = WarningRef | ErrorRef | BreakpointRef | ContextRef deriving (Eq, Show)+-- Order determines priority of the icons in the gutter+data LogRefType = ContextRef | BreakpointRef | ErrorRef | TestFailureRef | WarningRef | LintRef+    deriving (Eq, Show, Enum, Bounded)  data LogRef = LogRef {     logRefSrcSpan       ::   SrcSpan ,   logRefPackage       ::   IDEPackage ,   refDescription      ::   Text+,   logRefIdea          ::   Maybe (Text, Idea) ,   logLines            ::   (Int,Int) ,   logRefType          ::   LogRefType }   deriving (Eq)  instance Show LogRef where-    show lr =  (T.unpack $ refDescription lr) ++ displaySrcSpan (logRefSrcSpan lr)+    show lr = T.unpack (refDescription lr) ++ displaySrcSpan (logRefSrcSpan lr)  displaySrcSpan s = srcSpanFilename s ++ ":" ++     if srcSpanStartLine s == srcSpanEndLine s@@ -561,9 +582,9 @@ isContext = (== ContextRef) . logRefType  -- This should probably be in Gtk2Hs allong with a suitable parser-colorHexString (Color r g b) = '#' : (pad $ showHex r "")-                                  ++ (pad $ showHex g "")-                                  ++ (pad $ showHex b "")+colorHexString (Color r g b) = '#' : pad (showHex r "")+                                  ++ pad (showHex g "")+                                  ++ pad (showHex b "")     where pad s = replicate (4 - length s) '0' ++ s  @@ -578,7 +599,7 @@  type SpecialKeyTable alpha  =   Map (KeyVal,[Modifier]) (Map (KeyVal,[Modifier]) (ActionDescr alpha)) -type SpecialKeyCons  alpha  =   Maybe ((Map (KeyVal,[Modifier]) (ActionDescr alpha)),Text)+type SpecialKeyCons  alpha  =   Maybe (Map (KeyVal, [Modifier]) (ActionDescr alpha), Text)  data LogTag = LogTag | ErrorTag | FrameTag | InputTag | InfoTag @@ -595,7 +616,7 @@     |   InfoElementSelected {             mbInfo  :: Maybe Descr}     |   PaneSelected {-            paneN   :: Maybe (Text)}+            paneN   :: Maybe Text}    deriving (Eq, Ord, Show)  data SensitivityMask =@@ -629,8 +650,4 @@     |   CompartmentCollect Bool  type PackageDescrCache = Map PackageIdentifier ModuleDescrCache-#if MIN_VERSION_directory(1,2,0) type ModuleDescrCache = Map ModuleName (UTCTime, Maybe FilePath, ModuleDescr)-#else-type ModuleDescrCache = Map ModuleName (ClockTime, Maybe FilePath, ModuleDescr)-#endif

@@ -332,7 +332,7 @@  debugShowModules :: IDEAction debugShowModules = packageTry $ tryDebug $ debugCommand ":show modules" $-    logOutputLines_Default $ \log logLaunch output -> liftIO $ do+    logOutputLinesDefault_ $ \log logLaunch output -> liftIO $ do         case output of             ToolInput  line -> appendLog log logLaunch (line <> "\n") InputTag             ToolOutput line | ", interpreted )" `T.isSuffixOf` line

@@ -624,8 +624,10 @@                         mbText <- liftIO $ replacementText regex text matchIndex matches $ T.unpack replace                         case mbText of                             Just text -> do+                                beginUserAction ebuf                                 delete ebuf iterStart iterEnd                                 insert ebuf iterStart (T.pack text)+                                endUserAction ebuf                             Nothing -> do                                 sysMessage Normal                                     "Should never happen. findMatch worked but repleacementText failed"

@@ -23,7 +23,8 @@ ) where  import IDE.Core.State-import Data.Maybe (isNothing,isJust)+import Data.Maybe+       (mapMaybe, fromMaybe, catMaybes, fromJust, isNothing, isJust) import IDE.Metainfo.Provider        (getWorkspaceInfo, getPackageImportInfo, getIdentifierDescr) import Text.PrettyPrint (render)@@ -37,11 +38,10 @@ import Graphics.UI.Editor.Parameters        ((<<<-), paraMinSize, emptyParams, Parameter(..), paraMultiSel,         paraName)-import Data.Maybe (catMaybes, fromJust) import Text.ParserCombinators.Parsec hiding (parse) import qualified Text.ParserCombinators.Parsec as Parsec (parse) import Graphics.UI.Editor.Simple (staticListEditor)-import Control.Monad (forM, when)+import Control.Monad (void, MonadPlus(..), unless, forM, when) import Control.Applicative ((<$>)) import Data.List (stripPrefix, sort, nub, nubBy) import IDE.Utils.ServerConnection@@ -92,13 +92,15 @@     addPackageResults <- forM errors addPackage     let notInScopes = [ y | (x,y) <-             nubBy (\ (p1,_) (p2,_) -> p1 == p2)-                $ [(x,y) |  (x,y) <- [((parseNotInScope . refDescription) e, e) | e <- 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 <- errors]],+                  [(x,y) |  (x,y) <- [((parsePerhapsYouIntendedToUse . refDescription) e, e) | e <- errors]],                                 length x == 1]-    when (not (or addPackageResults) && null notInScopes && null extensions) $ ideMessage Normal $ "No errors that can be auto resolved"+    when (not (or addPackageResults) && null notInScopes && null extensions) $ do+        hlintResolved <- resolveActiveHLint+        unless hlintResolved $ ideMessage Normal "No errors, warnings or selected hlints that can be auto resolved"     addAll buildInBackground notInScopes extensions   where     addAll buildInBackground notInScopes extensions = addAllImports notInScopes (True,[])@@ -122,7 +124,7 @@     currentErr' <- readIDE currentError     case currentErr' of         Nothing -> do-            ideMessage Normal $ "No error selected"+            ideMessage Normal "No error selected"             return ()         Just ref -> addImport ref [] (\ _ -> return ()) @@ -146,7 +148,7 @@                         wslist = getIdentifierDescr (id' nis) symbolTable3 symbolTable4                     in case (list, wslist) of                         ([], []) ->  do-                            ideMessage Normal $ "Identifier " <> (id' nis) <> " not found"+                            ideMessage Normal $ "Identifier " <> id' nis <> " not found"                             continuation (True, descrList)                         ([], list) -> do                             window' <- getMainWindow@@ -156,11 +158,11 @@                                                 else Just (head descrList))                             case mbDescr of                                 Nothing     ->  continuation (False, [])-                                Just descr  ->  if elem descr descrList+                                Just descr  ->  if descr `elem` descrList                                                     then continuation (True,descrList)                                                     else addImport' nis (logRefFullFilePath error)                                                             descr descrList continuation-                        (descr : [], _)  ->  addImport' nis (logRefFullFilePath error) descr descrList continuation+                        ([descr], _)  ->  addImport' nis (logRefFullFilePath error) descr descrList continuation                         _ ->  do                             let fullList = list ++ wslist                             window' <- getMainWindow@@ -170,20 +172,20 @@                                                 else Just (head descrList))                             case mbDescr of                                 Nothing     ->  continuation (False, [])-                                Just descr  ->  if elem descr descrList+                                Just descr  ->  if descr `elem` descrList                                                     then continuation (True,descrList)                                                     else addImport' nis (logRefFullFilePath error)                                                             descr descrList continuation  addPackage :: LogRef -> IDEM Bool-addPackage error = do+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)+            gpd <- liftIO $ readPackageDescription normal (ipdCabalFile idePackage)             ideMessage Normal $ "addPackage " <> (T.pack . display $ pkgName pack)-            liftIO $ writeGenericPackageDescription (ipdCabalFile $ idePackage)+            liftIO $ writeGenericPackageDescription (ipdCabalFile idePackage)                 gpd { condLibrary     = addDepToLib pack (condLibrary gpd),                       condExecutables = map (addDepToExe pack)                                             (condExecutables gpd),@@ -215,7 +217,7 @@                 condTreeConstraints = deps <> [dep p],                 condTreeData        = bm { benchmarkBuildInfo = bi {targetBuildDepends = targetBuildDepends bi <> [dep p]}}})     -- Empty version is probably only going to happen for ghc-prim-    dep p | null . versionBranch $ packageVersion p = Dependency (packageName p) (anyVersion)+    dep p | null . versionBranch $ packageVersion p = Dependency (packageName p) anyVersion     dep p = Dependency (packageName p) (         intersectVersionRanges (orLaterVersion (packageVersion p))                                (earlierVersion (majorAndMinor (packageVersion p))))@@ -243,7 +245,7 @@                     Nothing -> Nothing                     Just pm -> Just (modu pm)     case (mbBuf,mbMod) of-        (Just buf,Just mod) -> do+        (Just buf,Just mod) ->             inActiveBufContext () $ \ nb _ gtkbuf idebuf n -> do                 ideMessage Normal $ "addImport " <> T.pack (show $ dscName descr) <> " from "                     <> T.pack (render $ disp mod)@@ -252,13 +254,13 @@                          ServerHeader (Left imports) ->                             case filter (qualifyAsImportStatement mod) imports of                                 []     ->   let newLine  =  prettyPrint (newImpDecl mod) <> "\n"-                                                lastLine = foldr max 0 (map (locationELine . importLoc) imports)+                                                lastLine = foldr (max . locationELine . importLoc) 0 imports                                             in do                                                 i1 <- getIterAtLine gtkbuf lastLine                                                 editInsertCode gtkbuf i1 newLine                                                 fileSave False                                                 setModified gtkbuf True-                                                continuation (True,(descr : descrList))+                                                continuation (True, descr : descrList)                                 l@(impDecl:_) ->                                                 let newDecl     =  addToDecl impDecl                                                     newLine     =  prettyPrint newDecl <> "\n"@@ -267,12 +269,12 @@                                                     lineEnd     =  locationELine myLoc                                                 in do                                                     i1 <- getIterAtLine gtkbuf (lineStart - 1)-                                                    i2 <- getIterAtLine gtkbuf (lineEnd)+                                                    i2 <- getIterAtLine gtkbuf lineEnd                                                     delete gtkbuf i1 i2                                                     editInsertCode gtkbuf i1 newLine                                                     fileSave False                                                     setModified gtkbuf True-                                                    continuation (True,(descr : descrList))+                                                    continuation (True, descr : descrList)                          ServerHeader (Right lastLine) ->                                             let newLine  =  prettyPrint (newImpDecl mod) <> "\n"                                             in do@@ -280,13 +282,13 @@                                                 editInsertCode gtkbuf i1 newLine                                                 fileSave False                                                 setModified gtkbuf True-                                                continuation (True,(descr : descrList))+                                                continuation (True, descr : descrList)                          ServerFailed string -> do                             ideMessage Normal ("Can't parse module header " <> T.pack filePath <>                                     " failed with: " <> string)                             continuation (False,[])                          _ ->    do-                            ideMessage Normal ("ImportTool>>addImport: Impossible server answer")+                            ideMessage Normal "ImportTool>>addImport: Impossible server answer"                             continuation (False,[])         _  -> return ()     where@@ -306,10 +308,8 @@                         importQualified = isJust (mbQual' nis),                         importSrc       = False,                         importPkg       = Nothing,-                        importAs        = if isJust (mbQual' nis)-                                            then Just (fromJust (mbQual' nis))-                                            else Nothing,-                        importSpecs = (Just (ImportSpecList False [newImportSpec]))}+                        importAs        = mplus (mbQual' nis) Nothing,+                        importSpecs = Just (ImportSpecList False [newImportSpec])}         newImportSpec :: ImportSpec         newImportSpec =  getRealId descr (id' nis)         addToDecl :: ImportDecl -> ImportDecl@@ -331,9 +331,7 @@         getReal _ = IVar id  qualString ::  ImportDecl -> Text-qualString impDecl = case importAs impDecl of-                        Nothing -> ""-                        Just modName -> modName+qualString impDecl = fromMaybe "" (importAs impDecl)  -- | The import data @@ -354,47 +352,49 @@ dot        = P.dot lexer operator   = T.pack <$> P.operator lexer -parseNotInScope :: Text -> (Maybe NotInScopeParseResult)+parseNotInScope :: Text -> Maybe NotInScopeParseResult parseNotInScope str =     case Parsec.parse scopeParser "" $ T.unpack str of         Left e   -> Nothing         Right r  -> Just r  scopeParser :: CharParser () NotInScopeParseResult-scopeParser = do-    whiteSpace-    symbol "Not in scope:"-    isSub   <- optionMaybe (try (choice [symbol "type constructor or class"-                    , symbol "data constructor"]))-    (   (do-            char '`'-            mbQual <- optionMaybe (try (do-                q  <- lexeme conid-                dot-                return q))-            id     <- optionMaybe (try identifier)-            case id of-                Just id -> return (NotInScopeParseResult mbQual-                                (T.take (T.length id - 1) id)  (isJust isSub) False)-                Nothing -> do-                    op <-   operator-                    char '\''-                    return (NotInScopeParseResult mbQual op (isJust isSub) True))-       <|> (do-            choice [char '‛', char '‘']-            mbQual <- optionMaybe (try (do-                q  <- lexeme conid-                dot-                return q))-            id     <- optionMaybe (try identifier)-            result <- case id of-                Just id -> return (NotInScopeParseResult mbQual-                                id  (isJust isSub) False)-                Nothing -> do-                    op <-   operator-                    return (NotInScopeParseResult mbQual op (isJust isSub) True)-            char '’'-            return result))+scopeParser = do whiteSpace+                 symbol "Not in scope:"+                 isSub <- optionMaybe+                            (try+                               (choice+                                  [symbol "type constructor or class", symbol "data constructor"]))+                 (do char '`'+                     mbQual <- optionMaybe+                                 (try+                                    (do q <- lexeme conid+                                        dot+                                        return q))+                     id <- optionMaybe (try identifier)+                     case id of+                         Just id -> return+                                      (NotInScopeParseResult mbQual (T.take (T.length id - 1) id)+                                         (isJust isSub)+                                         False)+                         Nothing -> do op <- operator+                                       char '\''+                                       return (NotInScopeParseResult mbQual op (isJust isSub) True))+                   <|>+                   (do choice [char '\8219', char '\8216']+                       mbQual <- optionMaybe+                                   (try+                                      (do q <- lexeme conid+                                          dot+                                          return q))+                       id <- optionMaybe (try identifier)+                       result <- case id of+                                     Just id -> return+                                                  (NotInScopeParseResult mbQual id (isJust isSub) False)+                                     Nothing -> do op <- operator+                                                   return (NotInScopeParseResult mbQual op (isJust isSub) True)+                       char '\8217'+                       return result)     <?> "scopeParser"  conid  = do@@ -413,9 +413,9 @@                 $ paraMultiSel <<<- ParaMultiSel False                     $ paraMinSize <<<- ParaMinSize (300,400)                         $ emptyParams)-            (\ a -> a)-            (\ a b -> a)-            (staticListEditor ( list) id)+            id+            const+            (staticListEditor list id)  selectModuleDialog :: Window -> [Descr] -> Text -> Maybe Text -> Maybe Descr -> IO (Maybe Descr) selectModuleDialog parentWindow list id mbQual mbDescr =@@ -430,7 +430,7 @@                                                             Just pm -> Just ((T.pack . render . disp . modu) pm)             let realSelectionString =  case mbSelectedString of                                             Nothing -> head selectionList-                                            Just str -> if elem str selectionList+                                            Just str -> if str `elem` selectionList                                                             then str                                                             else head selectionList             let qualId             =  case mbQual of@@ -453,7 +453,7 @@             set okButton [widgetCanDefault := True]             widgetGrabDefault okButton             resp <- dialogRun dia-            value                      <- ext (T.empty)+            value                      <- ext T.empty             widgetHide dia             widgetDestroy dia             --find@@ -469,7 +469,7 @@     ,   missingPackage    :: PackageId}     deriving (Eq, Show) -parseHiddenModule :: Text -> (Maybe HiddenModuleResult)+parseHiddenModule :: Text -> Maybe HiddenModuleResult parseHiddenModule str =     case Parsec.parse hiddenModuleParser "" $ T.unpack str of         Left e             -> Nothing@@ -482,16 +482,16 @@ hiddenModuleParser = do     whiteSpace     symbol "Could not find module "-    (char '`' <|> char '‛' <|> char '‘')+    char '`' <|> char '‛' <|> char '‘'     mod    <- T.pack <$> many (noneOf "'’")     many (noneOf "\n")     symbol "\n"     whiteSpace     symbol "It is a member of the hidden package "-    (char '`' <|> char '‛' <|> char '‘')+    char '`' <|> char '‛' <|> char '‘'     pack   <- T.pack <$> many (noneOf "'’@")     many (noneOf "'’")-    (char '\'' <|> char '’')+    char '\'' <|> char '’'     symbol ".\n"     many anyChar     return (mod, pack)@@ -510,7 +510,7 @@     concatMap (parseLine . T.dropWhile (==' ')) . T.lines   where     parseLine :: Text -> [KnownExtension]-    parseLine line = take 1 . catMaybes . map readMaybe $ catMaybes [+    parseLine line = take 1 . mapMaybe readMaybe $ catMaybes [         T.stripPrefix "Perhaps you intended to use -X" line       , T.stripPrefix "Perhaps you intended to use " line       , T.takeWhile (/=' ') <$> T.stripPrefix "Use -X" line@@ -547,12 +547,11 @@         addFixMenuItem (__"Add Import")  $ addImport logRef [] (\ _ -> return ())     when (isJust $ parseHiddenModule msg) $         addFixMenuItem (__"Add Package") $ addPackage logRef-    when ((length $ parsePerhapsYouIntendedToUse msg) == 1) $+    when (length (parsePerhapsYouIntendedToUse msg) == 1) $         addFixMenuItem (__"Add Extension") $ addExtension logRef (\ _ -> return ())   where     addFixMenuItem name fix = do         item <- menuItemNewWithLabel name-        item `on` menuItemActivate $ do-            reflectIDE (fix >> return ()) ideR+        item `on` menuItemActivate $ reflectIDE (void fix) ideR         menuShellAppend theMenu item 

@@ -1,4 +1,4 @@-{-# LANGUAGE CPP, ScopedTypeVariables, OverloadedStrings #-}+{-# LANGUAGE CPP, ScopedTypeVariables, OverloadedStrings, LambdaCase #-} ----------------------------------------------------------------------------- -- -- Module      :  IDE.Leksah@@ -75,7 +75,7 @@ import qualified Data.Conduit as C import qualified Data.Conduit.List as CL import Data.Conduit (($$))-import Control.Monad (when, unless, liftM)+import Control.Monad (void, when, unless, liftM) import Control.Monad.IO.Class (MonadIO(..)) import Control.Applicative ((<$>)) import qualified Data.Text as T (pack, unpack, stripPrefix, unlines)@@ -94,19 +94,19 @@        deriving (Show,Eq)  options :: [OptDescr Flag]-options =   [Option ['e'] ["emptySession"] (NoArg EmptySession)+options =   [Option "e" ["emptySession"] (NoArg EmptySession)                 "Start with empty session"-         ,   Option ['d'] ["defaultSession"] (NoArg DefaultSession)+         ,   Option "d" ["defaultSession"] (NoArg DefaultSession)                 "Start with default session (can be used together with a source file)"-         ,   Option ['l'] ["loadSession"] (ReqArg (SessionN . T.pack) "NAME")+         ,   Option "l" ["loadSession"] (ReqArg (SessionN . T.pack) "NAME")                 "Load session" -         ,   Option ['h'] ["help"] (NoArg Help)+         ,   Option "h" ["help"] (NoArg Help)                 "Display command line options"-         ,   Option ['v'] ["version"] (NoArg VersionF)+         ,   Option "v" ["version"] (NoArg VersionF)                 "Show the version number of ide" -         ,   Option ['e'] ["verbosity"] (ReqArg (Verbosity . T.pack) "Verbosity")+         ,   Option "e" ["verbosity"] (ReqArg (Verbosity . T.pack) "Verbosity")              "One of DEBUG, INFO, NOTICE, WARNING, ERROR, CRITICAL, ALERT, EMERGENCY"]  @@ -142,14 +142,14 @@ leksah = realMain #endif -realMain yiConfig = do+realMain yiConfig =   withSocketsDo $ handleExceptions $ do     dataDir         <- getDataDir     args            <-  getArgs      (o,files)       <-  ideOpts $ map T.pack args     isFirstStart    <-  liftM not $ hasSavedConfigFile standardPreferencesFilename-    let sessions      =   catMaybes $ map (\x -> case x of+    let sessions      =   mapMaybe (\case                                         SessionN s -> Just s                                         _          -> Nothing) o @@ -175,32 +175,31 @@                                         then standardSessionFilename                                         else emptySessionFilename -    sessionFP    <-  if  elem EmptySession o+    sessionFP    <-  if  EmptySession `elem` o                                 then getConfigFilePathForLoad                                                         emptySessionFilename Nothing dataDir-                                else if elem DefaultSession o+                                else if DefaultSession `elem` o                                         then getConfigFilePathForLoad                                                         standardSessionFilename Nothing dataDir                                         else case mbWSessionFP of                                                 Just fp -> return fp                                                 Nothing -> getConfigFilePathForLoad                                                                     ssession Nothing dataDir-    let verbosity'      =  catMaybes $-                                map (\x -> case x of-                                    Verbosity s -> Just s-                                    _           -> Nothing) o+    let verbosity'      =  mapMaybe (\case+                                        Verbosity s -> Just s+                                        _           -> Nothing) o     let verbosity       =  case verbosity' of                                [] -> INFO                                h:_ -> read $ T.unpack h-    updateGlobalLogger rootLoggerName (\ l -> setLevel verbosity l)-    when (elem VersionF o)+    updateGlobalLogger rootLoggerName (setLevel verbosity)+    when (VersionF `elem` o)         (sysMessage Normal $ "Leksah the Haskell IDE, version " <> T.pack (showVersion version))-    when (elem Help o)+    when (Help `elem` o)         (sysMessage Normal $ "Leksah the Haskell IDE " <> T.pack (usageInfo header options))      prefsPath       <- getConfigFilePathForLoad standardPreferencesFilename Nothing dataDir     prefs           <- readPrefs prefsPath-    when (not (elem VersionF o) && not (elem Help o))+    when (notElem VersionF o && notElem Help o)         (startGUI yiConfig sessionFP mbWorkspaceFP sourceFPs  prefs isFirstStart)  handleExceptions inner =@@ -213,7 +212,7 @@ -- | Start the GUI  startGUI :: Yi.Config -> FilePath -> Maybe FilePath -> [FilePath] -> Prefs -> Bool -> IO ()-startGUI yiConfig sessionFP mbWorkspaceFP sourceFPs iprefs isFirstStart = do+startGUI yiConfig sessionFP mbWorkspaceFP sourceFPs iprefs isFirstStart =   Yi.start yiConfig $ \yiControl -> do     st          <-  unsafeInitGUIForThreadedRTS     when rtsSupportsBoundThreads@@ -251,7 +250,7 @@                                             prefs <- readPrefs prefsPath                                             return $ Just prefs     timeoutRemove timeout-    postGUIAsync $ do+    postGUIAsync $         case mbStartupPrefs of             Nothing           -> return ()             Just startupPrefs -> startMainWindow yiControl sessionFP mbWorkspaceFP sourceFPs@@ -268,9 +267,7 @@     where         loop = do             quit <- loopTillIdle-            if quit-                then return ()-                else do+            unless quit $ do                     active <- newEmptyMVar                     mvarSentIdleMessage <- newEmptyMVar                     idleThread <- forkIO $ do@@ -281,17 +278,13 @@                             postGUIAsync onIdle                     quit <- mainIteration                     putMVar active ()-                    if quit-                        then return ()-                        else do+                    unless quit $ do                             -- If an idle message was sent then wait again                             sentIdleMessage <- isJust <$> tryTakeMVar mvarSentIdleMessage                             quit <- if sentIdleMessage                                 then mainIteration                                 else return False-                            if quit-                                then return ()-                                else loop+                            unless quit loop         loopTillIdle = do             pending <- eventsPending             if pending == 0@@ -316,14 +309,11 @@                         return quit                     else                         loopn (n+2)-        if quit-            then return ()-            else do+        unless quit $ do                 yield                 pending <- eventsPending                 if pending > 0-                    then do-                        loop False 50 pending+                    then loop False 50 pending                     else do                         threadDelay delay                         eventsPending >>= loop isIdle (if n > 0@@ -365,7 +355,7 @@             ,   panes         =   Map.empty             ,   activePane    =   Nothing             ,   paneMap       =   Map.empty-            ,   layout        =   (TerminalP Map.empty Nothing (-1) Nothing Nothing)+            ,   layout        =   TerminalP Map.empty Nothing (-1) Nothing Nothing             ,   panePathFromNB =  Map.empty             } @@ -424,7 +414,7 @@         registerLeksahEvents         pair <- recoverSession sessionFP         workspaceOpenThis False  mbWorkspaceFP-        mapM fileOpenThis sourceFPs+        mapM_ fileOpenThis sourceFPs         wins <- getWindows         mapM_ instrumentSecWindow (tail wins)         return pair@@ -455,9 +445,9 @@         createDirectoryIfMissing True $ welcomePath</>"src"         createDirectoryIfMissing True $ welcomePath</>"test"         copyFile (welcomeSource</>"Setup.lhs")            (welcomePath</>"Setup.lhs")-        copyFile (welcomeSource</>"leksah-welcome.cabal") (welcomeCabal)+        copyFile (welcomeSource</>"leksah-welcome.cabal") welcomeCabal         copyFile (welcomeSource</>"LICENSE")              (welcomePath</>"LICENSE")-        copyFile (welcomeSource</>"src"</>"Main.hs")      (welcomeMain)+        copyFile (welcomeSource</>"src"</>"Main.hs")      welcomeMain         copyFile (welcomeSource</>"test"</>"Main.hs")     (welcomePath</>"test"</>"Main.hs")         defaultWorkspace <- liftIO $ (</> "leksah.lkshw") <$> getHomeDirectory         defaultExists <- liftIO $ doesFileExist defaultWorkspace@@ -465,14 +455,14 @@             if defaultExists                 then workspaceOpenThis False (Just defaultWorkspace)                 else workspaceNewHere defaultWorkspace-            workspaceTryQuiet $ workspaceAddPackage' welcomeCabal >> return ()+            workspaceTryQuiet $ void (workspaceAddPackage' welcomeCabal)             fileOpenThis welcomeMain) ideR     reflectIDE (initInfo (modifyIDE_ (\ide -> ide{currentState = IsRunning}))) ideR     timeoutRemove timeout     postGUIAsync . mainLoop $         reflectIDE (do             currentPrefs <- readIDE prefs-            when (backgroundBuild currentPrefs) $ backgroundMake) ideR+            when (backgroundBuild currentPrefs) backgroundMake) ideR --    timeoutAddFull (do --        reflectIDE (do --            currentPrefs <- readIDE prefs@@ -501,7 +491,7 @@             (paraName <<<- ParaName "URL from which to download prebuilt metadata" $ emptyParams)             retrieveURL             (\b a -> a{retrieveURL = b})-            (textEditor (\ _ -> True) True)+            (textEditor (const True) True)     ,   mkField             (paraName <<<- ParaName "Strategy for downloading prebuilt metadata" $ emptyParams)             retrieveStrategy@@ -555,12 +545,12 @@                     writePrefs fp newPrefs                     fp2  <-  getConfigFilePathForSave strippedPreferencesFilename                     SP.writeStrippedPrefs fp2-                            (SP.Prefs {SP.sourceDirectories = sourceDirectories newPrefs,+                            SP.Prefs {SP.sourceDirectories = sourceDirectories newPrefs,                                        SP.unpackDirectory   = unpackDirectory newPrefs,                                        SP.retrieveURL       = retrieveURL newPrefs,                                        SP.retrieveStrategy  = retrieveStrategy newPrefs,                                        SP.serverPort        = serverPort newPrefs,-                                       SP.endWithLastConn   = endWithLastConn newPrefs})+                                       SP.endWithLastConn   = endWithLastConn newPrefs}                     firstBuild newPrefs                     return True         _ -> do

@@ -1,4 +1,4 @@-{-# LANGUAGE CPP, ScopedTypeVariables, OverloadedStrings #-}+{-# LANGUAGE RecordWildCards, ScopedTypeVariables, OverloadedStrings #-} ----------------------------------------------------------------------------- -- -- Module      :  IDE.LogRef@@ -26,7 +26,7 @@ ,   defaultLineLogger' ,   logOutputLines ,   logOutputLines_-,   logOutputLines_Default+,   logOutputLinesDefault_ ,   logOutput ,   logOutputDefault ,   logOutputPane@@ -56,7 +56,7 @@ import qualified IDE.Pane.Log as Log import IDE.Utils.Tool import System.FilePath (equalFilePath)-import Data.List (stripPrefix, elemIndex, isPrefixOf)+import Data.List (partition, stripPrefix, elemIndex, isPrefixOf) import Data.Maybe (catMaybes, isJust) import System.Exit (ExitCode(..)) import System.Log.Logger (debugM)@@ -72,6 +72,9 @@ import qualified Data.Text as T        (length, stripPrefix, isPrefixOf, unpack, unlines, pack, null) import Data.Monoid ((<>))+import qualified Data.Set as S (member, insert, empty)+import Data.Set (Set)+import System.FilePath.Windows ((</>))  showSourceSpan :: LogRef -> Text showSourceSpan = T.pack . displaySrcSpan . logRefSrcSpan@@ -80,37 +83,36 @@ selectRef (Just ref) = do     logRefs <- readIDE allLogRefs     case elemIndex ref logRefs of-        Nothing    -> liftIO $ debugM "leksah" "no index" >> return ()+        Nothing    -> liftIO . void $ debugM "leksah" "no index"         Just index -> do             mbBuf         <- selectSourceBuf (logRefFullFilePath ref)             case mbBuf of-                Just buf  -> markRefInSourceBuf index buf ref True-                Nothing   -> liftIO $ debugM "leksah" "no buf" >> return ()+                Just buf  -> markRefInSourceBuf buf ref True+                Nothing   -> liftIO . void $ debugM "leksah" "no buf"             log :: Log.IDELog <- Log.getLog             Log.markErrorInLog log (logLines ref) selectRef Nothing = return () -forOpenLogRefs :: (Int -> LogRef -> IDEBuffer -> IDEAction) -> IDEAction+forOpenLogRefs :: (LogRef -> IDEBuffer -> IDEAction) -> IDEAction forOpenLogRefs f = do     logRefs <- readIDE allLogRefs     allBufs <- allBuffers-    forM_ [0 .. ((length logRefs)-1)] (\index -> do-        let ref = logRefs !! index-            fp = logRefFullFilePath ref+    forM_ logRefs $ \ref -> do+        let fp = logRefFullFilePath ref         fpc <- liftIO $ myCanonicalizePath fp-        forM_ (filter (\buf -> case (fileName buf) of+        forM_ (filter (\buf -> case fileName buf of                 Just fn -> equalFilePath fpc fn-                Nothing -> False) allBufs) (f index ref))+                Nothing -> False) allBufs) (f ref)  markLogRefs :: IDEAction-markLogRefs = do-    forOpenLogRefs $ \index logRef buf -> markRefInSourceBuf index buf logRef False+markLogRefs =+    forOpenLogRefs $ \logRef buf -> markRefInSourceBuf buf logRef False  unmarkLogRefs :: IDEAction-unmarkLogRefs = do-    forOpenLogRefs $ \index logRef (IDEBuffer {sourceView = sv}) -> do+unmarkLogRefs =+    forOpenLogRefs $ \logRef (IDEBuffer {sourceView = sv}) -> do             buf     <-  getBuffer sv-            removeTagByName buf (T.pack $ show (logRefType logRef) ++ show index)+            removeTagByName buf (T.pack $ show (logRefType logRef))  setErrorList :: [LogRef] -> IDEAction setErrorList errs = do@@ -139,7 +141,7 @@ addLogRefs refs = do     ideR <- ask     unmarkLogRefs-    modifyIDE_ (\ide -> ide{allLogRefs = (allLogRefs ide) ++ refs})+    modifyIDE_ (\ide -> ide{allLogRefs = allLogRefs ide ++ refs})     setCurrentError Nothing     markLogRefs     triggerEventIDE ErrorChanged@@ -151,120 +153,102 @@ nextError = do     errs <- readIDE errorRefs     currentError <- readIDE currentError-    if null errs-        then return ()-        else do-            let new = case currentError of-                        Nothing -> 0-                        Just ref ->-                            case elemIndex ref errs of-                                Nothing -> 0-                                Just n | (n + 1) < length errs -> (n + 1)-                                Just n -> n-            setCurrentError (Just $ errs!!new)-            selectRef $ Just (errs!!new)+    unless (null errs) $+      do let new+               = case currentError of+                     Nothing -> 0+                     Just ref -> case elemIndex ref errs of+                                     Nothing -> 0+                                     Just n | (n + 1) < length errs -> n + 1+                                     Just n -> n+         setCurrentError (Just $ errs !! new)+         selectRef $ Just (errs !! new)  previousError :: IDEAction previousError = do     errs <- readIDE errorRefs     currentError <- readIDE currentError-    if null errs-        then return ()-        else do-            let new = case currentError of-                        Nothing -> (length errs - 1)-                        Just ref ->-                            case elemIndex ref errs of-                                Nothing -> (length errs - 1)-                                Just n | n > 0 -> (n - 1)-                                Just n -> 0-            setCurrentError (Just $ errs!!new)-            selectRef $ Just (errs!!new)+    unless (null errs) $+      do let new+               = case currentError of+                     Nothing -> length errs - 1+                     Just ref -> case elemIndex ref errs of+                                     Nothing -> length errs - 1+                                     Just n | n > 0 -> n - 1+                                     Just n -> 0+         setCurrentError (Just $ errs !! new)+         selectRef $ Just (errs !! new)  nextBreakpoint :: IDEAction nextBreakpoint = do     breaks <- readIDE breakpointRefs     currentBreak <- readIDE currentBreak-    if null breaks-        then return ()-        else do-            let new = case currentBreak of-                        Nothing -> 0-                        Just ref ->-                            case elemIndex ref breaks of-                                Nothing -> 0-                                Just n | (n + 1) < length breaks -> (n + 1)-                                Just n -> n-            setCurrentBreak (Just $ breaks!!new)-            selectRef $ Just (breaks!!new)+    unless (null breaks) $+      do let new+               = case currentBreak of+                     Nothing -> 0+                     Just ref -> case elemIndex ref breaks of+                                     Nothing -> 0+                                     Just n | (n + 1) < length breaks -> n + 1+                                     Just n -> n+         setCurrentBreak (Just $ breaks !! new)+         selectRef $ Just (breaks !! new)  previousBreakpoint :: IDEAction previousBreakpoint = do     breaks <- readIDE breakpointRefs     currentBreak <- readIDE currentBreak-    if null breaks-        then return ()-        else do-            let new = case currentBreak of-                        Nothing -> (length breaks - 1)-                        Just ref ->-                            case elemIndex ref breaks of-                                Nothing -> (length breaks - 1)-                                Just n | n > 0 -> (n - 1)-                                Just n -> 0-            setCurrentBreak (Just $ breaks!!new)-            selectRef $ Just (breaks!!new)+    unless (null breaks) $+      do let new+               = case currentBreak of+                     Nothing -> length breaks - 1+                     Just ref -> case elemIndex ref breaks of+                                     Nothing -> length breaks - 1+                                     Just n | n > 0 -> n - 1+                                     Just n -> 0+         setCurrentBreak (Just $ breaks !! new)+         selectRef $ Just (breaks !! new)  nextContext :: IDEAction nextContext = do     contexts <- readIDE contextRefs     currentContext <- readIDE currentContext-    if null contexts-        then return ()-        else do-            let new = case currentContext of-                        Nothing -> 0-                        Just ref ->-                            case elemIndex ref contexts of-                                Nothing -> 0-                                Just n | (n + 1) < length contexts -> (n + 1)-                                Just n -> n-            setCurrentContext (Just $ contexts!!new)-            selectRef $ Just (contexts!!new)+    unless (null contexts) $+      do let new+               = case currentContext of+                     Nothing -> 0+                     Just ref -> case elemIndex ref contexts of+                                     Nothing -> 0+                                     Just n | (n + 1) < length contexts -> n + 1+                                     Just n -> n+         setCurrentContext (Just $ contexts !! new)+         selectRef $ Just (contexts !! new)  previousContext :: IDEAction previousContext = do     contexts <- readIDE contextRefs     currentContext <- readIDE currentContext-    if null contexts-        then return ()-        else do-            let new = case currentContext of-                        Nothing -> (length contexts - 1)-                        Just ref ->-                            case elemIndex ref contexts of-                                Nothing -> (length contexts - 1)-                                Just n | n > 0 -> (n - 1)-                                Just n -> 0-            setCurrentContext (Just $ contexts!!new)-            selectRef $ Just (contexts!!new)+    unless (null contexts) $+      do let new+               = case currentContext of+                     Nothing -> length contexts - 1+                     Just ref -> case elemIndex ref contexts of+                                     Nothing -> length contexts - 1+                                     Just n | n > 0 -> n - 1+                                     Just n -> 0+         setCurrentContext (Just $ contexts !! new)+         selectRef $ Just (contexts !! new)  lastContext :: IDEAction lastContext = do     contexts <- readIDE contextRefs     currentContext <- readIDE currentContext-    if null contexts-        then return ()-        else do-            let new = (last contexts)-            setCurrentContext (Just new)-            selectRef $ Just new+    unless (null contexts) $ do+        let new = last contexts+        setCurrentContext (Just new)+        selectRef $ Just new -#if MIN_VERSION_ghc(7,0,1) fixColumn c = max 0 (c - 1)-#else-fixColumn = id-#endif  srcPathParser :: CharParser () FilePath srcPathParser = try (do@@ -308,8 +292,28 @@         return $ SrcSpan filePath line (fixColumn col) line (fixColumn col))     <?> "srcSpanParser" -docTestParser :: CharParser () (SrcSpan, Text)-docTestParser = try (do+data BuildOutput = BuildProgress Int Int FilePath+                 | DocTestFailure SrcSpan Text++buildOutputParser :: CharParser () BuildOutput+buildOutputParser = try (do+        char '['+        n <- int+        whiteSpace+        symbol "of"+        whiteSpace+        total <- int+        char ']'+        whiteSpace+        symbol "Compiling"+        many (noneOf "(")+        char '('+        whiteSpace+        file <- many (noneOf ",")+        char ','+        many anyChar+        return $ BuildProgress n total file)+    <|> try (do         symbol "###"         whiteSpace         symbol "Failure"@@ -322,8 +326,8 @@         char ':'         whiteSpace         text <- T.pack <$> many anyChar-        return ((SrcSpan file line 7 line (T.length text - 7)), "Failure in " <> text))-    <?> "docTestParser"+        return $ DocTestFailure (SrcSpan file line 7 line (T.length text - 7)) $ "Failure in " <> text)+    <?> "buildOutputParser"  data BuildError =   BuildLine                 |   EmptyLine@@ -331,14 +335,14 @@                 |   WarningLine Text                 |   OtherLine Text -buildLineParser :: CharParser () BuildError-buildLineParser = try (do+buildErrorParser :: CharParser () BuildError+buildErrorParser = try (do         char '['         int         symbol "of"         int         char ']'-        many (anyChar)+        many anyChar         return BuildLine)     <|> try (do         whiteSpace@@ -378,7 +382,7 @@         whiteSpace         span <- srcSpanParser         return (BreakpointDescription n span))-    <?> "buildLineParser"+    <?> "breaksLineParser"  setBreakpointLineParser :: CharParser () BreakpointDescription setBreakpointLineParser = try (do@@ -401,22 +405,22 @@ symbol = P.symbol lexer identifier = P.identifier lexer colon = P.colon lexer-int = fmap fromInteger $ P.integer lexer+int = fromInteger <$> P.integer lexer  defaultLineLogger :: IDELog -> LogLaunch -> ToolOutput -> IDEM Int defaultLineLogger log logLaunch out = liftIO $ defaultLineLogger' log logLaunch out  defaultLineLogger' :: IDELog -> LogLaunch -> ToolOutput -> IO Int-defaultLineLogger' log logLaunch out = do+defaultLineLogger' log logLaunch out =     case out of         ToolInput  line            -> appendLog' (line <> "\n") InputTag         ToolOutput line            -> appendLog' (line <> "\n") LogTag         ToolError  line            -> appendLog' (line <> "\n") ErrorTag         ToolPrompt line            -> do-            unless (T.null line) $ appendLog' (line <> "\n") LogTag >> return ()-            appendLog' (T.pack (concat (take 20 (repeat "- "))) <> "-\n") FrameTag-        ToolExit   ExitSuccess     -> appendLog' (T.pack (take 41 (repeat '-')) <> "\n") FrameTag-        ToolExit   (ExitFailure 1) -> appendLog' (T.pack (take 41 (repeat '=')) <> "\n") FrameTag+            unless (T.null line) $ void (appendLog' (line <> "\n") LogTag)+            appendLog' (T.pack (concat (replicate 20 "- ")) <> "-\n") FrameTag+        ToolExit   ExitSuccess     -> appendLog' (T.pack (replicate 41 '-') <> "\n") FrameTag+        ToolExit   (ExitFailure 1) -> appendLog' (T.pack (replicate 41 '=') <> "\n") FrameTag         ToolExit   (ExitFailure n) -> appendLog' (T.pack (take 41 ("========== " ++ show n <> " " ++ repeat '=')) <> "\n") FrameTag     where         appendLog' = Log.appendLog log logLaunch@@ -425,17 +429,17 @@ paneLineLogger log logLaunch out = liftIO $ paneLineLogger' log logLaunch out  paneLineLogger' :: IDELog -> LogLaunch -> ToolOutput -> IO (Maybe Text)-paneLineLogger' log logLaunch out = do+paneLineLogger' log logLaunch out =     case out of         ToolInput  line            -> appendLog' (line <> "\n") InputTag >> return Nothing         ToolOutput line            -> appendLog' (line <> "\n") LogTag >> return (Just line)         ToolError  line            -> appendLog' (line <> "\n") ErrorTag >> return Nothing         ToolPrompt line            -> do-            unless (T.null line) $ appendLog' (line <> "\n") LogTag >> return ()-            appendLog' (T.pack (concat (take 20 (repeat "- "))) <> "-\n") FrameTag+            unless (T.null line) $ void (appendLog' (line <> "\n") LogTag)+            appendLog' (T.pack (concat (replicate 20 "- ")) <> "-\n") FrameTag             return Nothing-        ToolExit   ExitSuccess     -> appendLog' (T.pack (take 41 (repeat '-')) <> "\n") FrameTag >> return Nothing-        ToolExit   (ExitFailure 1) -> appendLog' (T.pack (take 41 (repeat '=')) <> "\n") FrameTag >> return Nothing+        ToolExit   ExitSuccess     -> appendLog' (T.pack (replicate 41 '-') <> "\n") FrameTag >> return Nothing+        ToolExit   (ExitFailure 1) -> appendLog' (T.pack (replicate 41 '=') <> "\n") FrameTag >> return Nothing         ToolExit   (ExitFailure n) -> appendLog' (T.pack (take 41 ("========== " ++ show n ++ " " ++ repeat '=')) <> "\n") FrameTag >> return Nothing     where         appendLog' = Log.appendLog log logLaunch@@ -445,7 +449,7 @@                -> C.Sink ToolOutput IDEM [a] logOutputLines logLaunch lineLogger = do     log :: Log.IDELog <- lift $ postSyncIDE Log.getLog-    results <- (CL.mapM $ postSyncIDE . lineLogger log logLaunch) =$ CL.consume+    results <- CL.mapM (postSyncIDE . lineLogger log logLaunch) =$ CL.consume     lift $ triggerEventIDE (StatusbarChanged [CompartmentState "", CompartmentBuild False])     return results @@ -456,10 +460,10 @@     logOutputLines logLaunch lineLogger     return () -logOutputLines_Default :: (IDELog -> LogLaunch -> ToolOutput -> IDEM a)+logOutputLinesDefault_ :: (IDELog -> LogLaunch -> ToolOutput -> IDEM a)                        -> C.Sink ToolOutput IDEM ()-logOutputLines_Default lineLogger = do-    defaultLogLaunch <- lift $ getDefaultLogLaunch+logOutputLinesDefault_ lineLogger = do+    defaultLogLaunch <- lift getDefaultLogLaunch     logOutputLines_  defaultLogLaunch lineLogger  logOutput :: LogLaunch@@ -470,30 +474,41 @@  logOutputDefault :: C.Sink ToolOutput IDEM () logOutputDefault = do-    defaultLogLaunch <- lift $ getDefaultLogLaunch+    defaultLogLaunch <- lift getDefaultLogLaunch     logOutput defaultLogLaunch  logOutputPane :: Text -> IORef [Text] -> C.Sink ToolOutput IDEM () logOutputPane command buffer = do-    defaultLogLaunch <- lift $ getDefaultLogLaunch+    defaultLogLaunch <- lift getDefaultLogLaunch     result <- catMaybes <$> logOutputLines defaultLogLaunch paneLineLogger-    when (not $ null result) $ do+    unless (null result) $ do         new <- liftIO . atomicModifyIORef buffer $ \x -> let new = x ++ result in (new, new)         mbURI <- lift $ readIDE autoURI         unless (isJust mbURI) . lift . postSyncIDE . setOutput command $ T.unlines new +data BuildOutputState = BuildOutputState { log           :: IDELog+                                         , inError       :: Bool+                                         , inDocTest     :: Bool+                                         , errs          :: [LogRef]+                                         , testFails     :: [LogRef]+                                         , filesCompiled :: Set FilePath+                                         }++-- Not quite a Monoid+initialState :: IDELog -> BuildOutputState+initialState log = BuildOutputState log False False [] [] S.empty+ logOutputForBuild :: IDEPackage                   -> Bool                   -> Bool                   -> C.Sink ToolOutput IDEM [LogRef] logOutputForBuild package backgroundBuild jumpToWarnings = do-    liftIO $ putStrLn $ "logOutputForBuild"+    liftIO $ putStrLn "logOutputForBuild"     log    <- lift getLog-    logLaunch <- lift $ Log.getDefaultLogLaunch-    (_, _, _, errs) <- CL.foldM (readAndShow logLaunch) (log, False, False, [])+    logLaunch <- lift Log.getDefaultLogLaunch+    BuildOutputState {..} <- CL.foldM (readAndShow logLaunch) $ initialState log     ideR <- lift ask     liftIO $ postGUISync $ reflectIDE (do-        setErrorList $ reverse errs         triggerEventIDE (Sensitivity [(SensitivityError,not (null errs))])         let errorNum    =   length (filter isError errs)         let warnNum     =   length errs - errorNum@@ -502,88 +517,121 @@         unless (backgroundBuild || (not jumpToWarnings && errorNum == 0)) nextError         return errs) ideR   where-    readAndShow :: LogLaunch -> (IDELog, Bool, Bool, [LogRef]) -> ToolOutput -> IDEM (IDELog, Bool, Bool, [LogRef])-    readAndShow logLaunch (log, inError, inDocTest, errs) output = do+    readAndShow :: LogLaunch -> BuildOutputState -> ToolOutput -> IDEM BuildOutputState+    readAndShow logLaunch state@BuildOutputState {..} output = do         ideR <- ask+        let logPrevious (previous:_) = reflectIDE (addLogRef previous) ideR+            logPrevious _ = return ()+         liftIO $ postGUISync $ case output of             ToolError line -> do-                let parsed  =  parse buildLineParser "" $ T.unpack line+                let parsed  =  parse buildErrorParser "" $ T.unpack line                 let nonErrorPrefixes = ["Linking ", "ar:", "ld:", "ld warning:"]                 tag <- case parsed of                     Right BuildLine -> return InfoTag-                    Right (OtherLine text) | "Linking " `T.isPrefixOf` text -> do+                    Right (OtherLine text) | "Linking " `T.isPrefixOf` text ->                         -- when backgroundBuild $ lift interruptProcess-                        reflectIDE (do-                                setErrorList $ reverse errs-                            ) ideR                         return InfoTag-                    Right (OtherLine text) | any (`T.isPrefixOf` text) nonErrorPrefixes -> do+                    Right (OtherLine text) | any (`T.isPrefixOf` text) nonErrorPrefixes ->                         return InfoTag                     _ -> return ErrorTag                 lineNr <- Log.appendLog log logLaunch (line <> "\n") tag                 case (parsed, errs) of                     (Left e,_) -> do                         sysMessage Normal . T.pack $ show e-                        return (log, False, False, errs)-                    (Right ne@(ErrorLine span refType str),_) ->-                        return (log, True, False, ((LogRef span package str (lineNr,lineNr) refType):errs))-                    (Right (OtherLine str1),(LogRef span rootPath str (l1,l2) refType):tl) ->+                        return state { inError = False }+                    (Right ne@(ErrorLine span refType str),_) -> do+                        let ref  = LogRef span package str Nothing (lineNr,lineNr) refType+                            root = logRefRootPath ref+                            file = logRefFilePath ref+                            fullFilePath = logRefFullFilePath ref+                        unless (fullFilePath `S.member` filesCompiled) $+                            reflectIDE (removeBuildLogRefs root file) ideR+                        when inError $ logPrevious errs+                        return state { inError = True+                                     , errs = ref:errs+                                     , filesCompiled = S.insert fullFilePath filesCompiled+                                     }+                    (Right (OtherLine str1), ref@(LogRef span rootPath str Nothing (l1,l2) refType):tl) ->                         if inError-                            then return (log, True, False, ((LogRef span-                                                    rootPath-                                                    (if T.null str-                                                        then line-                                                        else str <> "\n" <> line)-                                                    (l1,lineNr) refType) : tl))-                            else return (log, False, False, errs)-                    (Right (WarningLine str1),(LogRef span rootPath str (l1,l2) isError):tl) ->+                            then return state { errs = LogRef span rootPath+                                                         (if T.null str then line else str <> "\n" <> line)+                                                         Nothing+                                                         (l1, lineNr)+                                                         refType+                                                         : tl+                                              }+                            else return state+                    (Right (WarningLine str1),LogRef span rootPath str Nothing (l1, l2) isError : tl) ->                         if inError-                            then return (log, True, False, ((LogRef span-                                                    rootPath-                                                    (if T.null str-                                                        then line-                                                        else str <> "\n" <> line)-                                                    (l1,lineNr) WarningRef) : tl))-                            else return (log, False, False, errs)-                    otherwise -> return (log, False, False, errs)-            ToolOutput line -> do-                case (parse docTestParser "" $ T.unpack line, inDocTest, errs) of-                    (Right (span, exp), _, _) -> do+                            then return state { errs = LogRef span rootPath+                                                         (if T.null str then line else str <> "\n" <> line)+                                                         Nothing+                                                         (l1, lineNr)+                                                         WarningRef+                                                         : tl+                                              }+                            else return state+                    _ -> do+                        when inError $ logPrevious errs+                        return state { inError = False }+            ToolOutput line ->+                case (parse buildOutputParser "" $ T.unpack line, inDocTest, testFails) of+                    (Right (BuildProgress n total file), _, _) -> do+                        logLn <- Log.appendLog log logLaunch (line <> "\n") LogTag+                        reflectIDE (triggerEventIDE (StatusbarChanged [CompartmentState+                            (T.pack $ "Compiling " ++ show n ++ " of " ++ show total), CompartmentBuild False])) ideR+                        let root = ipdBuildDir package+                            fullFilePath = root </> file+                        unless (fullFilePath `S.member` filesCompiled) $+                            reflectIDE (removeBuildLogRefs root file) ideR+                        when inDocTest $ logPrevious testFails+                        return state { inDocTest = False }+                    (Right (DocTestFailure span exp), _, _) -> do                         logLn <- Log.appendLog log logLaunch (line <> "\n") ErrorTag-                        return (log, inError, True, LogRef span+                        when inDocTest $ logPrevious testFails+                        return state { inDocTest = True+                                     , testFails = LogRef span                                             package                                             exp-                                            (logLn,logLn) ErrorRef : errs)-                    (_, True, (LogRef span rootPath str (l1,l2) refType):tl) -> do+                                            Nothing (logLn,logLn) TestFailureRef : testFails+                                     }+                    (_, True, LogRef span rootPath str Nothing (l1, l2) refType : tl) -> do                         logLn <- Log.appendLog log logLaunch (line <> "\n") ErrorTag-                        return (log, inError, inDocTest, LogRef span+                        return state { testFails = LogRef span                                             rootPath                                             (str <> "\n" <> line)-                                            (l1,logLn) ErrorRef : tl)+                                            Nothing (l1,logLn) TestFailureRef : tl+                                     }                     _ -> do                         Log.appendLog log logLaunch (line <> "\n") LogTag-                        return (log, inError, False, errs)+                        when inDocTest $ logPrevious testFails+                        return state { inDocTest = False }             ToolInput line -> do                 Log.appendLog log logLaunch (line <> "\n") InputTag-                return (log, inError, inDocTest, errs)+                return state             ToolPrompt line -> do-                unless (T.null line) $ Log.appendLog log logLaunch (line <> "\n") LogTag >> return ()+                unless (T.null line) . void $ Log.appendLog log logLaunch (line <> "\n") LogTag+                when inError $ logPrevious errs+                when inDocTest $ logPrevious testFails                 let errorNum    =   length (filter isError errs)                 let warnNum     =   length errs - errorNum                 case errs of                     [] -> defaultLineLogger' log logLaunch output                     _ -> Log.appendLog log logLaunch (T.pack $ "- - - " ++ show errorNum ++ " errors - "                                             ++ show warnNum ++ " warnings - - -\n") FrameTag-                return (log, inError, inDocTest, errs)+                return state { inError = False, inDocTest = False }             ToolExit _ -> do                 let errorNum    =   length (filter isError errs)-                let warnNum     =   length errs - errorNum-                case errs of-                    [] -> defaultLineLogger' log logLaunch output+                    warnNum     =   length errs - errorNum+                when inError $ logPrevious errs+                when inDocTest $ logPrevious testFails+                case (errs, testFails) of+                    ([], []) -> defaultLineLogger' log logLaunch output                     _ -> Log.appendLog log logLaunch (T.pack $ "----- " ++ show errorNum ++ " errors -- "-                                            ++ show warnNum ++ " warnings -----\n") FrameTag-                return (log, inError, inDocTest, errs)-+                                            ++ show warnNum ++ " warnings -- "+                                            ++ show (length testFails) ++ " doctest failures -----\n") FrameTag+                return state { inError = False, inDocTest = False }  --logOutputLines :: Text -- ^ logLaunch --               -> (LogLaunch -> ToolOutput -> IDEM a)@@ -594,13 +642,13 @@                         -> LogLaunch           -- ^ loglaunch                         -> C.Sink ToolOutput IDEM () logOutputForBreakpoints package logLaunch = do-    breaks <- logOutputLines logLaunch (\log logLaunch out -> do+    breaks <- logOutputLines logLaunch (\log logLaunch out ->         case out of             ToolOutput line -> do                 logLineNumber <- liftIO $ Log.appendLog log logLaunch (line <> "\n") LogTag                 case parse breaksLineParser "" $ T.unpack line of                     Right (BreakpointDescription n span) ->-                        return $ Just $ LogRef span package line (logLineNumber, logLineNumber) BreakpointRef+                        return $ Just $ LogRef span package line Nothing (logLineNumber, logLineNumber) BreakpointRef                     _ -> return Nothing             _ -> do                 defaultLineLogger log logLaunch out@@ -611,13 +659,13 @@                         -> LogLaunch           -- ^ loglaunch                         -> C.Sink ToolOutput IDEM () logOutputForSetBreakpoint package logLaunch = do-    breaks <- logOutputLines logLaunch (\log logLaunch out -> do+    breaks <- logOutputLines logLaunch (\log logLaunch out ->         case out of             ToolOutput line -> do                 logLineNumber <- liftIO $ Log.appendLog log logLaunch (line <> "\n") LogTag                 case parse setBreakpointLineParser "" $ T.unpack line of                     Right (BreakpointDescription n span) ->-                        return $ Just $ LogRef span package line (logLineNumber, logLineNumber) BreakpointRef+                        return $ Just $ LogRef span package line Nothing (logLineNumber, logLineNumber) BreakpointRef                     _ -> return Nothing             _ -> do                 defaultLineLogger log logLaunch out@@ -627,7 +675,7 @@ logOutputForSetBreakpointDefault :: IDEPackage                                  -> C.Sink ToolOutput IDEM () logOutputForSetBreakpointDefault package = do-    defaultLogLaunch <- lift $ getDefaultLogLaunch+    defaultLogLaunch <- lift getDefaultLogLaunch     logOutputForSetBreakpoint package defaultLogLaunch  logOutputForContext :: IDEPackage@@ -635,14 +683,14 @@                     -> (Text -> [SrcSpan])                     -> C.Sink ToolOutput IDEM () logOutputForContext package loglaunch getContexts = do-    refs <- fmap catMaybes $ logOutputLines loglaunch (\log logLaunch out -> do+    refs <- catMaybes <$> logOutputLines loglaunch (\log logLaunch out ->         case out of             ToolOutput line -> do                 logLineNumber <- liftIO $ Log.appendLog log logLaunch (line <> "\n") LogTag                 let contexts = getContexts line                 if null contexts                     then return Nothing-                    else return $ Just $ LogRef (last contexts) package line (logLineNumber, logLineNumber) ContextRef+                    else return $ Just $ LogRef (last contexts) package line Nothing (logLineNumber, logLineNumber) ContextRef             _ -> do                 defaultLineLogger log logLaunch out                 return Nothing)@@ -653,7 +701,7 @@ contextParser :: CharParser () SrcSpan contextParser = try (do         whiteSpace-        (symbol "Logged breakpoint at" <|> symbol "Stopped at")+        symbol "Logged breakpoint at" <|> symbol "Stopped at"         whiteSpace         srcSpanParser)     <?> "historicContextParser"@@ -671,7 +719,7 @@ logOutputForLiveContextDefault :: IDEPackage                                -> C.Sink ToolOutput IDEM () logOutputForLiveContextDefault package = do-    defaultLogLaunch <- lift $ getDefaultLogLaunch+    defaultLogLaunch <- lift getDefaultLogLaunch     logOutputForLiveContext package defaultLogLaunch  @@ -687,5 +735,5 @@ logOutputForHistoricContextDefault :: IDEPackage                                    -> C.Sink ToolOutput IDEM () logOutputForHistoricContextDefault package = do-    defaultLogLaunch <- lift $ getDefaultLogLaunch+    defaultLogLaunch <- lift getDefaultLogLaunch     logOutputForHistoricContext package defaultLogLaunch

@@ -90,18 +90,15 @@         then do             ideMessage Normal "Now updating system metadata ..."             callCollector False True True $ \ _ -> do-                ideMessage Normal "Now loading metadata ..."-                loadSystemInfo-                updateWorkspaceInfo' False $ \ _ -> do-                    void (triggerEventIDE (InfoChanged True))--                    liftIO $ infoM "leksah" "initInfo continuing"-                    continuation-        else do+                ideMessage Normal "Finished updating system metadata"+                doLoad+        else doLoad+    where+      doLoad = do             ideMessage Normal "Now loading metadata ..."             loadSystemInfo+            ideMessage Normal "Finished loading metadata"             updateWorkspaceInfo' False $ \ _ -> do-                ideMessage Normal "Finished"                 void (triggerEventIDE (InfoChanged True))                 continuation @@ -834,17 +831,30 @@                                 Nothing                                 Nothing                                 Nothing-                                (Just (BS.pack " Haskell keyword"))+                                (Just (BS.pack "Haskell keyword"))                                 KeywordDescr                                 True) keywords +misc :: [(Text, String)]+misc = [("--", "Haskell comment"), ("=", "Haskell definition")]++miscDescrs :: [Descr]+miscDescrs = map (\(s, d) -> Real $ RealDescr+                                s+                                Nothing+                                Nothing+                                Nothing+                                (Just (BS.pack d))+                                KeywordDescr+                                True) misc+ extensionDescrs :: [Descr] extensionDescrs =  map (\ext -> Real $ RealDescr                                     (T.pack $ "X" ++ show ext)                                     Nothing                                     Nothing                                     Nothing-                                    (Just (BS.pack " Haskell language extension"))+                                    (Just (BS.pack "Haskell language extension"))                                     ExtensionDescr                                     True)                                 ([minBound..maxBound]::[KnownExtension])@@ -855,7 +865,7 @@                                     Nothing                                     (Just (mdModuleId md))                                     Nothing-                                    (Just (BS.pack " Module name"))+                                    (Just (BS.pack "Module name"))                                     ModNameDescr                                     True) (pdModules pd) @@ -863,7 +873,7 @@ addOtherToScope (PackScope packageMap symbolTable) addAll = PackScope packageMap newSymbolTable     where newSymbolTable = foldl' (\ map descr -> symInsert (dscName descr) [descr] map)                         symbolTable (if addAll-                                        then keywordDescrs ++ extensionDescrs ++ modNameDescrs+                                        then keywordDescrs ++ extensionDescrs ++ modNameDescrs ++ miscDescrs                                         else modNameDescrs)           modNameDescrs = concatMap moduleNameDescrs (Map.elems packageMap) 

@@ -94,20 +94,18 @@ import IDE.LogRef import Distribution.ModuleName (ModuleName(..)) import Data.List (isInfixOf, nub, foldl', delete)-import IDE.Utils.Tool (ToolOutput(..), runTool, newGhci, ToolState(..), toolline)+import IDE.Utils.Tool (ToolOutput(..), runTool, newGhci, ToolState(..), toolline, ProcessHandle, executeGhciCommand) import qualified Data.Set as  Set (fromList) import qualified Data.Map as  Map (empty, fromList) import System.Exit (ExitCode(..)) import Control.Applicative ((<$>), (<*>))-import IDE.Utils.Tool (executeGhciCommand, getProcessExitCode, interruptProcessGroupOf,-    ProcessHandle) import qualified Data.Conduit as C (Sink, ZipSink(..), getZipSink) import qualified Data.Conduit.List as CL (foldM, fold, consume) import Data.Conduit (($$)) import Control.Monad.Trans.Reader (ask) import Control.Monad.IO.Class (MonadIO(..)) import Control.Monad.Trans.Class (lift)-import Control.Monad (when, unless, liftM, forM, forM_)+import Control.Monad (void, when, unless, liftM, forM, forM_) import Distribution.PackageDescription.PrettyPrint        (writeGenericPackageDescription) import Debug.Trace (trace)@@ -182,7 +180,7 @@      runExternalTool'        (__ "Configuring")                             (cabalCommand prefs)-                            (["configure"] ++ (ipdConfigFlags package))+                            ("configure" : ipdConfigFlags package)                             dir $ do         mbLastOutput <- C.getZipSink $ const <$> C.ZipSink sinkLast <*> C.ZipSink (logOutput logLaunch)         lift $ do@@ -202,11 +200,9 @@ runCabalBuild backgroundBuild jumpToWarnings withoutLinking package shallConfigure continuation = do     prefs <- readIDE prefs     let dir =  ipdBuildDir package-    let args = (["build"]-                ++ (if backgroundBuild && withoutLinking-                    then ["--with-ld=false"]-                    else [])-                ++ ipdBuildFlags package)+    let args = ["build"]+                ++ ["--with-ld=false" | backgroundBuild && withoutLinking]+                ++ ipdBuildFlags package     runExternalTool' (__ "Building") (cabalCommand prefs) args dir $ do         (mbLastOutput, isConfigErr, _) <- C.getZipSink $ (,,)             <$> C.ZipSink sinkLast@@ -242,7 +238,7 @@             if alreadyRunning                 then do                     interruptBuild-                    when (not backgroundBuild) $ liftIO $ do+                    unless backgroundBuild . liftIO $ do                         timeoutAddFull (do                             reflectIDE (do                                 buildPackage backgroundBuild jumpToWarnings withoutLinking@@ -265,7 +261,7 @@                 when (saveAllBeforeBuild prefs) (do fileSaveAll belongsToWorkspace; return ())                 (`runDebug` debug) . executeDebugCommand ":reload" $ do                     errs <- logOutputForBuild package backgroundBuild jumpToWarnings-                    unless (any isError $ errs) $ do+                    unless (any isError errs) $ do                         cmd <- lift $ readIDE autoCommand                         liftIO . postGUISync $ reflectIDE cmd ideR                         lift $ continuation True@@ -282,13 +278,12 @@     prefs     <- readIDE prefs     catchIDE (do         let dir = ipdBuildDir package-        runExternalTool' (__ "Documenting") (cabalCommand prefs) (["haddock"]-            ++ (ipdHaddockFlags package)) dir $ do+        runExternalTool' (__ "Documenting") (cabalCommand prefs) ("haddock" : ipdHaddockFlags package) dir $ do                 mbLastOutput <- C.getZipSink $ const <$> C.ZipSink sinkLast <*> (C.ZipSink $                     logOutputForBuild package backgroundBuild jumpToWarnings)-                lift $ reloadDoc+                lift reloadDoc                 lift $ continuation (mbLastOutput == Just (ToolExit ExitSuccess)))-        (\(e :: SomeException) -> putStrLn (show e))+        (\(e :: SomeException) -> print e)  packageClean :: PackageAction packageClean = do@@ -326,10 +321,10 @@                     let dir = ipdBuildDir package                     runExternalTool' (__ "Copying")                                     (cabalCommand prefs)-                                    (["copy"] ++ ["--destdir=" <> T.pack fp])+                                    ("copy" : ["--destdir=" <> T.pack fp])                                     dir                                     (logOutput logLaunch))-            (\(e :: SomeException) -> putStrLn (show e))+            (\(e :: SomeException) -> print e)  packageInstallDependencies :: PackageAction packageInstallDependencies = do@@ -345,9 +340,9 @@                    (if useCabalDev prefs                         then ["install-deps"]                         else ["install","--only-dependencies"])-                ++ (ipdConfigFlags package)-                ++ (ipdInstallFlags package)) dir (logOutput logLaunch))-            (\(e :: SomeException) -> putStrLn (show e))+                ++ ipdConfigFlags package+                ++ ipdInstallFlags package) dir (logOutput logLaunch))+            (\(e :: SomeException) -> print e)  packageCopy' :: IDEPackage -> (Bool -> IDEAction) -> IDEAction packageCopy' package continuation = do@@ -357,20 +352,19 @@      catchIDE (do         let dir = ipdBuildDir package-        runExternalTool' (__ "Copying") (cabalCommand prefs) (["copy"]-            ++ (ipdInstallFlags package)) dir $ do+        runExternalTool' (__ "Copying") (cabalCommand prefs) ("copy" : ipdInstallFlags package) dir $ do                 mbLastOutput <- C.getZipSink $ (const <$> C.ZipSink sinkLast) <*> C.ZipSink (logOutput logLaunch)                 lift $ continuation (mbLastOutput == Just (ToolExit ExitSuccess)))-        (\(e :: SomeException) -> putStrLn (show e))+        (\(e :: SomeException) -> print e)  packageRun :: PackageAction packageRun = ask >>= (liftIDE . packageRun' True)  packageRun' :: Bool -> IDEPackage -> IDEAction-packageRun' removeGhcjsFlagIfPresent package = do+packageRun' removeGhcjsFlagIfPresent package =     if removeGhcjsFlagIfPresent && "--ghcjs" `elem` ipdConfigFlags package         then do-            window <- liftIDE $ getMainWindow+            window <- liftIDE getMainWindow             resp <- liftIO $ do                 md <- messageDialogNew (Just window) [] MessageQuestion ButtonsCancel                         (__ "Package is configured to use GHCJS.  Would you like to remove --ghcjs from the configure flags and rebuild?")@@ -385,13 +379,14 @@                     let packWithNewFlags = package { ipdConfigFlags = filter (/="--ghcjs") $ ipdConfigFlags package }                     changePackage packWithNewFlags                     liftIO $ writeFlags (dropExtension (ipdCabalFile packWithNewFlags) ++ leksahFlagFileExtension) packWithNewFlags-                    packageConfig' packWithNewFlags $ \ ok -> when ok $ do+                    packageConfig' packWithNewFlags $ \ ok -> when ok $                         packageRun' False packWithNewFlags                 _  -> return ()         else liftIDE $ catchIDE (do             ideR        <- ask             maybeDebug   <- readIDE debugState-            pd <- liftIO $ readPackageDescription normal (ipdCabalFile package) >>= return . flattenPackageDescription+            pd <- liftIO $ liftM flattenPackageDescription+                             (readPackageDescription normal (ipdCabalFile package))             mbExe <- readIDE activeExe             let exe = take 1 . filter (isActiveExe mbExe) $ executables pd             let defaultLogName = T.pack . display . pkgName $ ipdPackageId package@@ -410,17 +405,17 @@                                                 , ipdExeFlags package])                                            dir                                            (logOutput logLaunch)-                Just debug -> do+                Just debug ->                     -- TODO check debug package matches active package                     runDebug (do                         case exe of-                            [Executable name mainFilePath _] -> do+                            [Executable name mainFilePath _] ->                                 executeDebugCommand (":module *" <> T.pack (map (\c -> if c == '/' then '.' else c) (takeWhile (/= '.') mainFilePath)))                                                     (logOutput logLaunch)                             _ -> return ()                         executeDebugCommand (":main " <> T.unwords (ipdExeFlags package)) (logOutput logLaunch))                         debug)-            (\(e :: SomeException) -> putStrLn (show e))+            (\(e :: SomeException) -> print e)   where     isActiveExe selected (Executable name _ _) = selected == Just (T.pack name) @@ -428,10 +423,10 @@ packageRunJavaScript = ask >>= (liftIDE . packageRunJavaScript' True)  packageRunJavaScript' :: Bool -> IDEPackage -> IDEAction-packageRunJavaScript' addFlagIfMissing package = do-    if addFlagIfMissing && not ("--ghcjs" `elem` ipdConfigFlags package)+packageRunJavaScript' addFlagIfMissing package =+    if addFlagIfMissing && ("--ghcjs" `notElem` ipdConfigFlags package)         then do-            window <- liftIDE $ getMainWindow+            window <- liftIDE getMainWindow             resp <- liftIO $ do                 md <- messageDialogNew (Just window) [] MessageQuestion ButtonsCancel                         (__ "Package is not configured to use GHCJS.  Would you like to add --ghcjs to the configure flags and rebuild?")@@ -443,16 +438,17 @@                 return resp             case resp of                 ResponseUser 1 -> do-                    let packWithNewFlags = package { ipdConfigFlags = ["--ghcjs"] ++ ipdConfigFlags package }+                    let packWithNewFlags = package { ipdConfigFlags = "--ghcjs" : ipdConfigFlags package }                     changePackage packWithNewFlags                     liftIO $ writeFlags (dropExtension (ipdCabalFile packWithNewFlags) ++ leksahFlagFileExtension) packWithNewFlags-                    packageConfig' packWithNewFlags $ \ ok -> when ok $ do+                    packageConfig' packWithNewFlags $ \ ok -> when ok $                         packageRunJavaScript' False packWithNewFlags                 _  -> return ()         else liftIDE $ buildPackage False False True package $ \ ok -> when ok $ liftIDE $ catchIDE (do                 ideR        <- ask                 maybeDebug   <- readIDE debugState-                pd <- liftIO $ readPackageDescription normal (ipdCabalFile package) >>= return . flattenPackageDescription+                pd <- liftIO $ liftM flattenPackageDescription+                                 (readPackageDescription normal (ipdCabalFile package))                 mbExe <- readIDE activeExe                 let exe = take 1 . filter (isActiveExe mbExe) $ executables pd                 let defaultLogName = T.pack . display . pkgName $ ipdPackageId package@@ -472,10 +468,10 @@                         openBrowser path #endif                       `catchIDE`-                        (\(e :: SomeException) -> putStrLn (show e))+                        (\(e :: SomeException) -> print e)                      _ -> return ())-                (\(e :: SomeException) -> putStrLn (show e))+                (\(e :: SomeException) -> print e)   where     isActiveExe selected (Executable name _ _) = selected == Just (T.pack name) @@ -493,11 +489,10 @@           catchIDE (do             prefs <- readIDE prefs             let dir = ipdBuildDir package-            runExternalTool' (__ "Registering") (cabalCommand prefs) (["register"]-                ++ (ipdRegisterFlags package)) dir $ do+            runExternalTool' (__ "Registering") (cabalCommand prefs) ("register" : ipdRegisterFlags package) dir $ do                     mbLastOutput <- C.getZipSink $ (const <$> C.ZipSink sinkLast) <*> C.ZipSink (logOutput logLaunch)                     lift $ continuation (mbLastOutput == Just (ToolExit ExitSuccess)))-            (\(e :: SomeException) -> putStrLn (show e))+            (\(e :: SomeException) -> print e)         else continuation True  packageTest :: PackageAction@@ -529,7 +524,7 @@                             else do                                 continuation (mbLastOutput == Just (ToolExit ExitSuccess))                                 return ())-            (\(e :: SomeException) -> putStrLn (show e))+            (\(e :: SomeException) -> print e)         else continuation True  packageSdist :: PackageAction@@ -542,9 +537,8 @@         catchIDE (do             prefs <- readIDE prefs             let dir = ipdBuildDir package-            runExternalTool' (__ "Source Dist") (cabalCommand prefs) (["sdist"]-                            ++ (ipdSdistFlags package)) dir (logOutput logLaunch))-            (\(e :: SomeException) -> putStrLn (show e))+            runExternalTool' (__ "Source Dist") (cabalCommand prefs) ("sdist" : ipdSdistFlags package) dir (logOutput logLaunch))+            (\(e :: SomeException) -> print e)   packageOpenDoc :: PackageAction@@ -565,7 +559,7 @@         openBrowser $ T.pack path #endif       `catchIDE`-        (\(e :: SomeException) -> putStrLn (show e))+        (\(e :: SomeException) -> print e)   runPackage ::  (ProcessHandle -> IDEAction)@@ -595,7 +589,7 @@                 pd <- readPackageDescription normal (ipdCabalFile p)                 return (Just (flattenPackageDescription pd,ipdCabalFile p)))                     (\(e :: SomeException) -> do-                        reflectIDE (ideMessage Normal ((__ "Can't load package ") <> T.pack (show e))) ideR+                        reflectIDE (ideMessage Normal (__ "Can't load package " <> T.pack (show e))) ideR                         return Nothing))  getEmptyModuleTemplate :: PackageDescription -> Text -> IO Text@@ -629,7 +623,7 @@         let npd = trace (show gpd) foldr addModule gpd locations         writeGenericPackageDescription (ipdCabalFile p) npd)            (\(e :: SomeException) -> do-            reflectIDE (ideMessage Normal ((__ "Can't update package ") <> T.pack (show e))) ideR+            reflectIDE (ideMessage Normal (__ "Can't update package " <> T.pack (show e))) ideR             return ()))   where     addModule LibExposedMod gpd@GenericPackageDescription{condLibrary = Just lib} =@@ -692,7 +686,7 @@                                                 (condExecutables gpd)}         writeGenericPackageDescription (ipdCabalFile p) npd)            (\(e :: SomeException) -> do-            reflectIDE (ideMessage Normal ((__ "Can't update package ") <> T.pack (show e))) ideR+            reflectIDE (ideMessage Normal (__ "Can't update package " <> T.pack (show e))) ideR             return ()))  delModFromLib :: ModuleName -> CondTree ConfVar [Dependency] Library ->@@ -714,7 +708,7 @@  isExposedModule :: ModuleName -> Maybe (CondTree ConfVar [Dependency] Library)  -> Bool isExposedModule mn Nothing                             = False-isExposedModule mn (Just CondNode{condTreeData = lib}) = elem mn (exposedModules lib)+isExposedModule mn (Just CondNode{condTreeData = lib}) = mn `elem` exposedModules lib  backgroundBuildToggled :: IDEAction backgroundBuildToggled = do@@ -752,10 +746,10 @@  interactiveFlags :: Prefs -> [Text] interactiveFlags prefs =-    (printEvldWithShowFlag $ printEvldWithShow prefs)-    : (breakOnExceptionFlag $ breakOnException prefs)-    : (breakOnErrorFlag $ breakOnError prefs)-    : [printBindResultFlag $ printBindResult prefs]+    printEvldWithShowFlag (printEvldWithShow prefs)+  : breakOnExceptionFlag (breakOnException prefs)+  : breakOnErrorFlag (breakOnError prefs)+  : [printBindResultFlag $ printBindResult prefs]  debugStart :: PackageAction debugStart = do@@ -769,7 +763,7 @@                 let dir = ipdBuildDir package                 mbExe <- readIDE activeExe                 ghci <- reifyIDE $ \ideR -> newGhci dir mbExe (interactiveFlags prefs')-                    $ reflectIDEI (logOutputForBuild package True False >> return ()) ideR+                    $ reflectIDEI (void (logOutputForBuild package True False)) ideR                 modifyIDE_ (\ide -> ide {debugState = Just (package, ghci)})                 triggerEventIDE (Sensitivity [(SensitivityInterpreting, True)])                 setDebugToggled True@@ -784,7 +778,7 @@                         modifiedPacks <- fileCheckAll belongsToPackages                         let modified = not (null modifiedPacks)                         prefs <- readIDE prefs-                        when ((not modified) && (backgroundBuild prefs)) $ do+                        when (not modified && backgroundBuild prefs) $ do                             -- So although none of the pakages are modified,                             -- they may have been modified in ghci mode.                             -- Lets build to make sure the binaries are up to date@@ -796,17 +790,17 @@             _ -> do                 sysMessage Normal (__ "Debugger already running")                 return ())-            (\(e :: SomeException) -> putStrLn (show e))+            (\(e :: SomeException) -> print e)  tryDebug :: DebugAction -> PackageAction tryDebug f = do     maybeDebug <- liftIDE $ readIDE debugState     case maybeDebug of-        Just debug -> do+        Just debug ->             -- TODO check debug package matches active package             liftIDE $ runDebug f debug         _ -> do-            window <- liftIDE $ getMainWindow+            window <- liftIDE getMainWindow             resp <- liftIO $ do                 md <- messageDialogNew (Just window) [] MessageQuestion ButtonsCancel                         (__ "GHCi debugger is not running.")@@ -829,16 +823,16 @@ tryDebugQuiet f = do     maybeDebug <- liftIDE $ readIDE debugState     case maybeDebug of-        Just debug -> do+        Just debug ->             -- TODO check debug package matches active package             liftIDE $ runDebug f debug-        _ -> do+        _ ->             return () -executeDebugCommand :: Text -> (C.Sink ToolOutput IDEM ()) -> DebugAction+executeDebugCommand :: Text -> C.Sink ToolOutput IDEM () -> DebugAction executeDebugCommand command handler = do     (_, ghci) <- ask-    lift $ do+    lift $         reifyIDE $ \ideR -> do             liftIO $ postGUIAsync $ reflectIDE (do                 triggerEventIDE (StatusbarChanged [CompartmentState command, CompartmentBuild True])@@ -865,7 +859,7 @@         pd <- readPackageDescription normal ipdCabalFile         return (Just (flattenPackageDescription pd)))             (\ (e  :: SomeException) -> do-                reflectIDE (ideMessage Normal ((__ "Can't activate package ") <> T.pack (show e))) ideR+                reflectIDE (ideMessage Normal (__ "Can't activate package " <> T.pack (show e))) ideR                 return Nothing))     case mbPackageD of         Nothing       -> return Nothing@@ -877,7 +871,7 @@                                         ++ [ (f, bi, True) | TestSuite _ (TestSuiteExeV10 _ f) bi _ <- testSuites packageD ]                                         ++ [ (f, bi, True) | Benchmark _ (BenchmarkExeV10 _ f) bi _ <- benchmarks packageD ]                 ipdExtraSrcs        = Set.fromList $ extraSrcFiles packageD-                ipdSrcDirs          = case (nub $ concatMap hsSourceDirs (allBuildInfo' packageD)) of+                ipdSrcDirs          = case nub $ concatMap hsSourceDirs (allBuildInfo' packageD) of                                             [] -> [".","src"]                                             l -> l                 ipdExes             = [ T.pack $ exeName e | e <- executables packageD@@ -902,11 +896,11 @@                 ipdSandboxSources   = []                 packp               = IDEPackage {..}                 pfile               = dropExtension ipdCabalFile-            pack <- (do+            pack <- do                 flagFileExists <- liftIO $ doesFileExist (pfile ++ leksahFlagFileExtension)                 if flagFileExists                     then liftIO $ readFlags (pfile ++ leksahFlagFileExtension) packp-                    else return packp)+                    else return packp             return (Just pack)  idePackageFromPath :: C.Sink ToolOutput IDEM () -> FilePath -> IDEM (Maybe IDEPackage)@@ -923,7 +917,7 @@                         map (T.unpack . toolline) . takeWhile (/= ToolOutput "") . drop 1 $ dropWhile (/= ToolOutput "") output                     _ -> []             paths <- liftIO $ takeMVar mvar-            sandboxSources <- concat <$> (forM paths $ \ path -> do+            sandboxSources <- concat <$> forM paths (\ path -> do                 contents <- liftIO $ getDirectoryContents path                 return . take 1 . map (path </>) $ filter ((== ".cabal") . takeExtension) contents)             s <- liftM catMaybes . mapM idePackageFromPath' $ nub sandboxSources

@@ -86,9 +86,10 @@     cellLayoutPackStart colA rendererA False     cellLayoutSetAttributes colA rendererA errorStore         $ \row -> [cellText := if index row == 0 then showSourceSpan (logRef row) else "",-                   cellTextForeground := if logRefType (logRef row) == WarningRef-                                            then "green"-                                            else "red"::Text ]+                   cellTextForeground := case logRefType (logRef row) of+                                            WarningRef -> "orange" :: Text+                                            LintRef    -> "green"+                                            _          -> "red" ]     rendererB    <- cellRendererTextNew     colB         <- treeViewColumnNew     treeViewColumnSetTitle colB (__ "Description")

@@ -74,8 +74,9 @@ import Data.List (sortBy, sort) import Data.Ord (comparing) import Data.Char (toLower)-import IDE.Core.Types (IDE(..), Prefs (..))+import IDE.Core.Types (IDEPackage(..), IDE(..), Prefs(..)) import Data.Tree (Tree(..))+import System.Log.Logger (debugM)  data FileRecord =     FileRecord FilePath@@ -208,7 +209,7 @@     let packages = maybe [] wsPackages mbWS     setDirectories store Nothing $ map PackageRecord packages -    forM_ (zip [0..] packages) $ \(n, package) -> do+    forM_ (zip [0..] packages) $ \(n, package) ->          refreshRecursively store [n] view  -- | Returns the 'FileRecord's at the given 'FilePath'.@@ -234,7 +235,7 @@     isExpanded <- liftIO $ treeViewRowExpanded view path     record     <- liftIO $ treeStoreGetValue store path -    when isExpanded $ do+    when isExpanded $         case record of             DirRecord dir -> do                 refreshDir store path dir@@ -252,6 +253,7 @@ -- add-source dependencies as a 'PackageRecord'. refreshPackage :: TreeStore FileRecord -> TreePath -> IDEPackage -> IDEAction refreshPackage store path p = do+    liftIO $ debugM "leksah" $ "refreshPackage " <> ipdCabalFile p     let dir = ipdBuildDir p     mbIter <- liftIO $ treeModelGetIter store path     when (isJust mbIter) $ do@@ -262,6 +264,7 @@ -- | Refreshes the child nodes of the node at the given 'TreePath'. refreshDir :: TreeStore FileRecord -> TreePath -> FilePath -> IDEAction refreshDir store path dir =  do+    liftIO $ debugM "leksah" $ "refreshPackage " <> dir     mbIter <- liftIO $ treeModelGetIter store path     when (isJust mbIter) $ do         contents <- dirContents dir

@@ -1,349 +1,332 @@-{-# LANGUAGE CPP #-}
-{-# LANGUAGE DeriveDataTypeable #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE TypeSynonymInstances #-}
-{-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE OverloadedStrings #-}
------------------------------------------------------------------------------
---
--- Module      :  IDE.Pane.HLint
--- Copyright   :  (c) Juergen Nicklisch-Franken, Hamish Mackenzie
--- License     :  GNU-GPL
---
--- Maintainer  :  <maintainer at leksah.org>
--- Stability   :  provisional
--- Portability  :  portable
---
--- | The pane of ide where HLint results are displayed
---
------------------------------------------------------------------------------
-
-module IDE.Pane.HLint (
-    IDEHLint(..)
-,   refreshHLint
-,   HLintState(..)
-,   getHLint
-) where
-
-
-import Graphics.UI.Gtk hiding (get)
-import qualified Graphics.UI.Gtk.Gdk.Events as Gdk
-import Text.ParserCombinators.Parsec.Language
-import Text.ParserCombinators.Parsec hiding(Parser)
-import qualified Text.ParserCombinators.Parsec.Token as P
-import Data.Maybe
-import Data.Typeable
-import IDE.Core.State hiding (SrcSpan(..))
-import IDE.BufferMode
-import IDE.LogRef (logOutput, defaultLineLogger)
-import IDE.Pane.SourceBuffer
-    (goToSourceDefinition', maybeActiveBuf, IDEBuffer(..), replaceHLintSource)
-import IDE.TextEditor (grabFocus)
-import Control.Applicative ((<$>))
-import System.FilePath ((</>), dropFileName)
-import System.Exit (ExitCode(..))
-import IDE.Pane.Log (getLog)
-import Control.Monad (void, forM_, foldM, when)
-import Control.Monad.Trans.Reader (ask)
-import Control.Monad.Trans.Class (MonadTrans(..))
-import Control.Monad.IO.Class (MonadIO(..))
-import Language.Haskell.HLint (Suggestion(..), suggestionLocation)
-import Language.Haskell.Exts (SrcLoc(..))
-import Language.Haskell.Exts.SrcLoc (SrcSpan(..))
-
-import qualified Language.Haskell.HLint2 as H
-import IDE.Utils.GUIUtils (__, treeViewContextMenu)
-import Data.List (isPrefixOf, findIndex)
-import Debug.Trace (trace)
-import Control.Exception (SomeException, catch)
-import Distribution.ModuleName (ModuleName)
-import IDE.Metainfo.Provider (getWorkspaceInfo)
-import qualified Data.Map as Map (keys, lookup)
-import Distribution.Package (PackageIdentifier(..))
-import Data.Text (Text)
-import qualified Data.Text as T
-       (replicate, unlines, init, lines, pack, unpack)
-import Data.Monoid ((<>))
-import qualified System.IO.Strict as S (readFile)
-
-data HLintRecord = HLintRecord {
-            condPackage :: Maybe IDEPackage
-        ,   context     :: Text
-        ,   condIdea    :: Maybe H.Idea
-        ,   parDir      :: Maybe FilePath
-        } deriving (Eq)
-
-isDir HLintRecord{parDir = Nothing}  = True
-isDir otherwies                     = False
-
--- | A HLint pane description
---
-
-data IDEHLint       =   IDEHLint {
-    scrolledView    ::   ScrolledWindow
-,   treeView        ::   TreeView
-,   hlintStore      ::   TreeStore HLintRecord
-} deriving Typeable
-
-data HLintState      =   HLintState
-    deriving(Eq,Ord,Read,Show,Typeable)
-
-instance Pane IDEHLint IDEM
-    where
-    primPaneName _  =   "HLint"
-    getAddedIndex _ =   0
-    getTopWidget    =   castToWidget . scrolledView
-    paneId b        =   "*HLint"
-
-instance RecoverablePane IDEHLint HLintState IDEM where
-    saveState p     =   return (Just HLintState)
-    recoverState pp HLintState =   do
-        nb      <-  getNotebook pp
-        buildPane pp nb builder
-    builder pp nb windows = reifyIDE $ \ ideR -> do
-        hlintStore   <-  treeStoreNew []
-        treeView    <-  treeViewNew
-        treeViewSetModel treeView hlintStore
-
-        renderer1    <- cellRendererTextNew
-        renderer10   <- cellRendererPixbufNew
-        col1         <- treeViewColumnNew
-        treeViewColumnSetTitle col1 (__ "Context")
-        treeViewColumnSetSizing col1 TreeViewColumnAutosize
-        treeViewColumnSetResizable col1 True
-        treeViewColumnSetReorderable col1 True
-        treeViewAppendColumn treeView col1
-        cellLayoutPackStart col1 renderer10 False
-        cellLayoutPackStart col1 renderer1 True
-        cellLayoutSetAttributes col1 renderer1 hlintStore
-            $ \row -> [ cellText := context row ]
-
-        treeViewSetHeadersVisible treeView False
-        sel <- treeViewGetSelection treeView
-        treeSelectionSetMode sel SelectionSingle
-
-        scrolledView <- scrolledWindowNew Nothing Nothing
-        scrolledWindowSetShadowType scrolledView ShadowIn
-        containerAdd scrolledView treeView
-        scrolledWindowSetPolicy scrolledView PolicyAutomatic PolicyAutomatic
-
-        let hlint = IDEHLint {..}
-        cid1 <- after treeView focusInEvent $ do
-            liftIO $ reflectIDE (makeActive hlint) ideR
-            return True
-        cid2 <- on treeView rowExpanded $ \ iter path -> do
-            record <- treeStoreGetValue hlintStore path
-            case record of
-                HLintRecord { condPackage = Just p, parDir = Nothing } ->
-                    reflectIDE (refreshDir hlintStore iter p) ideR
-                _ -> reflectIDE (ideMessage Normal (__ "Unexpected Expansion in HLint Pane")) ideR
-        cid3 <- on treeView rowActivated $ \ path col -> do
-            record <- treeStoreGetValue hlintStore path
-            mbIter <- treeModelGetIter hlintStore path
-            case (mbIter, record) of
-                (Just iter, HLintRecord { condPackage = Just p, parDir = Nothing }) ->
-                    reflectIDE (refreshDir hlintStore iter p) ideR
-                _ -> return ()
-        cid4 <- on treeView keyPressEvent $ do
-            name <- eventKeyName
-            liftIO $ case name of
-                        "Return" -> reflectIDE (gotoSource True treeView hlintStore) ideR
-                        "Escape" -> do
-                            reflectIDE (do
-                                lastActiveBufferPane ?>>= \paneName -> do
-                                    (PaneC pane) <- paneFromName paneName
-                                    makeActive pane
-                                    return ()
-                                triggerEventIDE StartFindInitial) ideR
-                            return True
-                            -- gotoSource True
-                        _ -> return False
-        treeViewContextMenu treeView
-            $ hlintContextMenu ideR hlintStore treeView
-        on sel treeSelectionSelectionChanged (reflectIDE (void $ gotoSource False treeView hlintStore) ideR)
-
-        return (Just hlint,map ConnectC [cid1])
-
-getHLint :: Maybe PanePath -> IDEM IDEHLint
-getHLint Nothing    = forceGetPane (Right "*HLint")
-getHLint (Just pp)  = forceGetPane (Left pp)
-
-data FindResult = WhereExpected TreeIter | Found TreeIter | NotFound
-
-find :: Eq a => a -> TreeStore a -> Maybe TreeIter -> IO FindResult
-find _ _ Nothing = return NotFound
-find a store (Just iter) = do
-    row <- treeModelGetRow store iter
-    if row == a
-        then return $ WhereExpected iter
-        else treeModelIterNext store iter >>= find'
-  where
-    find' :: Maybe TreeIter -> IO FindResult
-    find' Nothing = return NotFound
-    find' (Just iter) = do
-        row <- treeModelGetRow store iter
-        if row == a
-            then return $ Found iter
-            else treeModelIterNext store iter >>= find'
-
-removeUntil :: Eq a => a -> TreeStore a -> TreePath -> IO ()
-removeUntil a store path = do
-    row <- treeStoreGetValue store path
-    when (row /= a) $ do
-        found <- treeStoreRemove store path
-        when found $ removeUntil a store path
-
-removeRemaining :: TreeStore a -> TreePath -> IO ()
-removeRemaining store path = do
-    found <- treeStoreRemove store path
-    when found $ removeRemaining store path
-
-
-getSelectionHLintRecord ::  TreeView
-    ->  TreeStore HLintRecord
-    -> IO (Maybe HLintRecord)
-getSelectionHLintRecord treeView hlintStore = do
-    treeSelection   <-  treeViewGetSelection treeView
-    paths           <-  treeSelectionGetSelectedRows treeSelection
-    case paths of
-        p:_ ->  Just <$> treeStoreGetValue hlintStore p
-        _   ->  return Nothing
-
-refreshHLint :: WorkspaceAction
-refreshHLint = do
-    ws <- ask
-    maybeActive <- lift $ readIDE activePack
-    let packages = case maybeActive of
-            Just active -> active : filter (/= active) (wsAllPackages ws)
-            Nothing     -> wsAllPackages ws
-    lift $ hlintDirectories2 packages
-
-
---gotoSource :: Bool -> IDEM Bool
-gotoSource focus treeView hlintStore = do
-    sel <- liftIO $ getSelectionHLintRecord treeView hlintStore
-    case sel of
-        Just record ->
-            case record of
-                HLintRecord {condIdea = Just idea} ->
-                    goToSourceDefinition' (srcSpanFilename (H.ideaSpan idea))
-                                        (Location "" (srcSpanStartLine (H.ideaSpan idea))
-                                                         (srcSpanStartColumn (H.ideaSpan idea))
-                                                         (srcSpanEndLine (H.ideaSpan idea))
-                                                         (srcSpanEndColumn (H.ideaSpan idea)))
-                        ?>>= (\(IDEBuffer {sourceView = sv}) -> when focus $ grabFocus sv)
-                _ -> return ()
-        Nothing -> return ()
-    return True
-
-
-hlintDirectories2 :: [IDEPackage] -> IDEAction
-hlintDirectories2 packages = do
-    hlint <- getHLint Nothing
-    let store = hlintStore hlint
-    liftIO $ do
-        treeStoreClear store
-        forM_ packages $ \ p -> do
-            nDir <- treeModelIterNChildren store Nothing
-            treeStoreInsert store [] nDir $ HLintRecord (Just p) (packageIdentifierToString (ipdPackageId p)) Nothing Nothing
-            treeStoreInsert store [nDir] 0 $ HLintRecord (Just p) (packageIdentifierToString (ipdPackageId p)) Nothing Nothing
-
-refreshDir :: TreeStore HLintRecord -> TreeIter -> IDEPackage -> IDEM ()
-refreshDir store iter package = do
-    mbHlintDir <- liftIO $ leksahSubDir "hlint"
-    (flags, classify, hint) <- liftIO $ case mbHlintDir of
-                                            Just d  ->
-#if MIN_VERSION_hlint(1, 9, 13)
-                                                H.autoSettings' d
-#else
-                                                H.autoSettings
-#endif
-                                            Nothing -> H.autoSettings
-    let modules = Map.keys (ipdModules package)
-    paths <- getSourcePaths (ipdPackageId package) modules
-    resL <- liftIO $ mapM (\ file -> do
-        str <- S.readFile file
-        H.parseModuleEx flags file (Just str)) paths
-    let resOk = mapMaybe (\ pr -> case pr of
-                                    Left e -> trace ("can't parse: " ++ H.parseErrorContents e ++
-                                        " location " ++ show H.parseErrorLocation) Nothing
-                                    Right r -> Just r) resL
-    let ideas = H.applyHints classify hint resOk
-    liftIO $ setHLint2Results store iter (T.unpack $ packageIdentifierToString (ipdPackageId package)) ideas
-    return ()
-
-
-getSourcePaths :: PackageIdentifier -> [ModuleName] -> IDEM [FilePath]
-getSourcePaths packId names = do
-    mbWorkspaceInfo     <-  getWorkspaceInfo
-    case mbWorkspaceInfo of
-        Nothing -> return []
-        Just (sc, _) -> return (mapMaybe (sourcePathFromScope sc) names)
-    where
-    sourcePathFromScope :: GenScope -> ModuleName -> Maybe FilePath
-    sourcePathFromScope (GenScopeC (PackScope l _)) mn =
-        case packId `Map.lookup` l of
-            Just pack ->
-                case filter (\md -> modu (mdModuleId md) == mn)
-                                    (pdModules pack) of
-                    (mod : tl) ->  mdMbSourcePath mod
-                    []         -> Nothing
-            Nothing -> Nothing
-
-
-hlint2Record dir idea = HLintRecord {
-    condPackage = Nothing,
-    context     = T.pack $ show idea,
-    condIdea    = Just idea,
-    parDir      = Just dir}
-
-setHLint2Results :: TreeStore HLintRecord -> TreeIter -> FilePath -> [H.Idea] -> IO Int
-setHLint2Results store parent dir ideas = do
-    parentPath <- treeModelGetPath store parent
-    forM_ (zip [0..] records) $ \(n, record) -> do
-        mbChild <- treeModelIterNthChild store (Just parent) n
-        findResult <- find record store mbChild
-        case (mbChild, findResult) of
-            (_, WhereExpected _) -> return ()
-            (Just iter, Found _) -> do
-                path <- treeModelGetPath store iter
-                removeUntil record store path
-            _ -> treeStoreInsert store parentPath n record
-    removeRemaining store (parentPath++[nRecords])
-    return nRecords
-  where
-    records = map (hlint2Record dir) ideas
-    nRecords = length records
-
-hlintContextMenu :: IDERef
-                  -> TreeStore HLintRecord
-                  -> TreeView
-                  -> Menu
-                  -> IO ()
-hlintContextMenu ideR store treeView theMenu = do
-    mbSel           <-  getSelectionHLintRecord treeView store
-    item0           <-  menuItemNewWithLabel (__ "Replace")
-    item0 `on` menuItemActivate $ reflectIDE (replaceHlint store treeView mbSel) ideR
-    menuShellAppend theMenu item0
-  where
-    replaceableSelection Nothing = False
-    replaceableSelection (Just s) | isNothing (parDir s) = True
-                                  | otherwise = False
-
-replaceHlint store treeView (Just sel) =
-    case condIdea sel of
-        Just idea | isJust (H.ideaTo idea) ->
-            let lined = T.lines (T.pack $ fromJust (H.ideaTo idea))
-                startColumn = srcSpanStartColumn (H.ideaSpan idea)
-                source = T.init $ T.unlines (head lined :
-                                            map (\ s -> T.replicate startColumn " " <> s) (tail lined))
-            in
-                replaceHLintSource (srcSpanFilename (H.ideaSpan idea))
-                                   (srcSpanStartLine (H.ideaSpan idea))
-                                   startColumn
-                                   (srcSpanEndLine (H.ideaSpan idea))
-                                   (srcSpanEndColumn (H.ideaSpan idea))
-                                   source
-        otherwise -> return ()
-replaceHlint _ _ Nothing    = return ()
+{-# LANGUAGE CPP #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE OverloadedStrings #-}+-----------------------------------------------------------------------------+--+-- Module      :  IDE.Pane.HLint+-- Copyright   :  (c) Juergen Nicklisch-Franken, Hamish Mackenzie+-- License     :  GNU-GPL+--+-- Maintainer  :  <maintainer at leksah.org>+-- Stability   :  provisional+-- Portability  :  portable+--+-- | The pane of ide where HLint results are displayed+--+-----------------------------------------------------------------------------++module IDE.Pane.HLint (+    IDEHLint(..)+,   refreshHLint+,   HLintState(..)+,   getHLint+) where+++import Graphics.UI.Gtk hiding (get)+import qualified Graphics.UI.Gtk.Gdk.Events as Gdk+import Text.ParserCombinators.Parsec.Language+import Text.ParserCombinators.Parsec hiding(Parser)+import qualified Text.ParserCombinators.Parsec.Token as P+import Data.Maybe+import Data.Typeable+import IDE.Core.State hiding (SrcSpan(..))+import IDE.BufferMode+import IDE.LogRef (logOutput, defaultLineLogger)+import IDE.Pane.SourceBuffer+       (hlintSettings, hlintBuffer, fileSave, goToSourceDefinition',+        maybeActiveBuf, IDEBuffer(..), replaceHLintSource)+import IDE.TextEditor (TextEditor(..), grabFocus)+import Control.Applicative ((<$>))+import System.FilePath ((</>), dropFileName)+import System.Exit (ExitCode(..))+import IDE.Pane.Log (getLog)+import Control.Monad (forM, unless, void, forM_, foldM, when)+import Control.Monad.Trans.Reader (ask)+import Control.Monad.Trans.Class (MonadTrans(..))+import Control.Monad.IO.Class (MonadIO(..))+import Language.Haskell.Exts (SrcLoc(..))+import Language.Haskell.Exts.SrcLoc (SrcSpan(..))++import qualified Language.Haskell.HLint3 as H+import IDE.Utils.GUIUtils (__, treeViewContextMenu)+import Data.List (isPrefixOf, findIndex)+import Debug.Trace (trace)+import Control.Exception (SomeException, catch)+import Distribution.ModuleName (ModuleName)+import IDE.Metainfo.Provider (getWorkspaceInfo)+import qualified Data.Map as Map (keys, lookup)+import Distribution.Package (PackageIdentifier(..))+import Data.Text (Text)+import qualified Data.Text as T+       (replicate, unlines, init, lines, pack, unpack)+import Data.Monoid ((<>))+import qualified System.IO.Strict as S (readFile)+import Language.Haskell.HLint3+       (CppFlags(..), defaultParseFlags, parseFlagsAddFixities,+        resolveHints, readSettingsFile, findSettings, ParseFlags(..))+import Language.Preprocessor.Cpphs+       (runCpphsReturningSymTab, defaultCpphsOptions, CpphsOptions(..))+import System.Log.Logger (debugM)+import System.Directory (doesFileExist)+import qualified System.IO as S (writeFile)+import System.Glib.GTypeConstants (flags)++data HLintRecord = HLintRecord {+            condPackage :: Maybe IDEPackage+        ,   context     :: Text+        ,   condIdea    :: Maybe H.Idea+        ,   parDir      :: Maybe FilePath+        } deriving (Eq)++isDir HLintRecord{parDir = Nothing}  = True+isDir otherwies                     = False++-- | A HLint pane description+--++data IDEHLint       =   IDEHLint {+    scrolledView    ::   ScrolledWindow+,   treeView        ::   TreeView+,   hlintStore      ::   TreeStore HLintRecord+} deriving Typeable++data HLintState      =   HLintState+    deriving(Eq,Ord,Read,Show,Typeable)++instance Pane IDEHLint IDEM+    where+    primPaneName _  =   "HLint"+    getAddedIndex _ =   0+    getTopWidget    =   castToWidget . scrolledView+    paneId b        =   "*HLint"++instance RecoverablePane IDEHLint HLintState IDEM where+    saveState p     =   return (Just HLintState)+    recoverState pp HLintState =   do+        nb      <-  getNotebook pp+        buildPane pp nb builder+    builder pp nb windows = reifyIDE $ \ ideR -> do+        hlintStore   <-  treeStoreNew []+        treeView    <-  treeViewNew+        treeViewSetModel treeView hlintStore++        renderer1    <- cellRendererTextNew+        renderer10   <- cellRendererPixbufNew+        col1         <- treeViewColumnNew+        treeViewColumnSetTitle col1 (__ "Context")+        treeViewColumnSetSizing col1 TreeViewColumnAutosize+        treeViewColumnSetResizable col1 True+        treeViewColumnSetReorderable col1 True+        treeViewAppendColumn treeView col1+        cellLayoutPackStart col1 renderer10 False+        cellLayoutPackStart col1 renderer1 True+        cellLayoutSetAttributes col1 renderer1 hlintStore+            $ \row -> [ cellText := context row ]++        treeViewSetHeadersVisible treeView False+        sel <- treeViewGetSelection treeView+        treeSelectionSetMode sel SelectionSingle++        scrolledView <- scrolledWindowNew Nothing Nothing+        scrolledWindowSetShadowType scrolledView ShadowIn+        containerAdd scrolledView treeView+        scrolledWindowSetPolicy scrolledView PolicyAutomatic PolicyAutomatic++        let hlint = IDEHLint {..}+        cid1 <- after treeView focusInEvent $ do+            liftIO $ reflectIDE (makeActive hlint) ideR+            return True+        cid2 <- on treeView rowExpanded $ \ iter path -> do+            record <- treeStoreGetValue hlintStore path+            case record of+                HLintRecord { condPackage = Just p, parDir = Nothing } ->+                    reflectIDE (refreshDir hlintStore iter p) ideR+                _ -> reflectIDE (ideMessage Normal (__ "Unexpected Expansion in HLint Pane")) ideR+        cid3 <- on treeView rowActivated $ \ path col -> do+            record <- treeStoreGetValue hlintStore path+            mbIter <- treeModelGetIter hlintStore path+            case (mbIter, record) of+                (Just iter, HLintRecord { condPackage = Just p, parDir = Nothing }) ->+                    reflectIDE (refreshDir hlintStore iter p) ideR+                _ -> return ()+        cid4 <- on treeView keyPressEvent $ do+            name <- eventKeyName+            liftIO $ case name of+                        "Return" -> reflectIDE (gotoSource True treeView hlintStore) ideR+                        "Escape" -> do+                            reflectIDE (do+                                lastActiveBufferPane ?>>= \paneName -> do+                                    (PaneC pane) <- paneFromName paneName+                                    makeActive pane+                                    return ()+                                triggerEventIDE StartFindInitial) ideR+                            return True+                            -- gotoSource True+                        _ -> return False+        on sel treeSelectionSelectionChanged (reflectIDE (void $ gotoSource False treeView hlintStore) ideR)++        return (Just hlint,map ConnectC [cid1])++getHLint :: Maybe PanePath -> IDEM IDEHLint+getHLint Nothing    = forceGetPane (Right "*HLint")+getHLint (Just pp)  = forceGetPane (Left pp)++data FindResult = WhereExpected TreeIter | Found TreeIter | NotFound++find :: Eq a => a -> TreeStore a -> Maybe TreeIter -> IO FindResult+find _ _ Nothing = return NotFound+find a store (Just iter) = do+    row <- treeModelGetRow store iter+    if row == a+        then return $ WhereExpected iter+        else treeModelIterNext store iter >>= find'+  where+    find' :: Maybe TreeIter -> IO FindResult+    find' Nothing = return NotFound+    find' (Just iter) = do+        row <- treeModelGetRow store iter+        if row == a+            then return $ Found iter+            else treeModelIterNext store iter >>= find'++removeUntil :: Eq a => a -> TreeStore a -> TreePath -> IO ()+removeUntil a store path = do+    row <- treeStoreGetValue store path+    when (row /= a) $ do+        found <- treeStoreRemove store path+        when found $ removeUntil a store path++removeRemaining :: TreeStore a -> TreePath -> IO ()+removeRemaining store path = do+    found <- treeStoreRemove store path+    when found $ removeRemaining store path+++getSelectionHLintRecord ::  TreeView+    ->  TreeStore HLintRecord+    -> IO (Maybe HLintRecord)+getSelectionHLintRecord treeView hlintStore = do+    treeSelection   <-  treeViewGetSelection treeView+    paths           <-  treeSelectionGetSelectedRows treeSelection+    case paths of+        p:_ ->  Just <$> treeStoreGetValue hlintStore p+        _   ->  return Nothing++refreshHLint :: WorkspaceAction+refreshHLint = do+    ws <- ask+    maybeActive <- lift $ readIDE activePack+    let packages = case maybeActive of+            Just active -> active : filter (/= active) (wsAllPackages ws)+            Nothing     -> wsAllPackages ws+    lift $ hlintDirectories2 packages+++--gotoSource :: Bool -> IDEM Bool+gotoSource focus treeView hlintStore = do+    sel <- liftIO $ getSelectionHLintRecord treeView hlintStore+    case sel of+        Just record ->+            case record of+                HLintRecord {condIdea = Just idea} ->+                    goToSourceDefinition' (srcSpanFilename (H.ideaSpan idea))+                                        (Location "" (srcSpanStartLine (H.ideaSpan idea))+                                                         (srcSpanStartColumn (H.ideaSpan idea))+                                                         (srcSpanEndLine (H.ideaSpan idea))+                                                         (srcSpanEndColumn (H.ideaSpan idea)))+                        ?>>= (\buf@IDEBuffer {sourceView = sv} -> do+                            hlintBuffer buf+                            when focus $ grabFocus sv)+                _ -> return ()+        Nothing -> return ()+    return True+++hlintDirectories2 :: [IDEPackage] -> IDEAction+hlintDirectories2 packages = do+    hlint <- getHLint Nothing+    let store = hlintStore hlint+    liftIO $ do+        treeStoreClear store+        forM_ packages $ \ p -> do+            nDir <- treeModelIterNChildren store Nothing+            treeStoreInsert store [] nDir $ HLintRecord (Just p) (packageIdentifierToString (ipdPackageId p)) Nothing Nothing+            treeStoreInsert store [nDir] 0 $ HLintRecord (Just p) (packageIdentifierToString (ipdPackageId p)) Nothing Nothing++refreshDir :: TreeStore HLintRecord -> TreeIter -> IDEPackage -> IDEM ()+refreshDir store iter package = do+    ideR <- ask+    (flags, classify, hint) <- hlintSettings package+    let modules = Map.keys (ipdModules package)+    paths <- getSourcePaths (ipdPackageId package) modules+    res <- forM paths $ \ file -> do+        str <- liftIO $ S.readFile file+        liftIO . debugM "leksah" $ "refreshDir hlint parsing " <> file+        do result <- liftIO $ H.parseModuleEx flags file (Just str)+           case result of+                Left e -> do ideMessage Normal . T.pack $+                               "can't parse: " <> H.parseErrorContents e <> " location " <>+                                 show (H.parseErrorLocation e)+                             return Nothing+                Right r -> do liftIO . debugM "leksah" $+                                "refreshDir hlint parsed " <> file+                              return $ Just r+        `catchIDE` (\(e :: SomeException) -> do+                            reflectIDE (ideMessage Normal . T.pack $ show e) ideR+                            return Nothing)+    liftIO $ debugM "leksah" "refreshDir hlint parse complete"+    let ideas = H.applyHints classify hint (catMaybes res)+    liftIO $ setHLint2Results store iter (T.unpack $ packageIdentifierToString (ipdPackageId package)) ideas+    return ()+++getSourcePaths :: PackageIdentifier -> [ModuleName] -> IDEM [FilePath]+getSourcePaths packId names = do+    mbWorkspaceInfo     <-  getWorkspaceInfo+    case mbWorkspaceInfo of+        Nothing -> return []+        Just (sc, _) -> return (mapMaybe (sourcePathFromScope sc) names)+    where+    sourcePathFromScope :: GenScope -> ModuleName -> Maybe FilePath+    sourcePathFromScope (GenScopeC (PackScope l _)) mn =+        case packId `Map.lookup` l of+            Just pack ->+                case filter (\md -> modu (mdModuleId md) == mn)+                                    (pdModules pack) of+                    (mod : tl) ->  mdMbSourcePath mod+                    []         -> Nothing+            Nothing -> Nothing+++hlint2Record dir idea = HLintRecord {+    condPackage = Nothing,+    context     = T.pack $ show idea,+    condIdea    = Just idea,+    parDir      = Just dir}++setHLint2Results :: TreeStore HLintRecord -> TreeIter -> FilePath -> [H.Idea] -> IO Int+setHLint2Results store parent dir ideas = do+    liftIO $ debugM "leksah" "setHLint2Results"+    parentPath <- treeModelGetPath store parent+    forM_ (zip [0..] records) $ \(n, record) -> do+        mbChild <- treeModelIterNthChild store (Just parent) n+        findResult <- find record store mbChild+        case (mbChild, findResult) of+            (_, WhereExpected _) -> return ()+            (Just iter, Found _) -> do+                path <- treeModelGetPath store iter+                removeUntil record store path+            _ -> treeStoreInsert store parentPath n record+    liftIO $ debugM "leksah" "setHLint2Results removing remaining records"+    removeRemaining store (parentPath++[nRecords])+    return nRecords+  where+    records = map (hlint2Record dir) ideas+    nRecords = length records+

@@ -39,7 +39,7 @@ import IDE.SymbolNavigation import IDE.Pane.SourceBuffer import IDE.TextEditor (newDefaultBuffer, TextEditor(..), EditorView(..))-import IDE.Utils.GUIUtils (getDarkState, openBrowser, __)+import IDE.Utils.GUIUtils (openBrowser, __) import Control.Monad.IO.Class (MonadIO(..)) import Control.Monad.Reader.Class (MonadReader(..)) import Graphics.UI.Gtk@@ -85,10 +85,7 @@         descriptionBuffer <- newDefaultBuffer Nothing ""         descriptionView   <- newView descriptionBuffer (textviewFont prefs) -        preferDark <- getDarkState-        setStyle preferDark descriptionBuffer $ case sourceStyle prefs of-                                        (False,_) -> Nothing-                                        (True,v) -> Just v+        updateStyle descriptionBuffer          sw <- getScrolledWindow descriptionView @@ -154,14 +151,7 @@ setInfoStyle = getPane >>= setInfoStyle'   where     setInfoStyle' Nothing = return ()-    setInfoStyle' (Just IDEInfo{..}) = do-        prefs <- readIDE prefs-        preferDark <- getDarkState-        buffer <- getBuffer descriptionView-        setStyle preferDark buffer $ case sourceStyle prefs of-                                    (False,_) -> Nothing-                                    (True,v) -> Just v-+    setInfoStyle' (Just IDEInfo{..}) = getBuffer descriptionView >>= updateStyle  getInfoCont ::  IDEM (Maybe Descr) getInfoCont = do

@@ -408,12 +408,11 @@         (_,y')      <-  textViewWindowToBufferCoords tv TextWindowWidget (x,y)         (iter,_)    <-  textViewGetLineAtY tv y'         textIterGetLine iter-    case filter (\(es,_) -> fst (logLines es) <= (line'+1) && snd (logLines es) >= (line'+1))-            (zip logRefs' [0..(length logRefs')]) of-        [(thisRef,n)] -> do+    case filter (\es -> fst (logLines es) <= (line'+1) && snd (logLines es) >= (line'+1)) logRefs' of+        [thisRef] -> do             mbBuf <- selectSourceBuf (logRefFullFilePath thisRef)             case mbBuf of-                Just buf -> markRefInSourceBuf n buf thisRef True+                Just buf -> markRefInSourceBuf buf thisRef True                 Nothing -> return ()             log :: IDELog <- getLog             markErrorInLog log (logLines thisRef)

@@ -69,7 +69,8 @@ import Graphics.UI.Editor.Simple        (textEditor, boolEditor, staticListEditor) import Graphics.UI.Editor.Composite (maybeEditor)-import IDE.Utils.GUIUtils (stockIdFromType, __)+import IDE.Utils.GUIUtils+       (stockIdFromType, __, treeViewContextMenu) import IDE.Metainfo.Provider        (getSystemInfo, getWorkspaceInfo, getPackageInfo) import System.Log.Logger (debugM)@@ -79,9 +80,8 @@ import Control.Monad (when, void) import Control.Monad.Trans.Class (MonadTrans(..)) import Control.Monad.Trans.Reader (ask)-import IDE.Utils.GUIUtils (treeViewContextMenu) import System.Glib.Properties (newAttrFromMaybeStringProperty)-import Data.Text (Text)+import Data.Text (Text, toCaseFold) import qualified Data.Text as T (unpack, isInfixOf, toLower, pack) import Data.Monoid ((<>)) import qualified Text.Printf as S (printf)@@ -97,19 +97,20 @@ type ModuleRecord = (Text, Maybe (ModuleDescr,PackageDescr))  data IDEModules     =   IDEModules {-    outer           ::   VBox-,   paned           ::   HPaned-,   treeView        ::   TreeView-,   treeStore       ::   TreeStore ModuleRecord-,   descrView       ::   TreeView-,   descrStore      ::   TreeStore Descr-,   packageScopeB   ::   RadioButton-,   workspaceScopeB ::   RadioButton-,   systemScopeB    ::   RadioButton-,   dependsB        ::   CheckButton-,   blacklistB      ::   CheckButton-,   oldSelection    ::   IORef SelectionState-,   expanderState   ::   IORef ExpanderState+    outer            ::   VBox+,   paned            ::   HPaned+,   treeView         ::   TreeView+,   treeStore        ::   TreeStore ModuleRecord+,   descrView        ::   TreeView+,   descrStore       ::   TreeStore Descr+,   descrSortedStore ::   TypedTreeModelSort Descr -- ^ The sorted model for descrs+,   packageScopeB    ::   RadioButton+,   workspaceScopeB  ::   RadioButton+,   systemScopeB     ::   RadioButton+,   dependsB         ::   CheckButton+,   blacklistB       ::   CheckButton+,   oldSelection     ::   IORef SelectionState+,   expanderState    ::   IORef ExpanderState } deriving Typeable  @@ -141,7 +142,7 @@  instance Pane IDEModules IDEM     where-    primPaneName _  =   (__ "Modules")+    primPaneName _  =   __ "Modules"     getAddedIndex _ =   0     getTopWidget    =   castToWidget . outer     paneId b        =   "*Modules"@@ -168,7 +169,7 @@             Just p  ->  liftIO $ do                 i   <-  panedGetPosition (paned p)                 mbTreeSelection     <-  getSelectionTree (treeView m) (treeStore m)-                mbFacetSelection    <-  getSelectionDescr (descrView m) (descrStore m)+                mbFacetSelection    <-  getSelectionDescr (descrView m) (descrStore m) (descrSortedStore m)                 let mbs = (case mbTreeSelection of                             Just (_,Just (md,_)) -> Just (modu $ mdModuleId md)                             otherwise            -> Nothing,@@ -181,7 +182,7 @@         p           <-  buildPane pp nb builder         mod         <-  getModules Nothing         liftIO $ writeIORef (expanderState mod) exp-        liftIO $ writeIORef (oldSelection mod) (SelectionState (fst se) (snd se) scope useBlacklist)+        liftIO $ writeIORef (oldSelection mod) (uncurry SelectionState se scope useBlacklist)         liftIO $ panedSetPosition (paned mod) i         return p     builder pp nb windows = do@@ -241,7 +242,9 @@              descrView   <-  treeViewNew             descrStore  <-  treeStoreNew []-            treeViewSetModel descrView descrStore+            -- sorted model+            descrSortedStore <- treeModelSortNewWithModel descrStore+            treeViewSetModel descrView descrSortedStore             renderer30    <- cellRendererPixbufNew             renderer31    <- cellRendererPixbufNew             renderer3   <- cellRendererTextNew@@ -267,6 +270,14 @@                                                         then ("ide_source" :: Text)                                                         else "ide_source_local"                                                 else "ide_empty"]+            -- sort definitions on name, ignoring case+            treeSortableSetSortFunc descrSortedStore 2 $ \iter1 iter2 -> do+                d1 <- treeModelGetRow descrStore iter1+                d2 <- treeModelGetRow descrStore iter2+                let cafName = toCaseFold . descrTreeText+                return (compare (cafName d1) (cafName d2))+            treeViewColumnSetSortColumnId col 2+            treeSortableSetSortColumnId descrSortedStore 2 SortAscending             treeViewSetHeadersVisible descrView True             treeViewSetEnableSearch descrView True             treeViewSetSearchEqualFunc descrView (Just (descrViewSearch descrView descrStore))@@ -306,7 +317,7 @@             oldState <- liftIO $ newIORef $ SelectionState Nothing Nothing SystemScope False             expanderState <- liftIO $ newIORef emptyExpansion             scopeRef <- newIORef (SystemScope,True)-            let modules = IDEModules boxOuter pane' treeView treeStore descrView descrStore+            let modules = IDEModules boxOuter pane' treeView treeStore descrView descrStore descrSortedStore                                 rb1 rb2 rb3 cb2 cb oldState expanderState             cid1 <- after treeView focusInEvent $ do                 liftIO $ reflectIDE (makeActive modules) ideR@@ -316,8 +327,8 @@                 return True             (cid3, cid4) <- treeViewContextMenu treeView $ modulesContextMenu ideR treeStore treeView             cid5 <- treeView `on` rowActivated $ modulesSelect ideR treeStore treeView-            (cid6, cid7) <- treeViewContextMenu descrView $ descrViewContextMenu ideR descrStore descrView-            cid8 <- descrView `on` rowActivated $ descrViewSelect ideR descrStore+            (cid6, cid7) <- treeViewContextMenu descrView $ descrViewContextMenu ideR descrStore descrSortedStore descrView+            cid8 <- descrView `on` rowActivated $ descrViewSelect ideR descrStore descrSortedStore             on rb1 toggled (reflectIDE scopeSelection ideR)             on rb2 toggled (reflectIDE scopeSelection ideR)             on rb3 toggled (reflectIDE scopeSelection ideR)@@ -325,12 +336,12 @@             on cb2 toggled (reflectIDE scopeSelection ideR)             sel     <-  treeViewGetSelection treeView             on sel treeSelectionSelectionChanged $ do-                fillFacets treeView treeStore descrView descrStore+                fillFacets treeView treeStore descrView descrStore descrSortedStore                 reflectIDE recordSelHistory ideR                 return ()             sel2    <-  treeViewGetSelection descrView             on sel2 treeSelectionSelectionChanged $ do-                fillInfo descrView descrStore ideR+                fillInfo descrView descrStore descrSortedStore ideR                 reflectIDE recordSelHistory ideR                 return ()             return (Just modules,map ConnectC [cid1, cid2, cid3, cid4, cid5, cid6, cid7, cid8])@@ -368,27 +379,27 @@     pid = pack pm     ps  = case packageScope of                     Nothing -> (False,False)-                    Just (GenScopeC (PackScope psc1 _), GenScopeC (PackScope psc2 _)) ->-                                    if Map.member pid psc1-                                        then (True,False)-                                        else if Map.member pid psc2-                                            then (True,True)-                                            else (False, False)+                    Just+                      (GenScopeC (PackScope psc1 _),+                       GenScopeC (PackScope psc2 _)) | Map.member pid psc1 ->+                                                       (True, False)+                                                     | Map.member pid psc2 -> (True, True)+                                                     | otherwise -> (False, False)     ws  = case workspaceScope of                         Nothing -> (False,False)-                        Just (GenScopeC (PackScope wsc1 _), GenScopeC (PackScope wsc2 _)) ->-                                        if Map.member pid wsc1-                                            then (True,False)-                                            else if Map.member pid wsc2-                                                then (True,True)-                                                else (False, False)+                        Just+                          (GenScopeC (PackScope wsc1 _),+                           GenScopeC (PackScope wsc2 _)) | Map.member pid wsc1 ->+                                                           (True, False)+                                                         | Map.member pid wsc2 -> (True, True)+                                                         | otherwise -> (False, False)   selectIdentifier' :: ModuleName -> Text -> IDEAction selectIdentifier'  moduleName symbol =     let nameArray = map T.pack $ components moduleName     in do-        liftIO $ debugM "leksah" "selectIdentifier'"+        liftIO $ debugM "leksah" $ "selectIdentifier' " <> show moduleName <> " " <> T.unpack symbol         mods            <- getModules Nothing         mbTree          <-  liftIO $ treeStoreGetTreeSave (treeStore mods) []         case treePathFromNameArray mbTree nameArray [] of@@ -402,7 +413,8 @@                 selF        <-  treeViewGetSelection (descrView mods)                 case  findPathFor symbol mbFacetTree of                     Nothing     ->  sysMessage Normal (__ "no path found")-                    Just path   ->  do+                    Just childPath   ->  do+                        path    <- treeModelSortConvertChildPathToPath (descrSortedStore mods) childPath                         treeViewExpandToPath (descrView mods) path                         treeSelectionSelectPath selF path                         col     <-  treeViewGetColumn (descrView mods) 0@@ -413,7 +425,7 @@ findPathFor :: Text -> Maybe (Tree Descr) -> Maybe TreePath findPathFor symbol (Just (Node _ forest)) =     foldr ( \i mbTreePath -> findPathFor' [i] (forest !! i) mbTreePath)-                            Nothing  [0 .. ((length forest) - 1)]+                            Nothing  [0 .. (length forest - 1)]     where     findPathFor' :: TreePath -> Tree Descr -> Maybe TreePath -> Maybe TreePath     findPathFor' _ node (Just p)                  =   Just p@@ -422,13 +434,13 @@             then Just (reverse path)             else                 foldr ( \i mbTreePath -> findPathFor' (i:path) (sub !! i) mbTreePath)-                            Nothing     [0 .. ((length sub) - 1)]+                            Nothing     [0 .. (length sub - 1)] findPathFor symbol Nothing = Nothing  treePathFromNameArray :: Maybe ModTree -> [Text] -> [Int] -> Maybe [Int] treePathFromNameArray (Just tree) [] accu      =   Just (reverse accu) treePathFromNameArray (Just tree) (h:t) accu   =-    let names   =   map (\t -> fst $ rootLabel t) (subForest tree)+    let names   =   map (fst . rootLabel) (subForest tree)         mbIdx   =   elemIndex h names     in case mbIdx of             Nothing ->  Nothing@@ -446,7 +458,7 @@     val    <- treeStoreGetValue treeStore path     mbTree <- treeStoreGetTreeSave treeStore path     exp    <- treeViewRowExpanded treeView path-    when (isJust mbTree && (not (null (subForest (fromJust mbTree)))) && not exp) $+    when (isJust mbTree && not (null (subForest (fromJust mbTree))) && not exp) $         let found = searchInModSubnodes (fromJust mbTree) string         in when found $ do             treeViewExpandRow treeView path False@@ -459,14 +471,14 @@  searchInModSubnodes :: ModTree -> Text -> Bool searchInModSubnodes tree str =-    not $ null-        $ filter (\ (_,mbPair) ->-            case mbPair of-                Nothing -> False-                Just (mod,_) ->-                    let cstr = T.pack $ show (Present (mdModuleId mod))-                    in  T.isInfixOf (T.toLower str) (T.toLower cstr))-                            $ concatMap flatten (subForest tree)+    any+      (\ (_, mbPair) ->+         case mbPair of+             Nothing -> False+             Just (mod, _) -> let cstr+                                    = T.pack $ show (Present (mdModuleId mod))+                                in T.isInfixOf (T.toLower str) (T.toLower cstr))+      (concatMap flatten (subForest tree))  descrViewSearch :: TreeView     -> TreeStore Descr@@ -488,32 +500,32 @@  searchInFacetSubnodes :: DescrTree -> Text -> Bool searchInFacetSubnodes tree str =-    not $ null-        $ filter (\ val ->-            T.isInfixOf (T.toLower str) (T.toLower (descrTreeText val)))-                $ concatMap flatten (subForest tree)+    any+      (T.isInfixOf (T.toLower str) . T.toLower . descrTreeText)+      (concatMap flatten (subForest tree)) +-- | Fill facet view with descrs from selected module fillFacets :: TreeView     -> TreeStore ModuleRecord     -> TreeView     -> TreeStore Descr+    -> TypedTreeModelSort Descr     -> IO ()-fillFacets treeView treeStore descrView descrStore = do+fillFacets treeView treeStore descrView descrStore descrSortedStore = do     liftIO $ debugM "leksah" "fillFacets"-    sel             <-  getSelectionTree treeView treeStore+    sel        <- getSelectionTree treeView treeStore+    emptyModel <- treeStoreNew []+    treeViewSetModel descrView emptyModel+    treeStoreClear descrStore     case sel of         Just (_,Just (mod,package))-            ->  let forest = buildFacetForrest mod in do-                        emptyModel <- treeStoreNew []-                        treeViewSetModel descrView emptyModel-                        treeStoreClear descrStore-                        mapM_ (\(e,i) -> treeStoreInsertTree descrStore [] i e)-                                    $ zip forest [0 .. length forest]-                        treeViewSetModel descrView descrStore-                        treeViewSetEnableSearch descrView True-                        treeViewSetSearchEqualFunc descrView (Just (descrViewSearch descrView descrStore))-        otheriwse-            ->  treeStoreClear descrStore+            ->  mapM_ (\(e,i) -> treeStoreInsertTree descrStore [] i e)+                                    $ zip (buildFacetForrest mod) [0 ..]+        _   ->  return ()+    treeViewSetModel descrView descrSortedStore+    treeViewSetEnableSearch descrView True+    treeViewSetSearchEqualFunc descrView (Just (descrViewSearch descrView descrStore))+    liftIO $ debugM "leksah" "fillFacets done"  getSelectionTree ::  TreeView     ->  TreeStore ModuleRecord@@ -528,32 +540,37 @@             val     <-  treeStoreGetValue treeStore a             return (Just val) +-- | Get selected Descr, if any getSelectionDescr ::  TreeView     ->  TreeStore Descr+    -> TypedTreeModelSort Descr     -> IO (Maybe Descr)-getSelectionDescr treeView treeStore = do+getSelectionDescr treeView treeStore descrSortedStore = do     liftIO $ debugM "leksah" "getSelectionDescr"     treeSelection   <-  treeViewGetSelection treeView     paths           <-  treeSelectionGetSelectedRows treeSelection     case paths of-        a:r ->  do-            val     <-  treeStoreGetValue treeStore a+        a:_ ->  do+            unsorteda <- treeModelSortConvertPathToChildPath descrSortedStore a+            val     <-  treeStoreGetValue treeStore unsorteda             return (Just val)         _  ->  return Nothing -+-- | Fill info pane with selected Descr if any fillInfo :: TreeView     -> TreeStore Descr+    -> TypedTreeModelSort Descr     -> IDERef     -> IO ()-fillInfo treeView lst ideR  = do+fillInfo treeView lst descrSortedStore ideR  = do     liftIO $ debugM "leksah" "fillInfo"     treeSelection   <-  treeViewGetSelection treeView     paths           <-  treeSelectionGetSelectedRows treeSelection     case paths of         []      ->  return ()         [a]     ->  do-            descr    <-  treeStoreGetValue lst a+            unsorteda <- treeModelSortConvertPathToChildPath descrSortedStore a+            descr    <-  treeStoreGetValue lst unsorteda             reflectIDE (setInfo descr) ideR             return ()         _       ->  return ()@@ -578,9 +595,8 @@         SystemScope -> do             accessibleInfo'             <-  getSystemInfo             case accessibleInfo' of-                Nothing ->  liftIO $ do-                                        treeStoreClear (treeStore mods)-                                        --treeStoreInsertTree (treeStore mods) [] 0 (Node ("",[]) [])+                Nothing ->  liftIO $ treeStoreClear (treeStore mods)+                                     --treeStoreInsertTree (treeStore mods) [] 0 (Node ("",[]) [])                 Just (GenScopeC ai@(PackScope pm ps)) ->                     let p2  =   if useBlacklist                                     then PackScope (Map.filter (filterBlacklist@@ -647,7 +663,7 @@ descrTreeText (Real (RealDescr id _ _ _ _ (InstanceDescr binds) _)) = id <> " " <> printBinds binds     where         printBinds []       =   ""-        printBinds (a:[])   =   a+        printBinds [a]   =   a         printBinds (a:b)    =   a <> " " <> printBinds b descrTreeText d = dscName d @@ -672,38 +688,55 @@     buildFacet descr =             case dscTypeHint descr of                 DataDescr constructors fields ->-                    Node descr ((map (\(SimpleDescr fn ty loc comm exp) ->-                        Node (makeReexported descr (Real $ RealDescr{dscName' = fn, dscMbTypeStr' = ty,-                            dscMbModu' = dsMbModu descr, dscMbLocation' = loc,-                            dscMbComment' = comm, dscTypeHint' = ConstructorDescr descr, dscExported' = exp})) [])-                                constructors)-                                    ++  (map (\(SimpleDescr fn ty loc comm exp) ->-                                        Node (makeReexported descr (Real $-                                        RealDescr{dscName' = fn, dscMbTypeStr' = ty,-                                        dscMbModu' = dsMbModu descr, dscMbLocation' = loc,-                                        dscMbComment' = comm, dscTypeHint' = FieldDescr descr, dscExported' = exp})) [])-                                    fields))+                    Node descr (map+                                  (\ (SimpleDescr fn ty loc comm exp) ->+                                     Node+                                       (makeReexported descr+                                          (Real+                                             RealDescr{dscName' = fn, dscMbTypeStr' = ty,+                                                       dscMbModu' = dsMbModu descr, dscMbLocation' = loc,+                                                       dscMbComment' = comm, dscTypeHint' = ConstructorDescr descr,+                                                       dscExported' = exp}))+                                       [])+                                  constructors+                                  +++                                  map+                                    (\ (SimpleDescr fn ty loc comm exp) ->+                                       Node+                                         (makeReexported descr+                                            (Real+                                               RealDescr{dscName' = fn, dscMbTypeStr' = ty,+                                                         dscMbModu' = dsMbModu descr, dscMbLocation' = loc,+                                                         dscMbComment' = comm, dscTypeHint' = FieldDescr descr,+                                                         dscExported' = exp}))+                                         [])+                                    fields)                 NewtypeDescr (SimpleDescr fn ty loc comm exp) mbField ->-                    Node descr (Node (makeReexported descr (Real $-                            RealDescr{dscName' = fn, dscMbTypeStr' = ty,-                                dscMbModu' = dsMbModu descr, dscMbLocation' = loc,-                                dscMbComment' = comm, dscTypeHint' = ConstructorDescr descr, dscExported' = exp})) []+                    Node descr (Node (makeReexported descr (Real+                                                              RealDescr{dscName' = fn, dscMbTypeStr' = ty,+                                                                        dscMbModu' = dsMbModu descr, dscMbLocation' = loc,+                                                                        dscMbComment' = comm, dscTypeHint' = ConstructorDescr descr,+                                                                        dscExported' = exp})) []                                 : case  mbField of                                     Just (SimpleDescr fn ty loc comm exp) ->-                                        [Node (makeReexported descr (Real $ RealDescr{dscName' = fn, dscMbTypeStr' = ty,-                                        dscMbModu' = dsMbModu descr, dscMbLocation' = loc,-                                        dscMbComment' = comm, dscTypeHint' = FieldDescr descr, dscExported' = exp})) []]+                                        [Node (makeReexported descr (Real+                                                                       RealDescr{dscName' = fn, dscMbTypeStr' = ty,+                                                                                 dscMbModu' = dsMbModu descr, dscMbLocation' = loc,+                                                                                 dscMbComment' = comm, dscTypeHint' = FieldDescr descr,+                                                                                 dscExported' = exp})) []]                                     Nothing -> [])                 ClassDescr _ methods ->                     Node descr (map (\(SimpleDescr fn ty loc comm exp) ->-                        Node (makeReexported descr (Real $ RealDescr{dscName' = fn, dscMbTypeStr' = ty,-                            dscMbModu' = dsMbModu descr, dscMbLocation' = loc,-                            dscMbComment' = comm, dscTypeHint' = MethodDescr descr, dscExported' = exp})) [])+                        Node (makeReexported descr (Real+                                                      RealDescr{dscName' = fn, dscMbTypeStr' = ty,+                                                                dscMbModu' = dsMbModu descr, dscMbLocation' = loc,+                                                                dscMbComment' = comm, dscTypeHint' = MethodDescr descr,+                                                                dscExported' = exp})) [])                                 methods)                 _ -> Node descr []         where             makeReexported :: Descr -> Descr -> Descr-            makeReexported (Reexported d1) d2 = Reexported $ ReexportedDescr{dsrMbModu = dsrMbModu d1, dsrDescr = d2}+            makeReexported (Reexported d1) d2 = Reexported ReexportedDescr{dsrMbModu = dsrMbModu d1, dsrDescr = d2}             makeReexported _ d2               = d2      addInstances :: (DescrForest,[Descr])@@ -721,17 +754,17 @@     matches (Real (instDescr@RealDescr{dscTypeHint' = InstanceDescr binds}))                 (Node dd@(Real (RealDescr id _ _ _ _ (DataDescr _ _) _)) sub) (forest,False)         | not (null binds) && id == head binds-            =   ((Node dd (sub ++ [Node newInstDescr []])):forest,True)+            =   (Node dd (sub ++ [Node newInstDescr []]) : forest,True)         where newInstDescr = if isNothing (dscMbLocation' instDescr)                                 then Real $ instDescr{dscMbLocation' = dscMbLocation dd}-                                else Real $ instDescr+                                else Real instDescr     matches (Real (instDescr@RealDescr{dscTypeHint' = InstanceDescr binds}))                 (Node dd@(Real (RealDescr id _ _ _ _ (NewtypeDescr _ _) _)) sub) (forest,False)         | not (null binds) && id == head binds-            =   ((Node dd (sub ++ [Node newInstDescr []])):forest,True)+            =   (Node dd (sub ++ [Node newInstDescr []]) : forest,True)         where newInstDescr = if isNothing (dscMbLocation' instDescr)                                 then Real $ instDescr{dscMbLocation' = dscMbLocation dd}-                                else Real $ instDescr+                                else Real instDescr     matches _ node (forest,b)  = (node:forest,b)  @@ -754,7 +787,7 @@ insertPairsInTree tree pair =     let nameArray           =   map T.pack . components . modu . mdModuleId $ fst pair         (startArray,last)   =   splitAt (length nameArray - 1) nameArray-        pairedWith          =   (map (\n -> (n,Nothing)) startArray) ++ [(head last,Just pair)]+        pairedWith          =   map (\ n -> (n, Nothing)) startArray ++ [(head last, Just pair)]     in  insertNodesInTree pairedWith tree  @@ -834,25 +867,24 @@         case mbFile of             Nothing     ->  return ()             Just fp     ->  do-                resp <- reflectIDE (respDelModDialog)ideR-                if (resp == False) then return ()-                    else do+                resp <- reflectIDE respDelModDialog ideR+                when resp $ do                         exists <- doesFileExist fp                         if exists                            then do                              reflectIDE (liftIO $ removeFile fp) ideR                              reflectIDE (packageTry $ delModule treeView store)ideR-                           else do+                           else                              reflectIDE (packageTry $ delModule treeView store)ideR                         reflectIDE (packageTry packageConfig) ideR                         return ()     sel         <-  getSelectionTree treeView store     case sel of-        Just (s, Nothing) -> do+        Just (s, Nothing) ->             mapM_ (menuShellAppend theMenu) [castToMenuItem item1, castToMenuItem sep1, castToMenuItem item2,                 castToMenuItem item3, castToMenuItem item4, castToMenuItem item5, castToMenuItem sep2,                 castToMenuItem item6]-        Just (_,Just (m,_)) -> do+        Just (_,Just (m,_)) ->             mapM_ (menuShellAppend theMenu) [castToMenuItem item1, castToMenuItem sep1, castToMenuItem item2,                 castToMenuItem item3, castToMenuItem item4, castToMenuItem item5, castToMenuItem sep2,                 castToMenuItem item6, castToMenuItem item7]@@ -870,37 +902,42 @@     mbFile <- getSelectedModuleFile <$> getSelectionTree treeView store     case mbFile of         Nothing -> return ()-        Just fp -> liftIO $ reflectIDE (selectSourceBuf fp) ideR >> return ()+        Just fp -> liftIO $ void (reflectIDE (selectSourceBuf fp) ideR) +-- | Build contextual menu on selected Descr descrViewContextMenu :: IDERef                    -> TreeStore Descr+                   -> TypedTreeModelSort Descr                    -> TreeView                    -> Menu                    -> IO ()-descrViewContextMenu ideR store descrView theMenu = do+descrViewContextMenu ideR store descrSortedStore descrView theMenu = do     liftIO $ debugM "leksah" "descrViewContextMenu"     item1           <-  menuItemNewWithLabel (__ "Go to definition")     item1 `on` menuItemActivate $ do-        sel         <-  getSelectionDescr descrView store+        sel         <-  getSelectionDescr descrView store descrSortedStore         case sel of             Just descr      ->  reflectIDE (goToDefinition descr) ideR             otherwise       ->  sysMessage Normal (__ "Modules>> descrViewPopup: no selection")     item2           <-  menuItemNewWithLabel (__ "Insert in buffer")     item2 `on` menuItemActivate $ do-        sel         <-  getSelectionDescr descrView store+        sel         <-  getSelectionDescr descrView store descrSortedStore         case sel of             Just descr      ->  reflectIDE (insertInBuffer descr) ideR             otherwise       ->  sysMessage Normal (__ "Modules>> descrViewPopup: no selection")     mapM_ (menuShellAppend theMenu) [item1, item2] +-- | Selects the Descr referenced by the path descrViewSelect :: IDERef               -> TreeStore Descr+              -> TypedTreeModelSort Descr               -> TreePath               -> TreeViewColumn               -> IO ()-descrViewSelect ideR store path _ = do+descrViewSelect ideR store descrSortedStore path _ = do     liftIO $ debugM "leksah" "descrViewSelect"-    descr <- treeStoreGetValue store path+    unsortedp <- treeModelSortConvertPathToChildPath descrSortedStore path+    descr <- treeStoreGetValue store unsortedp     reflectIDE (goToDefinition descr) ideR  setScope :: (Scope,Bool) -> IDEAction@@ -939,11 +976,10 @@     rb3s                <-  liftIO $ toggleButtonGetActive (systemScopeB mods)     cb1s                <-  liftIO $ toggleButtonGetActive (dependsB mods)     cbs                 <-  liftIO $ toggleButtonGetActive (blacklistB mods)-    let scope           =   if rb1s-                                then PackageScope cb1s-                                else if rb2s-                                    then WorkspaceScope cb1s-                                    else SystemScope+    let scope+          | rb1s      = PackageScope cb1s+          | rb2s      = WorkspaceScope cb1s+          | otherwise = SystemScope     return (scope,cbs)  scopeSelection :: IDEAction@@ -959,7 +995,7 @@     recordExpanderState     mods                <-  getModules Nothing     mbTreeSelection     <-  liftIO $ getSelectionTree (treeView mods) (treeStore mods)-    mbDescrSelection    <-  liftIO $ getSelectionDescr (descrView mods) (descrStore mods)+    mbDescrSelection    <-  liftIO $ getSelectionDescr (descrView mods) (descrStore mods) (descrSortedStore mods)      ts                  <-  liftIO $ treeViewGetSelection (treeView mods)     withoutRecordingDo $ do@@ -1009,7 +1045,8 @@                                 selF          <-  treeViewGetSelection (descrView mods)                                 case  findPathFor symbol mbDescrTree of                                     Nothing     ->  sysMessage Normal (__ "no path found")-                                    Just path   ->  do+                                    Just childPath   ->  do+                                        path    <- treeModelSortConvertChildPathToPath (descrSortedStore mods) childPath                                         treeSelectionSelectPath selF path                                         col     <-  treeViewGetColumn (descrView mods) 0                                         treeViewScrollToCell (descrView mods) (Just path) col@@ -1017,7 +1054,7 @@  reloadKeepSelection :: Bool -> IDEAction reloadKeepSelection isInitial = do-    liftIO . debugM "leksah" $ (T.unpack $ __ ">>>Info Changed!!! ") ++ show isInitial+    liftIO . debugM "leksah" $ T.unpack (__ ">>>Info Changed!!! ") ++ show isInitial     mbMod <- getPane     case mbMod of         Nothing -> return ()@@ -1026,7 +1063,7 @@             if not $ isStartingOrClosing state                 then do                     mbTreeSelection     <-  liftIO $ getSelectionTree (treeView mods) (treeStore mods)-                    mbDescrSelection    <-  liftIO $ getSelectionDescr (descrView mods) (descrStore mods)+                    mbDescrSelection    <-  liftIO $ getSelectionDescr (descrView mods) (descrStore mods) (descrSortedStore mods)                     sc                  <-  getScope                     recordExpanderState                     fillModulesList sc@@ -1040,14 +1077,12 @@                      applyExpanderState                     selectNames mbs-                else if isInitial == True-                        then do+                else when isInitial $ do                             SelectionState moduleS' facetS' sc bl <- liftIO $ readIORef (oldSelection mods)                             setScope (sc,bl)                             fillModulesList (sc, bl)                             selectNames (moduleS', facetS')                             applyExpanderState-                        else return ()  treeStoreGetTreeSave :: TreeStore a -> TreePath -> IO (Maybe (Tree a)) treeStoreGetTreeSave treeStore treePath = catch (do@@ -1062,7 +1097,7 @@     paths <- treeSelectionGetSelectedRows sel     case paths of         []     -> return ()-        (hd:_) -> treeViewExpandRow treeView hd True >> return ()+        (hd:_) -> void (treeViewExpandRow treeView hd True)  collapseHere :: TreeView -> IO () collapseHere treeView = do@@ -1071,18 +1106,18 @@     paths <- treeSelectionGetSelectedRows sel     case paths of         []     -> return ()-        (hd:_) -> treeViewCollapseRow treeView hd >> return ()+        (hd:_) -> void (treeViewCollapseRow treeView hd)  delModule :: TreeView -> TreeStore ModuleRecord -> PackageAction delModule treeview store = do     liftIO $ debugM "leksah" "delModule"-    window <- liftIDE $ getMainWindow+    window <- liftIDE getMainWindow     sel   <- liftIO $ treeViewGetSelection treeview     paths <- liftIO $ treeSelectionGetSelectedRows sel     categories <- case paths of         []     -> return []-        (treePath:_) -> liftIO $ mapM (treeStoreGetValue store)-                                    $ map (\n -> take n treePath)  [1 .. length treePath]+        (treePath:_) -> liftIO $ mapM (treeStoreGetValue store . (`take` treePath))+                                   [1 .. length treePath]      liftIDE $ ideMessage Normal (T.pack $ printf (__ "categories: %s") (show categories)) @@ -1094,7 +1129,7 @@                          liftIDE $ ideMessage Normal ("modName: " <> T.pack (show modName))                          delModuleFromPackageDescr modName -respDelModDialog :: IDEM (Bool)+respDelModDialog :: IDEM Bool respDelModDialog = do     liftIO $ debugM "leksah" "respDelModDialog"     window <- getMainWindow@@ -1115,8 +1150,8 @@     paths <- liftIO $ treeSelectionGetSelectedRows sel     categories <- case paths of         []     -> return []-        (treePath:_) -> liftIO $ mapM (treeStoreGetValue store)-                                    $ map (\n -> take n treePath)  [1 .. length treePath]+        (treePath:_) -> liftIO $ mapM (treeStoreGetValue store . (`take` treePath))+                                   [1 .. length treePath]     addModule categories  -- Includes non buildable@@ -1129,13 +1164,12 @@ addModule :: [ModuleRecord] -> PackageAction addModule categories = do     liftIO $ debugM "leksah" "selectIdentifier"-    mbPD <- liftIDE $ getPackageDescriptionAndPath+    mbPD <- liftIDE getPackageDescriptionAndPath     case mbPD of         Nothing             -> liftIDE $ ideMessage Normal (__ "No package description")         Just (pd,cabalPath) -> let srcPaths = nub $ concatMap hsSourceDirs $ allBuildInfo' pd                                    rootPath = dropFileName cabalPath-                                   modPath  = foldr (\a b -> a <> "." <> b) ""-                                                (map fst categories)+                                   modPath  = foldr ((\ a b -> a <> "." <> b) . fst) "" categories                                in do             window' <- liftIDE getMainWindow             mbResp <- liftIO $ addModuleDialog window' modPath srcPaths (hasLibs pd) $@@ -1185,7 +1219,7 @@     liftIO $ debugM "leksah" "addModuleDialog"     dia                        <-   dialogNew     set dia [ windowTransientFor := parent-            , windowTitle := (__ "Construct new module") ]+            , windowTitle := __ "Construct new module" ]     windowSetDefaultSize dia 400 100 #ifdef MIN_VERSION_gtk3     upper                      <-   dialogGetContentArea dia@@ -1239,31 +1273,32 @@ moduleFields :: [FilePath] -> Bool -> [Text] -> FieldDescription AddModule moduleFields list hasLibs exesTests = VFD emptyParams $ [         mkField-            (paraName <<<- ParaName ((__ "New module "))+            (paraName <<<- ParaName (__ "New module ")                     $ emptyParams)             moduleName             (\ a b -> b{moduleName = a})             (textEditor (const True) True),         mkField-            (paraName <<<- ParaName ((__ "Root of the source path"))+            (paraName <<<- ParaName (__ "Root of the source path")                 $ paraMultiSel <<<- ParaMultiSel False                     $ paraMinSize <<<- ParaMinSize (-1, 120)                         $ emptyParams)-            (\a -> T.pack $ sourceRoot a)+            (T.pack . sourceRoot)             (\ a b -> b{sourceRoot = T.unpack a})             (staticListEditor (map T.pack list) id)]-        ++ (if hasLibs-                then [-                    mkField-                        (paraName <<<- ParaName ((__ "Library should"))-                                $ emptyParams)-                        libExposed-                        (\ a b -> b{libExposed = a})-                        (maybeEditor (boolEditor, paraName <<<- ParaName ((__ "Expose module")) $ emptyParams) True (__ "Include module"))]-                else [])+        ++ [mkField+              (paraName <<<- ParaName (__ "Library should") $ emptyParams)+              libExposed+              (\ a b -> b{libExposed = a})+              (maybeEditor+                 (boolEditor,+                  paraName <<<- ParaName (__ "Expose module") $ emptyParams)+                 True+                 (__ "Include module"))+            | hasLibs]         ++ map (\ name ->             mkField-                (paraName <<<- ParaName ((__ "Include in ") <> name)+                (paraName <<<- ParaName (__ "Include in " <> name)                         $ emptyParams)                 (Set.member name . exesAndTests)                 (\ a b -> b{exesAndTests = (if a then Set.insert else Set.delete) name (exesAndTests b)})@@ -1284,15 +1319,15 @@         paths2 <-  getExpandedRows (descrView m) (descrStore m)         modifyIORef (expanderState m) (\ es ->             case (sc,bl) of-                ((PackageScope False),True)    -> es{packageExp          = (paths1,paths2)}-                ((PackageScope False),False)   -> es{packageExpNoBlack   = (paths1,paths2)}-                (PackageScope True,True)  -> es{packageDExp        = (paths1,paths2)}-                (PackageScope True,False) -> es{packageDExpNoBlack = (paths1,paths2)}+                (PackageScope False, True)  -> es{packageExp         = (paths1,paths2)}+                (PackageScope False, False) -> es{packageExpNoBlack  = (paths1,paths2)}+                (PackageScope True, True)   -> es{packageDExp        = (paths1,paths2)}+                (PackageScope True, False)  -> es{packageDExpNoBlack = (paths1,paths2)} -                ((WorkspaceScope False),True)    -> es{workspaceExp          = (paths1,paths2)}-                ((WorkspaceScope False),False)   -> es{workspaceExpNoBlack   = (paths1,paths2)}-                (WorkspaceScope True,True)  -> es{workspaceDExp        = (paths1,paths2)}-                (WorkspaceScope True,False) -> es{workspaceDExpNoBlack = (paths1,paths2)}+                (WorkspaceScope False, True)  -> es{workspaceExp         = (paths1,paths2)}+                (WorkspaceScope False, False) -> es{workspaceExpNoBlack  = (paths1,paths2)}+                (WorkspaceScope True,True)    -> es{workspaceDExp        = (paths1,paths2)}+                (WorkspaceScope True,False)   -> es{workspaceDExpNoBlack = (paths1,paths2)}                  (SystemScope,True)   -> es{systemExp         = (paths1,paths2)}                 (SystemScope,False)  -> es{systemExpNoBlack  = (paths1,paths2)})@@ -1333,18 +1368,18 @@     liftIO $ do         es <- readIORef (expanderState m)         let (paths1,paths2) = case (sc,bl) of-                                ((PackageScope False),True)      -> packageExp es-                                ((PackageScope False),False)     -> packageExpNoBlack es-                                (PackageScope True,True)         -> packageDExp es-                                (PackageScope True,False)        -> packageDExpNoBlack es-                                ((WorkspaceScope False),True)    -> workspaceExp es-                                ((WorkspaceScope False),False)   -> workspaceExpNoBlack es-                                (WorkspaceScope True,True)       -> workspaceDExp es-                                (WorkspaceScope True,False)      -> workspaceDExpNoBlack es-                                (SystemScope,True)               -> systemExp es-                                (SystemScope,False)              -> systemExpNoBlack es-        mapM_ (\p -> treeViewExpandToPath (treeView m) p) paths1-        mapM_ (\p -> treeViewExpandToPath (descrView m) p) paths2+                                (PackageScope False, True)      -> packageExp es+                                (PackageScope False, False)     -> packageExpNoBlack es+                                (PackageScope True,True)        -> packageDExp es+                                (PackageScope True,False)       -> packageDExpNoBlack es+                                (WorkspaceScope False, True)    -> workspaceExp es+                                (WorkspaceScope False, False)   -> workspaceExpNoBlack es+                                (WorkspaceScope True,True)      -> workspaceDExp es+                                (WorkspaceScope True,False)     -> workspaceDExpNoBlack es+                                (SystemScope,True)              -> systemExp es+                                (SystemScope,False)             -> systemExpNoBlack es+        mapM_ (treeViewExpandToPath (treeView m)) paths1+        mapM_ (treeViewExpandToPath (descrView m)) paths2  -- * GUI History @@ -1354,7 +1389,7 @@     mods <- getModules Nothing     ideR <- ask     selTree <- liftIO $ getSelectionTree (treeView mods) (treeStore mods)-    selDescr <- liftIO $ getSelectionDescr (descrView mods) (descrStore mods)+    selDescr <- liftIO $ getSelectionDescr (descrView mods) (descrStore mods) (descrSortedStore mods)     let selMod = case selTree of                         Just (_,Just (md,_)) -> Just (modu $ mdModuleId md)                         otherwise -> Nothing@@ -1362,8 +1397,8 @@                         Nothing -> Nothing                         Just descr -> Just (dscName descr)     oldSel       <- liftIO $ readIORef (oldSelection mods)-    triggerEventIDE (RecordHistory ((ModuleSelected selMod selFacet),-        (ModuleSelected (moduleS' oldSel) (facetS' oldSel))))+    triggerEventIDE (RecordHistory (ModuleSelected selMod selFacet,+                                    ModuleSelected (moduleS' oldSel) (facetS' oldSel)))     liftIO $ writeIORef (oldSelection mods) (oldSel{moduleS'= selMod, facetS' = selFacet})     return () @@ -1383,8 +1418,8 @@     ideR                    <-  ask     mods                    <-  getModules Nothing     oldSel                  <-  liftIO $ readIORef (oldSelection mods)-    triggerEventIDE (RecordHistory ((ScopeSelected sc bl),-        (ScopeSelected (scope' oldSel) (blacklist' oldSel))))+    triggerEventIDE (RecordHistory (ScopeSelected sc bl,+                                    ScopeSelected (scope' oldSel) (blacklist' oldSel)))     liftIO $ writeIORef (oldSelection mods) (oldSel{scope'= sc, blacklist' = bl})     return () @@ -1394,9 +1429,9 @@     mods <-  getModules Nothing     liftIO $ do         toggleButtonSetActive (blacklistB mods) bl-        toggleButtonSetActive (packageScopeB mods) (sc == (PackageScope False))+        toggleButtonSetActive (packageScopeB mods)   (sc == PackageScope False)         toggleButtonSetActive (workspaceScopeB mods) (sc == PackageScope True)-        toggleButtonSetActive (systemScopeB mods) (sc == SystemScope)+        toggleButtonSetActive (systemScopeB mods)    (sc == SystemScope)     setScope (sc,bl)     oldSel <- liftIO $ readIORef (oldSelection mods)     liftIO $ writeIORef (oldSelection mods) (oldSel{scope'= sc, blacklist' = bl})

@@ -78,8 +78,7 @@        (Notifier, Editor(..), GUIEventSelector(..), GUIEvent(..)) import Distribution.Compiler     (CompilerFlavor(..))-import Distribution.Simple (knownExtensions)-import Distribution.Simple (Extension(..), VersionRange, anyVersion)+import Distribution.Simple (knownExtensions, Extension(..), VersionRange, anyVersion) import Default (Default(..)) import IDE.Utils.GUIUtils import IDE.Pane.SourceBuffer (fileOpenThis)@@ -91,7 +90,7 @@ import Control.Monad.Trans.Reader (ask) import Control.Monad.IO.Class (MonadIO(..)) import Control.Monad.Trans.Class (lift)-import Control.Monad (when)+import Control.Monad (void, when) import Distribution.PackageDescription.PrettyPrint        (writeGenericPackageDescription) import Distribution.Version (Version(..), orLaterVersion)@@ -167,10 +166,12 @@ --  choosePackageDir :: Window -> Maybe FilePath -> IO (Maybe FilePath)-choosePackageDir window mbDir = chooseDir window (__ "Select root folder for package") mbDir+choosePackageDir window+  = chooseDir window (__ "Select root folder for package")  choosePackageFile :: Window -> Maybe FilePath -> IO (Maybe FilePath)-choosePackageFile window mbDir = chooseFile window (__ "Select cabal package file (.cabal)") mbDir+choosePackageFile window+  = chooseFile window (__ "Select cabal package file (.cabal)")  packageEdit :: PackageAction packageEdit = do@@ -208,27 +209,23 @@                         Nothing -> False                         Just condTree -> not (null (condTreeComponents condTree))         exeConds = foldr (\ (_,condTree) hasConfigs ->-                                if hasConfigs-                                    then True-                                    else not (null (condTreeComponents condTree)))+                                (hasConfigs || not (null (condTreeComponents condTree))))                         False (condExecutables gpd)         testConds = foldr (\ (_,condTree) hasConfigs ->-                                if hasConfigs-                                    then True-                                    else not (null (condTreeComponents condTree)))+                                (hasConfigs || not (null (condTreeComponents condTree))))                         False (condTestSuites gpd)     in libConds || exeConds || testConds  hasUnknownTestTypes :: PackageDescription -> Bool hasUnknownTestTypes pd =-    not . null . filter unknown $ testSuites pd+    any unknown $ testSuites pd   where     unknown (TestSuite _ (TestSuiteExeV10 _ _) _ _) = False     unknown _ = True  hasUnknownBenchmarkTypes :: PackageDescription -> Bool hasUnknownBenchmarkTypes pd =-    not . null . filter unknown $ benchmarks pd+    any unknown $ benchmarks pd   where     unknown (Benchmark _ (BenchmarkExeV10 _ _) _ _) = False     unknown _ = True@@ -241,20 +238,20 @@ packageFields :: FilePath -> FieldDescription NewPackage packageFields workspaceDir = VFD emptyParams [         mkField-            (paraName <<<- ParaName ((__ "New package name"))+            (paraName <<<- ParaName (__ "New package name")                     $ emptyParams)             newPackageName             (\ a b -> b{newPackageName = a})             (textEditor (const True) True),         mkField-            (paraName <<<- ParaName ((__ "Parent directory"))+            (paraName <<<- ParaName (__ "Parent directory")                 $ paraMinSize <<<- ParaMinSize (-1, 120)                     $ emptyParams)-            (\a -> newPackageParentDir a)+            newPackageParentDir             (\ a b -> b{newPackageParentDir = a})             (fileEditor (Just workspaceDir) FileChooserActionSelectFolder "Select"),         mkField-            (paraName <<<- ParaName ((__ "Copy existing package"))+            (paraName <<<- ParaName (__ "Copy existing package")                     $ emptyParams)             templatePackage             (\ a b -> b{templatePackage = a})@@ -269,7 +266,7 @@ newPackageDialog parent workspaceDir = do     dia                        <-   dialogNew     set dia [ windowTransientFor := parent-            , windowTitle := (__ "Create New Package") ]+            , windowTitle := __ "Create New Package" ] #ifdef MIN_VERSION_gtk3     upper                      <-   dialogGetContentArea dia #else@@ -298,7 +295,7 @@     mbNewPackage <- liftIO $ newPackageDialog (head windows) workspaceDir     case mbNewPackage of         Nothing -> return ()-        Just NewPackage{..} | templatePackage == Nothing -> do+        Just NewPackage{..} | isNothing templatePackage -> do             let dirName = newPackageParentDir </> T.unpack newPackageName             mbCabalFile <-  liftIO $ cabalFileName dirName             window <- getMainWindow@@ -350,7 +347,7 @@                                   , defaultLanguage = Just Haskell2010}}]                           , testSuites = [emptyTestSuite {                                     testName = "test-" ++ T.unpack newPackageName-                                  , testInterface = (TestSuiteExeV10 (Version [1,0] []) "Main.hs")+                                  , testInterface = TestSuiteExeV10 (Version [1,0] []) "Main.hs"                                   , testBuildInfo = emptyBuildInfo {                                         hsSourceDirs    = ["test"]                                       , targetBuildDepends = [@@ -377,16 +374,16 @@ cloneFields :: [PackageId] -> FilePath -> FieldDescription ClonePackageSourceRepo cloneFields packages workspaceDir = VFD emptyParams [         mkField-            (paraName <<<- ParaName ((__ "Existing package to clone source repository"))+            (paraName <<<- ParaName (__ "Existing package to clone source repository")                     $ emptyParams)             packageToClone             (\ a b -> b{packageToClone = a})             (comboEntryEditor ((sort . nub) (map (T.pack . display . pkgName) packages))),         mkField-            (paraName <<<- ParaName ((__ "Parent directory"))+            (paraName <<<- ParaName (__ "Parent directory")                 $ paraMinSize <<<- ParaMinSize (-1, 120)                     $ emptyParams)-            (\a -> cloneParentDir a)+            cloneParentDir             (\ a b -> b{cloneParentDir = a})             (fileEditor (Just workspaceDir) FileChooserActionSelectFolder "Select")] @@ -395,7 +392,7 @@     packages                   <- getInstalledPackageIds     dia                        <-   dialogNew     set dia [ windowTransientFor := parent-            , windowTitle := (__ "Clone Package") ]+            , windowTitle := __ "Clone Package" ] #ifdef MIN_VERSION_gtk3     upper                      <-   dialogGetContentArea dia #else@@ -434,7 +431,7 @@         when oldDirExists $ removeDirectoryRecursive tempDir         createDirectory tempDir     runExternalTool' (__ "Unpacking") "cabal" (["unpack"]-              ++ (if sourceRepo then ["--source-repository"] else [])+              ++ ["--source-repository" | sourceRepo]               ++ ["--destdir=" <> T.pack tempDir, packageToUnpack]) tempDir $ do         mbLastOutput <- C.getZipSink $ const <$> C.ZipSink sinkLast <*> C.ZipSink log         case mbLastOutput of@@ -445,17 +442,17 @@                         liftIO $ removeDirectoryRecursive tempDir                         lift $ ideMessage High $ "Nothing found in " <> T.pack tempDir <> " after doing a cabal unpack."                     [repoName] -> do-                        let destDir = parentDir </> (fromMaybe repoName $ T.unpack <$> mbNewName)+                        let destDir = parentDir </> fromMaybe repoName (T.unpack <$> mbNewName)                         exists <- liftIO $ (||) <$> doesDirectoryExist destDir <*> doesFileExist destDir                         if exists                             then lift $ ideMessage High $ T.pack destDir <> " already exists"                             else do                                 liftIO $ renameDirectory (tempDir </> repoName) destDir                                 mbCabalFile <- liftIO $ cabalFileName destDir-                                window <- lift $ getMainWindow+                                window <- lift getMainWindow                                 lift $ case (mbCabalFile, mbNewName) of                                     (Just cfn, Just newName) -> do-                                        let newCfn = takeDirectory cfn </> (T.unpack newName) ++ ".cabal"+                                        let newCfn = takeDirectory cfn </> T.unpack newName ++ ".cabal"                                         when (cfn /= newCfn) . liftIO $ do                                             s <- T.readFile cfn                                             T.writeFile newCfn $ renameCabalFile (T.pack $ takeBaseName cfn) newName s@@ -480,7 +477,7 @@         prefixesWithLength = zip prefixes $ map T.length prefixes         renameLine :: Text -> Text         renameLine line =-            case catMaybes $ map (rename (line, T.toLower line)) prefixesWithLength of+            case mapMaybe (rename (line, T.toLower line)) prefixesWithLength of                 l:_ -> l                 []  -> line         rename :: (Text, Text) -> (Text, Int) -> Maybe Text@@ -545,11 +542,11 @@  toEditor :: PackageDescription -> PackageDescriptionEd toEditor pd =-    let     (exes,exeBis) = unzip $ map (\((Executable s fb bi), i) -> ((Executable' (T.pack s) fb i), bi))+    let     (exes,exeBis) = unzip $ map (\(Executable s fb bi, i) -> (Executable' (T.pack s) fb i, bi))                             (zip (executables pd) [0..])-            (tests,testBis) = unzip $ map (\((TestSuite s fb bi _), i) -> ((Test' (T.pack s) fb i), bi))+            (tests,testBis) = unzip $ map (\(TestSuite s fb bi _, i) -> (Test' (T.pack s) fb i, bi))                             (zip (testSuites pd) [length exeBis..])-            (bms,benchmarkBis) = unzip $ map (\((Benchmark s fb bi _), i) -> ((Benchmark' (T.pack s) fb i), bi))+            (bms,benchmarkBis) = unzip $ map (\(Benchmark s fb bi _, i) -> (Benchmark' (T.pack s) fb i, bi))                             (zip (benchmarks pd) [length testBis..])             bis = exeBis ++ testBis ++ benchmarkBis             (mbLib,bis2) = case library pd of@@ -584,7 +581,7 @@  instance Pane PackagePane IDEM     where-    primPaneName _  =   (__ "Package")+    primPaneName _  =   __ "Package"     getAddedIndex _ =   0     getTopWidget    =   castToWidget . packageBox     paneId b        =   "*Package"@@ -602,7 +599,7 @@         Nothing -> do             pp  <- getBestPathForId "*Package"             nb  <- getNotebook pp-            packageInfos <- liftIO $ getInstalledPackageIds+            packageInfos <- liftIO getInstalledPackageIds             let packageEd = toEditor packageD             initPackage packagePath packageEd                 (packageDD@@ -627,17 +624,15 @@ initPackage packageDir packageD packageDescr panePath nb modules afterSaveAction origPackageD = do     let fields =  flattenFieldDescription packageDescr     let initialPackagePath = packageDir </> (display . pkgName . package . pd) packageD ++ ".cabal"-    packageInfos <- liftIO $ getInstalledPackageIds+    packageInfos <- liftIO getInstalledPackageIds     mbP <- buildThisPane panePath nb         (builder' packageDir packageD packageDescr afterSaveAction             initialPackagePath modules packageInfos fields origPackageD)     case mbP of         Nothing -> return ()         Just (PackagePane{packageNotifer = pn}) -> do-            liftIO $ triggerEvent pn (GUIEvent {-                    selector = MayHaveChanged,-                    eventText = "",-                    gtkReturn = True})+            liftIO $ triggerEvent pn GUIEvent{selector = MayHaveChanged, eventText = "",+                                              gtkReturn = True}             return ()  builder' :: FilePath ->@@ -673,18 +668,16 @@     boxPackStart vb label PackNatural 0     boxPackEnd vb bb PackNatural 7 -    let fieldNames = map (\fd -> case getParameterPrim paraName (parameters fd) of-                                    Just s -> s-                                    Nothing -> (__ "Unnamed")) fields+    let fieldNames = map (fromMaybe (__ "Unnamed") . getParameterPrim paraName . parameters) fields     on addB buttonActivated $ do         mbNewPackage' <- extract packageD [getExt]         case mbNewPackage' of             Nothing -> sysMessage Normal (__ "Content doesn't validate")             Just pde -> reflectIDE (do                     closePane packagePane-                    initPackage packageDir pde {bis = bis pde ++ [bis pde !! 0]}+                    initPackage packageDir pde {bis = bis pde ++ [head (bis pde)]}                         (packageDD-                            (packageInfos)+                            packageInfos                             packageDir                             modules                             (length (bis pde) + 1)@@ -713,7 +706,7 @@                                 Nothing -> False                                 Just p -> p /= origPackageD         if not hasChanged-            then reflectIDE (closePane packagePane >> return ()) ideR+            then reflectIDE (void (closePane packagePane)) ideR             else do                 md <- messageDialogNew (Just window) []                     MessageQuestion@@ -723,8 +716,7 @@                 resp <- dialogRun md                 widgetDestroy md                 case resp of-                    ResponseYes ->   do-                        reflectIDE (closePane packagePane >> return ()) ideR+                    ResponseYes ->   reflectIDE (void (closePane packagePane)) ideR                     _  ->   return ()     on save buttonActivated $ do         mbNewPackage' <- extract packageD [getExt]@@ -765,7 +757,7 @@     -> [(Text, FieldDescription PackageDescriptionEd)]     -> FieldDescription PackageDescriptionEd packageDD packages fp modules numBuildInfos extras = NFD ([-    ((__ "Package"), VFD emptyParams [+    (__ "Package", VFD emptyParams [         mkField             (paraName <<<- ParaName (__ "Synopsis")            $ paraSynopsis <<<- ParaSynopsis (__ "A one-line summary of this package")@@ -803,7 +795,7 @@             (\ a b -> b{pd = (pd b){category = a}})             (stringEditor (const True) True)     ]),-    ((__ "Description"), VFD emptyParams [+    (__ "Description", VFD emptyParams [         mkField             (paraName <<<- ParaName (__ "Stability") $ emptyParams)             (stability . pd)@@ -859,7 +851,7 @@ --            (sourceRepos . pd) --            (\ a b -> b{pd = (pd b){sourceRepos = a}}) --            reposEditor]),-    ((__ "Dependencies  "), VFD emptyParams [+    (__ "Dependencies  ", VFD emptyParams [         mkField             (paraName <<<- ParaName (__ "Build Dependencies")                 $ paraSynopsis <<<- ParaSynopsis (__ "Does this package depends on other packages?")@@ -870,7 +862,7 @@             (\ a b -> b{pd = (pd b){buildDepends = a}})             (dependenciesEditor packages)     ]),-    ((__ "Meta Dep."), VFD emptyParams [+    (__ "Meta Dep.", VFD emptyParams [         mkField             (paraName <<<- ParaName (__ "Cabal version")                 $ paraSynopsis <<<- ParaSynopsis@@ -891,7 +883,7 @@             (\ a b -> b{pd = (pd b){testedWith = a}})             testedWithEditor     ]),-    ((__ "Data Files"), VFD emptyParams [+    (__ "Data Files", VFD emptyParams [         mkField             (paraName <<<- ParaName (__ "Data Files")                 $ paraSynopsis <<<- ParaSynopsis@@ -908,7 +900,7 @@             (\ a b -> b{pd = (pd b){dataDir = a}})             (fileEditor (Just fp) FileChooserActionSelectFolder (__ "Select file"))     ]),-    ((__ "Extra Files"), VFD emptyParams [+    (__ "Extra Files", VFD emptyParams [         mkField             (paraName <<<- ParaName (__ "Extra Source Files")                 $ paraSynopsis <<<- ParaSynopsis@@ -930,7 +922,7 @@             (\ a b -> b{pd = (pd b){extraTmpFiles = a}})             (filesEditor (Just fp) FileChooserActionOpen (__ "Select File"))     ]),-    ((__ "Other"),VFD emptyParams  [+    (__ "Other",VFD emptyParams  [         mkField             (paraName <<<- ParaName (__ "Build Type")                 $ paraSynopsis <<<- ParaSynopsis@@ -949,15 +941,15 @@             (customFieldsPD . pd)             (\ a b -> b{pd = (pd b){customFieldsPD = a}})             (multisetEditor-                (ColumnDescr True [((__ "Name"),\(n,_) -> [cellText := T.pack n])-                                   ,((__ "Value"),\(_,v) -> [cellText := T.pack v])])-                ((pairEditor-                    (stringxEditor (const True),emptyParams)-                    (stringEditor (const True) True,emptyParams)),emptyParams)+                (ColumnDescr True [(__ "Name",\(n,_) -> [cellText := T.pack n])+                                   ,(__ "Value",\(_,v) -> [cellText := T.pack v])])+                (pairEditor (stringxEditor (const True), emptyParams)+                   (stringEditor (const True) True, emptyParams),+                 emptyParams)             Nothing             Nothing)     ]),-    ((__ "Executables"),VFD emptyParams  [+    (__ "Executables",VFD emptyParams  [         mkField             (paraName <<<- ParaName (__ "Executables")                 $ paraSynopsis <<<- ParaSynopsis@@ -967,7 +959,7 @@             (\ a b -> b{exes = a})             (executablesEditor (Just fp) modules numBuildInfos)     ]),-    ((__ "Tests"),VFD emptyParams  [+    (__ "Tests",VFD emptyParams  [         mkField             (paraName <<<- ParaName (__ "Tests")                 $ paraSynopsis <<<- ParaSynopsis@@ -977,7 +969,7 @@             (\ a b -> b{tests = a})             (testsEditor (Just fp) modules numBuildInfos)     ]),-    ((__ "Benchmarks"),VFD emptyParams  [+    (__ "Benchmarks",VFD emptyParams  [         mkField             (paraName <<<- ParaName (__ "Benchmarks")                 $ paraSynopsis <<<- ParaSynopsis@@ -987,7 +979,7 @@             (\ a b -> b{bms = a})             (benchmarksEditor (Just fp) modules numBuildInfos)     ]),-    ((__ "Library"), VFD emptyParams [+    (__ "Library", VFD emptyParams [         mkField             (paraName <<<- ParaName (__ "Library")            $ paraSynopsis <<<- ParaSynopsis@@ -1012,10 +1004,10 @@  buildInfoD :: Maybe FilePath -> [ModuleName] -> Int -> [(Text,FieldDescription PackageDescriptionEd)] buildInfoD fp modules i = [-    ((T.pack $ printf (__ "%s Build Info") (show (i + 1))), VFD emptyParams [+    (T.pack $ printf (__ "%s Build Info") (show (i + 1)), VFD emptyParams [         mkField             (paraName <<<- ParaName (__ "Component is buildable here") $ emptyParams)-            (buildable . (\a -> a !! i) . bis)+            (buildable . (!! i) . bis)             (\ a b -> b{bis = update (bis b) i (\bi -> bi{buildable = a})})             boolEditor     ,   mkField@@ -1027,7 +1019,7 @@                         $ paraDirection  <<<- ParaDirection Vertical                             $ paraMinSize <<<- ParaMinSize (-1,150)                                 $ emptyParams)-            (hsSourceDirs . (\a -> a !! i) . bis)+            (hsSourceDirs . (!! i) . bis)             (\ a b -> b{bis = update (bis b) i (\bi -> bi{hsSourceDirs = a})})             (filesEditor fp FileChooserActionSelectFolder (__ "Select folder"))     ,   mkField@@ -1039,59 +1031,59 @@                         $ paraMinSize <<<- ParaMinSize (-1,300)                             $ paraPack <<<- ParaPack PackGrow                                 $ emptyParams)-            (map (T.pack . display) . otherModules . (\a -> a !! i) . bis)+            (map (T.pack . display) . otherModules . (!! i) . bis)             (\ a b -> b{bis = update (bis b) i (\bi ->-                bi{otherModules = (map (\i -> forceJust (simpleParse $ T.unpack i)-                "   PackageEditor >> buildInfoD: no parse for moduile name" ) a)})})+                bi{otherModules = map (\i -> forceJust (simpleParse $ T.unpack i)+                "   PackageEditor >> buildInfoD: no parse for moduile name" ) a})})             (modulesEditor modules)     ]),-    ((T.pack $ printf (__ "%s Compiler ") (show (i + 1))), VFD emptyParams [+    (T.pack $ printf (__ "%s Compiler ") (show (i + 1)), VFD emptyParams [         mkField             (paraName  <<<- ParaName (__ "Options for haskell compilers")             $ paraDirection <<<- ParaDirection Vertical             $ paraShadow <<<- ParaShadow ShadowIn             $ paraPack <<<- ParaPack PackGrow $ emptyParams)-            (options . (\a -> a !! i) . bis)+            (options . (!! i) . bis)             (\ a b -> b{bis = update (bis b) i (\bi -> bi{options = a})})             (multisetEditor-                (ColumnDescr True [( (__ "Compiler Flavor"),\(cv,_) -> [cellText := T.pack $ show cv])-                                   ,( (__ "Options"),\(_,op) -> [cellText := T.pack $ concatMap (\s -> ' ' : s) op])])-                ((pairEditor+                (ColumnDescr True [( __ "Compiler Flavor",\(cv,_) -> [cellText := T.pack $ show cv])+                                   ,(__ "Options",\(_,op) -> [cellText := T.pack $ concatMap (\s -> ' ' : s) op])])+                (pairEditor                     (compilerFlavorEditor,emptyParams)-                    (optsEditor,emptyParams)),-                        (paraDirection <<<- ParaDirection Vertical-                            $ paraShadow  <<<- ParaShadow ShadowIn $ emptyParams))+                    (optsEditor,emptyParams),+                        paraDirection <<<- ParaDirection Vertical+                            $ paraShadow  <<<- ParaShadow ShadowIn $ emptyParams)                 Nothing                 Nothing) #if MIN_VERSION_Cabal(1,22,0)      ,  mkField             (paraName <<<- ParaName (__ "Additional options for GHC when built with profiling")            $ emptyParams)-            (profOptions . (\a -> a !! i) . bis)+            (profOptions . (!! i) . bis)             (\ a b -> b{bis = update (bis b) i (\bi -> bi{profOptions = a})})             compilerOptsEditor      ,  mkField             (paraName <<<- ParaName (__ "Additional options for GHC when the package is built as shared library")            $ emptyParams)-            (sharedOptions . (\a -> a !! i) . bis)+            (sharedOptions . (!! i) . bis)             (\ a b -> b{bis = update (bis b) i (\bi -> bi{sharedOptions = a})})             compilerOptsEditor #else      ,  mkField             (paraName <<<- ParaName (__ "Additional options for GHC when built with profiling")            $ emptyParams)-            (ghcProfOptions . (\a -> a !! i) . bis)+            (ghcProfOptions . (!! i) . bis)             (\ a b -> b{bis = update (bis b) i (\bi -> bi{ghcProfOptions = a})})             optsEditor      ,  mkField             (paraName <<<- ParaName (__ "Additional options for GHC when the package is built as shared library")            $ emptyParams)-            (ghcSharedOptions . (\a -> a !! i) . bis)+            (ghcSharedOptions . (!! i) . bis)             (\ a b -> b{bis = update (bis b) i (\bi -> bi{ghcSharedOptions = a})})             optsEditor #endif     ]),-    ((T.pack $ printf (__ "%s Extensions ") (show (i + 1))), VFD emptyParams [+    (T.pack $ printf (__ "%s Extensions ") (show (i + 1)), VFD emptyParams [         mkField             (paraName  <<<- ParaName (__ "Extensions")                 $ paraSynopsis  <<<- ParaSynopsis@@ -1099,65 +1091,65 @@                          $ paraMinSize <<<- ParaMinSize (-1,400)                             $ paraPack <<<- ParaPack PackGrow                                 $ emptyParams)-            (oldExtensions . (\a -> a !! i) . bis)+            (oldExtensions . (!! i) . bis)             (\ a b -> b{bis = update (bis b) i (\bi -> bi{oldExtensions = a})})             extensionsEditor     ]),-    ((T.pack $ printf (__ "%s Build Tools ") (show (i + 1))), VFD emptyParams [+    (T.pack $ printf (__ "%s Build Tools ") (show (i + 1)), VFD emptyParams [         mkField             (paraName <<<- ParaName (__ "Tools needed for a build")                 $ paraDirection <<<- ParaDirection Vertical                     $ paraMinSize <<<- ParaMinSize (-1,120)                         $ emptyParams)-            (buildTools . (\a -> a !! i) . bis)+            (buildTools . (!! i) . bis)             (\ a b -> b{bis = update (bis b) i (\bi -> bi{buildTools = a})})             (dependenciesEditor [])     ]),-    ((T.pack $ printf (__ "%s Pkg Config ") (show (i + 1))), VFD emptyParams [+    (T.pack $ printf (__ "%s Pkg Config ") (show (i + 1)), VFD emptyParams [         mkField             (paraName <<<- ParaName (__ "A list of pkg-config packages, needed to build this package")                 $ paraDirection <<<- ParaDirection Vertical                     $ paraMinSize <<<- ParaMinSize (-1,120)                         $ emptyParams)-            (pkgconfigDepends . (\a -> a !! i) . bis)+            (pkgconfigDepends . (!! i) . bis)             (\ a b -> b{bis = update (bis b) i (\bi -> bi{pkgconfigDepends = a})})             (dependenciesEditor [])     ]),-    ((T.pack $ printf (__ "%s Opts C -1-") (show (i + 1))), VFD emptyParams [+    (T.pack $ printf (__ "%s Opts C -1-") (show (i + 1)), VFD emptyParams [          mkField             (paraName <<<- ParaName (__ "Options for C compiler")                 $ paraDirection <<<- ParaDirection Vertical                     $ emptyParams)-            (ccOptions . (\a -> a !! i) . bis)+            (ccOptions . (!! i) . bis)             (\ a b -> b{bis = update (bis b) i (\bi -> bi{ccOptions = a})})             optsEditor     ,    mkField             (paraName <<<- ParaName (__ "Options for linker")                 $ paraDirection <<<- ParaDirection Vertical                     $ emptyParams)-            (ldOptions . (\a -> a !! i) . bis)+            (ldOptions . (!! i) . bis)             (\ a b -> b{bis = update (bis b) i (\bi -> bi{ldOptions = a})})             optsEditor     ,    mkField             (paraName <<<- ParaName (__ "A list of header files to use when compiling")                 $ paraDirection <<<- ParaDirection Vertical $ emptyParams)-            (map T.pack . includes . (\a -> a !! i) . bis)+            (map T.pack . includes . (!! i) . bis)             (\ a b -> b{bis = update (bis b) i (\bi -> bi{includes = map T.unpack a})})             (textsEditor (const True) True)      ,   mkField             (paraName <<<- ParaName (__ "A list of header files to install")                 $ paraMinSize <<<- ParaMinSize (-1,150)                     $ paraDirection <<<- ParaDirection Vertical $ emptyParams)-            (installIncludes . (\a -> a !! i) . bis)+            (installIncludes . (!! i) . bis)              (\ a b -> b{bis = update (bis b) i (\bi -> bi{installIncludes = a})})            (filesEditor fp FileChooserActionOpen (__ "Select File"))     ]),-    ((T.pack $ printf (__ "%s Opts C -2-") (show (i + 1))), VFD emptyParams [+    (T.pack $ printf (__ "%s Opts C -2-") (show (i + 1)), VFD emptyParams [          mkField             (paraName <<<- ParaName (__ "A list of directories to search for header files")                 $ paraMinSize <<<- ParaMinSize (-1,150)                     $ paraDirection <<<- ParaDirection Vertical $ emptyParams)-            (includeDirs . (\a -> a !! i) . bis)+            (includeDirs . (!! i) . bis)             (\ a b -> b{bis = update (bis b) i (\bi -> bi{includeDirs = a})})             (filesEditor fp FileChooserActionSelectFolder (__ "Select Folder"))      ,   mkField@@ -1165,39 +1157,39 @@                 (__ "A list of C source files to be compiled,linked with the Haskell files.")                 $ paraMinSize <<<- ParaMinSize (-1,150)                     $ paraDirection <<<- ParaDirection Vertical $ emptyParams)-            (cSources . (\a -> a !! i) . bis)+            (cSources . (!! i) . bis)             (\ a b -> b{bis = update (bis b) i (\bi -> bi{cSources = a})})             (filesEditor fp FileChooserActionOpen (__ "Select file"))     ]),-    ((T.pack $ printf (__ "%s Opts Libs ") (show (i + 1))), VFD emptyParams [+    (T.pack $ printf (__ "%s Opts Libs ") (show (i + 1)), VFD emptyParams [          mkField             (paraName <<<- ParaName (__ "A list of extra libraries to link with")                 $ paraMinSize <<<- ParaMinSize (-1,150)                     $ paraDirection <<<- ParaDirection Vertical $ emptyParams)-            (map T.pack . extraLibs . (\a -> a !! i) . bis)+            (map T.pack . extraLibs . (!! i) . bis)             (\ a b -> b{bis = update (bis b) i (\bi -> bi{extraLibs = map T.unpack a})})             (textsEditor (const True) True)      ,   mkField             (paraName <<<- ParaName (__ "A list of directories to search for libraries.")                 $ paraMinSize <<<- ParaMinSize (-1,150)                     $ paraDirection <<<- ParaDirection Vertical $ emptyParams)-            (extraLibDirs . (\a -> a !! i) . bis)+            (extraLibDirs . (!! i) . bis)             (\ a b -> b{bis = update (bis b) i (\bi -> bi{extraLibDirs = a})})             (filesEditor fp FileChooserActionSelectFolder (__ "Select Folder"))    ]),-    ((T.pack $ printf (__ "%s Other") (show (i + 1))), VFD emptyParams [+    (T.pack $ printf (__ "%s Other") (show (i + 1)), VFD emptyParams [          mkField             (paraName <<<- ParaName (__ "Options for C preprocessor")                 $ paraDirection <<<- ParaDirection Vertical                     $ emptyParams)-            (cppOptions . (\a -> a !! i) . bis)+            (cppOptions . (!! i) . bis)             (\ a b -> b{bis = update (bis b) i (\bi -> bi{cppOptions = a})})             optsEditor     ,   mkField             (paraName <<<- ParaName (__ "Support frameworks for Mac OS X")                 $ paraMinSize <<<- ParaMinSize (-1,150)                     $ paraDirection <<<- ParaDirection Vertical $ emptyParams)-            (map T.pack . frameworks . (\a -> a !! i) . bis)+            (map T.pack . frameworks . (!! i) . bis)             (\ a b -> b{bis = update (bis b) i (\bi -> bi{frameworks = map T.unpack a})})             (textsEditor (const True) True)     ,   mkField@@ -1205,14 +1197,14 @@                 $ paraShadow <<<- ParaShadow ShadowIn                     $ paraMinSize <<<- ParaMinSize (-1,150)                         $ paraDirection <<<- ParaDirection Vertical $ emptyParams)-             (customFieldsBI . (\a -> a !! i) . bis)+             (customFieldsBI . (!! i) . bis)             (\ a b -> b{bis = update (bis b) i (\bi -> bi{customFieldsBI = a})})             (multisetEditor-                (ColumnDescr True [((__ "Name"),\(n,_) -> [cellText := T.pack n])-                                   ,((__ "Value"),\(_,v) -> [cellText := T.pack v])])-                ((pairEditor+                (ColumnDescr True [(__ "Name",\(n,_) -> [cellText := T.pack n])+                                   ,(__ "Value",\(_,v) -> [cellText := T.pack v])])+                (pairEditor                     (stringxEditor (const True),emptyParams)-                    (stringEditor (const True) True,emptyParams)),emptyParams)+                    (stringEditor (const True) True,emptyParams),emptyParams)             Nothing             Nothing)             ])]@@ -1244,16 +1236,15 @@     return (wid,oinj,oext)  compilerOptRecordEditor :: Editor (CompilerFlavor, [String])-compilerOptRecordEditor para noti = do+compilerOptRecordEditor para =     pairEditor         (compilerFlavorEditor             , paraName <<<- ParaName "Compiler" $ emptyParams)         (optsEditor,paraName <<<- ParaName "Options" $ emptyParams)         (paraDirection <<<- ParaDirection Vertical $ para)-        noti  compilerOptsEditor :: Editor [(CompilerFlavor, [String])]-compilerOptsEditor p noti =+compilerOptsEditor p =     multisetEditor         (ColumnDescr True [("Compiler",\(compiler, _) -> [cellText := T.pack $ show compiler])                            ,("Options",\(_, opts    ) -> [cellText := T.pack $ unwords opts])])@@ -1269,12 +1260,11 @@                     $ paraDirection  <<<-  ParaDirection Vertical                         $ paraPack <<<- ParaPack PackGrow                             $ p)-        noti  packageEditor :: Editor PackageIdentifier packageEditor para noti = do     (wid,inj,ext) <- pairEditor-        (stringEditor (\s -> not (null s)) True, paraName <<<- ParaName (__ "Name") $ emptyParams)+        (stringEditor (not . null) True, paraName <<<- ParaName (__ "Name") $ emptyParams)         (versionEditor, paraName <<<- ParaName (__ "Version") $ emptyParams)         (paraDirection <<<- ParaDirection Horizontal             $ paraShadow <<<- ParaShadow ShadowIn@@ -1284,30 +1274,31 @@         mbp <- ext         case mbp of             Nothing -> return Nothing-            Just (n,v) -> do+            Just (n,v) -> return $                 if null n-                    then return Nothing-                    else return (Just $PackageIdentifier (PackageName n) v)+                    then Nothing+                    else Just $ PackageIdentifier (PackageName n) v     return (wid,pinj,pext)  testedWithEditor :: Editor [(CompilerFlavor, VersionRange)]-testedWithEditor para = do+testedWithEditor =     multisetEditor-       (ColumnDescr True [((__ "Compiler Flavor"),\(cv,_) -> [cellText := T.pack $ show cv])-                           ,((__ "Version Range"),\(_,vr) -> [cellText := T.pack $ display vr])])+       (ColumnDescr True [(__ "Compiler Flavor",\(cv,_) -> [cellText := T.pack $ show cv])+                           ,(__ "Version Range",\(_,vr) -> [cellText := T.pack $ display vr])])        (pairEditor-            (compilerFlavorEditor, paraShadow <<<- (ParaShadow ShadowNone) $ emptyParams)-            (versionRangeEditor, paraShadow <<<- (ParaShadow ShadowNone) $ emptyParams),-            (paraDirection <<<- (ParaDirection Vertical) $ emptyParams))+          (compilerFlavorEditor,+           paraShadow <<<- ParaShadow ShadowNone $ emptyParams)+          (versionRangeEditor,+           paraShadow <<<- ParaShadow ShadowNone $ emptyParams),+        paraDirection <<<- ParaDirection Vertical $ emptyParams)        Nothing        (Just (==))-       para  compilerFlavorEditor :: Editor CompilerFlavor compilerFlavorEditor para noti = do     (wid,inj,ext) <- eitherOrEditor-        (comboSelectionEditor flavors (T.pack . show), paraName <<<- (ParaName (__ "Select compiler")) $ emptyParams)-        (textEditor (\s -> not (T.null s)) True, paraName <<<- (ParaName (__ "Specify compiler")) $ emptyParams)+        (comboSelectionEditor flavors (T.pack . show), paraName <<<- ParaName (__ "Select compiler") $ emptyParams)+        (textEditor (not . T.null) True, paraName <<<- ParaName (__ "Specify compiler") $ emptyParams)         (__ "Other")         (paraName <<<- ParaName (__ "Select") $ para)         noti@@ -1327,8 +1318,8 @@ buildTypeEditor :: Editor BuildType buildTypeEditor para noti = do     (wid,inj,ext) <- eitherOrEditor-        (comboSelectionEditor flavors (T.pack . show), paraName <<<- (ParaName (__ "Select")) $ emptyParams)-        (textEditor (const True) True, paraName <<<- (ParaName (__ "Unknown")) $ emptyParams)+        (comboSelectionEditor flavors (T.pack . show), paraName <<<- ParaName (__ "Select") $ emptyParams)+        (textEditor (const True) True, paraName <<<- ParaName (__ "Unknown") $ emptyParams)         (__ "Unknown")         (paraName <<<- ParaName (__ "Select") $ para)         noti@@ -1511,8 +1502,8 @@                 (buildInfoEditorP numBuildInfos, paraName <<<- ParaName (__ "Build Info")                 $ paraPack <<<- ParaPack PackNatural                 $ para),-                (paraDirection <<<- ParaDirection Vertical-                $ emptyParams))+                paraDirection <<<- ParaDirection Vertical+                $ emptyParams)             (tupel3Editor                 (modulesEditor (sort modules),                 paraName <<<- ParaName (__ "Reexported Modules")@@ -1526,8 +1517,8 @@                 paraName <<<- ParaName (__ "Exposed Signatures")                 $ paraMinSize <<<- ParaMinSize (-1,300)                 $ para),-                (paraDirection <<<- ParaDirection Vertical-                $ emptyParams))+                paraDirection <<<- ParaDirection Vertical+                $ emptyParams)             (paraDirection <<<- ParaDirection Vertical             $ emptyParams)             noti@@ -1581,10 +1572,9 @@ executablesEditor :: Maybe FilePath -> [ModuleName] -> Int -> Editor [Executable'] executablesEditor fp modules countBuildInfo p =     multisetEditor-        (ColumnDescr True [( (__ "Executable Name"),\(Executable' exeName _ _) -> [cellText := exeName])-                           ,( (__ "Module Path"),\(Executable'  _ mp _) -> [cellText := T.pack mp])--                           ,( (__ "Build info index"),\(Executable'  _ _ bii) -> [cellText := T.pack $ show (bii + 1)])])+        (ColumnDescr True [(__ "Executable Name",\(Executable' exeName _ _) -> [cellText := exeName])+                           ,(__ "Module Path",\(Executable'  _ mp _) -> [cellText := T.pack mp])+                           ,(__ "Build info index",\(Executable'  _ _ bii) -> [cellText := T.pack $ show (bii + 1)])])         (executableEditor fp modules countBuildInfo,emptyParams)         Nothing         Nothing@@ -1594,10 +1584,10 @@ executableEditor :: Maybe FilePath -> [ModuleName] -> Int -> Editor Executable' executableEditor fp modules countBuildInfo para noti = do     (wid,inj,ext) <- tupel3Editor-        (textEditor (\s -> not (T.null s)) True,+        (textEditor (not . T.null) True,             paraName <<<- ParaName (__ "Executable Name")             $ emptyParams)-        (stringEditor (\s -> not (null s)) True,+        (stringEditor (not . null) True,             paraDirection <<<- ParaDirection Vertical             $ paraName <<<- ParaName (__ "File with main function")             $ emptyParams)@@ -1620,9 +1610,9 @@ testsEditor :: Maybe FilePath -> [ModuleName] -> Int -> Editor [Test'] testsEditor fp modules countBuildInfo p =     multisetEditor-        (ColumnDescr True [( (__ "Test Name"),\(Test' testName _ _) -> [cellText := testName])-                           ,( (__ "Interface"),\(Test'  _ i _) -> [cellText := T.pack $ interfaceName i])-                           ,( (__ "Build info index"),\(Test'  _ _ bii) -> [cellText := T.pack $ show (bii + 1)])])+        (ColumnDescr True [(__ "Test Name",\(Test' testName _ _) -> [cellText := testName])+                           ,(__ "Interface",\(Test'  _ i _) -> [cellText := T.pack $ interfaceName i])+                           ,(__ "Build info index",\(Test'  _ _ bii) -> [cellText := T.pack $ show (bii + 1)])])         (testEditor fp modules countBuildInfo,emptyParams)         Nothing         Nothing@@ -1635,10 +1625,10 @@ testEditor :: Maybe FilePath -> [ModuleName] -> Int -> Editor Test' testEditor fp modules countBuildInfo para noti = do     (wid,inj,ext) <- tupel3Editor-        (textEditor (\s -> not (T.null s)) True,+        (textEditor (not . T.null) True,             paraName <<<- ParaName (__ "Test Name")             $ emptyParams)-        (stringEditor (\s -> not (null s)) True,+        (stringEditor (not . null) True,             paraDirection <<<- ParaDirection Vertical             $ paraName <<<- ParaName (__ "File with main function")             $ emptyParams)@@ -1662,9 +1652,9 @@ benchmarksEditor :: Maybe FilePath -> [ModuleName] -> Int -> Editor [Benchmark'] benchmarksEditor fp modules countBuildInfo p =     multisetEditor-        (ColumnDescr True [( (__ "Benchmark Name"),\(Benchmark' benchmarkName _ _) -> [cellText := benchmarkName])-                           ,( (__ "Interface"),\(Benchmark'  _ i _) -> [cellText := T.pack $ interfaceName i])-                           ,( (__ "Build info index"),\(Benchmark'  _ _ bii) -> [cellText := T.pack $ show (bii + 1)])])+        (ColumnDescr True [(__ "Benchmark Name",\(Benchmark' benchmarkName _ _) -> [cellText := benchmarkName])+                           ,(__ "Interface",\(Benchmark'  _ i _) -> [cellText := T.pack $ interfaceName i])+                           ,(__ "Build info index",\(Benchmark'  _ _ bii) -> [cellText := T.pack $ show (bii + 1)])])         (benchmarkEditor fp modules countBuildInfo,emptyParams)         Nothing         Nothing@@ -1677,10 +1667,10 @@ benchmarkEditor :: Maybe FilePath -> [ModuleName] -> Int -> Editor Benchmark' benchmarkEditor fp modules countBuildInfo para noti = do     (wid,inj,ext) <- tupel3Editor-        (textEditor (\s -> not (T.null s)) True,+        (textEditor (not . T.null) True,             paraName <<<- ParaName (__ "Benchmark Name")             $ emptyParams)-        (stringEditor (\s -> not (null s)) True,+        (stringEditor (not . null) True,             paraDirection <<<- ParaDirection Vertical             $ paraName <<<- ParaName (__ "File with main function")             $ emptyParams)

@@ -71,14 +71,14 @@ import Control.Exception(SomeException,catch) import Prelude hiding(catch) import Data.List (isSuffixOf, sortBy)-import Data.Maybe (catMaybes, fromMaybe, isJust)+import Data.Maybe (mapMaybe, catMaybes, fromMaybe, isJust) import Graphics.UI.Gtk.Windows.MessageDialog        (ButtonsType(..), MessageType(..)) import System.Glib.Attributes (set) import Graphics.UI.Gtk.General.Enums        (ButtonBoxStyle(..), WindowPosition(..)) import Control.Monad.IO.Class (MonadIO(..))-import Control.Monad (void, forM_, when)+import Control.Monad (void, when) import System.FilePath ((</>)) import Data.Text (Text) import qualified Data.Text as T (isSuffixOf, unpack, pack, null)@@ -86,6 +86,7 @@ import Control.Applicative ((<$>)) import Distribution.Text (display, simpleParse) import IDE.Pane.Files (refreshFiles)+import Data.Foldable (forM_)  -- --------------------------------------------------------------------- -- This needs to be incremented, when the preferences format changes@@ -150,9 +151,7 @@              on preview buttonActivated $ do                 mbNewPrefs <- extract initialPrefs [ext]-                case mbNewPrefs of-                    Nothing -> return ()-                    Just newPrefs -> applyPrefs newPrefs+                forM_ mbNewPrefs applyPrefs              on restore buttonActivated $ do                 applyPrefs initialPrefs@@ -361,12 +360,7 @@             (\mbs -> do                 setInfoStyle                 buffers <- allBuffers-                preferDark <- getDarkState-                mapM_ (\(IDEBuffer {sourceView = sv}) -> do-                    ebuf <- getBuffer sv-                    setStyle preferDark ebuf (case mbs of-                                    (False,_) -> Nothing-                                    (True,s) -> Just s)) buffers)+                mapM_ updateStyle' buffers)     ,   mkFieldPP             (paraName <<<- ParaName (__ "Found Text Background") $ emptyParams)             (PP.text . show)@@ -477,7 +471,7 @@             showHiddenFiles             (\b a -> a {showHiddenFiles = b})             boolEditor-            (\b -> refreshFiles)+            (const refreshFiles)     ,   mkFieldPP             (paraName <<<- ParaName (__ "Use ctrl Tab for Notebook flipper") $ emptyParams)             (PP.text . show)@@ -634,7 +628,7 @@                         $ paraMinSize <<<- ParaMinSize (-1,200)                             $ emptyParams)             (PP.text . show . map display)-            (fmap (catMaybes . map simpleParse) readParser)+            (fmap (mapMaybe simpleParse) readParser)             packageBlacklist             (\b a -> a{packageBlacklist = b})             (dependenciesEditor packages)

@@ -67,7 +67,9 @@ import Control.Monad (void) import Graphics.UI.Gtk.General.Enums (ShadowType(..)) import Data.Text (Text)-import qualified Data.Text as T (pack, null)+import qualified Data.Text as T (unpack, pack, null)+import System.Log.Logger (debugM)+import Data.Monoid ((<>))  -- | A search pane description --@@ -251,6 +253,7 @@                 searchMetaGUI_ text             searchMetaGUI_ :: Text -> IDEAction             searchMetaGUI_ str = do+                liftIO $ debugM "leksah" $ "searchMetGUI_ " <> T.unpack str                 liftIO $ bringPaneToFront search                 liftIO $ entrySetText entry str                 scope  <- liftIO $ getScope search

@@ -65,6 +65,13 @@ ,   editKeystrokeCandy ,   editCandy +,   updateStyle+,   updateStyle'+,   addLogRef+,   removeBuildLogRefs+,   resolveActiveHLint+,   hlintSettings+,   hlintBuffer ,   markRefInSourceBuf ,   inBufContext ,   inActiveBufContext@@ -122,8 +129,6 @@ import Graphics.UI.Gtk.Windows.MessageDialog        (ButtonsType(..), MessageType(..)) import Graphics.UI.Gtk.Windows.Dialog (ResponseId(..))-import Graphics.UI.Gtk-       (eventModifier, eventKeyName, eventKeyVal, Underline(..)) import Graphics.UI.Gtk.Selectors.FileChooser        (FileChooserAction(..)) import System.Glib.Attributes (AttrOp(..), set)@@ -131,7 +136,7 @@ import IDE.BufferMode import Control.Monad.Trans.Reader (ask) import Control.Monad.IO.Class (MonadIO(..))-import Control.Monad (forM, filterM, unless, when, liftM)+import Control.Monad (filterM, foldM, void, unless, when, liftM) import Control.Exception as E (catch, SomeException)  import qualified IDE.Command.Print as Print@@ -139,11 +144,26 @@ import System.Log.Logger (debugM) import Data.Text (Text) import qualified Data.Text as T-       (length, findIndex, replicate, lines, dropWhileEnd, unlines, strip,-        null, pack, unpack)+       (reverse, take, drop, init, length, findIndex, replicate, lines,+        dropWhileEnd, unlines, strip, null, pack, unpack) import Data.Monoid ((<>)) import qualified Data.Text.IO as T (writeFile, readFile) import Data.Time (UTCTime(..))+import Control.Concurrent (forkIO)+import Language.Haskell.HLint3+       (Hint(..), Classify(..), ParseError(..), Idea(..), Severity(..),+        parseFlagsAddFixities, resolveHints, readSettingsFile,+        findSettings, applyHints, defaultParseFlags, parseModuleEx,+        ParseFlags(..), CppFlags(..))+import qualified Language.Haskell.Exts.SrcLoc as HSE+       (SrcLoc(..), SrcSpan(..))+import Language.Preprocessor.Cpphs as Cpphs+       (runCpphsReturningSymTab, defaultCpphsOptions, CpphsOptions(..))+import qualified System.IO.Strict as S (readFile)+import Graphics.UI.Gtk.Gdk.EventM+       (eventModifier, eventKeyName, eventKeyVal)+import Data.Foldable (forM_)+import Data.Traversable (forM)  allBuffers :: MonadIDE m => m [IDEBuffer] allBuffers = liftIDE getPanes@@ -245,7 +265,7 @@                     liftIO $ debugM "lekash" "selectSourceBuf newTextBuffer returned"                     return nbuf                 else do-                    ideMessage Normal ((__ "File path not found ") <> T.pack fpc)+                    ideMessage Normal (__ "File path not found " <> T.pack fpc)                     return Nothing  goToDefinition :: Descr -> IDEAction@@ -260,15 +280,15 @@      liftIO . debugM "leksah" $ show (mbPackagePath, dscMbLocation idDescr, mbSourcePath)     case (mbPackagePath, dscMbLocation idDescr, mbSourcePath) of-        (Just packagePath, Just loc, _) -> goToSourceDefinition (dropFileName packagePath) loc >> return ()-        (_, Just loc, Just sourcePath)  -> goToSourceDefinition' sourcePath loc >> return ()-        (_, _, Just sp) -> selectSourceBuf sp >> return ()+        (Just packagePath, Just loc, _) -> void (goToSourceDefinition (dropFileName packagePath) loc)+        (_, Just loc, Just sourcePath)  -> void (goToSourceDefinition' sourcePath loc)+        (_, _, Just sp) -> void (selectSourceBuf sp)         _  -> return ()   where     packagePathFromScope :: GenScope -> Maybe FilePath     packagePathFromScope (GenScopeC (PackScope l _)) =         case dscMbModu idDescr of-            Just mod -> case (pack mod) `Map.lookup` l of+            Just mod -> case pack mod `Map.lookup` l of                             Just pack -> pdMbSourcePath pack                             Nothing   -> Nothing             Nothing -> Nothing@@ -276,7 +296,7 @@     sourcePathFromScope :: GenScope -> Maybe FilePath     sourcePathFromScope (GenScopeC (PackScope l _)) =         case dscMbModu idDescr of-            Just mod -> case (pack mod) `Map.lookup` l of+            Just mod -> case pack mod `Map.lookup` l of                             Just pack ->                                 case filter (\md -> mdModuleId md == fromJust (dscMbModu idDescr))                                                     (pdModules pack) of@@ -286,14 +306,14 @@             Nothing -> Nothing  goToSourceDefinition :: FilePath -> Location -> IDEM (Maybe IDEBuffer)-goToSourceDefinition packagePath loc = do+goToSourceDefinition packagePath loc =     goToSourceDefinition' (packagePath </> locationFile loc) loc  goToSourceDefinition' :: FilePath -> Location -> IDEM (Maybe IDEBuffer) goToSourceDefinition' sourcePath Location{..} = do     mbBuf     <- selectSourceBuf sourcePath     case mbBuf of-        Just buf -> do+        Just buf ->             inActiveBufContext () $ \_ sv ebuf _ _ -> do                 liftIO $ debugM "lekash" "goToSourceDefinition calculating range"                 lines           <-  getLineCount ebuf@@ -316,29 +336,46 @@         Nothing -> return ()     return mbBuf -replaceHLintSource :: FilePath -> Int -> Int -> Int -> Int -> Text -> IDEAction-replaceHLintSource file lineS columnS lineE columnE to = do-    mbBuf     <- selectSourceBuf file+indentHLintText :: Int -> Text -> Text+indentHLintText startColumn text =+    T.init $ T.unlines (take 1 lines <> drop 1 (map (indent <>) lines))+  where+    lines = T.lines text+    indent = T.replicate startColumn " "
++replaceHLintSource :: (Bool, Int) -> (Text, Idea) -> IDEM (Bool, Int)+replaceHLintSource (changed, delta) (from, Idea{ideaSpan = ideaSpan, ideaTo = Just ideaTo}) = do+    let HSE.SrcSpan{..} = ideaSpan+        to = indentHLintText (srcSpanStartColumn-1) (T.pack ideaTo)+    liftIO . debugM "leksah" $ "replaceHLintSource From: " <> show from <> "\nreplaceHLintSource To:   " <> show to+    mbBuf <- selectSourceBuf srcSpanFilename     case mbBuf of-        Just buf -> inActiveBufContext () $ \_ sv ebuf _ _ -> do-            useCandy    <- useCandyFor buf-            candy'      <- readIDE candy-            realString <-  if useCandy then stringToCandy candy' to else return to+        Just buf -> inActiveBufContext (changed, delta) $ \_ sv ebuf _ _ -> do+            useCandy   <- useCandyFor buf+            candy'     <- readIDE candy+            realString <- if useCandy then stringToCandy candy' to else return to             (lineS', columnS', lineE', columnE') <- if useCandy                     then do-                        (_,e1) <- positionToCandy candy' ebuf (lineS,columnS - 1)-                        (_,e2) <- positionToCandy candy' ebuf (lineE,columnE - 1)-                        return (lineS-1,e1,lineE-1,e2)-                    else return (lineS-1, columnS-1, lineE-1, columnE-1)-            i1  <- getIterAtLine ebuf (lineS')-            i1' <- forwardCharsC i1 (columnS')-            i2  <- getIterAtLine ebuf (lineE')-            i2' <- forwardCharsC i2 (columnE')-            delete ebuf i1' i2'-            editInsertCode ebuf i1' realString-            fileSave False-            setModified ebuf True-        _ -> return ()+                        (_,e1) <- positionToCandy candy' ebuf (srcSpanStartLine + delta, srcSpanStartColumn - 1)+                        (_,e2) <- positionToCandy candy' ebuf (srcSpanEndLine + delta, srcSpanEndColumn - 1)+                        return (srcSpanStartLine-1 + delta,e1,srcSpanEndLine-1 + delta,e2)+                    else return (srcSpanStartLine-1 + delta,srcSpanStartColumn-1,srcSpanEndLine-1 + delta,srcSpanEndColumn-1)+            i1  <- getIterAtLine ebuf lineS'+            i1' <- forwardCharsC i1 columnS'+            i2  <- getIterAtLine ebuf lineE'+            i2' <- forwardCharsC i2 columnE'+            candy <- readIDE candy+            check <- getCandylessPart candy ebuf i1' i2'+            if check == from+                then do+                    beginUserAction ebuf+                    delete ebuf i1' i2'+                    editInsertCode ebuf i1' realString+                    endUserAction ebuf+                    return (True, delta + length (T.lines to) - length (T.lines from))+                else return (changed, delta)+        _ -> return (changed, delta)+replaceHLintSource x _ = return x  insertInBuffer :: Descr -> IDEAction insertInBuffer idDescr = do@@ -356,31 +393,49 @@                         iter <- getIterAtMark ebuf mark                         insert ebuf iter (dscName idDescr) -markRefInSourceBuf :: Int -> IDEBuffer -> LogRef -> Bool -> IDEAction-markRefInSourceBuf index buf logRef scrollTo = do+updateStyle' :: IDEBuffer -> IDEAction+updateStyle' IDEBuffer {sourceView = sv} = getBuffer sv >>= updateStyle++removeLogRefs :: [LogRefType] -> FilePath -> FilePath -> IDEAction+removeLogRefs types root file = do+    modifyIDE_ (\ide -> ide{allLogRefs = filter keep $ allLogRefs ide})++    buffers <- allBuffers+    let matchingBufs = filter (maybe False (equalFilePath (root </> file)) . fileName) buffers+    forM_ matchingBufs $ \ (IDEBuffer {sourceView = sv}) -> do+        buf <- getBuffer sv+        forM_ types $ removeTagByName buf . T.pack . show++    triggerEventIDE ErrorChanged+    return ()+  where+    keep ref = logRefRootPath ref /= root+            || logRefFilePath ref /= file+            || logRefType ref `notElem` types++removeBuildLogRefs :: FilePath -> FilePath -> IDEAction+removeBuildLogRefs = removeLogRefs [ErrorRef, WarningRef, TestFailureRef]++addLogRef :: LogRef -> IDEAction+addLogRef ref = do+    modifyIDE_ (\ide -> ide{allLogRefs = allLogRefs ide <> [ref]})++    buffers <- allBuffers+    let matchingBufs = filter (maybe False (equalFilePath (logRefFullFilePath ref)) . fileName) buffers+    forM_ matchingBufs $ \ buf -> markRefInSourceBuf buf ref False++    triggerEventIDE ErrorChanged+    return ()++markRefInSourceBuf :: IDEBuffer -> LogRef -> Bool -> IDEAction+markRefInSourceBuf buf logRef scrollTo = do     useCandy    <- useCandyFor buf     candy'      <- readIDE candy     contextRefs <- readIDE contextRefs     prefs       <- readIDE prefs     inBufContext () buf $ \_ sv ebuf buf _ -> do-        let tagName = T.pack $ show (logRefType logRef) ++ show index+        let tagName = T.pack $ show (logRefType logRef)         liftIO . debugM "lekash" . T.unpack $ "markRefInSourceBuf getting or creating tag " <> tagName-        tagTable <- getTagTable ebuf-        mbTag <- lookupTag tagTable tagName-        case mbTag of-            Just existingTag -> do-                removeTagByName ebuf tagName-            Nothing -> do-                errtag <- newTag tagTable tagName-                case logRefType logRef of-                    ErrorRef -> do-                        underline errtag UnderlineError-                    WarningRef -> do-                        underline errtag UnderlineError-                    BreakpointRef -> do-                        background errtag $ breakpointBackground prefs-                    ContextRef -> do-                        background errtag $ contextBackground prefs          liftIO $ debugM "lekash" "markRefInSourceBuf calculating range"         let start' = (srcSpanStartLine (logRefSrcSpan logRef),@@ -394,7 +449,7 @@                     then positionToCandy candy' ebuf end'                     else return end'         lines   <-  getLineCount ebuf-        iterTmp <-  getIterAtLine ebuf (max 0 (min (lines-1) ((fst start)-1)))+        iterTmp <-  getIterAtLine ebuf (max 0 (min (lines-1) (fst start - 1)))         chars   <-  getCharsInLine iterTmp         iter    <- atLineOffset iterTmp (max 0 (min (chars-1) (snd start))) @@ -405,7 +460,7 @@                     Nothing -> atEnd iter                     Just we -> return we             else do-                newTmp  <- getIterAtLine ebuf (max 0 (min (lines-1) ((fst end)-1)))+                newTmp  <- getIterAtLine ebuf (max 0 (min (lines-1) (fst end - 1)))                 chars   <- getCharsInLine newTmp                 new     <- atLineOffset newTmp (max 0 (min (chars-1) (snd end)))                 forwardCharC new@@ -417,12 +472,7 @@         unless isOldContext $ do             liftIO $ debugM "lekash" "markRefInSourceBuf calling applyTagByName"             lineStart <- backwardToLineStartC iter-            createMark sv tagName lineStart (-                case logRefType logRef of-                    ErrorRef      -> "dialog-error"-                    WarningRef    -> "dialog-warning"-                    BreakpointRef -> "media-playback-pause"-                    ContextRef    -> "media-playback-start") $ refDescription logRef+            createMark sv (logRefType logRef) lineStart $ refDescription logRef             applyTagByName ebuf tagName iter iter2         when scrollTo $ do             ideR    <- ask@@ -439,11 +489,11 @@ -- | Tries to create a new text buffer, fails when the given filepath -- does not exist or when it is not a text file. newTextBuffer :: PanePath -> Text -> Maybe FilePath -> IDEM (Maybe IDEBuffer)-newTextBuffer panePath bn mbfn = do+newTextBuffer panePath bn mbfn =      case mbfn of             Nothing -> buildPane "" Nothing             Just fn ->-                do eErrorContents <- liftIO $ do+                do eErrorContents <- liftIO $                                          catch (Right <$> T.readFile fn)                                                (\e -> return $ Left (show (e :: IOError)))                    case eErrorContents of@@ -484,7 +534,7 @@     Gtk.Notebook ->     Gtk.Window ->     IDEM (Maybe IDEBuffer,Connections)-builder' bs mbfn ind bn rbn ct prefs fileContents modTime pp nb windows = do+builder' bs mbfn ind bn rbn ct prefs fileContents modTime pp nb windows =     -- display a file     case textEditorType prefs of         "GtkSourceView" -> newGtkBuffer mbfn fileContents >>= makeBuffer modTime@@ -517,12 +567,9 @@                                 (False,_) -> Nothing                                 (True,v) -> Just v         setIndentWidth sv $ tabWidth prefs-        setTabWidth sv $ 8 -- GHC treats tabs as 8 we should display them that way+        setTabWidth sv 8 -- GHC treats tabs as 8 we should display them that way         drawTabs sv-        preferDark <- getDarkState-        setStyle preferDark buffer $ case sourceStyle prefs of-                            (False,_) -> Nothing-                            (True,v) -> Just v+        updateStyle buffer          -- put it in a scrolled window         sw <- getScrolledWindow sv@@ -541,11 +588,9 @@             mode = mod}         -- events         ids1 <- sv `afterFocusIn` makeActive buf-        ids2 <- onCompletion sv (do-                Completion.complete sv False) $ do-                    Completion.cancel+        ids2 <- onCompletion sv (Completion.complete sv False) Completion.cancel         ids3 <- onButtonPress sv $ do-                click <- lift $ Gtk.eventClick+                click <- lift Gtk.eventClick                 liftIDE $                     case click of                         Gtk.DoubleClick -> do@@ -556,7 +601,7 @@          (GetTextPopup mbTpm) <- triggerEvent ideR (GetTextPopup Nothing)         ids4 <- case mbTpm of-            Just tpm    -> sv `onPopulatePopup` \menu -> liftIO $ (tpm ideR menu)+            Just tpm    -> sv `onPopulatePopup` \menu -> liftIO $ tpm ideR menu             Nothing     -> do                 sysMessage Normal "SourceBuffer>> no text popup"                 return []@@ -570,8 +615,7 @@                     tagTable <- getTagTable ebuf                     mbTag <- lookupTag tagTable tagName                     case mbTag of-                        Just existingTag -> do-                            removeTagByName ebuf tagName+                        Just existingTag -> removeTagByName ebuf tagName                         Nothing -> do                             tag <- newTag tagTable tagName                             background tag $ matchBackground prefs@@ -582,13 +626,11 @@                              sTxt      <- getCandylessPart candy' ebuf si1 si2                             let strippedSTxt = T.strip sTxt-                            if T.null strippedSTxt-                                then return ()-                                else do-                                    bi1 <- getStartIter ebuf-                                    bi2 <- getEndIter ebuf-                                    forwardApplying bi1 strippedSTxt (Just si1) tagName ebuf-                                    forwardApplying si2 strippedSTxt (Just bi2) tagName ebuf+                            unless (T.null strippedSTxt) $+                              do bi1 <- getStartIter ebuf+                                 bi2 <- getEndIter ebuf+                                 forwardApplying bi1 strippedSTxt (Just si1) tagName ebuf+                                 forwardApplying si2 strippedSTxt (Just bi2) tagName ebuf             return False          ids6 <- onKeyPress sv $ do@@ -638,7 +680,7 @@                         slice <- getSlice buffer start end True                         triggerEventIDE (SelectInfo slice True)                         return True-                    _ -> do+                    _ ->                         -- liftIO $ print ("sourcebuffer key:",name,modifier,keyval)                         return False         ids7 <- do@@ -646,7 +688,7 @@             sw <- getScrolledWindow sv             createHyperLinkSupport sv sw (\ctrl shift iter -> do                 (beg, en) <- getIdentifierUnderCursorFromIter (iter, iter)-                return (beg, if ctrl then en else beg)) (\_ shift' slice -> do+                return (beg, if ctrl then en else beg)) (\_ shift' slice ->                             unless (T.null slice) $ do                                 -- liftIO$ print ("slice",slice)                                 triggerEventIDE (SelectInfo slice shift')@@ -667,9 +709,8 @@             Just (start, end) -> do                 startsWord <- startsWord start                 endsWord <- endsWord end-                if (startsWord && endsWord)-                    then applyTagByName ebuf tagName start end-                    else return ()+                when (startsWord && endsWord) $+                    applyTagByName ebuf tagName start end                 forwardApplying end txt mbTi tagName ebuf             Nothing -> return() @@ -679,7 +720,7 @@     currentChar <- getChar sel     let mbStartCharCat = getCharacterCategory currentChar     mbPrevCharCat <- getCharacterCategory <$> (backwardCharC sel >>= getChar)-    return $ currentChar == Nothing || currentChar == Just '\n' || mbStartCharCat /= mbPrevCharCat && (mbStartCharCat == SyntaxCharacter || mbStartCharCat == IdentifierCharacter)+    return $ isNothing currentChar || currentChar == Just '\n' || mbStartCharCat /= mbPrevCharCat && (mbStartCharCat == SyntaxCharacter || mbStartCharCat == IdentifierCharacter)  getIdentifierUnderCursor :: forall editor. TextEditor editor => EditorBuffer editor -> IDEM (EditorIter editor, EditorIter editor) getIdentifierUnderCursor buffer = do@@ -741,7 +782,7 @@                                         load <- readIDE (autoLoad . prefs)                                         if load                                             then do-                                                ideMessage Normal $ (__ "Auto Loading ") <> T.pack fn+                                                ideMessage Normal $ __ "Auto Loading " <> T.pack fn                                                 revert buf                                                 return (False, True)                                             else do@@ -751,7 +792,7 @@                                                             (Just window) []                                                             MessageQuestion                                                             ButtonsNone-                                                            ((__"File \"") <> name <> (__ "\" has changed on disk."))+                                                            (__ "File \"" <> name <> __ "\" has changed on disk.")                                                     dialogAddButton md (__ "_Load From Disk") (ResponseUser 1)                                                     dialogAddButton md (__ "_Always Load From Disk") (ResponseUser 2)                                                     dialogAddButton md (__ "_Don't Load") (ResponseUser 3)@@ -772,7 +813,7 @@                                                         nmt2 <- liftIO $ getModificationTime fn                                                         liftIO $ writeIORef (modTime buf) (Just nmt2)                                                         return (True, True)-                                                    _           ->  do return (False, False)+                                                    _              -> return (False, False)                                     else return (False, False)                         else return (False, False)                 Nothing -> return (False, False)@@ -791,7 +832,7 @@                 return ())  fileRevert :: IDEAction-fileRevert = inActiveBufContext () $ \ _ _ _ currentBuffer _ -> do+fileRevert = inActiveBufContext () $ \ _ _ _ currentBuffer _ ->     revert currentBuffer  revert :: MonadIDE m => IDEBuffer -> m ()@@ -807,10 +848,10 @@             mt <- liftIO $ getModificationTime fn             beginNotUndoableAction buffer             setText buffer $ T.pack fc-            if useCandy-                then modeTransformToCandy (mode buf)-                         (modeEditInCommentOrString (mode buf)) buffer-                else return ()+            when useCandy $+                modeTransformToCandy (mode buf)+                    (modeEditInCommentOrString (mode buf))+                    buffer             endNotUndoableAction buffer             setModified buffer False             return mt@@ -849,9 +890,7 @@         Just path -> do           nb <- getNotebook path           mbBS <- maybeActiveBuf-          case mbBS of-              Nothing -> return ()-              Just buf -> markLabelAsChanged nb buf+          forM_ mbBS (markLabelAsChanged nb)  markLabelAsChanged :: Notebook -> IDEBuffer -> IDEAction markLabelAsChanged nb (buf@IDEBuffer{sourceView = sv}) = do@@ -872,10 +911,10 @@     case mbpage of         Nothing     -> throwIDE (__ "fileSave: Page not found")         Just page   ->-            if isJust mbfn && query == False+            if isJust mbfn && not query                 then do (modifiedOnDiskNotLoaded, modifiedOnDisk) <- checkModTime ideBuf -- The user is given option to reload                         modifiedInBuffer <- getModified ebuf-                        if (modifiedOnDiskNotLoaded || modifiedInBuffer)+                        if modifiedOnDiskNotLoaded || modifiedInBuffer                             then do                                 fileSave' (forceLineEnds prefs) (removeTBlanks prefs) nb ideBuf                                     useCandy candy $fromJust mbfn@@ -884,7 +923,7 @@                             else return modifiedOnDisk                 else reifyIDE $ \ideR   ->  do                     dialog <- fileChooserDialogNew-                                    (Just $ (__ "Save File"))+                                    (Just $ __ "Save File")                                     (Just window)                                 FileChooserActionSave                                 [("gtk-cancel"     --buttons to display@@ -892,7 +931,7 @@                                 ,("gtk-save"                                 , ResponseAccept)]                     case mbfn of-                        Just fn -> fileChooserSelectFilename dialog fn >> return ()+                        Just fn -> void (fileChooserSelectFilename dialog fn)                         Nothing -> return ()                     widgetShow dialog                     response <- dialogRun dialog@@ -932,7 +971,7 @@     where         fileSave' :: Bool -> Bool -> Notebook -> IDEBuffer -> Bool -> CandyTable -> FilePath -> IDEAction         fileSave' forceLineEnds removeTBlanks nb ideBuf useCandy candyTable fn = do-            buf     <-   getBuffer $ sv+            buf     <-   getBuffer sv             text    <-   getCandylessText candyTable buf             let text' = if removeTBlanks                             then T.unlines $ map (T.dropWhileEnd $ \c -> c == ' ') $ T.lines text@@ -943,7 +982,103 @@                     return False)             setModified buf (not succ)             markLabelAsChanged nb ideBuf+            hlintBuffer' ideBuf text' fn +hlintSettings :: IDEPackage -> IDEM (ParseFlags, [Classify], Hint)+hlintSettings package = do+    mbHlintDir <- liftIO $ leksahSubDir "hlint"+    let cabalMacros = ipdBuildDir package </> "dist/build/autogen/cabal_macros.h"+    cabalMacrosExist <- liftIO $ doesFileExist cabalMacros+    defines <- liftIO $ if cabalMacrosExist+                            then do+                                raw <- S.readFile cabalMacros+                                map (\(a, b) -> (a, concat (lines b))) . snd <$> runCpphsReturningSymTab defaultCpphsOptions cabalMacros raw+                            else return []+    (fixities, classify, hints) <- liftIO $ findSettings (readSettingsFile mbHlintDir) Nothing+    let hint = resolveHints hints+        flags = parseFlagsAddFixities fixities defaultParseFlags{ cppFlags = Cpphs defaultCpphsOptions+            { defines = defines } }+    liftIO . debugM "leksah" $ "hlintSettings defines = " <> show defines+    return (flags, classify, hint)++hlintBuffer :: IDEBuffer -> IDEAction+hlintBuffer ideBuf@IDEBuffer{..} = do+    buf   <- getBuffer sourceView+    candy <- readIDE candy+    text  <- getCandylessText candy buf+    maybe (return ()) (hlintBuffer' ideBuf text) fileName++hlintBuffer' :: IDEBuffer -> Text -> FilePath -> IDEAction+hlintBuffer' ideBuf text fn = do+    packs <- belongsToPackages ideBuf+    ideR <- ask+    case packs of+        (package:_) -> do+            let file = makeRelative (ipdBuildDir package) fn+            removeLogRefs [LintRef] (ipdBuildDir package) file+            liftIO . void . forkIO $ do+                (flags, classify, hint) <- reflectIDE (hlintSettings package) ideR+                parseResult <- parseModuleEx flags fn (Just $ T.unpack text)+                case parseResult of+                    (Right m) -> do+                        let allIdeas = applyHints classify hint [m]+                            ideas = filter (\Idea{..} -> ideaSeverity /= Ignore+                                                         && equalFilePath (HSE.srcSpanFilename ideaSpan) fn) allIdeas+                        forM_ ideas $ \ idea@Idea{..} -> do+                            let fixColumn c = max 0 (c - 1)+                                srcSpan = SrcSpan file+                                                  (HSE.srcSpanStartLine ideaSpan)+                                                  (HSE.srcSpanStartColumn ideaSpan - 1)+                                                  (HSE.srcSpanEndLine ideaSpan)+                                                  (HSE.srcSpanEndColumn ideaSpan - 1)+                                fromLines = drop (HSE.srcSpanStartLine ideaSpan - 1)+                                          . take (HSE.srcSpanEndLine ideaSpan) $ T.lines text+                                fixHead [] = []+                                fixHead (x:xs) = T.drop (HSE.srcSpanStartColumn ideaSpan - 1) x : xs+                                fixTail [] = []+                                fixTail (x:xs) = T.take (HSE.srcSpanEndColumn ideaSpan - 1) x : xs+                                from = T.reverse . T.drop 1 . T.reverse+                                     . T.unlines . fixHead . reverse . fixTail $ reverse fromLines+                            reflectIDE (postAsyncIDE $ addLogRef+                                (LogRef srcSpan package (T.pack ideaHint <> maybe "" (("\n" <>) . T.pack) ideaTo)+                                        (Just (from, idea)) (0, 0) LintRef)) ideR+                    Left error -> do+                            let loc = parseErrorLocation error+                                srcSpan = SrcSpan file+                                                  (HSE.srcLine loc)+                                                  (HSE.srcColumn loc - 1)+                                                  (HSE.srcLine loc)+                                                  (HSE.srcColumn loc - 1)+                            reflectIDE (postAsyncIDE $ addLogRef+                                (LogRef srcSpan package ("Hlint Parse Error: " <> T.pack (parseErrorMessage error))+                                        Nothing (0, 0) LintRef)) ideR+        _ -> liftIO . debugM "leksah" $ "hlintBuffer package not found for " <> fn++resolveActiveHLint :: IDEM Bool+resolveActiveHLint = inActiveBufContext False  $ \_ _ ebuf _ _ -> do+    allLogRefs <- readIDE allLogRefs+    (iStart, iEnd) <- getSelectionBounds ebuf+    lStart <- getLine iStart+    cStart <- getLineOffset iStart+    lEnd <- getLine iEnd+    cEnd <- getLineOffset iEnd+    let selectedRefs = filter (\ LogRef{..} -> logRefType == LintRef+                         && (lStart+1, cStart) <= (srcSpanEndLine logRefSrcSpan, srcSpanEndColumn logRefSrcSpan)+                         && (lEnd+1, cEnd) >= (srcSpanStartLine logRefSrcSpan, srcSpanStartColumn logRefSrcSpan)) allLogRefs+        safeRefs = takeWhileNotOverlapping selectedRefs+    (changed, _) <- foldM replaceHLintSource (False, 0) . catMaybes $ map logRefIdea safeRefs+    prefs <- readIDE prefs+    when changed $ if backgroundBuild prefs+                        then setModified ebuf True+                        else void $ fileSave False+    return changed
+  where+    takeWhileNotOverlapping = takeWhileNotOverlapping' (-1)+    takeWhileNotOverlapping' _ [] = []+    takeWhileNotOverlapping' line (ref:refs)+        | srcSpanEndLine (logRefSrcSpan ref) > line = ref : takeWhileNotOverlapping' (srcSpanEndLine $ logRefSrcSpan ref) refs+        | otherwise = takeWhileNotOverlapping' line refs+ fileSave :: Bool -> IDEM Bool fileSave query = inActiveBufContext False $ fileSaveBuffer query @@ -984,19 +1119,19 @@     return ()  fileClose :: IDEM Bool-fileClose = inActiveBufContext True $ fileClose'+fileClose = inActiveBufContext True fileClose'  fileClose' :: TextEditor editor => Notebook -> EditorView editor -> EditorBuffer editor -> IDEBuffer -> Int  -> IDEM Bool fileClose' nb _ ebuf currentBuffer i = do     window  <- getMainWindow     modified <- getModified ebuf-    cancel <- reifyIDE $ \ideR   ->  do+    cancel <- reifyIDE $ \ideR   ->         if modified             then do                 md <- messageDialogNew (Just window) []                                             MessageQuestion                                             ButtonsCancel-                                            ((__ "Save changes to document: ")+                                            (__ "Save changes to document: "                                                 <> paneName currentBuffer                                                 <> "?")                 dialogAddButton md (__ "_Save") ResponseYes@@ -1016,8 +1151,7 @@         then return False         else do             closeThisPane currentBuffer-            when (isJust $ fileName currentBuffer)-                (addRecentlyUsedFile (fromJust $ fileName currentBuffer))+            forM_ (fileName currentBuffer) addRecentlyUsedFile             return True  fileCloseAll :: (IDEBuffer -> IDEM Bool)  -> IDEM Bool@@ -1035,7 +1169,7 @@  fileCloseAllButPackage :: IDEAction fileCloseAllButPackage = do-    mbActivePath    <-  (fmap ipdBuildDir) <$> readIDE activePack+    mbActivePath    <-  fmap ipdBuildDir <$> readIDE activePack     bufs            <-  allBuffers     case mbActivePath of         Just p -> mapM_ (close' p) bufs@@ -1058,7 +1192,7 @@ fileCloseAllButWorkspace = do     mbWorkspace     <-  readIDE workspace     bufs            <-  allBuffers-    when (not (null bufs) && isJust mbWorkspace) $ do+    when (not (null bufs) && isJust mbWorkspace) $         mapM_ (close' (fromJust mbWorkspace)) bufs     where         close' workspace (buf@IDEBuffer {sourceView = sv}) = do@@ -1075,7 +1209,7 @@                             $ do fileClose' nb sv ebuf buf i; return ()         isSubPathOfAny workspace fileName =             let paths = wsPackages workspace >>= ipdAllDirs-            in  or (map (\dir -> isSubPath dir fileName) paths)+            in  any (`isSubPath` fileName) paths   fileOpen :: IDEAction@@ -1085,7 +1219,7 @@     mbBuf <- maybeActiveBuf     mbFileName <- liftIO $ do         dialog <- fileChooserDialogNew-                        (Just $ (__ "Open File"))+                        (Just $ __ "Open File")                         (Just window)                     FileChooserActionOpen                     [("gtk-cancel"@@ -1093,7 +1227,7 @@                     ,("gtk-open"                     ,ResponseAccept)]         case mbBuf >>= fileName of-            Just fn -> fileChooserSetCurrentFolder dialog (dropFileName $ fn) >> return ()+            Just fn -> void (fileChooserSetCurrentFolder dialog (dropFileName fn))             Nothing -> return ()         widgetShow dialog         response <- dialogRun dialog@@ -1109,9 +1243,7 @@                 widgetDestroy dialog                 return Nothing             _ -> return Nothing-    case mbFileName of-        Nothing -> return ()-        Just fp -> fileOpenThis fp+    forM_ mbFileName fileOpenThis   fileOpenThis :: FilePath -> IDEAction@@ -1150,70 +1282,65 @@             return ()  filePrint :: IDEAction-filePrint = inActiveBufContext () $ filePrint'+filePrint = inActiveBufContext () filePrint'  filePrint' :: TextEditor editor => Notebook -> EditorView view -> EditorBuffer editor -> IDEBuffer -> Int -> IDEM () filePrint' nb _ ebuf currentBuffer _ = do     let pName = paneName currentBuffer     window  <- getMainWindow     print <- reifyIDE $ \ideR ->  do-                md <- messageDialogNew (Just window) []-                                            MessageQuestion-                                            ButtonsNone-                                            (__"Print document: "-                                                <> pName-                                                <> "?")-                dialogAddButton md (__"_Print") ResponseYes-                dialogAddButton md (__"_Don't Print") ResponseNo-                set md [ windowWindowPosition := WinPosCenterOnParent ]-                resp <- dialogRun md-                widgetDestroy md-                case resp of-                    ResponseYes ->   do-                        return True-                    ResponseCancel  ->   return False-                    ResponseNo      ->   return False-                    _               ->   return False-    if not print-        then return ()-        else do-            --real code-            modified <- getModified ebuf-            cancel <- reifyIDE $ \ideR ->  do-                if modified-                    then do-                        md <- messageDialogNew (Just window) []-                                                    MessageQuestion-                                                    ButtonsNone-                                                    (__"Save changes to document: "-                                                        <> pName-                                                        <> "?")-                        dialogAddButton md (__"_Save") ResponseYes-                        dialogAddButton md (__"_Don't Save") ResponseNo-                        dialogAddButton md (__"_Cancel Printing") ResponseCancel-                        set md [ windowWindowPosition := WinPosCenterOnParent ]-                        resp <- dialogRun md-                        widgetDestroy md-                        case resp of-                            ResponseYes ->   do-                                reflectIDE (fileSave False) ideR-                                return False-                            ResponseCancel  ->   return True-                            ResponseNo      ->   return False-                            _               ->   return False-                    else-                        return False-            if cancel-                then return ()-                else do-                    case fileName currentBuffer of-                        Just name -> do-                                      status <- liftIO $ Print.print name-                                      case status of-                                        Left error -> liftIO $ showDialog (T.pack $ show error) MessageError-                                        Right _ -> liftIO $ showDialog "Print job has been sent successfully" MessageInfo-                                      return ()-                        Nothing   -> return ()+        md <- messageDialogNew (Just window) []+                                    MessageQuestion+                                    ButtonsNone+                                    (__"Print document: "+                                        <> pName+                                        <> "?")+        dialogAddButton md (__"_Print") ResponseYes+        dialogAddButton md (__"_Don't Print") ResponseNo+        set md [ windowWindowPosition := WinPosCenterOnParent ]+        resp <- dialogRun md+        widgetDestroy md+        case resp of+            ResponseYes     ->   return True+            ResponseCancel  ->   return False+            ResponseNo      ->   return False+            _               ->   return False+    when print $ do+        --real code+        modified <- getModified ebuf+        cancel <- reifyIDE $ \ideR ->+            if modified+                then do+                    md <- messageDialogNew (Just window) []+                                                MessageQuestion+                                                ButtonsNone+                                                (__"Save changes to document: "+                                                    <> pName+                                                    <> "?")+                    dialogAddButton md (__"_Save") ResponseYes+                    dialogAddButton md (__"_Don't Save") ResponseNo+                    dialogAddButton md (__"_Cancel Printing") ResponseCancel+                    set md [ windowWindowPosition := WinPosCenterOnParent ]+                    resp <- dialogRun md+                    widgetDestroy md+                    case resp of+                        ResponseYes ->   do+                            reflectIDE (fileSave False) ideR+                            return False+                        ResponseCancel  ->   return True+                        ResponseNo      ->   return False+                        _               ->   return False+                else+                    return False+        unless cancel $+            case fileName currentBuffer of+                Just name -> do+                              status <- liftIO $ Print.print name+                              case status of+                                Left error -> liftIO $ showDialog (T.pack $ show error) MessageError+                                Right _ -> liftIO $ showDialog "Print job has been sent successfully" MessageInfo+                              return ()+                Nothing   -> return ()  editUndo :: IDEAction editUndo = inActiveBufContext () $ \_ _ buf _ _ -> do@@ -1258,14 +1385,12 @@     prefs <- readIDE prefs     let str = T.replicate (tabWidth prefs) " "     b <- canShiftLeft str prefs-    if b-        then do-            doForSelectedLines [] $ \ebuf lineNr -> do-                sol <- getIterAtLine ebuf lineNr-                sol2 <- forwardCharsC sol (tabWidth prefs)-                delete ebuf sol sol2-            return ()-        else return ()+    when b $ do+        doForSelectedLines [] $ \ebuf lineNr -> do+            sol <- getIterAtLine ebuf lineNr+            sol2 <- forwardCharsC sol (tabWidth prefs)+            delete ebuf sol sol2+        return ()     where     canShiftLeft str prefs = do         boolList <- doForSelectedLines [] $ \ebuf lineNr -> do@@ -1288,12 +1413,10 @@ alignChar :: Char -> IDEAction alignChar char = do     positions     <- positionsOfChar-    let alignTo = foldl' max 0 (catMaybes (map snd positions))-    if (alignTo > 0)-        then alignChar (Map.fromList positions) alignTo-        else return ()+    let alignTo = foldl' max 0 (mapMaybe snd positions)+    when (alignTo > 0) $ alignChar (Map.fromList positions) alignTo     where-    positionsOfChar :: IDEM ([(Int, Maybe Int)])+    positionsOfChar :: IDEM [(Int, Maybe Int)]     positionsOfChar = doForSelectedLines [] $ \ebuf lineNr -> do             sol <- getIterAtLine ebuf lineNr             eol <- forwardToLineEndC sol@@ -1301,7 +1424,7 @@             return (lineNr, T.findIndex (==char) line)     alignChar :: Map Int (Maybe Int) -> Int -> IDEM ()     alignChar positions alignTo = do-            doForSelectedLines [] $ \ebuf lineNr -> do+            doForSelectedLines [] $ \ebuf lineNr ->                 case lineNr `Map.lookup` positions of                     Just (Just n)  ->  do                         sol       <- getIterAtLine ebuf lineNr@@ -1322,9 +1445,9 @@ addRecentlyUsedFile :: FilePath -> IDEAction addRecentlyUsedFile fp = do     state <- readIDE currentState-    when (not $ isStartingOrClosing state) $ do+    unless (isStartingOrClosing state) $ do         recentFiles' <- readIDE recentFiles-        unless (elem fp recentFiles') $+        unless (fp `elem` recentFiles') $             modifyIDE_ (\ide -> ide{recentFiles = take 12 (fp : recentFiles')})         triggerEventIDE UpdateRecent         return ()@@ -1332,10 +1455,10 @@ removeRecentlyUsedFile :: FilePath -> IDEAction removeRecentlyUsedFile fp = do     state <- readIDE currentState-    when (not $ isStartingOrClosing state) $ do+    unless (isStartingOrClosing state) $ do         recentFiles' <- readIDE recentFiles-        when (elem fp recentFiles') $-            modifyIDE_ (\ide -> ide{recentFiles = filter (\e -> e /= fp) recentFiles'})+        when (fp `elem` recentFiles') $+            modifyIDE_ (\ide -> ide{recentFiles = filter (/= fp) recentFiles'})         triggerEventIDE UpdateRecent         return () @@ -1364,7 +1487,7 @@                 iStart <- getIterAtLine ebuf line                 iEnd <- forwardToLineEndC iStart                 return (iStart, iEnd)-        fmap Just $ getCandylessPart candy' ebuf i1 i2+        Just <$> getCandylessPart candy' ebuf i1 i2  selectedLocation :: IDEM (Maybe (Int, Int)) selectedLocation = do@@ -1416,7 +1539,7 @@ belongsToPackage :: FilePath -> IDEPackage -> Bool belongsToPackage f = any (`isSubPath` f) . ipdAllDirs -belongsToWorkspace b =  belongsToPackages b >>= return . (not . null)+belongsToWorkspace b =  liftM (not . null) (belongsToPackages b)  useCandyFor :: MonadIDE m => IDEBuffer -> m Bool useCandyFor aBuffer = do

@@ -80,25 +80,25 @@     paneId b        =   "*Doc"  instance RecoverablePane IDEDocumentation DocumentationState IDEM where-    saveState p     =   liftIO $ do+    saveState p     =   liftIO $ #ifdef WEBKITGTK-        zoom <- webView p `get` webViewZoomLevel-        uri  <- webView p `get` webViewUri-        return (Just DocumentationState{..})+         do zoom <- webView p `get` webViewZoomLevel+            uri  <- webView p `get` webViewUri+            return (Just DocumentationState{..}) #else-        Just <$> readIORef (docState p)+            Just <$> readIORef (docState p) #endif     recoverState pp DocumentationState {..} =   do         nb      <-  getNotebook pp         mbPane <- buildPane pp nb builder         case mbPane of             Nothing -> return ()-            Just p  -> liftIO $ do+            Just p  -> liftIO $ #ifdef WEBKITGTK-                webView p `set` [webViewZoomLevel := zoom]-                maybe (return ()) (webViewLoadUri (webView p)) uri+                 do webView p `set` [webViewZoomLevel := zoom]+                    maybe (return ()) (webViewLoadUri (webView p)) uri #else-                writeIORef (docState p) DocumentationState {..}+                    writeIORef (docState p) DocumentationState {..} #endif         return mbPane     builder pp nb windows = reifyIDE $ \ ideR -> do@@ -140,22 +140,22 @@ getDocumentation (Just pp)  = forceGetPane (Left pp)  loadDoc :: Text -> IDEAction-loadDoc uri = do+loadDoc uri = #ifdef WEBKITGTK-    doc <- getDocumentation Nothing-    let view = webView doc-    liftIO $ webViewLoadUri view uri+     do doc <- getDocumentation Nothing+        let view = webView doc+        liftIO $ webViewLoadUri view uri #else-    return ()+        return () #endif  reloadDoc :: IDEAction-reloadDoc = do+reloadDoc = #ifdef WEBKITGTK-    doc <- getDocumentation Nothing-    let view = webView doc-    liftIO $ webViewReload view+     do doc <- getDocumentation Nothing+        let view = webView doc+        liftIO $ webViewReload view #else-    return ()+        return () #endif 

@@ -94,7 +94,7 @@     paneId b        =   "*Inspect"  instance RecoverablePane IDEInspect InspectState IDEM where-    saveState p     =   liftIO $ do+    saveState p     =   liftIO $ #ifdef WEBKITGTK         return (Just InspectState{}) #else@@ -105,7 +105,7 @@         mbPane <- buildPane pp nb builder         case mbPane of             Nothing -> return ()-            Just p  -> liftIO $ do+            Just p  -> liftIO $ #ifdef WEBKITGTK                 return () #else

@@ -102,25 +102,25 @@     paneId b        =   "*Out"  instance RecoverablePane IDEOutput OutputState IDEM where-    saveState p     =   liftIO $ do+    saveState p     =   liftIO $ #ifdef WEBKITGTK-        zoom <- webView p `get` webViewZoomLevel-        alwaysHtml <- readIORef $ alwaysHtmlRef p-        return (Just OutputState{..})+         do zoom <- webView p `get` webViewZoomLevel+            alwaysHtml <- readIORef $ alwaysHtmlRef p+            return (Just OutputState{..}) #else-        Just <$> readIORef (outState p)+            Just <$> readIORef (outState p) #endif     recoverState pp OutputState {..} =   do         nb      <-  getNotebook pp         mbPane <- buildPane pp nb builder         case mbPane of             Nothing -> return ()-            Just p  -> liftIO $ do+            Just p  -> liftIO $ #ifdef WEBKITGTK-                webView p `set` [webViewZoomLevel := zoom]-                writeIORef (alwaysHtmlRef p) alwaysHtml+                 do webView p `set` [webViewZoomLevel := zoom]+                    writeIORef (alwaysHtmlRef p) alwaysHtml #else-                writeIORef (outState p) OutputState {..}+                   writeIORef (outState p) OutputState {..} #endif         return mbPane     builder pp nb windows = reifyIDE $ \ ideR -> do@@ -216,34 +216,34 @@         ++ "/value.html"  setOutput :: Text -> Text -> IDEAction-setOutput command str = do+setOutput command str = #ifdef WEBKITGTK-    out <- getOutputPane Nothing-    liftIO $ do-        entrySetText (uriEntry out) (T.pack $ show command)-        uri <- getValueUri-        alwaysHtml <- readIORef $ alwaysHtmlRef out-        let view = webView out-            html = case (alwaysHtml, parseValue $ T.unpack str) of-                        (False, Just value) -> T.pack $ valToHtmlPage defaultHtmlOpts value-                        _                   -> str-        webViewLoadString view html Nothing uri+     do out <- getOutputPane Nothing+        liftIO $ do+            entrySetText (uriEntry out) (T.pack $ show command)+            uri <- getValueUri+            alwaysHtml <- readIORef $ alwaysHtmlRef out+            let view = webView out+                html = case (alwaysHtml, parseValue $ T.unpack str) of+                            (False, Just value) -> T.pack $ valToHtmlPage defaultHtmlOpts value+                            _                   -> str+            webViewLoadString view html Nothing uri #else-    return ()+        return () #endif  loadOutputUri :: FilePath -> IDEAction-loadOutputUri uri = do+loadOutputUri uri = #ifdef WEBKITGTK-    out <- getOutputPane Nothing-    let view = webView out-    liftIO $ do-        entrySetText (uriEntry out) (T.pack uri)-        currentUri <- webViewGetUri view-        if Just (T.pack uri) == currentUri-            then webViewReload view-            else webViewLoadUri view (T.pack uri)+     do out <- getOutputPane Nothing+        let view = webView out+        liftIO $ do+            entrySetText (uriEntry out) (T.pack uri)+            currentUri <- webViewGetUri view+            if Just (T.pack uri) == currentUri+                then webViewReload view+                else webViewLoadUri view (T.pack uri) #else-    return ()+        return () #endif 

@@ -73,10 +73,12 @@ import IDE.Workspaces (workspaceOpenThis) import IDE.Completion (setCompletionSize) import Control.Monad.IO.Class (MonadIO(..))-import Control.Monad (forM_, forM, when)+import Control.Monad (void, when) import System.Log.Logger (debugM) import Data.Text (Text) import qualified Data.Text as T (pack)+import Data.Traversable (forM)+import Data.Foldable (forM_)  -- --------------------------------------------------------------------- -- This needs to be incremented, when the session format changes@@ -109,45 +111,45 @@     deriving(Eq,Ord,Read,Show)  asPaneState :: RecoverablePane alpha beta gamma => beta -> PaneState-asPaneState s | isJust ((cast s) :: Maybe BufferState)      =   BufferSt (fromJust $ cast s)-asPaneState s | isJust ((cast s) :: Maybe LogState)         =   LogSt (fromJust $ cast s)-asPaneState s | isJust ((cast s) :: Maybe InfoState)        =   InfoSt (fromJust $ cast s)-asPaneState s | isJust ((cast s) :: Maybe ModulesState)     =   ModulesSt (fromJust $ cast s)-asPaneState s | isJust ((cast s) :: Maybe PrefsState)       =   PrefsSt (fromJust $ cast s)-asPaneState s | isJust ((cast s) :: Maybe FlagsState)       =   FlagsSt (fromJust $ cast s)-asPaneState s | isJust ((cast s) :: Maybe SearchState)      =   SearchSt (fromJust $ cast s)-asPaneState s | isJust ((cast s) :: Maybe FilesState)       =   FilesSt (fromJust $ cast s)-asPaneState s | isJust ((cast s) :: Maybe GrepState)        =   GrepSt (fromJust $ cast s)-asPaneState s | isJust ((cast s) :: Maybe HLintState)       =   HLintSt (fromJust $ cast s)-asPaneState s | isJust ((cast s) :: Maybe DocumentationState) = DocumentationSt (fromJust $ cast s)-asPaneState s | isJust ((cast s) :: Maybe OutputState)      =   OutputSt (fromJust $ cast s)-asPaneState s | isJust ((cast s) :: Maybe InspectState)     =   InspectSt (fromJust $ cast s)-asPaneState s | isJust ((cast s) :: Maybe BreakpointsState) =   BreakpointsSt (fromJust $ cast s)-asPaneState s | isJust ((cast s) :: Maybe TraceState)       =   TraceSt (fromJust $ cast s)-asPaneState s | isJust ((cast s) :: Maybe VariablesState)   =   VariablesSt (fromJust $ cast s)-asPaneState s | isJust ((cast s) :: Maybe ErrorsState)      =   ErrorsSt (fromJust $ cast s)-asPaneState s | isJust ((cast s) :: Maybe WorkspaceState)   =   WorkspaceSt (fromJust $ cast s)+asPaneState s | isJust (cast s :: Maybe BufferState)      =   BufferSt (fromJust $ cast s)+asPaneState s | isJust (cast s :: Maybe LogState)         =   LogSt (fromJust $ cast s)+asPaneState s | isJust (cast s :: Maybe InfoState)        =   InfoSt (fromJust $ cast s)+asPaneState s | isJust (cast s :: Maybe ModulesState)     =   ModulesSt (fromJust $ cast s)+asPaneState s | isJust (cast s :: Maybe PrefsState)       =   PrefsSt (fromJust $ cast s)+asPaneState s | isJust (cast s :: Maybe FlagsState)       =   FlagsSt (fromJust $ cast s)+asPaneState s | isJust (cast s :: Maybe SearchState)      =   SearchSt (fromJust $ cast s)+asPaneState s | isJust (cast s :: Maybe FilesState)       =   FilesSt (fromJust $ cast s)+asPaneState s | isJust (cast s :: Maybe GrepState)        =   GrepSt (fromJust $ cast s)+asPaneState s | isJust (cast s :: Maybe HLintState)       =   HLintSt (fromJust $ cast s)+asPaneState s | isJust (cast s :: Maybe DocumentationState) = DocumentationSt (fromJust $ cast s)+asPaneState s | isJust (cast s :: Maybe OutputState)      =   OutputSt (fromJust $ cast s)+asPaneState s | isJust (cast s :: Maybe InspectState)     =   InspectSt (fromJust $ cast s)+asPaneState s | isJust (cast s :: Maybe BreakpointsState) =   BreakpointsSt (fromJust $ cast s)+asPaneState s | isJust (cast s :: Maybe TraceState)       =   TraceSt (fromJust $ cast s)+asPaneState s | isJust (cast s :: Maybe VariablesState)   =   VariablesSt (fromJust $ cast s)+asPaneState s | isJust (cast s :: Maybe ErrorsState)      =   ErrorsSt (fromJust $ cast s)+asPaneState s | isJust (cast s :: Maybe WorkspaceState)   =   WorkspaceSt (fromJust $ cast s) asPaneState s                                               =   error "SaveSession>>asPaneState incomplete cast"  recover :: PanePath -> PaneState -> IDEAction-recover pp (BufferSt p)         =   recoverState pp p >> return ()-recover pp (LogSt p)            =   recoverState pp p >> return ()-recover pp (InfoSt p)           =   recoverState pp p >> return ()-recover pp (ModulesSt p)        =   recoverState pp p >> return ()-recover pp (PrefsSt p)          =   recoverState pp p >> return ()-recover pp (FlagsSt p)          =   recoverState pp p >> return ()-recover pp (SearchSt p)         =   recoverState pp p >> return ()-recover pp (FilesSt p)          =   recoverState pp p >> return ()-recover pp (GrepSt p)           =   recoverState pp p >> return ()-recover pp (HLintSt p)          =   recoverState pp p >> return ()-recover pp (DocumentationSt p)  =   recoverState pp p >> return ()-recover pp (OutputSt p)         =   recoverState pp p >> return ()-recover pp (InspectSt p)        =   recoverState pp p >> return ()-recover pp (BreakpointsSt p)    =   recoverState pp p >> return ()-recover pp (TraceSt p)          =   recoverState pp p >> return ()-recover pp (VariablesSt p)      =   recoverState pp p >> return ()-recover pp (ErrorsSt p)         =   recoverState pp p >> return ()-recover pp (WorkspaceSt p)      =   recoverState pp p >> return ()+recover pp (BufferSt p)         =   void (recoverState pp p)+recover pp (LogSt p)            =   void (recoverState pp p)+recover pp (InfoSt p)           =   void (recoverState pp p)+recover pp (ModulesSt p)        =   void (recoverState pp p)+recover pp (PrefsSt p)          =   void (recoverState pp p)+recover pp (FlagsSt p)          =   void (recoverState pp p)+recover pp (SearchSt p)         =   void (recoverState pp p)+recover pp (FilesSt p)          =   void (recoverState pp p)+recover pp (GrepSt p)           =   void (recoverState pp p)+recover pp (HLintSt p)          =   void (recoverState pp p)+recover pp (DocumentationSt p)  =   void (recoverState pp p)+recover pp (OutputSt p)         =   void (recoverState pp p)+recover pp (InspectSt p)        =   void (recoverState pp p)+recover pp (BreakpointsSt p)    =   void (recoverState pp p)+recover pp (TraceSt p)          =   void (recoverState pp p)+recover pp (VariablesSt p)      =   void (recoverState pp p)+recover pp (ErrorsSt p)         =   void (recoverState pp p)+recover pp (WorkspaceSt p)      =   void (recoverState pp p)  -- --------------------------------------------------------------------- @@ -186,43 +188,43 @@         sessionVersion      =   theSessionVersion     ,   saveTime            =   ""     ,   layoutS             =   VerticalP-                                    (TerminalP {+                                    TerminalP {                                         paneGroups = Map.fromList []                                       , paneTabs = Just TopP                                       , currentPage = -1                                       , detachedId = Nothing-                                      , detachedSize = Nothing})+                                      , detachedSize = Nothing}                                     (HorizontalP-                                        (TerminalP {+                                        TerminalP {                                             paneGroups = Map.fromList [                                                 ("Debug",HorizontalP-                                                    (TerminalP {+                                                    TerminalP {                                                         paneGroups = Map.fromList []                                                       , paneTabs = Nothing                                                       , currentPage = -1                                                       , detachedId = Nothing-                                                      , detachedSize = Nothing})-                                                    (TerminalP {+                                                      , detachedSize = Nothing}+                                                    TerminalP {                                                         paneGroups = Map.fromList []                                                       , paneTabs = Just TopP                                                       , currentPage = -1                                                       , detachedId = Nothing-                                                      , detachedSize = Nothing}) 167)]+                                                      , detachedSize = Nothing} 167)]                                           , paneTabs = Just TopP                                           , currentPage = 2                                           , detachedId = Nothing-                                          , detachedSize = Nothing})-                                        (TerminalP {+                                          , detachedSize = Nothing}+                                        TerminalP {                                             paneGroups = Map.fromList []                                           , paneTabs = Just TopP                                           , currentPage = 1                                           , detachedId = Nothing-                                          , detachedSize = Nothing}) 456) 693+                                          , detachedSize = Nothing} 456) 693     ,   population          =   [ (Just (InfoSt (InfoState Nothing)),[SplitP RightP,SplitP BottomP])                                 , (Just (LogSt LogState),[SplitP RightP,SplitP BottomP])                                 , (Just (ModulesSt                                     (ModulesState 200 (SystemScope,False) (Nothing,Nothing)-                                        (ExpanderState {+                                        ExpanderState {                                             packageExp = ([],[])                                           , packageExpNoBlack = ([],[])                                           , packageDExp = ([],[])@@ -232,7 +234,7 @@                                           , workspaceDExp = ([],[])                                           , workspaceDExpNoBlack = ([],[])                                           , systemExp = ([],[])-                                          , systemExpNoBlack = ([],[])}))),[SplitP RightP,SplitP TopP])+                                          , systemExpNoBlack = ([],[])})),[SplitP RightP,SplitP TopP])                                 , (Just (WorkspaceSt WorkspaceState),[SplitP RightP,SplitP BottomP])]     ,   windowSize          =   (1024,768)     ,   fullScreen          =   False@@ -258,85 +260,85 @@ sessionDescr :: [FieldDescriptionS SessionState] sessionDescr = [         mkFieldS-            (paraName <<<- ParaName ( "Version of session file format") $ emptyParams)+            (paraName <<<- ParaName "Version of session file format" $ emptyParams)             (PP.text . show)             intParser             sessionVersion             (\ b a -> a{sessionVersion = b})     ,   mkFieldS-            (paraName <<<- ParaName ( "Time of storage") $ emptyParams)+            (paraName <<<- ParaName "Time of storage" $ emptyParams)             (PP.text . show)             stringParser             saveTime             (\ b a -> a{saveTime = b})     ,   mkFieldS-            (paraName <<<- ParaName ( "Layout") $ emptyParams)+            (paraName <<<- ParaName "Layout" $ emptyParams)             (PP.text . show)             readParser             layoutS             (\ b a -> a{layoutS = b})     ,   mkFieldS-            (paraName <<<- ParaName ( "Population") $ emptyParams)+            (paraName <<<- ParaName "Population" $ emptyParams)             (PP.text . show)             readParser             population             (\ b a -> a{population = b})     ,   mkFieldS-            (paraName <<<- ParaName ( "Window size") $ emptyParams)+            (paraName <<<- ParaName "Window size" $ emptyParams)             (PP.text . show)             (pairParser intParser)             windowSize             (\(c,d) a -> a{windowSize = (c,d)})     ,   mkFieldS-            (paraName <<<- ParaName ( "Full screen") $ emptyParams)+            (paraName <<<- ParaName "Full screen" $ emptyParams)             (PP.text . show)             readParser             fullScreen             (\b a -> a{fullScreen = b})     ,   mkFieldS-            (paraName <<<- ParaName ( "Dark") $ emptyParams)+            (paraName <<<- ParaName "Dark" $ emptyParams)             (PP.text . show)             readParser             dark             (\b a -> a{dark = b})     ,   mkFieldS-            (paraName <<<- ParaName ( "Completion size") $ emptyParams)+            (paraName <<<- ParaName "Completion size" $ emptyParams)             (PP.text . show)             (pairParser intParser)             completionSize             (\(c,d) a -> a{completionSize = (c,d)})     ,   mkFieldS-            (paraName <<<- ParaName ( "Workspace") $ emptyParams)+            (paraName <<<- ParaName "Workspace" $ emptyParams)             (PP.text . show)             readParser             workspacePath             (\fp a -> a{workspacePath = fp})     ,   mkFieldS-            (paraName <<<- ParaName ( "Active pane") $ emptyParams)+            (paraName <<<- ParaName "Active pane" $ emptyParams)             (PP.text . show)             readParser             activePaneN             (\fp a -> a{activePaneN = fp})     ,   mkFieldS-            (paraName <<<- ParaName ( "Toolbar visible") $ emptyParams)+            (paraName <<<- ParaName "Toolbar visible" $ emptyParams)             (PP.text . show)             readParser             toolbarVisibleS             (\fp a -> a{toolbarVisibleS = fp})     ,   mkFieldS-            (paraName <<<- ParaName ( "FindbarState") $ emptyParams)+            (paraName <<<- ParaName "FindbarState" $ emptyParams)             (PP.text . show)             readParser             findbarState             (\fp a -> a{findbarState = fp})     ,   mkFieldS-            (paraName <<<- ParaName ( "Recently opened files") $ emptyParams)+            (paraName <<<- ParaName "Recently opened files" $ emptyParams)             (PP.text . show)             readParser             recentOpenedFiles             (\fp a -> a{recentOpenedFiles = fp})     ,   mkFieldS-            (paraName <<<- ParaName ( "Recently opened workspaces") $ emptyParams)+            (paraName <<<- ParaName "Recently opened workspaces" $ emptyParams)             (PP.text . show)             readParser             recentOpenedWorksp@@ -365,7 +367,7 @@             sysMessage Normal (__ "Now saving session")             bufs <- allBuffers             case filter (\b -> bufferName b == "_Eval.hs") bufs of-                [(IDEBuffer {sourceView = sv})] -> do+                [IDEBuffer{sourceView = sv}] -> do                     ebuf <- getBuffer sv                     setModified ebuf False                 _     -> return ()@@ -427,7 +429,7 @@     response <- liftIO $ do         configFolder <- getConfigDir         dialog <- fileChooserDialogNew-                  (Just $ (__ "Select session file"))+                  (Just $ __ "Select session file")                   (Just window')               FileChooserActionOpen               [("gtk-cancel"@@ -457,16 +459,15 @@     recentFiles'      <- readIDE recentFiles     recentWorkspaces' <- readIDE recentWorkspaces     b <- fileCloseAll (\_ -> return True)-    if b-        then do-            detachedCloseAll-            paneCloseAll-            groupsCloseAll-            viewCollapseAll-            recoverSession sessionPath-            modifyIDE_ (\ide -> ide{recentFiles = recentFiles', recentWorkspaces = recentWorkspaces'})-            return ()-        else return ()+    when b $ do+        detachedCloseAll+        paneCloseAll+        groupsCloseAll+        viewCollapseAll+        recoverSession sessionPath+        modifyIDE_ (\ ide -> ide{ recentFiles      = recentFiles'+                                , recentWorkspaces = recentWorkspaces'})+        return ()  detachedCloseAll :: IDEAction detachedCloseAll = do@@ -487,11 +488,11 @@ viewCollapseAll = do     layout' <- getLayout     case layout' of-        TerminalP {}      -> return ()-        VerticalP _ _ _   -> viewCollapse' [SplitP LeftP]-        HorizontalP _ _ _ -> viewCollapse' [SplitP TopP]+        TerminalP {}   -> return ()+        VerticalP {}   -> viewCollapse' [SplitP LeftP]+        HorizontalP {} -> viewCollapse' [SplitP TopP] -mkLayout :: IDEM(PaneLayout)+mkLayout :: IDEM PaneLayout mkLayout = do     rawLayout <- getLayout     getLayout' rawLayout []@@ -519,7 +520,7 @@         size <- case detachedId raw of             Just _  -> do                 Just parent <- liftIO $ widgetGetParent nb-                liftIO $ fmap Just $ windowGetSize (castToWindow parent)+                liftIO (Just <$> windowGetSize (castToWindow parent))             Nothing -> return $ detachedSize raw         return raw {                 paneGroups   = Map.fromAscList groups2@@ -560,7 +561,7 @@         sessionSt    <- liftIO $ catch                             (readFields sessionPath sessionDescr defaultSession)                             (\(_ :: SomeException) -> return defaultSession)-        liftIO $ windowSetDefaultSize wdw (fst (windowSize sessionSt))(snd (windowSize sessionSt))+        liftIO $ uncurry (windowSetDefaultSize wdw) (windowSize sessionSt)         applyLayout (layoutS sessionSt)         workspaceOpenThis False (workspacePath sessionSt)         liftIO $ debugM "leksah" "recoverSession calling populate"@@ -616,7 +617,7 @@         case mbTabPos of             Just p -> liftIO $notebookSetTabPos nb (paneDirectionToPosType p)             _      -> return ()-        forM_ (Map.toAscList groups) $ \(group, g) -> do+        forM_ (Map.toAscList groups) $ \(group, g) ->             applyLayout' g (pp ++ [GroupP group])     applyLayout' (VerticalP l r pos) pp = do         viewSplit' pp Vertical@@ -632,10 +633,7 @@         applyLayout' b (pp ++ [SplitP BottomP])  populate :: [(Maybe PaneState,PanePath)] -> IDEAction-populate = mapM_ (\ (mbPs,pp) ->-            case mbPs of-                Nothing -> return ()-                Just s ->  recover pp s)+populate = mapM_ (\ (mbPs,pp) -> forM_ mbPs (recover pp))  setCurrentPages :: PaneLayout -> IDEAction setCurrentPages layout = setCurrentPages' layout []@@ -645,7 +643,7 @@     setCurrentPages' (VerticalP l r _) p    =   do  setCurrentPages' l (SplitP LeftP : p)                                                     setCurrentPages' r (SplitP RightP : p)     setCurrentPages' (TerminalP groups _ ind _ _) p  =  do-                                                    forM_ (Map.toAscList groups) $ \(group, g) -> do+                                                    forM_ (Map.toAscList groups) $ \(group, g) ->                                                         setCurrentPages' g (GroupP group : p)                                                     when (ind >=  0) $ do                                                         nb <- getNotebook (reverse p)@@ -661,8 +659,7 @@         (Just window, False) -> liftIO $ windowUnfullscreen window  viewDark :: IDEAction-viewDark = do-    getDarkState >>= setDark+viewDark = getDarkState >>= setDark  #ifdef MIN_VERSION_gtk3 getActiveSettings :: PaneMonad alpha => alpha (Maybe Settings)@@ -678,11 +675,7 @@     setInfoStyle     prefs <- readIDE prefs     buffers <- allBuffers-    mapM_ (\(IDEBuffer {sourceView = sv}) -> do-        ebuf <- getBuffer sv-        setStyle dark ebuf (case sourceStyle prefs of-                        (False,_) -> Nothing-                        (True,s) -> Just s)) buffers+    mapM_ updateStyle' buffers #ifdef MIN_VERSION_gtk3     mbSettings <- getActiveSettings     case mbSettings of

@@ -39,7 +39,7 @@  import IDE.Core.State import IDE.TextEditor-import Control.Monad (unless)+import Control.Monad (when, unless) import Data.Text (Text) import qualified Data.Text as T        (pack, singleton, replicate, head, takeWhile, isSuffixOf, length,@@ -53,10 +53,9 @@ --------------------------------------------------------------------------------- -- * Implementation -notBeforeId     =   Set.fromList $['a'..'z'] ++ ['A'..'Z'] ++ ['_']-notAfterId      =   Set.fromList $['a'..'z'] ++ ['A'..'Z'] ++ ['0'..'9'] ++ ['_']-notBeforeOp     =   Set.fromList $['!','#','$','%','&','*','+','.','/','<','=','>','?','@','\\',-                                    '^','|','-','~','\'','"']+notBeforeId     =   Set.fromList $['a'..'z'] ++ ['A'..'Z'] ++ "_"+notAfterId      =   Set.fromList $['a'..'z'] ++ ['A'..'Z'] ++ ['0'..'9'] ++ "_"+notBeforeOp     =   Set.fromList "!#$%&*+./<=>?@\\^|-~'\"" notAfterOp      =   notBeforeOp  keystrokeCandy :: TextEditor editor => CandyTable -> Maybe Char -> EditorBuffer editor -> (Text -> Bool) -> IDEM ()@@ -69,32 +68,31 @@     startIter   <-  backwardToLineStartC endIter     slice       <-  getSlice ebuf startIter endIter True     mbc2        <-  case mbc of-                        Just c -> return (Just c)-                        Nothing -> do-                            getChar endIter+                        Just c  -> return (Just c)+                        Nothing -> getChar endIter     let block   =  editInCommentOrString slice     unless block $         replace mbc2 cursorMark slice offset transformTable     where     -- replace ::  Maybe Char -> m -> Text -> Int -> [(Bool,Text,Text)] -> IDEM ()-    replace mbAfterChar cursorMark match offset list = replace' list+    replace mbAfterChar cursorMark match offset = replace'         where         replace' [] = return ()         replace' ((isOp,from,to):rest) =             let beforeChar  =  T.index match (max 0 (T.length match - (T.length from + 1)))-                beforeOk    =  not $if isOp-                                    then Set.member beforeChar notBeforeOp-                                    else Set.member beforeChar notBeforeId+                beforeOk    =  not $ if isOp+                                        then Set.member beforeChar notBeforeOp+                                        else Set.member beforeChar notBeforeId                 afterOk     =  case mbAfterChar of                                 Nothing -> True                                 Just afterChar ->-                                     not $if isOp-                                        then Set.member afterChar notAfterOp-                                        else Set.member afterChar notAfterId+                                     not $ if isOp+                                                then Set.member afterChar notAfterOp+                                                else Set.member afterChar notAfterId             in if T.isSuffixOf from match && beforeOk && afterOk                 then do                     beginNotUndoableAction ebuf-                    start   <-  getIterAtOffset ebuf (offset - (T.length from))+                    start   <-  getIterAtOffset ebuf (offset - T.length from)                     end     <-  getIterAtOffset ebuf offset                     delete ebuf start end                     ins     <-   getIterAtMark ebuf cursorMark@@ -135,29 +133,23 @@                                 mbChar <- getChar iter                                 case mbChar of                                     Nothing     ->  return True-                                    Just char   ->  return (not $if isOp+                                    Just char   ->  return (not $ if isOp                                                                     then Set.member char notBeforeOp                                                                     else Set.member char notBeforeId)-                    if beforeOk-                        then do-                            afterOk <-  do-                                endOff  <-  getOffset end-                                iter    <-  getIterAtOffset buf endOff-                                mbChar  <-  getChar iter-                                case mbChar of-                                    Nothing     ->  return True-                                    Just char   ->  return (not $if isOp-                                                                    then Set.member char notAfterOp-                                                                    else Set.member char notAfterId)-                            if afterOk-                                then do-                                    delete buf st end-                                    insert buf st to-                                    return ()-                                else do-                                    return ()-                        else do-                        return ()+                    when beforeOk $ do+                        afterOk <-  do+                            endOff  <-  getOffset end+                            iter    <-  getIterAtOffset buf endOff+                            mbChar  <-  getChar iter+                            case mbChar of+                                Nothing     ->  return True+                                Just char   ->  return (not $ if isOp+                                                                then Set.member char notAfterOp+                                                                else Set.member char notAfterId)+                        when afterOk $ do+                            delete buf st end+                            insert buf st to+                            return ()                 replaceTo' (stOff + 1)  transformFromCandy :: TextEditor editor => CandyTable -> EditorBuffer editor -> IDEM ()@@ -183,8 +175,7 @@     mapM_ (\tbl ->  replaceFrom workBuffer tbl 0) transformTableBack     i1          <-  getStartIter workBuffer     i2          <-  getEndIter workBuffer-    text2       <-  getText workBuffer i1 i2 True-    return text2+    getText workBuffer i1 i2 True  getCandylessPart :: TextEditor editor => CandyTable -> EditorBuffer editor -> EditorIter editor -> EditorIter editor -> IDEM Text getCandylessPart (CT(_,transformTableBack)) ebuf i1 i2 = do@@ -193,17 +184,15 @@     mapM_ (\tbl ->  replaceFrom workBuffer tbl 0) transformTableBack     i1          <-  getStartIter workBuffer     i2          <-  getEndIter workBuffer-    text2       <-  getText workBuffer i1 i2 True-    return text2+    getText workBuffer i1 i2 True  stringToCandy :: CandyTable -> Text -> IDEM Text stringToCandy  candyTable text = do     workBuffer  <-  simpleGtkBuffer text-    transformToCandy candyTable workBuffer (\ _ -> False)+    transformToCandy candyTable workBuffer (const False)     i1          <-  getStartIter workBuffer     i2          <-  getEndIter workBuffer-    text2       <-  getText workBuffer i1 i2 True-    return text2+    getText workBuffer i1 i2 True  -- We only need a TextMark here not a SourceMark createTextMark (GtkBuffer sb) (GtkIter i) leftGravity = liftIO $  textBufferCreateMark sb Nothing i leftGravity@@ -231,13 +220,13 @@     transformFromCandy candyTable workBuffer     i3          <- getIterAtOffset workBuffer column     mark        <- createTextMark workBuffer i3 True-    transformToCandy candyTable workBuffer (\ _ -> False)+    transformToCandy candyTable workBuffer (const False)     i4          <- getIterAtTextMark workBuffer mark     columnNew   <- getLineOffset i4     return (line,columnNew)  replaceFrom :: TextEditor editor => EditorBuffer editor -> (Text,Text,Int) -> Int -> IDEM ()-replaceFrom buf (to,from,spaces) offset = replaceFrom' offset+replaceFrom buf (to,from,spaces) = replaceFrom'     where     replaceFrom' offset = do         iter        <-  getIterAtOffset buf offset@@ -247,18 +236,14 @@             Just (st,end)   ->  do                 offset  <-  getOffset st                 delete buf st end-                if spaces > 0-                    then do-                        iter2 <-    getIterAtOffset buf offset-                        iter3 <-    getIterAtOffset buf (offset + spaces + 1)-                        slice <-    getSlice buf iter2 iter3 True-                        let l = T.length (T.takeWhile (== ' ') slice)-                        if l > 1-                            then do-                                iter4 <- atOffset iter3 (offset + l - 1)-                                delete buf iter2 iter4-                            else return ()-                    else return ()+                when (spaces > 0) $ do+                    iter2 <-    getIterAtOffset buf offset+                    iter3 <-    getIterAtOffset buf (offset + spaces + 1)+                    slice <-    getSlice buf iter2 iter3 True+                    let l = T.length (T.takeWhile (== ' ') slice)+                    when (l > 1) $ do+                        iter4 <- atOffset iter3 (offset + l - 1)+                        delete buf iter2 iter4                 iter    <-  getIterAtOffset buf offset                 insert buf iter to                 replaceFrom' offset@@ -266,7 +251,7 @@ type CandyTableI = [(Text,Char,Bool)]  forthFromTable :: CandyTableI -> CandyTableForth-forthFromTable table = map forthFrom table+forthFromTable = map forthFrom     where     forthFrom (str,chr,noTrimming) =         let isOp = not (Set.member (T.head str) notBeforeId)@@ -276,7 +261,7 @@         in (isOp,from,to)  backFromTable :: CandyTableI -> CandyTableBack-backFromTable table = map backFrom table+backFromTable = map backFrom     where     backFrom (str,chr,noTrimming) =         let numTrailingBlanks = if noTrimming then 0 else T.length str - 1

@@ -70,9 +70,9 @@     underline linkTag UnderlineSingle     cursor <- liftIO $ cursorNew Hand2 -    id1 <- liftIO $ sw `on` leaveNotifyEvent $ do+    id1 <- liftIO (sw `on` leaveNotifyEvent $ do         eventTime >>= (liftIO . pointerUngrab)-        return True+        return True)      let moveOrClick eventX eventY mods eventTime click = do         sx <- liftIO $ scrolledWindowGetHAdjustment sw >>= adjustmentGetValue@@ -80,7 +80,7 @@          let ex = eventX + sx             ey = eventY + sy-            ctrlPressed = (mapControlCommand Control) `elem` mods+            ctrlPressed = mapControlCommand Control `elem` mods             shiftPressed = Shift `elem` mods         iter <- getIterAtLocation sv (round ex) (round ey)         (Rectangle _ _ szx szy) <- liftIO $ widgetGetAllocation sw@@ -94,13 +94,13 @@             removeTagByName tvb "link"             offs <- getLineOffset beg             offsc <- getLineOffset iter-            if (T.length slice > 1) then do-                if (click) then do+            if T.length slice > 1 then+                if click then do                         liftIO $ pointerUngrab eventTime                         clickHandler ctrlPressed shiftPressed slice                     else do                         applyTagByName tvb "link" beg en-                        Just screen <- liftIO $ screenGetDefault+                        Just screen <- liftIO screenGetDefault #ifdef MIN_VERSION_gtk3                         mbDW <- liftIO $ widgetGetWindow tv #else@@ -117,42 +117,43 @@             return True     lineNumberBugFix <- liftIO $ newIORef Nothing     let fixBugWithX mods isHint (eventX, eventY) ptrx = do-            let hasNoControlModifier = not $ (mapControlCommand Control) `elem` mods+            let hasNoControlModifier = mapControlCommand Control `notElem` mods             lnbf <- readIORef lineNumberBugFix             -- print ("ishint?, adjusted, event.x, ptr.x, adjustment,hasControl?",isHint,ptrx - fromMaybe (-1000) lnbf , eventX, ptrx, lnbf, hasNoControlModifier)-            when (isHint && hasNoControlModifier) $ do+            when (isHint && hasNoControlModifier) $                 -- get difference between event X and pointer x                 -- event X is in coordinates of sourceView text                 -- pointer X is in coordinates of window (remember "show line numbers" ?)                 liftIO $ writeIORef lineNumberBugFix $ Just (ptrx - eventX)   -- captured difference             -- When control key is pressed, mostly NON-HINT events come,             -- GTK gives (mistakenly?) X in window coordinates in such cases-            let nx = if (isJust lnbf && not isHint)+            let nx = if isJust lnbf && not isHint                         then ptrx - fromJust lnbf    -- translate X back                         else eventX             return (nx, eventY)     ideR <- ask-    id2 <- liftIO $ sw `on` motionNotifyEvent $ do-        isHint <- eventIsHint-        eventTime <- eventTime-        mods <- eventModifier-        (oldX, oldY) <- eventCoordinates-        (rootX, _) <- eventRootCoordinates-        (eventX, eventY) <- liftIO $ fixBugWithX mods isHint (oldX, oldY) rootX-        liftIO $ do-            -- print ("move adjustment: isHint, old, new root", isHint, eventX, oldX, rootX)-            (`reflectIDE` ideR) $ moveOrClick eventX eventY mods eventTime False-        return True-    id3 <- liftIO $ sw `on` buttonPressEvent $ do-        eventTime <- eventTime-        mods <- eventModifier-        -- liftIO $ print ("button press")-        (oldX, oldY) <- eventCoordinates-        (rootX, _) <- eventRootCoordinates-        (eventX, eventY) <- liftIO $ fixBugWithX mods False (oldX, oldY) rootX-        -- liftIO $ print ("click adjustment: old, new", eventX, oldX)-        liftIO $ (`reflectIDE` ideR) $ moveOrClick eventX eventY mods eventTime True+    liftIO $ do+        id2 <- sw `on` motionNotifyEvent $ do+            isHint <- eventIsHint+            eventTime <- eventTime+            mods <- eventModifier+            (oldX, oldY) <- eventCoordinates+            (rootX, _) <- eventRootCoordinates+            (eventX, eventY) <- liftIO $ fixBugWithX mods isHint (oldX, oldY) rootX+            liftIO $+                -- print ("move adjustment: isHint, old, new root", isHint, eventX, oldX, rootX)+                (`reflectIDE` ideR) $ moveOrClick eventX eventY mods eventTime False+            return True+        id3 <- sw `on` buttonPressEvent $ do+            eventTime <- eventTime+            mods <- eventModifier+            -- liftIO $ print ("button press")+            (oldX, oldY) <- eventCoordinates+            (rootX, _) <- eventRootCoordinates+            (eventX, eventY) <- liftIO $ fixBugWithX mods False (oldX, oldY) rootX+            -- liftIO $ print ("click adjustment: old, new", eventX, oldX)+            liftIO $ (`reflectIDE` ideR) $ moveOrClick eventX eventY mods eventTime True -    return $ [ConnectC id1, ConnectC id2, ConnectC id3]+        return [ConnectC id1, ConnectC id2, ConnectC id3]  

@@ -14,10 +14,7 @@ -----------------------------------------------------------------------------  module IDE.TextEditor (-    module IDE.TextEditor.Class-  , module IDE.TextEditor.GtkSourceView-  , module IDE.TextEditor.Yi-  , module IDE.TextEditor.CodeMirror+    module Exported    , TextEditor(..)   , EditorBuffer(..)@@ -36,10 +33,10 @@ #endif ) where -import IDE.TextEditor.Class-import IDE.TextEditor.GtkSourceView-import IDE.TextEditor.Yi-import IDE.TextEditor.CodeMirror+import IDE.TextEditor.Class as Exported+import IDE.TextEditor.GtkSourceView as Exported+import IDE.TextEditor.Yi as Exported+import IDE.TextEditor.CodeMirror as Exported  newDefaultBuffer = newGtkBuffer 

@@ -15,9 +15,13 @@  module IDE.TextEditor.Class (     TextEditor(..)+  , EditorStyle(..)+  , updateStyle ) where -import IDE.Core.Types (IDERef, IDEM, IDEEventM)+import IDE.Core.Types+       (LogRefType, IDE(..), IDERef, IDEM, IDEEventM, EditorStyle(..),+        IDEAction(..), editorStyle) import Graphics.UI.Editor.Basics (Connection) import Control.Monad.Reader (ReaderT(..)) import Graphics.UI.Gtk@@ -29,7 +33,15 @@ import Control.Monad.IO.Class (MonadIO(..)) import System.Glib.Signals (on) import Data.Text (Text)+import IDE.Core.State (readIDE)+import IDE.Utils.GUIUtils (getDarkState) +updateStyle :: TextEditor editor => EditorBuffer editor -> IDEAction+updateStyle ebuf = do+    prefs <- readIDE prefs+    preferDark <- getDarkState+    setStyle ebuf $ editorStyle preferDark prefs+ class TextEditor editor where     data EditorBuffer editor     data EditorView editor@@ -50,10 +62,9 @@     canUndo :: EditorBuffer editor -> IDEM Bool     copyClipboard :: EditorBuffer editor -> Clipboard -> IDEM ()     createMark :: EditorView editor-                  -> Text+                  -> LogRefType                   -> EditorIter editor                   -> Text-                  -> Text                   -> IDEM (EditorMark editor)     cutClipboard :: EditorBuffer editor -> Clipboard -> Bool -> IDEM ()     delete :: EditorBuffer editor -> EditorIter editor -> EditorIter editor -> IDEM ()@@ -97,7 +108,7 @@                        -> IDEM ()     selectRange :: EditorBuffer editor -> EditorIter editor -> EditorIter editor -> IDEM ()     setModified :: EditorBuffer editor -> Bool -> IDEM ()-    setStyle :: Bool -> EditorBuffer editor -> Maybe Text -> IDEM ()+    setStyle :: EditorBuffer editor -> EditorStyle -> IDEM ()     setText :: EditorBuffer editor -> Text -> IDEM ()     undo :: EditorBuffer editor -> IDEM () 

@@ -1,8 +1,10 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE TypeFamilies #-}+#ifdef LEKSAH_WITH_CODE_MIRROR {-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE CPP #-}+#endif {-# LANGUAGE RankNTypes #-} {-# LANGUAGE NoImplicitPrelude #-} -----------------------------------------------------------------------------@@ -261,7 +263,7 @@         m <- codeMirror         lift $ (m ^. historySize ^. undo') >>= valToBool     copyClipboard (CMBuffer cm) _ = return () -- TODO-    createMark (CMView cm) _name (CMIter _ i) _icon _tooltip = runCM cm $ do+    createMark (CMView cm) _refType (CMIter _ i) _tooltip = runCM cm $ do         m <- codeMirror         lift $ CMMark <$> do                 o <- obj@@ -349,7 +351,7 @@     setModified (CMBuffer cm) modified = unless modified . runCM cm $ do         m <- codeMirror         lift $ m ^. markClean >> return ()-    setStyle preferDark (CMBuffer cm) mbStyle = return () -- TODO+    setStyle (CMBuffer cm) _style = return () -- TODO     setText (CMBuffer cm) text = runCM cm $ do         m <- codeMirror         lift $ m ^. setValue text

@@ -1,4 +1,5 @@ {-# LANGUAGE CPP #-}+{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE OverloadedStrings #-}@@ -30,8 +31,10 @@  ) where -import IDE.TextEditor.Class (TextEditor(..))-import IDE.Core.Types (colorHexString, Prefs(..), IDE(..), IDEM)+import IDE.TextEditor.Class (TextEditor(..), EditorStyle(..))+import IDE.Core.Types+       (LogRefType(..), LogRef(..), LogRefType, colorHexString, Prefs(..),+        IDE(..), IDEM) import Control.Monad.IO.Class (MonadIO(..)) import Graphics.UI.Gtk        (castToWidget, textViewGetIterAtLocation, focusOutEvent,@@ -71,7 +74,8 @@         textBufferApplyTagByName, TextTag, TextTagTable, TextMark,         textBufferSetText, textIterCopy, TextIter, Modifier(..),         FontDescription, fontDescriptionFromString, fontDescriptionNew,-        fontDescriptionSetFamily, EventMask(..), after,+        fontDescriptionSetFamily, EventMask(..), after, Underline(..),+        Color(..), #ifdef MIN_VERSION_gtk3         widgetGetWindow #else@@ -81,7 +85,8 @@ import Data.Typeable (Typeable) import Control.Applicative ((<$>)) import Graphics.UI.Gtk.SourceView-       (sourceBufferCreateSourceMark, SourceMark,+       (sourceBufferRemoveSourceMarks, sourceViewGetMarkAttributes,+        sourceBufferCreateSourceMark, SourceMark,         sourceViewSetShowLineMarks,         sourceStyleSchemeManagerAppendSearchPath, sourceViewSetTabWidth,         sourceViewSetShowLineNumbers, sourceViewSetRightMarginPosition,@@ -107,29 +112,33 @@        (SourceDrawSpacesFlags(..), SourceSmartHomeEndType(..)) import Graphics.UI.Gtk.General.Enums        (PolicyType(..), TextWindowType(..), WrapMode(..))-import Control.Monad (when, forM_)+import Control.Monad (void, when, forM_) import Control.Monad.Reader.Class (MonadReader(..)) import Graphics.UI.Editor.Basics (Connection(..))-import Data.Maybe (maybeToList, fromJust)+import Data.Maybe (isNothing, maybeToList, fromJust) import Data.IORef (writeIORef, readIORef, newIORef) import System.Glib.MainLoop (priorityDefault, idleRemove)-import Data.Char (isSymbol, isAlphaNum)+import Data.Char (isDigit, isSymbol, isAlphaNum) import System.Glib.Signals (after, on) import Control.Monad.Trans.Class (MonadTrans(..)) import System.Glib.Attributes (get, AttrOp(..), set) import qualified Graphics.UI.Gtk as Gtk (endUserAction) import IDE.Utils.GUIUtils (fontDescription) import Data.Text (Text)-import qualified Data.Text as T (all, length, pack)+import qualified Data.Text as T+       (drop, dropWhile, all, length, pack) import Data.Monoid ((<>)) import Graphics.UI.Gtk.Multiline.TextBuffer-       (textBufferDeleteMark, textBufferGetMark)+       (textBufferDeleteMarkByName, textBufferDeleteMark,+        textBufferGetMark) import Graphics.UI.Gtk.SourceView.SourceMarkAttributes        (queryTooltipText, sourceMarkAttributesSetIconName,         sourceMarkAttributesNew) import Graphics.UI.Gtk.SourceView.SourceView        (sourceViewSetMarkAttributes)-import Graphics.UI.Gtk.Multiline.TextMark (toTextMark)+import Graphics.UI.Gtk.Multiline.TextMark+       (textMarkGetName, toTextMark)+import Control.Arrow (Arrow(..))  transformGtkIter :: EditorIter GtkSourceView -> (TextIter -> IO a) -> IDEM (EditorIter GtkSourceView) transformGtkIter (GtkIter i) f = do@@ -171,6 +180,9 @@     sourceBufferBeginNotUndoableAction buffer     textBufferSetText buffer contents     sourceBufferEndNotUndoableAction buffer+    tagTable <- textBufferGetTagTable buffer+    forM_ [minBound .. maxBound :: LogRefType] $ \ refType ->+        textTagNew (Just . T.pack $ show refType) >>= textTagTableAdd tagTable     return $ GtkBuffer buffer  instance TextEditor GtkSourceView where@@ -189,18 +201,15 @@     canRedo (GtkBuffer sb) = liftIO $ sourceBufferGetCanRedo sb     canUndo (GtkBuffer sb) = liftIO $ sourceBufferGetCanUndo sb     copyClipboard (GtkBuffer sb) clipboard = liftIO $ textBufferCopyClipboard sb clipboard-    createMark (GtkView sv) name (GtkIter i) icon tooltip = liftIO $ do-        attributes <- sourceMarkAttributesNew-        sourceMarkAttributesSetIconName attributes (Just icon)-        on attributes queryTooltipText $ \ mark -> return tooltip-        sourceViewSetMarkAttributes sv name (Just attributes) 1+    createMark (GtkView sv) refType (GtkIter i) tooltip = liftIO $ do+        let cat = T.pack $ show refType         sb <- castToSourceBuffer <$> get sv textViewBuffer-        GtkMark . toTextMark <$> sourceBufferCreateSourceMark sb (Just name) name i+        n <- textIterGetLine i+        GtkMark . toTextMark <$> sourceBufferCreateSourceMark sb (Just $ T.pack (show n) <> " " <> tooltip) cat i     cutClipboard (GtkBuffer sb) clipboard defaultEditable = liftIO $ textBufferCutClipboard sb clipboard defaultEditable     delete (GtkBuffer sb) (GtkIter first) (GtkIter last) = liftIO $         textBufferDelete sb first last-    deleteSelection (GtkBuffer sb) = liftIO $-        textBufferDeleteSelection sb  True True >> return ()+    deleteSelection (GtkBuffer sb) = liftIO . void $ textBufferDeleteSelection sb True True     endNotUndoableAction (GtkBuffer sb) = liftIO $ sourceBufferEndNotUndoableAction sb     endUserAction (GtkBuffer sb) = liftIO $ textBufferEndUserAction sb     getEndIter (GtkBuffer sb) = liftIO $ GtkIter <$> textBufferGetEndIter sb@@ -211,7 +220,7 @@     getLineCount (GtkBuffer sb) = liftIO $ textBufferGetLineCount sb     getModified (GtkBuffer sb) = liftIO $ textBufferGetModified sb     getSelectionBoundMark (GtkBuffer sb) = liftIO $ GtkMark <$> textBufferGetSelectionBound sb-    getSelectionBounds (GtkBuffer sb) = liftIO $ (\(a, b) -> (GtkIter a, GtkIter b)) <$>+    getSelectionBounds (GtkBuffer sb) = liftIO $ (GtkIter *** GtkIter) <$>         textBufferGetSelectionBounds sb     getInsertIter (GtkBuffer sb) = liftIO $ GtkIter <$> do         insertMark <- textBufferGetInsert sb@@ -235,6 +244,19 @@             sourceViewSetAutoIndent sv True             sourceViewSetSmartHomeEnd sv SourceSmartHomeEndBefore             sourceViewSetShowLineMarks sv True+            forM_ [minBound..maxBound] $ \ refType -> do+                let cat = T.pack $ show refType+                    icon = case refType of+                            ErrorRef       -> "dialog-error"+                            WarningRef     -> "dialog-warning"+                            TestFailureRef -> "software-update-urgent"+                            LintRef        -> "emblem-generic"+                            BreakpointRef  -> "media-playback-pause"+                            ContextRef     -> "media-playback-start"+                attributes <- sourceMarkAttributesNew+                sourceMarkAttributesSetIconName attributes (Just (icon :: Text))+                on attributes queryTooltipText $ \ mark -> maybe "" (T.drop 1 . T.dropWhile isDigit) <$> textMarkGetName mark+                sourceViewSetMarkAttributes sv cat (Just attributes) (1 + fromEnum(maxBound :: LogRefType) - fromEnum refType)             if wrapLines prefs                 then textViewSetWrapMode sv WrapWord                 else textViewSetWrapMode sv WrapNone@@ -250,25 +272,38 @@         first <- textBufferGetStartIter sb         last <- textBufferGetEndIter sb         textBufferRemoveTagByName sb name first last-        mbMark <- textBufferGetMark sb name-        case mbMark of-            Just mark -> textBufferDeleteMark sb mark-            Nothing   -> return ()+        sourceBufferRemoveSourceMarks sb first last name     selectRange (GtkBuffer sb) (GtkIter first) (GtkIter last) = liftIO $         textBufferSelectRange sb first last-    setModified (GtkBuffer sb) modified = liftIO $ textBufferSetModified sb modified >> return ()-    setStyle preferDark (GtkBuffer sb) mbStyle = liftIO $ do-        case mbStyle of+    setModified (GtkBuffer sb) modified = liftIO . void $ textBufferSetModified sb modified+    setStyle (GtkBuffer sb) EditorStyle {..} =+        case styleName of             Nothing  -> return ()             Just str -> do-                styleManager <- sourceStyleSchemeManagerNew-                dataDir <- getDataDir-                sourceStyleSchemeManagerAppendSearchPath styleManager $ dataDir </> "data/styles"-                ids <- sourceStyleSchemeManagerGetSchemeIds styleManager+                styleManager <- liftIO sourceStyleSchemeManagerNew+                dataDir <- liftIO getDataDir+                liftIO $ sourceStyleSchemeManagerAppendSearchPath styleManager $ dataDir </> "data/styles"+                ids <- liftIO $ sourceStyleSchemeManagerGetSchemeIds styleManager                 let preferedNames = if preferDark then [str<>"-dark", str] else [str]-                forM_ (take 1 $ filter (flip elem ids) preferedNames) $ \ name -> do-                    scheme <- sourceStyleSchemeManagerGetScheme styleManager name-                    sourceBufferSetStyleScheme sb (Just scheme)+                forM_ (take 1 $ filter (`elem` ids) preferedNames) $ \ name -> do+                    liftIO $ do+                        scheme <- sourceStyleSchemeManagerGetScheme styleManager name+                        sourceBufferSetStyleScheme sb (Just scheme)+                    tagTable <- getTagTable (GtkBuffer sb)+                    let isDark = name `elem` ["leksah-dark", "oblivion", "cobalt"]+                    forM_ [minBound .. maxBound] $ \ refType -> do+                        mbTag <- lookupTag tagTable (T.pack $ show refType)+                        case mbTag of+                            Nothing  -> return ()+                            Just tag ->+                                case refType of+                                    ErrorRef            -> underline tag UnderlineError+                                    WarningRef          -> underline tag UnderlineError+                                    TestFailureRef      -> underline tag UnderlineError+                                    LintRef | isDark    -> background tag $ Color 0 15000 0+                                            | otherwise -> background tag $ Color 60000 65535 60000+                                    BreakpointRef       -> background tag breakpointBG+                                    ContextRef          -> background tag contextBG     setText (GtkBuffer sb) text = liftIO $ textBufferSetText sb text     undo (GtkBuffer sb) = liftIO $ sourceBufferUndo sb @@ -290,11 +325,11 @@     getIterAtLocation (GtkView sv) x y = liftIO $ GtkIter <$> textViewGetIterAtLocation sv x y     getIterLocation (GtkView sv) (GtkIter i) = liftIO $ textViewGetIterLocation sv i     getOverwrite (GtkView sv) = liftIO $ textViewGetOverwrite sv-    getScrolledWindow (GtkView sv) = liftIO $ fmap (castToScrolledWindow . fromJust) $ widgetGetParent sv+    getScrolledWindow (GtkView sv) = liftIO $ (castToScrolledWindow . fromJust) <$> widgetGetParent sv     getEditorWidget (GtkView sv) = return $ castToWidget sv     grabFocus (GtkView sv) = liftIO $ widgetGrabFocus sv     scrollToMark (GtkView sv) (GtkMark m) withMargin mbAlign = liftIO $ textViewScrollToMark sv m withMargin mbAlign-    scrollToIter (GtkView sv) (GtkIter i) withMargin mbAlign = liftIO $ textViewScrollToIter sv i withMargin mbAlign >> return ()+    scrollToIter (GtkView sv) (GtkIter i) withMargin mbAlign = liftIO . void $ textViewScrollToIter sv i withMargin mbAlign     setFont (GtkView sv) mbFontString = do         fd <- fontDescription mbFontString         liftIO $ widgetModifyFont sv (Just fd)@@ -308,7 +343,7 @@             else liftIO $ do                 textViewSetWrapMode sv WrapNone                 scrolledWindowSetPolicy sw PolicyAutomatic PolicyAutomatic-    setRightMargin (GtkView sv) mbRightMargin = liftIO $ do+    setRightMargin (GtkView sv) mbRightMargin = liftIO $         case mbRightMargin of             Just n -> do                 sourceViewSetShowRightMargin sv True@@ -354,26 +389,26 @@             lastHandler <- newIORef Nothing             id1 <- after sb bufferInsertText $ \iter text -> do                 mapM_ idleRemove =<< maybeToList <$> readIORef lastHandler-                writeIORef lastHandler =<< Just <$> do-                    (flip idleAdd) priorityDefault $ do-                        let isIdent a = isAlphaNum a || a == '\'' || a == '_' || a == '.'-                        let isOp    a = isSymbol   a || a == ':'  || a == '\\' || a == '*' || a == '/' || a == '-'-                                                     || a == '!'  || a == '@' || a == '%' || a == '&' || a == '?'-                        if (T.all isIdent text) || (T.all isOp text)-                            then do-                                hasSel <- textBufferHasSelection sb-                                if not hasSel-                                    then do-                                        (iterC, _) <- textBufferGetSelectionBounds sb-                                        atC <- textIterEqual iter iterC-                                        when atC $ reflectIDE start ideR-                                        return False-                                    else do-                                        reflectIDE cancel ideR-                                        return False-                            else do-                                reflectIDE cancel ideR-                                return False+                h <- flip idleAdd priorityDefault $ do+                    let isIdent a = isAlphaNum a || a == '\'' || a == '_' || a == '.'+                    let isOp    a = isSymbol   a || a == ':'  || a == '\\' || a == '*' || a == '/' || a == '-'+                                                 || a == '!'  || a == '@' || a == '%' || a == '&' || a == '?'+                    if T.all isIdent text || T.all isOp text+                        then do+                            hasSel <- textBufferHasSelection sb+                            if not hasSel+                                then do+                                    (iterC, _) <- textBufferGetSelectionBounds sb+                                    atC <- textIterEqual iter iterC+                                    when atC $ reflectIDE start ideR+                                    return False+                                else do+                                    reflectIDE cancel ideR+                                    return False+                        else do+                            reflectIDE cancel ideR+                            return False+                writeIORef lastHandler (Just h)                 return ()             id2 <- sv `on` moveCursor $ \_ _ _ -> reflectIDE cancel ideR             id3 <- sv `on` buttonPressEvent $ lift $ reflectIDE cancel ideR >> return False@@ -394,7 +429,7 @@     onLookupInfo (GtkView sv) f = do         liftIO $ sv `widgetAddEvents` [ButtonReleaseMask]         id1 <- sv `onIDE` buttonReleaseEvent $ do-            mod <- lift $ eventModifier+            mod <- lift eventModifier             case mod of                 [Control] -> f >> return True                 _             -> return False@@ -430,7 +465,7 @@             case mbLimit of                 Just (GtkIter limit) -> Just limit                 Nothing              -> Nothing-    forwardSearch (GtkIter i) str flags mbLimit = liftIO $ fmap (fmap (\(a, b) -> (GtkIter a, GtkIter b))) $+    forwardSearch (GtkIter i) str flags mbLimit = liftIO $ fmap (fmap (GtkIter *** GtkIter)) $         textIterForwardSearch i str flags $             case mbLimit of                 Just (GtkIter limit) -> Just limit

@@ -75,14 +75,14 @@ chooseDir :: Window -> Text -> Maybe FilePath -> IO (Maybe FilePath) chooseDir window prompt mbFolder = do     dialog <- fileChooserDialogNew-                    (Just $ prompt)+                    (Just prompt)                     (Just window)                 FileChooserActionSelectFolder                 [("gtk-cancel"                 ,ResponseCancel)                 ,("gtk-open"                 ,ResponseAccept)]-    when (isJust mbFolder) $ fileChooserSetCurrentFolder dialog (fromJust mbFolder) >> return ()+    when (isJust mbFolder) . void $ fileChooserSetCurrentFolder dialog (fromJust mbFolder)     widgetShow dialog     response <- dialogRun dialog     case response of@@ -101,14 +101,14 @@ chooseFile :: Window -> Text -> Maybe FilePath -> IO (Maybe FilePath) chooseFile window prompt mbFolder = do     dialog <- fileChooserDialogNew-                    (Just $ prompt)+                    (Just prompt)                     (Just window)                 FileChooserActionOpen                 [("gtk-cancel"                 ,ResponseCancel)                 ,("gtk-open"                 ,ResponseAccept)]-    when (isJust mbFolder) $ fileChooserSetCurrentFolder dialog (fromJust mbFolder)  >> return ()+    when (isJust mbFolder) $ void (fileChooserSetCurrentFolder dialog (fromJust mbFolder))     widgetShow dialog     response <- dialogRun dialog     case response of@@ -127,12 +127,12 @@ chooseSaveFile :: Window -> Text -> Maybe FilePath -> IO (Maybe FilePath) chooseSaveFile window prompt mbFolder = do     dialog <- fileChooserDialogNew-              (Just $ prompt)+              (Just prompt)               (Just window)               FileChooserActionSave               [("gtk-cancel", ResponseCancel)               ,("gtk-save",   ResponseAccept)]-    when (isJust mbFolder) $ fileChooserSetCurrentFolder dialog (fromJust mbFolder)  >> return ()+    when (isJust mbFolder) $ void (fileChooserSetCurrentFolder dialog (fromJust mbFolder))     widgetShow dialog     res <- dialogRun dialog     case res of@@ -198,7 +198,7 @@     ui <- getUIAction "ui/menubar/_View/Dark" castToToggleAction     liftIO $toggleActionSetActive ui b -getForgetSession :: PaneMonad alpha => alpha  (Bool)+getForgetSession :: PaneMonad alpha => alpha Bool getForgetSession = do     ui <- getUIAction "ui/menubar/_Configuration/Forget Session" castToToggleAction     liftIO $toggleActionGetActive ui@@ -211,7 +211,7 @@         Nothing     -> throwIDE ("State.hs>>getMenuItem: Can't find ui path " <> path)         Just widget -> return (castToMenuItem widget) -getBackgroundBuildToggled :: PaneMonad alpha => alpha  (Bool)+getBackgroundBuildToggled :: PaneMonad alpha => alpha Bool getBackgroundBuildToggled = do     ui <- getUIAction "ui/toolbar/BuildToolItems/BackgroundBuild" castToToggleAction     liftIO $ toggleActionGetActive ui@@ -221,7 +221,7 @@     ui <- getUIAction "ui/toolbar/BuildToolItems/BackgroundBuild" castToToggleAction     liftIO $ toggleActionSetActive ui b -getRunUnitTests :: PaneMonad alpha => alpha  (Bool)+getRunUnitTests :: PaneMonad alpha => alpha Bool getRunUnitTests = do     ui <- getUIAction "ui/toolbar/BuildToolItems/RunUnitTests" castToToggleAction     liftIO $ toggleActionGetActive ui@@ -231,7 +231,7 @@     ui <- getUIAction "ui/toolbar/BuildToolItems/RunUnitTests" castToToggleAction     liftIO $ toggleActionSetActive ui b -getMakeModeToggled :: PaneMonad alpha => alpha  (Bool)+getMakeModeToggled :: PaneMonad alpha => alpha Bool getMakeModeToggled = do     ui <- getUIAction "ui/toolbar/BuildToolItems/MakeMode" castToToggleAction     liftIO $ toggleActionGetActive ui@@ -241,7 +241,7 @@     ui <- getUIAction "ui/toolbar/BuildToolItems/MakeMode" castToToggleAction     liftIO $ toggleActionSetActive ui b -getDebugToggled :: PaneMonad alpha => alpha  (Bool)+getDebugToggled :: PaneMonad alpha => alpha Bool getDebugToggled = do     ui <- getUIAction "ui/toolbar/BuildToolItems/Debug" castToToggleAction     liftIO $ toggleActionGetActive ui@@ -325,9 +325,9 @@ #endif  fontDescription :: Maybe Text -> IDEM FontDescription-fontDescription mbFontString = liftIO $ do+fontDescription mbFontString = liftIO $     case mbFontString of-        Just str -> do+        Just str ->             fontDescriptionFromString str         Nothing -> do             f <- fontDescriptionNew

@@ -42,11 +42,11 @@     q <- case q' of         Just q -> return q         Nothing -> do-            q <- liftIO $ newEmptyMVar+            q <- liftIO newEmptyMVar             modifyIDE_ (\ ide -> ide{serverQueue = Just q})             ideR <- ask             liftIO . forkIO . forever $ do-                debugM "leksah" $ "Ready for command"+                debugM "leksah" "Ready for command"                 (command, cont) <- takeMVar q                 reflectIDE (doServerCommand' command cont) ideR             return q