module IDE.Pane.Grep (
IDEGrep(..)
, grepWorkspace
, GrepState(..)
, getGrep
) 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
import IDE.BufferMode
import IDE.Utils.Tool (runTool, ToolOutput(..), getProcessExitCode, interruptProcessGroupOf)
import Control.Concurrent
(forkOS, newEmptyMVar, isEmptyMVar, takeMVar, putMVar, MVar,
forkIO)
import IDE.LogRef (logOutput, defaultLineLogger)
import IDE.Pane.SourceBuffer
(goToSourceDefinition, maybeActiveBuf, IDEBuffer(..))
import IDE.TextEditor (grabFocus)
import Control.Applicative ((<$>))
import System.FilePath ((</>), dropFileName)
import System.Exit (ExitCode(..))
import IDE.Pane.Log (getLog)
import Control.DeepSeq
import qualified Data.Enumerator as E
(Step(..), run_, Iteratee(..), run)
import qualified Data.Enumerator.List as EL
(foldM, head, dropWhile, isolate)
import Data.Enumerator (($$), (>>==))
import qualified Data.List as L ()
import Control.Monad (foldM, when)
import Control.Monad.Trans.Reader (ask)
import Control.Monad.Trans.Class (MonadTrans(..))
import Control.Monad.IO.Class (MonadIO(..))
data GrepRecord = GrepRecord {
file :: FilePath
, line :: Int
, context :: String
, parDir :: Maybe FilePath
}
isDir GrepRecord{parDir = Nothing} = True
isDir otherwies = False
data IDEGrep = IDEGrep {
scrolledView :: ScrolledWindow
, treeView :: TreeView
, grepStore :: TreeStore GrepRecord
, waitingGrep :: MVar Bool
, activeGrep :: MVar Bool
} 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
grepStore <- treeStoreNew []
treeView <- treeViewNew
treeViewSetModel treeView grepStore
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 grepStore
$ \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 grepStore
$ \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 grepStore
$ \row -> [ cellText := context row]
treeViewSetHeadersVisible treeView True
sel <- treeViewGetSelection treeView
treeSelectionSetMode sel SelectionSingle
scrolledView <- scrolledWindowNew Nothing Nothing
containerAdd scrolledView treeView
scrolledWindowSetPolicy scrolledView PolicyAutomatic PolicyAutomatic
waitingGrep <- newEmptyMVar
activeGrep <- newEmptyMVar
let grep = IDEGrep {..}
let
gotoSource :: Bool -> IO Bool
gotoSource focus = do
sel <- getSelectionGrepRecord treeView grepStore
case sel of
Just record -> reflectIDE (do
case record of
GrepRecord {file=f, line=l, parDir=Just pp} ->
(goToSourceDefinition (pp </> f) $ Just $ Location l 0 l 0)
?>>= (\b -> when focus $ grabFocus (sourceView b))
_ -> return ()) ideR
Nothing -> return ()
return True
cid1 <- treeView `afterFocusIn`
(\_ -> do reflectIDE (makeActive grep) ideR ; return True)
cid2 <- treeView `onKeyPress`
(\e ->
case e of
k@(Gdk.Key _ _ _ _ _ _ _ _ _ _)
| Gdk.eventKeyName k == "Return" -> do
gotoSource True
| Gdk.eventKeyName k == "Escape" -> do
reflectIDE (do
lastActiveBufferPane ?>>= \paneName -> do
(PaneC pane) <- paneFromName paneName
makeActive pane
return ()
triggerEventIDE StartFindInitial) ideR
return True
| otherwise -> do
return False
_ -> return False
)
sel `onSelectionChanged` (gotoSource False >> 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
let parDir = Nothing
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
-> TreeStore GrepRecord
-> IO (Maybe GrepRecord)
getSelectionGrepRecord treeView grepStore = do
treeSelection <- treeViewGetSelection treeView
paths <- treeSelectionGetSelectedRows treeSelection
case paths of
p:_ -> Just <$> treeStoreGetValue grepStore p
_ -> return Nothing
grepWorkspace :: String -> Bool -> WorkspaceAction
grepWorkspace "" caseSensitive = return ()
grepWorkspace regexString caseSensitive = do
ws <- ask
maybeActive <- lift $ readIDE activePack
let packages = case maybeActive of
Just active -> active : (filter (/= active) $ wsPackages ws)
Nothing -> wsPackages ws
lift $ grepDirectories regexString caseSensitive $
map (\p -> (dropFileName (ipdCabalFile p), ipdSrcDirs p)) $ packages
grepDirectories :: String -> Bool -> [(FilePath, [FilePath])] -> IDEAction
grepDirectories regexString caseSensitive dirs = do
grep <- getGrep Nothing
let store = grepStore grep
ideRef <- ask
liftIO $ do
bringPaneToFront grep
forkIO $ do
putMVar (waitingGrep grep) True
putMVar (activeGrep grep) True
takeMVar (waitingGrep grep)
postGUISync $ treeStoreClear store
totalFound <- foldM (\a (dir, subDirs) -> do
nooneWaiting <- isEmptyMVar (waitingGrep grep)
found <- if nooneWaiting
then do
(output, pid) <- runTool "grep" ((if caseSensitive then [] else ["-i"])
++ ["-r", "-E", "-n", "-I", "--exclude=*~",
#if !defined(darwin_HOST_OS)
"--exclude-dir=.svn",
"--exclude-dir=_darcs",
"--exclude-dir=.git",
#endif
regexString] ++ subDirs) (Just dir)
reflectIDE (do
E.run_ $ output $$ do
let max = 1000
step <- EL.isolate (toInteger max) $$ setGrepResults dir
case step of
E.Continue _ -> do
liftIO $ interruptProcessGroupOf pid
liftIO $ postGUISync $ do
nDir <- treeModelIterNChildren store Nothing
liftIO $ treeStoreChange store [nDir1] (\r -> r{ context = "(Stoped Searching)" })
return ()
EL.dropWhile (const True)
return max
E.Yield n _ -> return n
_ -> return 0) ideRef
else return 0
return $ a + found) 0 dirs
nooneWaiting <- isEmptyMVar (waitingGrep grep)
when nooneWaiting $ postGUISync $ do
nDir <- treeModelIterNChildren store Nothing
treeStoreInsert store [] nDir $ GrepRecord "Search Complete" totalFound "" Nothing
takeMVar (activeGrep grep) >> return ()
return ()
setGrepResults :: FilePath -> E.Iteratee ToolOutput IDEM Int
setGrepResults dir = do
ideRef <- lift ask
grep <- lift $ getGrep Nothing
log <- lift $ getLog
let store = grepStore grep
view = treeView grep
nDir <- liftIO $ postGUISync $ do
nDir <- treeModelIterNChildren store Nothing
treeStoreInsert store [] nDir $ GrepRecord dir 0 "" Nothing
when (nDir == 0) (widgetGrabFocus view >> return())
return nDir
EL.foldM (\count line -> do
if isError line
then do
liftIO $ postGUISync $ reflectIDE (defaultLineLogger log line >> return ()) ideRef
return count
else do
case process dir line of
Nothing -> return count
Just record -> liftIO $ do
nooneWaiting <- isEmptyMVar (waitingGrep grep)
when nooneWaiting $ postGUISync $ do
parent <- treeModelGetIter store [nDir]
n <- treeModelIterNChildren store parent
treeStoreInsert store [nDir] n record
treeStoreChange store [nDir] (\r -> r{ line = n+1 })
when (nDir == 0 && n == 0) $
treeViewExpandAll view
return (count+1)) 0
where
process pp (ToolOutput line) =
case parse grepLineParser "" line of
Right record -> Just record{parDir = Just pp}
_ -> Nothing
process _ _ = Nothing
isError (ToolExit ExitSuccess) = False
isError (ToolExit (ExitFailure 1)) = False
isError o = isNothing (process "" o)