{- | Editor integration. -}

module Hledger.UI.Editor (
   -- TextPosition
   endPosition
  ,runEditor
  ,runIadd
  )
where

import Control.Applicative ((<|>))
import Data.List (intercalate)
import Data.Maybe (catMaybes)
import Data.Bifunctor (bimap)
import Safe
import System.Environment
import System.Exit
import System.FilePath
import System.Process

import Hledger

-- | A position we can move to in a text editor: a line and optional column number.
-- Line number 1 or 0 means the first line. A negative line number means the last line.
type TextPosition = (Int, Maybe Int)

-- | The text position meaning "last line, first column".
endPosition :: Maybe TextPosition
endPosition :: Maybe TextPosition
endPosition = forall a. a -> Maybe a
Just (-Int
1, forall a. Maybe a
Nothing)

-- | Run the hledger-iadd executable on the given file, blocking until it exits,
-- and return the exit code; or raise an error.
-- hledger-iadd is an alternative to the built-in add command.
runIadd :: FilePath -> IO ExitCode
runIadd :: FilePath -> IO ExitCode
runIadd FilePath
f = FilePath -> IO ProcessHandle
runCommand (FilePath
"hledger-iadd -f " forall a. [a] -> [a] -> [a]
++ FilePath
f) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ProcessHandle -> IO ExitCode
waitForProcess

-- | Run the user's preferred text editor (or try a default editor),
-- on the given file, blocking until it exits, and return the exit
-- code; or raise an error. If a text position is provided, the editor
-- will be focussed at that position in the file, if we know how.
runEditor :: Maybe TextPosition -> FilePath -> IO ExitCode
runEditor :: Maybe TextPosition -> FilePath -> IO ExitCode
runEditor Maybe TextPosition
mpos FilePath
f = Maybe TextPosition -> FilePath -> IO FilePath
editFileAtPositionCommand Maybe TextPosition
mpos FilePath
f forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FilePath -> IO ProcessHandle
runCommand forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ProcessHandle -> IO ExitCode
waitForProcess

-- | Get a shell command line to open the user's preferred text editor
-- (or a default editor) on the given file, and to focus it at the
-- given text position if one is provided and if we know how.
--
-- Just ('-' : _, _) is any text position with a negative line number.
-- A text position with a negative line number means the last line.
--
-- Some tests:
-- @
-- EDITOR program:  Maybe TextPosition    Command should be:
-- ---------------  --------------------- ------------------------------------
-- emacs            Just (line, Just col) emacs +LINE:COL FILE
--                  Just (line, Nothing)  emacs +LINE     FILE
--                  Just ('-' : _, _)     emacs FILE -f end-of-buffer
--                  Nothing               emacs           FILE
--
-- emacsclient      Just (line, Just col) emacsclient +LINE:COL FILE
--                  Just (line, Nothing)  emacsclient +LINE     FILE
--                  Just ('-' : _, _)     emacsclient           FILE
--                  Nothing               emacsclient           FILE
--
-- nano             Just (line, Just col) nano +LINE:COL FILE
--                  Just (line, Nothing)  nano +LINE     FILE
--                  Just ('-' : _, _)     nano           FILE
--                  Nothing               nano           FILE
--
-- vscode           Just (line, Just col) vscode --goto FILE:LINE:COL
--                  Just (line, Nothing)  vscode --goto FILE:LINE
--                  Just ('-' : _, _)     vscode        FILE
--                  Nothing               vscode        FILE
--
-- kak              Just (line, Just col) kak +LINE:COL FILE
--                  Just (line, Nothing)  kak +LINE     FILE
--                  Just ('-' : _, _)     kak +:        FILE
--                  Nothing               kak           FILE
--
-- vi & variants    Just (line, _)        vi +LINE FILE
--                  Just ('-' : _, _)     vi +     FILE
--                  Nothing               vi       FILE
--
-- (other PROG)     _                     PROG FILE
--
-- (not set)        Just (line, Just col) emacsclient -a '' -nw +LINE:COL FILE
--                  Just (line, Nothing)  emacsclient -a '' -nw +LINE     FILE
--                  Just ('-' : _, _)     emacsclient -a '' -nw           FILE
--                  Nothing               emacsclient -a '' -nw           FILE
-- @
--
editFileAtPositionCommand :: Maybe TextPosition -> FilePath -> IO String
editFileAtPositionCommand :: Maybe TextPosition -> FilePath -> IO FilePath
editFileAtPositionCommand Maybe TextPosition
mpos FilePath
f = do
  FilePath
cmd <- IO FilePath
getEditCommand
  let editor :: FilePath
editor = FilePath -> FilePath
lowercase forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
takeBaseName forall a b. (a -> b) -> a -> b
$ forall a. a -> [a] -> a
headDef FilePath
"" forall a b. (a -> b) -> a -> b
$ FilePath -> [FilePath]
words' FilePath
cmd
      f' :: FilePath
