Grep.hs

{-# OPTIONS_GHC -XDeriveDataTypeable -XMultiParamTypeClasses -XTypeSynonymInstances
    -XRecordWildCards #-}
-----------------------------------------------------------------------------
--
-- Module      :  IDE.Pane.Grep
-- Copyright   :  (c) Juergen Nicklisch-Franken, Hamish Mackenzie
-- License     :  GNU-GPL
--
-- Maintainer  :  <maintainer at leksah.org>
-- Stability   :  provisional
-- Portability  :  portable
--
-- | The pane of ide where grep results are displayed
--
-------------------------------------------------------------------------------

module IDE.Pane.Grep (
    IDEGrep(..)
,   setGrepResults
,   GrepState(..)
,   getGrep
) where

import Graphics.UI.Gtk hiding (get)
import Text.ParserCombinators.Parsec.Language
import Text.ParserCombinators.Parsec hiding(Parser)
import qualified Text.ParserCombinators.Parsec.Token as P
import Data.Maybe
import Control.Monad.Reader
import Data.Typeable
import IDE.Core.State
import IDE.Utils.Tool (ToolOutput(..))
import Control.Concurrent (forkIO)
import IDE.LogRef (logOutput)
import IDE.Pane.SourceBuffer
    (goToSourceDefinition)

data GrepRecord = GrepRecord {
    file        :: FilePath
,   line        :: Int
,   context     :: String
}

-- | A grep pane description
--

data IDEGrep        =   IDEGrep {
    scrolledView    ::   ScrolledWindow
,   treeView        ::   TreeView
,   grepStore       ::   ListStore GrepRecord
} deriving Typeable

data GrepState      =   GrepState
    deriving(Eq,Ord,Read,Show,Typeable)

instance Pane IDEGrep IDEM
    where
    primPaneName _  =   "Grep"
    getAddedIndex _ =   0
    getTopWidget    =   castToWidget . scrolledView
    paneId b        =   "*Grep"

instance RecoverablePane IDEGrep GrepState IDEM where
    saveState p     =   do
        return (Just GrepState)
    recoverState pp GrepState =   do
        nb      <-  getNotebook pp
        buildPane pp nb builder
    builder pp nb windows = reifyIDE $ \ ideR -> do
        listStore   <-  listStoreNew []
        treeView    <-  treeViewNew
        treeViewSetModel treeView listStore

        renderer1    <- cellRendererTextNew
        renderer10   <- cellRendererPixbufNew
        col1         <- treeViewColumnNew
        treeViewColumnSetTitle col1 "File"
        treeViewColumnSetSizing col1 TreeViewColumnAutosize
        treeViewColumnSetResizable col1 True
        treeViewColumnSetReorderable col1 True
        treeViewAppendColumn treeView col1
        cellLayoutPackStart col1 renderer10 False
        cellLayoutPackStart col1 renderer1 True
        cellLayoutSetAttributes col1 renderer1 listStore
            $ \row -> [ cellText := file row]

        renderer2   <- cellRendererTextNew
        col2        <- treeViewColumnNew
        treeViewColumnSetTitle col2 "Line"
        treeViewColumnSetSizing col2 TreeViewColumnAutosize
        treeViewColumnSetResizable col2 True
        treeViewColumnSetReorderable col2 True
        treeViewAppendColumn treeView col2
        cellLayoutPackStart col2 renderer2 True
        cellLayoutSetAttributes col2 renderer2 listStore
            $ \row -> [ cellText := show $ line row]

        renderer3    <- cellRendererTextNew
        renderer30   <- cellRendererPixbufNew
        col3         <- treeViewColumnNew
        treeViewColumnSetTitle col3 "Context"
        treeViewColumnSetSizing col3 TreeViewColumnAutosize
        treeViewColumnSetResizable col3 True
        treeViewColumnSetReorderable col3 True
        treeViewAppendColumn treeView col3
        cellLayoutPackStart col3 renderer30 False
        cellLayoutPackStart col3 renderer3 True
        cellLayoutSetAttributes col3 renderer3 listStore
            $ \row -> [ cellText := context row]


        treeViewSetHeadersVisible treeView True
        sel <- treeViewGetSelection treeView
        treeSelectionSetMode sel SelectionSingle

        sw <- scrolledWindowNew Nothing Nothing
        containerAdd sw treeView
        scrolledWindowSetPolicy sw PolicyAutomatic PolicyAutomatic

        let grep = IDEGrep sw treeView listStore

        cid1 <- treeView `afterFocusIn`
            (\_ -> do reflectIDE (makeActive grep) ideR ; return True)
        sel `onSelectionChanged` do
            sel <- getSelectionGrepRecord treeView listStore
            case sel of
                Just record -> reflectIDE (do
                    goToSourceDefinition (file record)
                        $ Just $ Location (line record) 0 (line record) 0) ideR
                Nothing -> return ()

        return (Just grep,[ConnectC cid1])

getGrep :: Maybe PanePath -> IDEM IDEGrep
getGrep Nothing    = forceGetPane (Right "*Grep")
getGrep (Just pp)  = forceGetPane (Left pp)

grepLineParser :: CharParser () GrepRecord
grepLineParser = try (do
        file <- many (noneOf ":")
        char ':'
        line <- int
        char ':'
        context <- many anyChar
        return $ GrepRecord {..}
    <?> "grepLineParser")

lexer = P.makeTokenParser emptyDef
lexeme = P.lexeme lexer
whiteSpace = P.whiteSpace lexer
hexadecimal = P.hexadecimal lexer
symbol = P.symbol lexer
identifier = P.identifier lexer
colon = P.colon lexer
int = fmap fromInteger $ P.integer lexer

getSelectionGrepRecord ::  TreeView
    ->  ListStore GrepRecord
    -> IO (Maybe GrepRecord)
getSelectionGrepRecord treeView listStore = do
    treeSelection   <-  treeViewGetSelection treeView
    paths           <-  treeSelectionGetSelectedRows treeSelection
    case paths of
        [a]:r ->  do
            size    <-  listStoreGetSize listStore
            if a < size
                then fmap Just $ listStoreGetValue listStore a
                else return Nothing
        _  ->  return Nothing

setGrepResults :: [ToolOutput] -> IDEAction
setGrepResults output = do
    grep <- getGrep Nothing
    ideRef <- ask
    liftIO $ do
        let (displayed, dropped) = splitAt 10000 output
        bringPaneToFront grep
        forkIO $ do
            let errors = filter (isNothing . process) output
                    ++ if null dropped
                        then []
                        else [ToolError $ "Dropped " ++ show (length dropped) ++ " search results"]
            unless (null errors) $ reflectIDE (logOutput errors) ideRef
            return ()
        postGUIAsync $ listStoreClear (grepStore grep)
        forM_ (catMaybes (map process displayed)) $ \record -> do
            postGUIAsync $ do
                listStoreAppend (grepStore grep) record
                return ()
    where
        process (ToolOutput line) =
            case parse grepLineParser "" line of
                Right record -> Just record
                _ -> Nothing
        process _ = Nothing