Search.hs

module Hob.Ui.Editor.Search (
        highlightSearchPreview,
        resetSearchPreview,
        findFirstFromCursor,
        findNext,
        findPrevious,
        resetSearch,
        getEditorSearchString,
        startReplace,
        replaceNext,
        resetReplace,
    ) where

import Control.Monad              (when)
import Data.Text                  (pack)
import Graphics.UI.Gtk
import Graphics.UI.Gtk.SourceView (SourceView)
import System.Glib.GObject        (Quark)

import Hob.Control

highlightSearchPreview :: SourceView -> String -> IO()
highlightSearchPreview editor text = do
    buffer <- textViewGetBuffer editor
    tagTable <- textBufferGetTagTable buffer
    tag <- maybe (addNewSearchTag tagTable) return =<< textTagTableLookup tagTable "search"
    (start, end) <- textBufferGetBounds buffer
    addNewSearchTags buffer tag start end
    where
        addNewSearchTag tagTable = do
            tag <- textTagNew $ Just $ pack "search"
            tag `set` [textTagBackground := "#707550"]
            textTagTableAdd tagTable tag
            return tag
        addNewSearchTags buffer tag start end = do
            result <- textIterForwardSearch start text [TextSearchTextOnly] (Just end)
            case result of
                Just (matchStart, matchEnd) -> do
                    textBufferApplyTag buffer tag matchStart matchEnd
                    addNewSearchTags buffer tag matchEnd end
                Nothing -> return()

resetSearch :: SourceView -> IO()
resetSearch editor = do
    setEditorSearchString editor Nothing
    resetSearchPreview editor

resetSearchPreview :: SourceView -> IO()
resetSearchPreview editor = do
    buffer <- textViewGetBuffer editor
    tagTable <- textBufferGetTagTable buffer
    maybeDo (removeEditorTag buffer) =<< textTagTableLookup tagTable "search"
    where
        removeEditorTag buffer tag = do
            (start, end) <- textBufferGetBounds buffer
            textBufferRemoveTag buffer tag start end

findNext :: SourceView -> IO()
findNext editor = do
     searchString <- getEditorSearchString editor
     maybeDo (searchExecute editor) searchString

findPrevious :: SourceView -> IO()
findPrevious editor = do
    searchString <- getEditorSearchString editor
    maybeDo (searchExecuteBackwards editor) searchString

findFirstFromCursor :: SourceView -> String -> IO()
findFirstFromCursor editor text = do
    setEditorSearchString editor $ Just text
    highlightSearchPreview editor text
    searchExecute editor text


startReplace :: SourceView -> String -> String -> IO()
startReplace editor textFrom textTo = do
    findFirstFromCursor editor textFrom
    setEditorReplaceString editor $ Just textTo

replaceNext :: SourceView -> IO()
replaceNext editor = do
    maybeDo replaceSelectionWith =<< getEditorReplaceString editor
    findNext editor
    where
        replaceSelectionWith replaceText = maybeDo (replaceSearchSelectionWith replaceText) =<< getEditorSearchString editor
        replaceSearchSelectionWith replaceText searchText = do
            buffer <- textViewGetBuffer editor
            (s, e) <- textBufferGetSelectionBounds buffer
            selectedText <- textBufferGetText buffer s e False
            when (searchText == selectedText) $ do
                textBufferDelete buffer s e
                textBufferInsert buffer s replaceText

resetReplace :: SourceView -> IO()
resetReplace editor = do
    resetSearch editor
    setEditorReplaceString editor Nothing


searchExecute :: SourceView -> String -> IO()
searchExecute editor text = do
    buffer <- textViewGetBuffer editor
    (_, start) <- textBufferGetSelectionBounds buffer
    maybe (retryFromStart buffer) (selectMatch editor buffer) =<< findNextResult start
    where
        findNextResult start = textIterForwardSearch start text [TextSearchTextOnly] Nothing
        retryFromStart buffer = do
            (start, _) <- textBufferGetBounds buffer
            maybeDo (selectMatch editor buffer) =<< findNextResult start

searchExecuteBackwards :: SourceView -> String -> IO()
searchExecuteBackwards editor text = do
    buffer <- textViewGetBuffer editor
    (end, _) <- textBufferGetSelectionBounds buffer
    maybe (retryFromEnd buffer) (selectMatch editor buffer) =<< findPreviousResult end
    where
        findPreviousResult end = textIterBackwardSearch end text [TextSearchTextOnly] Nothing
        retryFromEnd buffer = do
            (_, end) <- textBufferGetBounds buffer
            maybeDo (selectMatch editor buffer) =<< findPreviousResult end

selectMatch :: (TextViewClass tv, TextBufferClass tb) => tv -> tb -> (TextIter, TextIter) -> IO ()
selectMatch editor buffer (start, end) = do
    textBufferSelectRange buffer start end
    caretMark <- textBufferGetInsert buffer
    textViewScrollToMark editor caretMark 0.1 Nothing

setEditorSearchString :: SourceView -> Maybe String -> IO ()
setEditorSearchString editor searchString = do
    quark <- searchStringQuark
    objectSetAttribute quark editor searchString

getEditorSearchString :: SourceView -> IO (Maybe String)
getEditorSearchString editor = do
    quark <- searchStringQuark
    objectGetAttributeUnsafe quark editor

searchStringQuark :: IO Quark
searchStringQuark = quarkFromString "activeSearchString"

setEditorReplaceString :: SourceView -> Maybe String -> IO ()
setEditorReplaceString editor replaceString = do
    quark <- replaceStringQuark
    objectSetAttribute quark editor replaceString

getEditorReplaceString :: SourceView -> IO (Maybe String)
getEditorReplaceString editor = do
    quark <- replaceStringQuark
    objectGetAttributeUnsafe quark editor

replaceStringQuark :: IO Quark
replaceStringQuark = quarkFromString "activeReplaceString"