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

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

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

import qualified Data.Attoparsec.Text             as P (string)
import           Data.Monoid                      ((<>))
import           Yi.Editor                        (printMsg, withCurrentBuffer)
import           Yi.Keymap                        (Action (BufferA, EditorA))
import           Yi.Keymap.Vim.Common             (EventString)
import           Yi.Keymap.Vim.Ex.Commands.Common (BoolOptionAction (..), parseBoolOption, pureExCommand)
import qualified Yi.Keymap.Vim.Ex.Commands.Common as Ex (parse)
import           Yi.Keymap.Vim.Ex.Types           (ExCommand (..), evStringToExCommand)
import           Yi.String                        (showT)
import           Yi.UI.LineNumbers                (getDisplayLineNumbersLocal, setDisplayLineNumbersLocal)

-- | Defines the following commands:
-- - :set [no]number        (toggle buffer-local line numbers)
-- - :unset number          (make the current buffer use the global setting)
parse :: EventString -> Maybe ExCommand
parse :: EventString -> Maybe ExCommand
parse = [EventString -> Maybe ExCommand] -> EventString -> Maybe ExCommand
evStringToExCommand
  [ Text
-> (BoolOptionAction -> Action) -> EventString -> Maybe ExCommand
parseBoolOption Text
"number" BoolOptionAction -> Action
actionSet
  , EventString -> Maybe ExCommand
parseUnset
  ]

actionSet :: BoolOptionAction -> Action
actionSet :: BoolOptionAction -> Action
actionSet BoolOptionAction
BoolOptionAsk = EditorM () -> Action
forall a. Show a => EditorM a -> Action
EditorA (EditorM () -> Action) -> EditorM () -> Action
forall a b. (a -> b) -> a -> b
$ do
  Maybe Bool
mb <- BufferM (Maybe Bool) -> EditorM (Maybe Bool)
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer BufferM (Maybe Bool)
getDisplayLineNumbersLocal
  Text -> EditorM ()
forall (m :: * -> *). MonadEditor m => Text -> m ()
printMsg (Text -> EditorM ()) -> Text -> EditorM ()
forall a b. (a -> b) -> a -> b
$ Text
"number = " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> case Maybe Bool
mb of
    Maybe Bool
Nothing -> Text
"<unset>"
    Just Bool
b  -> Bool -> Text
forall a. Show a => a -> Text
showT Bool
b
actionSet (BoolOptionSet Bool
b) = BufferM () -> Action
forall a. Show a => BufferM a -> Action
BufferA (BufferM () -> Action) -> BufferM () -> Action
forall a b. (a -> b) -> a -> b
$ Maybe Bool -> BufferM ()
setDisplayLineNumbersLocal (Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
b)
actionSet BoolOptionAction
BoolOptionInvert = BufferM () -> Action
forall a. Show a => BufferM a -> Action
BufferA (BufferM () -> Action) -> BufferM () -> Action
forall a b. (a -> b) -> a -> b
$ do
  Maybe Bool
b <- BufferM (Maybe Bool)
getDisplayLineNumbersLocal
  Maybe Bool -> BufferM ()
setDisplayLineNumbersLocal ((Bool -> Bool) -> Maybe Bool -> Maybe Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Bool
not Maybe Bool
b)

parseUnset :: EventString -> Maybe ExCommand
parseUnset :: EventString -> Maybe ExCommand
parseUnset = Parser ExCommand -> EventString -> Maybe ExCommand
Ex.parse (Parser ExCommand -> EventString -> Maybe ExCommand)
-> Parser ExCommand -> EventString -> Maybe ExCommand
forall a b. (a -> b) -> a -> b
$ do
  Text
_ <- Text -> Parser Text
P.string Text
"unset number"
  ExCommand -> Parser ExCommand
forall (m :: * -> *) a. Monad m => a -> m a
return (ExCommand -> Parser ExCommand) -> ExCommand -> Parser ExCommand
forall a b. (a -> b) -> a -> b
$ ExCommand
pureExCommand
    { cmdShow :: Text
cmdShow = Text
"unset number"
    , cmdAction :: Action
cmdAction = BufferM () -> Action
forall a. Show a => BufferM a -> Action
BufferA (BufferM () -> Action) -> BufferM () -> Action
forall a b. (a -> b) -> a -> b
$ Maybe Bool -> BufferM ()
setDisplayLineNumbersLocal Maybe Bool
forall a. Maybe a
Nothing
    }