module Reanimate.Misc
  ( requireExecutable,
    runCmd,
    runCmd_,
    runCmdLazy,
    withTempDir,
    withTempFile,
    renameOrCopyFile,
    getReanimateCacheDirectory,
    fileUri
  )
where

import           Control.Concurrent (forkIO)
import           Control.Exception  (catch, evaluate, finally, throw)
import qualified Data.Text          as T
import qualified Data.Text.IO       as T
import           Foreign.C.Error    (Errno (Errno), eXDEV)
import           GHC.IO.Exception   (ExitCode (ExitFailure, ExitSuccess), IOException (ioe_errno))
import           System.Directory   (XdgDirectory (XdgCache), copyFile, createDirectoryIfMissing,
                                     findExecutable, getXdgDirectory, removeFile, renameFile)
import           System.FilePath    ((<.>), (</>))
import           System.IO          (hClose, hGetContents, hIsEOF, hPutStr, stderr)
import           System.IO.Temp     (withSystemTempDirectory, withSystemTempFile)
import           System.Process     (readProcessWithExitCode, runInteractiveProcess,
                                     showCommandForUser, terminateProcess, waitForProcess)

requireExecutable :: String -> IO FilePath
requireExecutable :: String -> IO String
requireExecutable String
exec = do
  Maybe String
mbPath <- String -> IO (Maybe String)
findExecutable String
exec
  case Maybe String
mbPath of
    Maybe String
Nothing   -> String -> IO String
forall a. HasCallStack => String -> a
error (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ String
"Couldn't find executable: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
exec
    Just String
path -> String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
path

runCmd :: FilePath -> [String] -> IO ()
runCmd :: String -> [String] -> IO ()
runCmd String
exec [String]
args = do
  Either String String
ret <- String -> [String] -> IO (Either String String)
runCmd_ String
exec [String]
args
  case Either String String
ret of
    Left String
err -> String -> IO ()
forall a. HasCallStack => String -> a
error (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> [String] -> String
showCommandForUser String
exec [String]
args String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
":\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
err
    Right {} -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

runCmd_ :: FilePath -> [String] -> IO (Either String String)
runCmd_ :: String -> [String] -> IO (Either String String)
runCmd_ String
exec [String]
args = do
  (ExitCode
ret, String
stdout, String
errMsg) <- String -> [String] -> String -> IO (ExitCode, String, String)
readProcessWithExitCode String
exec [String]
args String
""
  Int
_ <- Int -> IO Int
forall a. a -> IO a
evaluate (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
stdout Int -> Int -> Int
forall a. Num a => a -> a -> a
+ String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
errMsg)
  case ExitCode
ret of
    ExitCode
ExitSuccess -> Either String String -> IO (Either String String)
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Either String String
forall a b. b -> Either a b
Right String
stdout)
    -- ExitFailure err
    --   | False ->
    --     return $
    --       Left $
    --         "Failed to run: "
    --           ++ showCommandForUser exec args
    --           ++ "\n"
    --           ++ "Error code: "
    --           ++ show err
    --           ++ "\n"
    --           ++ "stderr: "
    --           ++ errMsg
    ExitFailure {}
      | String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
errMsg -> -- LaTeX prints errors to stdout. :(
        Either String String -> IO (Either String String)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String String -> IO (Either String String))
-> Either String String -> IO (Either String String)
forall a b. (a -> b) -> a -> b
$ String -> Either String String
forall a b. a -> Either a b
Left String
stdout
    ExitFailure {} -> Either String String -> IO (Either String String)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String String -> IO (Either String String))
-> Either String String -> IO (Either String String)
forall a b. (a -> b) -> a -> b
$ String -> Either String String
forall a b. a -> Either a b
Left String
errMsg

runCmdLazy ::
  FilePath -> [String] -> (IO (Either String T.Text) -> IO a) -> IO a
runCmdLazy :: String -> [String] -> (IO (Either String Text) -> IO a) -> IO a
runCmdLazy String
exec [String]
args IO (Either String Text) -> IO a
handler = do
  (Handle
inp, Handle
out, Handle
err, ProcessHandle
pid) <- String
-> [String]
-> Maybe String
-> Maybe [(String, String)]
-> IO (Handle, Handle, Handle, ProcessHandle)
runInteractiveProcess String
exec [String]
args Maybe String
forall a. Maybe a
Nothing Maybe [(String, String)]
forall a. Maybe a
Nothing
  Handle -> IO ()
hClose Handle
inp
  String
errOutput <- Handle -> IO String
hGetContents Handle
err
  ThreadId
