{-# OPTIONS_HADDOCK show-extensions #-}

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

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

import           Data.Char                        (isDigit)
import qualified Data.Text                        as T (all, null, unpack)
import           Yi.Buffer                        (firstNonSpaceB, gotoLn)
import           Yi.Keymap                        (Action (BufferA))
import           Yi.Keymap.Vim.Common             (EventString (Ev))
import           Yi.Keymap.Vim.Ex.Commands.Common (pureExCommand)
import           Yi.Keymap.Vim.Ex.Types           (ExCommand (cmdAction, cmdShow))

parse :: EventString -> Maybe ExCommand
parse :: EventString -> Maybe ExCommand
parse (Ev Text
s) = if Bool -> Bool
not (Text -> Bool
T.null Text
s) Bool -> Bool -> Bool
&& (Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isDigit Text
s
    then let l :: Int
l = String -> Int
forall a. Read a => String -> a
read (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
s in
         ExCommand -> Maybe ExCommand
forall a. a -> Maybe a
Just (ExCommand -> Maybe ExCommand) -> ExCommand -> Maybe ExCommand
forall a b. (a -> b) -> a -> b
$ ExCommand
pureExCommand {
             cmdAction :: Action
cmdAction = BufferM () -> Action
forall a. Show a => BufferM a -> Action
BufferA (BufferM () -> Action) -> BufferM () -> Action
forall a b. (a -> b) -> a -> b
$ Int -> BufferM Int
gotoLn Int
l BufferM Int -> BufferM () -> BufferM ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BufferM ()
firstNonSpaceB
           , cmdShow :: Text
cmdShow = Text
s
         }
    else Maybe ExCommand
forall a. Maybe a
Nothing