module IDE.Pane.Errors (
IDEErrors
, ErrorsState
, fillErrorList
, selectError
, getErrors
, selectMatchingErrors
) where
import Graphics.UI.Gtk
import Data.Typeable (Typeable)
import IDE.Core.State
import IDE.ImportTool
(addResolveMenuItems, resolveErrors)
import Data.List (elemIndex)
import IDE.LogRef (showSourceSpan)
import Control.Monad.IO.Class (MonadIO(..))
import IDE.Utils.GUIUtils (getDarkState, treeViewContextMenu, __)
import Data.Text (Text)
import Control.Monad (void, when, forM_)
import qualified Data.Text as T
(intercalate, lines, takeWhile, length, drop)
import Data.IORef (writeIORef, readIORef, newIORef, IORef)
import Data.Maybe (isNothing)
data IDEErrors = IDEErrors {
scrolledView :: ScrolledWindow
, treeView :: TreeView
, errorStore :: ListStore ErrColumn
, autoClose :: IORef Bool
} deriving Typeable
data ErrColumn = ErrColumn {
logRef :: LogRef,
background :: Text}
data ErrorsState = ErrorsState {
} deriving(Eq,Ord,Read,Show,Typeable)
instance Pane IDEErrors IDEM
where
primPaneName _ = __ "Errors"
getTopWidget = castToWidget . scrolledView
paneId _b = "*Errors"
instance RecoverablePane IDEErrors ErrorsState IDEM where
saveState _p = return (Just ErrorsState)
recoverState pp ErrorsState = do nb <- getNotebook pp
buildPane pp nb builder
builder = builder'
builder' :: PanePath ->
Notebook ->
Window ->
IDEM (Maybe IDEErrors, Connections)
builder' _pp _nb _windows = reifyIDE $ \ ideR -> do
errorStore <- listStoreNew []
treeView <- treeViewNew
treeViewSetModel treeView errorStore
rendererA <- cellRendererTextNew
colA <- treeViewColumnNew
treeViewColumnSetTitle colA (__ "Description")
treeViewColumnSetSizing colA TreeViewColumnAutosize
treeViewColumnSetResizable colA True
treeViewColumnSetReorderable colA True
treeViewAppendColumn treeView colA
cellLayoutPackStart colA rendererA False
cellLayoutSetAttributes colA rendererA errorStore
$ \row -> [cellText := removeIndentation (refDescription (logRef row)),
cellTextBackground := background row ]
rendererB <- cellRendererTextNew
colB <- treeViewColumnNew
treeViewColumnSetTitle colB (__ "Location")
treeViewColumnSetSizing colB TreeViewColumnAutosize
treeViewColumnSetResizable colB True
treeViewColumnSetReorderable colB True
treeViewAppendColumn treeView colB
cellLayoutPackStart colB rendererB False
cellLayoutSetAttributes colB rendererB errorStore
$ \row -> [ cellText := showSourceSpan (logRef row),
cellTextBackground := background row ]
treeViewSetHeadersVisible treeView False
selB <- treeViewGetSelection treeView
treeSelectionSetMode selB SelectionMultiple
scrolledView <- scrolledWindowNew Nothing Nothing
scrolledWindowSetShadowType scrolledView ShadowIn
containerAdd scrolledView treeView
scrolledWindowSetPolicy scrolledView PolicyAutomatic PolicyAutomatic
autoClose <- newIORef False
let pane = IDEErrors {..}
cid1 <- after treeView focusInEvent $ do
liftIO $ reflectIDE (makeActive pane) ideR
return True
(cid2, cid3) <- treeViewContextMenu treeView $ errorsContextMenu ideR errorStore treeView
cid4 <- treeView `on` rowActivated $ errorsSelect ideR errorStore
reflectIDE (fillErrorList' pane) ideR
return (Just pane, map ConnectC [cid1, cid2, cid3, cid4])
removeIndentation t = T.intercalate "\n" $ map (T.drop minIndent) l
where
l = T.lines t
minIndent = minimum $ map (T.length . T.takeWhile (== ' ')) l
getErrors :: Maybe PanePath -> IDEM IDEErrors
getErrors Nothing = forceGetPane (Right "*Errors")
getErrors (Just pp) = forceGetPane (Left pp)
fillErrorList :: IDEAction
fillErrorList = getPane >>= maybe (return ()) fillErrorList'
fillErrorList' :: IDEErrors -> IDEAction
fillErrorList' pane = do
refs <- readIDE errorRefs
ac <- liftIO $ readIORef (autoClose pane)
when (null refs && ac) . void $ closePane pane
isDark <- getDarkState
liftIO $ do
let store = errorStore pane
listStoreClear store
forM_ (zip refs [0..]) $ \ (lr, index) ->
listStoreInsert store index $ ErrColumn lr (
(if even index then fst else snd) $
(if isDark then fst else snd) $
case logRefType lr of
WarningRef -> (("#282000", "#201900"), ("#FFF1DE", "#FFF5E8"))
LintRef -> (("#003000", "#002800"), ("#DBFFDB", "#EDFFED"))
_ -> (("#380000", "#280000"), ("#FFDEDE", "#FFEBEB")))
getSelectedError :: TreeView
-> ListStore ErrColumn
-> IO (Maybe LogRef)
getSelectedError treeView store = do
treeSelection <- treeViewGetSelection treeView
paths <- treeSelectionGetSelectedRows treeSelection
case paths of
[a]:r -> do
val <- listStoreGetValue store a
return (Just (logRef val))
_ -> return Nothing
selectError :: Maybe LogRef -> IDEAction
selectError mbLogRef = do
(mbPane :: Maybe IDEErrors) <- getPane
errorRefs' <- readIDE errorRefs
errors <- getErrors Nothing
when (isNothing mbPane) $ do
liftIO $ writeIORef (autoClose errors) True
displayPane errors False
liftIO $ do
selection <- treeViewGetSelection (treeView errors)
case mbLogRef of
Nothing -> treeSelectionUnselectAll selection
Just lr -> case lr `elemIndex` errorRefs' of
Nothing -> return ()
Just ind -> treeSelectionSelectPath selection [ind]
errorsContextMenu :: IDERef
-> ListStore ErrColumn
-> TreeView
-> Menu
-> IO ()
errorsContextMenu ideR store treeView theMenu = do
mbSel <- getSelectedError treeView store
item0 <- menuItemNewWithLabel (__ "Resolve Errors")
item0 `on` menuItemActivate $ reflectIDE resolveErrors ideR
menuShellAppend theMenu item0
case mbSel of
Just sel -> addResolveMenuItems ideR theMenu sel
Nothing -> return ()
errorsSelect :: IDERef
-> ListStore ErrColumn
-> TreePath
-> TreeViewColumn
-> IO ()
errorsSelect ideR store [index] _ = do
ref <- listStoreGetValue store index
reflectIDE (setCurrentError (Just (logRef ref))) ideR
errorsSelect _ _ _ _ = return ()
selectMatchingErrors :: Maybe SrcSpan -> IDEM ()
selectMatchingErrors mbSpan = do
mbErrors <- getPane
case mbErrors of
Nothing -> return ()
Just pane ->
liftIO $ do
treeSel <- treeViewGetSelection (treeView pane)
case mbSpan of
Nothing -> treeSelectionUnselectAll treeSel
Just (SrcSpan file lStart cStart lEnd cEnd) -> do
size <- listStoreGetSize (errorStore pane)
forM_ (take size [0..]) $ \ n -> do
mbIter <- treeModelGetIter (errorStore pane) [n]
case mbIter of
Nothing -> return ()
Just iter -> do
ErrColumn {logRef = ref@LogRef{..}} <- listStoreGetValue (errorStore pane) n
isSelected <- treeSelectionIterIsSelected treeSel iter
let shouldBeSel = file == logRefFullFilePath ref
&& (lStart, cStart) <= (srcSpanEndLine logRefSrcSpan,
srcSpanEndColumn logRefSrcSpan)
&& (lEnd, cEnd) >= (srcSpanStartLine logRefSrcSpan,
srcSpanStartColumn logRefSrcSpan)
when (isSelected && not shouldBeSel) $ treeSelectionUnselectIter treeSel iter
when (not isSelected && shouldBeSel) $ treeSelectionSelectIter treeSel iter