_ <- IO () -> IO ThreadId
forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ Handle -> String -> IO ()
hPutStr Handle
stderr String
errOutput
  let fetch :: IO (Either String Text)
fetch = do
        Bool
eof <- Handle -> IO Bool
hIsEOF Handle
out
        if Bool
eof
          then do
            Int
_ <- Int -> IO Int
forall a. a -> IO a
evaluate (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
errOutput)
            ExitCode
ret <- ProcessHandle -> IO ExitCode
waitForProcess ProcessHandle
pid
            case ExitCode
ret of
              ExitCode
ExitSuccess    -> Either String Text -> IO (Either String Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Either String Text
forall a b. a -> Either a b
Left String
"")
              ExitFailure {} -> Either String Text -> IO (Either String Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Either String Text
forall a b. a -> Either a b
Left String
errOutput)
          else {-ExitFailure errMsg -> do
                 return $ Left $
                   "Failed to run: " ++ showCommandForUser exec args ++ "\n" ++
                   "Error code: " ++ show errMsg ++ "\n" ++
                   "stderr: " ++ stderr-}
          do
            Text
line <- Handle -> IO Text
T.hGetLine Handle
out
            Either String Text -> IO (Either String Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Either String Text
forall a b. b -> Either a b
Right Text
line)
  IO (Either String Text) -> IO a
handler IO (Either String Text)
fetch IO a -> IO () -> IO a
forall a b. IO a -> IO b -> IO a
`finally` do
    ProcessHandle -> IO ()
terminateProcess ProcessHandle
pid
    ExitCode
_ <- ProcessHandle -> IO ExitCode
waitForProcess ProcessHandle
pid
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- renameFile fails if we're crossing filesystem boundaries. If this happens,
-- revert back to copyFile + removeFile.
renameOrCopyFile :: FilePath -> FilePath -> IO ()
renameOrCopyFile :: String -> String -> IO ()
renameOrCopyFile String
src String
dst = String -> String -> IO ()
renameFile String
src String
dst IO () -> (IOException -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` IOException -> IO ()
exdev
  where
    exdev :: IOException -> IO ()
exdev IOException
e =
      if (CInt -> Errno) -> Maybe CInt -> Maybe Errno
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CInt -> Errno
Errno (IOException -> Maybe CInt
ioe_errno IOException
e) Maybe Errno -> Maybe Errno -> Bool
forall a. Eq a => a -> a -> Bool
== Errno -> Maybe Errno
forall a. a -> Maybe a
Just Errno
eXDEV
        then String -> String -> IO ()
copyFile String
src String
dst IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> IO ()
removeFile String
src
        else IOException -> IO ()
forall a e. Exception e => e -> a
throw IOException
e

withTempDir :: (FilePath -> IO a) -> IO a
withTempDir :: (String -> IO a) -> IO a
withTempDir = String -> (String -> IO a) -> IO a
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
String -> (String -> m a) -> m a
withSystemTempDirectory String
"reanimate"

withTempFile :: String -> (FilePath -> IO a) -> IO a
withTempFile :: String -> (String -> IO a) -> IO a
withTempFile String
ext String -> IO a
action =
  String -> (String -> Handle -> IO a) -> IO a
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
String -> (String -> Handle -> m a) -> m a
withSystemTempFile (String
"reanimate" String -> String -> String
<.> String
ext) ((String -> Handle -> IO a) -> IO a)
-> (String -> Handle -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \String
path Handle
hd ->
    Handle -> IO ()
hClose Handle
hd IO () -> IO a -> IO a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> IO a
action String
path

getReanimateCacheDirectory :: IO FilePath
getReanimateCacheDirectory :: IO String
getReanimateCacheDirectory = do
  String
root <- XdgDirectory -> String -> IO String
getXdgDirectory XdgDirectory
XdgCache String
"reanimate"
  let path :: String
path = String
root String -> String -> String
</> Int -> String
forall a. Show a => a -> String
show Int
cacheVersion
  Bool -> String -> IO ()
createDirectoryIfMissing Bool
True String
path
  String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
path
  where
    -- Incrementing this value invalidates all cached results.
    cacheVersion :: Int
    cacheVersion :: Int
cacheVersion = Int
0

-- | A valid file URI is file://<hostname>/<path>. If <hostname> is absent, it
--   is file:///<path>. On Windows, absolute paths begin (for example) "C:\".
fileUri :: FilePath -> String
fileUri :: String -> String
fileUri String
path = String
"file://" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
path'
 where
  path' :: String
path' = case String
path of
    Char
'/' : String
_ -> String
path
    String
_ -> Char
'/' Char -> String -> String
forall a. a -> [a] -> [a]
: String
path