module Test.Sandwich.Formatters.TerminalUI.OpenInEditor where

import Control.Applicative
import Data.Function
import qualified Data.Text as T
import GHC.Stack
import System.Environment
import System.Exit
import System.Process


autoOpenInEditor :: Maybe String -> (T.Text -> IO ()) -> SrcLoc -> IO ()
autoOpenInEditor :: Maybe String -> (Text -> IO ()) -> SrcLoc -> IO ()
autoOpenInEditor Maybe String
terminalUIDefaultEditor Text -> IO ()
debugFn (SrcLoc {Int
String
srcLocEndCol :: SrcLoc -> Int
srcLocEndLine :: SrcLoc -> Int
srcLocFile :: SrcLoc -> String
srcLocModule :: SrcLoc -> String
srcLocPackage :: SrcLoc -> String
srcLocStartCol :: SrcLoc -> Int
srcLocStartLine :: SrcLoc -> Int
srcLocEndCol :: Int
srcLocEndLine :: Int
srcLocStartCol :: Int
srcLocStartLine :: Int
srcLocFile :: String
srcLocModule :: String
srcLocPackage :: String
..}) = do
  Maybe String
maybeEditor' <- String -> IO (Maybe String)
lookupEnv String
"EDITOR"
  let maybeEditor :: Maybe String
maybeEditor = Maybe String
maybeEditor' forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe String
terminalUIDefaultEditor

  case Maybe String
maybeEditor of
    Maybe String
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Just String
editorString -> do
      let editor :: String
editor = String
editorString
                 forall a b. a -> (a -> b) -> b
& String -> Text
T.pack
                 forall a b. a -> (a -> b) -> b
& Text -> Text -> Text -> Text
T.replace Text
"LINE" (String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Int
srcLocStartLine)
                 forall a b. a -> (a -> b) -> b
& Text -> Text -> Text -> Text
T.replace Text
"COLUMN" (String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Int
srcLocStartCol)
                 forall a b. a -> (a -> b) -> b
& Text -> Text
fillInFile
                 forall a b. a -> (a -> b) -> b
& Text -> String
T.unpack

      Text -> IO ()
debugFn (Text
"Opening editor with command: " forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
editor)

      (Maybe Handle
_, Maybe Handle
_, Maybe Handle
_, ProcessHandle
p) <- CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
createProcess ((String -> CreateProcess
shell String
editor) { delegate_ctlc :: Bool
delegate_ctlc = Bool
True })
      ProcessHandle -> IO ExitCode
waitForProcess ProcessHandle
p forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        ExitCode
ExitSuccess -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
        ExitFailure Int
n -> Text -> IO ()
debugFn (Text
"Editor failed with exit code " forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (forall a. Show a => a -> String
show Int
n))

  where
    fillInFile :: Text -> Text
fillInFile Text
cmd
      | Text
"FILE" Text -> Text -> Bool
`T.isInfixOf` Text
cmd = Text -> Text -> Text -> Text
T.replace Text
"FILE" (String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show String
srcLocFile) Text
cmd
      | Bool
otherwise = Text
cmd forall a. Semigroup a => a -> a -> a
<> Text
" '" forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
srcLocFile forall a. Semigroup a => a -> a -> a
<> Text
"'"

-- elisp = [i|(progn
--              (x-focus-frame (selected-frame))
--              (raise-frame)
--              (recenter)
--              )|]