f' = FilePath -> FilePath
singleQuoteIfNeeded FilePath
f
      mpos' :: Maybe (FilePath, Maybe FilePath)
mpos' = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap forall a. Show a => a -> FilePath
show (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Show a => a -> FilePath
show) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe TextPosition
mpos
      join :: [a] -> [Maybe [a]] -> [a]
join [a]
sep = forall a. [a] -> [[a]] -> [a]
intercalate [a]
sep forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [Maybe a] -> [a]
catMaybes
      args :: [FilePath]
args = case FilePath
editor of
        FilePath
"emacs" -> case Maybe (FilePath, Maybe FilePath)
mpos' of
          Maybe (FilePath, Maybe FilePath)
Nothing -> [FilePath
f']
          Just (Char
'-' : FilePath
_, Maybe FilePath
_) -> [FilePath
f', FilePath
"-f", FilePath
"end-of-buffer"]
          Just (FilePath
l, Maybe FilePath
mc) -> [Char
'+' forall a. a -> [a] -> [a]
: forall {a}. [a] -> [Maybe [a]] -> [a]
join FilePath
":" [forall a. a -> Maybe a
Just FilePath
l, Maybe FilePath
mc], FilePath
f']
        FilePath
e | FilePath
e forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FilePath
"emacsclient", FilePath
"nano"] -> case Maybe (FilePath, Maybe FilePath)
mpos' of
          Maybe (FilePath, Maybe FilePath)
Nothing -> [FilePath
f']
          Just (Char
'-' : FilePath
_, Maybe FilePath
_) -> [FilePath
f']
          Just (FilePath
l, Maybe FilePath
mc) -> [Char
'+' forall a. a -> [a] -> [a]
: forall {a}. [a] -> [Maybe [a]] -> [a]
join FilePath
":" [forall a. a -> Maybe a
Just FilePath
l, Maybe FilePath
mc], FilePath
f']
        FilePath
"vscode" -> case Maybe (FilePath, Maybe FilePath)
mpos' of
          Maybe (FilePath, Maybe FilePath)
Nothing -> [FilePath
f']
          Just (Char
'-' : FilePath
_, Maybe FilePath
_) -> [FilePath
f']
          Just (FilePath
l, Maybe FilePath
mc) -> [FilePath
"--goto", forall {a}. [a] -> [Maybe [a]] -> [a]
join FilePath
":" [forall a. a -> Maybe a
Just FilePath
f', forall a. a -> Maybe a
Just FilePath
l, Maybe FilePath
mc]]
        FilePath
"kak" -> case Maybe (FilePath, Maybe FilePath)
mpos' of
          Maybe (FilePath, Maybe FilePath)
Nothing -> [FilePath
f']
          Just (Char
'-' : FilePath
_, Maybe FilePath
_) -> [FilePath
"+:", FilePath
f']
          Just (FilePath
l, Maybe FilePath
mc) -> [Char
'+' forall a. a -> [a] -> [a]
: forall {a}. [a] -> [Maybe [a]] -> [a]
join FilePath
":" [forall a. a -> Maybe a
Just FilePath
l, Maybe FilePath
mc], FilePath
f']
        FilePath
e | FilePath
e forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FilePath
"vi",  FilePath
"vim", FilePath
"view", FilePath
"nvim", FilePath
"evim", FilePath
"eview",
                      FilePath
"gvim", FilePath
"gview", FilePath
"rvim", FilePath
"rview",
                      FilePath
"rgvim", FilePath
"rgview", FilePath
"ex"] -> case Maybe (FilePath, Maybe FilePath)
mpos' of
          Maybe (FilePath, Maybe FilePath)
Nothing -> [FilePath
f']
          Just (Char
'-' : FilePath
_, Maybe FilePath
_) -> [FilePath
"+", FilePath
f']
          Just (FilePath
l, Maybe FilePath
_) -> [Char
'+' forall a. a -> [a] -> [a]
: FilePath
l, FilePath
f']
        FilePath
_ -> [FilePath
f']
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
unwords forall a b. (a -> b) -> a -> b
$ FilePath
cmdforall a. a -> [a] -> [a]
:[FilePath]
args

-- | Get the user's preferred edit command. This is the value of the
-- $HLEDGER_UI_EDITOR environment variable, or of $EDITOR, or a
-- default ("emacsclient -a '' -nw", which starts/connects to an emacs
-- daemon in terminal mode).
getEditCommand :: IO String
getEditCommand :: IO FilePath
getEditCommand = do
  Maybe FilePath
hledger_ui_editor_env <- FilePath -> IO (Maybe FilePath)
lookupEnv FilePath
"HLEDGER_UI_EDITOR"
  Maybe FilePath
editor_env            <- FilePath -> IO (Maybe FilePath)
lookupEnv FilePath
"EDITOR"
  let Just FilePath
cmd = Maybe FilePath
hledger_ui_editor_env forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe FilePath
editor_env forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. a -> Maybe a
Just FilePath
"emacsclient -a '' -nw"
  forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
cmd