{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE OverloadedStrings #-}
-- For some reason ghc warns about not using
-- Control.Monad.IO.Class but it's needed for
-- MonadIO
{-# OPTIONS_GHC -Wunused-imports #-}

module Language.LSP.Test.Compat where

import Data.Maybe
import Data.Row
import Data.Text qualified as T
import System.IO

#if MIN_VERSION_process(1,6,3)
-- We have to hide cleanupProcess for process-1.6.3.0
-- cause it is in the public api for 1.6.3.0 versions
-- shipped with ghc >= 8.6 and < 8.6.4
import System.Process hiding (getPid, cleanupProcess, withCreateProcess)
# if MIN_VERSION_process(1,6,4)
import qualified System.Process (getPid, cleanupProcess, withCreateProcess)
# else
import Foreign.C.Error
import GHC.IO.Exception ( IOErrorType(..), IOException(..) )

import qualified System.Process (getPid)
import qualified Control.Exception as C
# endif
#else
import Control.Concurrent.MVar
import Foreign.C.Error
import GHC.IO.Exception ( IOErrorType(..), IOException(..) )
import System.Process hiding (withCreateProcess)
import System.Process.Internals

import qualified Control.Exception as C
#endif

#ifdef mingw32_HOST_OS
import qualified System.Win32.Process
#else
import qualified System.Posix.Process
#endif

getCurrentProcessID :: IO Int
#ifdef mingw32_HOST_OS
getCurrentProcessID = fromIntegral <$> System.Win32.Process.getCurrentProcessId
#else
getCurrentProcessID :: IO Int
getCurrentProcessID = Pid -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Pid -> Int) -> IO Pid -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Pid
System.Posix.Process.getProcessID
#endif

getProcessID :: ProcessHandle -> IO Int
getProcessID :: ProcessHandle -> IO Int
getProcessID ProcessHandle
p = Pid -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Pid -> Int) -> (Maybe Pid -> Pid) -> Maybe Pid -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Pid -> Pid
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Pid -> Int) -> IO (Maybe Pid) -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProcessHandle -> IO (Maybe Pid)
getProcessID' ProcessHandle
p
 where
#if MIN_VERSION_process(1,6,3)
  getProcessID' :: ProcessHandle -> IO (Maybe Pid)
getProcessID' = ProcessHandle -> IO (Maybe Pid)
System.Process.getPid
#else
#if MIN_VERSION_process(1,6,0)
  getProcessID' (ProcessHandle mh _ _) = do
#else
  getProcessID' (ProcessHandle mh _) = do
#endif
    p_ <- readMVar mh
    case p_ of
#ifdef mingw32_HOST_OS
      OpenHandle h -> do
        pid <- System.Win32.Process.getProcessId h
        return $ Just pid
#else
      OpenHandle pid -> return $ Just pid
#endif
      _ -> return Nothing
#endif

cleanupProcess ::
  (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) -> IO ()
withCreateProcess ::
  CreateProcess ->
  (Maybe Handle -> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO a) ->
  IO a

#if MIN_VERSION_process(1,6,4)

cleanupProcess :: (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) -> IO ()
cleanupProcess = (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) -> IO ()
System.Process.cleanupProcess

withCreateProcess :: forall a.
CreateProcess
-> (Maybe Handle
    -> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO a)
-> IO a
withCreateProcess = CreateProcess
-> (Maybe Handle
    -> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO a)
-> IO a
forall a.
CreateProcess
-> (Maybe Handle
    -> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO a)
-> IO a
System.Process.withCreateProcess

#else

cleanupProcess (mb_stdin, mb_stdout, mb_stderr, ph) = do
    -- We ignore the spurious "permission denied" error in windows:
    --   see https://github.com/haskell/process/issues/110
    ignorePermDenied $ terminateProcess ph
    -- Note, it's important that other threads that might be reading/writing
    -- these handles also get killed off, since otherwise they might be holding
    -- the handle lock and prevent us from closing, leading to deadlock.
    maybe (return ()) (ignoreSigPipe . hClose) mb_stdin
    maybe (return ()) hClose mb_stdout
    maybe (return ()) hClose mb_stderr

    return ()
  where ignoreSigPipe = ignoreIOError ResourceVanished ePIPE
        ignorePermDenied = ignoreIOError PermissionDenied eACCES
    
ignoreIOError :: IOErrorType -> Errno -> IO () -> IO ()
ignoreIOError ioErrorType errno =
  C.handle $ \e -> case e of
                     IOError { ioe_type  = iot
                             , ioe_errno = Just ioe }
                       | iot == ioErrorType && Errno ioe == errno -> return ()
                     _ -> C.throwIO e

withCreateProcess c action =
  C.bracket (createProcess c) cleanupProcess
            (\(m_in, m_out, m_err, ph) -> action m_in m_out m_err ph)

#endif

lspTestClientInfo :: Rec ("name" .== T.Text .+ "version" .== Maybe T.Text)
lspTestClientInfo :: Rec (Extend "name" Text ('R '[]) .+ ("version" .== Maybe Text))
lspTestClientInfo = Label "name"
#name Label "name" -> Text -> Rec (Extend "name" Text ('R '[]))
forall (l :: Symbol) a.
KnownSymbol l =>
Label l -> a -> Rec (l .== a)
.== Text
"lsp-test" Rec ('R '["name" ':-> Text])
-> Rec ('R '["version" ':-> Maybe Text])
-> Rec ('R '["name" ':-> Text] .+ 'R '["version" ':-> Maybe Text])
forall (l :: Row (*)) (r :: Row (*)).
FreeForall l =>
Rec l -> Rec r -> Rec (l .+ r)
.+ Label "version"
#version Label "version" -> Maybe Text -> Rec ("version" .== Maybe Text)
forall (l :: Symbol) a.
KnownSymbol l =>
Label l -> a -> Rec (l .== a)
.== (Text -> Maybe Text
forall a. a -> Maybe a
Just CURRENT_PACKAGE_VERSION)