{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_HADDOCK show-extensions #-}

-- |
-- Module      :  Yi.Keymap.Vim.Ex.Commands.Nohl
-- License     :  GPL-2
-- Maintainer  :  yi-devel@googlegroups.com
-- Stability   :  experimental
-- Portability :  portable

module Yi.Keymap.Vim.Ex.Commands.Nohl (parse) where

import qualified Data.Text                        as T
import           Yi.Keymap                        (Action (EditorA))
import           Yi.Keymap.Vim.Common             (EventString(..))
import           Yi.Keymap.Vim.Ex.Commands.Common (pureExCommand)
import           Yi.Keymap.Vim.Ex.Types           (ExCommand (cmdAction, cmdShow))
import           Yi.Search                        (resetRegexE)

parse :: EventString -> Maybe ExCommand
parse :: EventString -> Maybe ExCommand
parse (Ev Text
s)
  | Text -> Text -> Bool
T.isPrefixOf Text
s Text
"nohlsearch" Bool -> Bool -> Bool
&& Text -> Int -> Ordering
T.compareLength Text
s Int
2 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT = ExCommand -> Maybe ExCommand
forall a. a -> Maybe a
Just ExCommand
nohl
  | Bool
otherwise                                                = Maybe ExCommand
forall a. Maybe a
Nothing

nohl :: ExCommand
nohl :: ExCommand
nohl = ExCommand
pureExCommand {
    cmdAction :: Action
cmdAction = EditorM () -> Action
forall a. Show a => EditorM a -> Action
EditorA EditorM ()
resetRegexE
  , cmdShow :: Text
cmdShow = Text
"nohlsearch"
  }