{-|
Module      : Util.System
Description : Utilities for interacting with the system.

License     : BSD3
Maintainer  : The Idris Community.
-}
{-# LANGUAGE CPP, ForeignFunctionInterface #-}
module Util.System( tempfile
                  , withTempdir
                  , rmFile
                  , catchIO
                  , isDarwin
                  , isWindows
                  , writeSource
                  , writeSourceText
                  , readSource
                  , readSourceStrict
                  , setupBundledCC
                  , isATTY
                  ) where

import Control.Exception as CE
import Control.Monad (when)
import qualified Data.Text as T
import qualified Data.Text.IO as TIO
import Foreign.C
import System.Directory (createDirectoryIfMissing, getTemporaryDirectory,
                         removeDirectoryRecursive, removeFile)
import System.FilePath (normalise, (</>))
import System.Info
import System.IO
import System.IO.Error

#ifdef FREESTANDING
import Data.List (intercalate)
import System.Directory (doesDirectoryExist)
import System.Environment (getEnv, getExecutablePath, setEnv)
import System.FilePath (dropFileName, isAbsolute, searchPathSeparator)
import Tools_idris
#endif

#ifdef mingw32_HOST_OS
import Graphics.Win32.Misc (getStdHandle, sTD_OUTPUT_HANDLE)
import System.Console.MinTTY (isMinTTYHandle)
#endif

catchIO :: IO a -> (IOError -> IO a) -> IO a
catchIO :: forall a. IO a -> (IOError -> IO a) -> IO a
catchIO = IO a -> (IOError -> IO a) -> IO a
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
CE.catch

isWindows :: Bool
isWindows :: Bool
isWindows = String
os String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"win32", String
"mingw32", String
"cygwin32"]

isDarwin :: Bool
isDarwin :: Bool
isDarwin = String
os String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"darwin"

-- | Create a temp file with the extensiom ext (in the format ".xxx")
tempfile :: String -> IO (FilePath, Handle)
tempfile :: String -> IO (String, Handle)
tempfile String
ext = do String
dir <- IO String
getTemporaryDirectory
                  String -> String -> IO (String, Handle)
openTempFile (String -> String
normalise String
dir) (String -> IO (String, Handle)) -> String -> IO (String, Handle)
forall a b. (a -> b) -> a -> b
$ String
"idris" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
ext

-- | Read a source file, same as readFile but make sure the encoding is utf-8.
readSource :: FilePath -> IO String
readSource :: String -> IO String
readSource String
f = do Handle
h <- String -> IOMode -> IO Handle
openFile String
f IOMode
ReadMode
                  Handle -> TextEncoding -> IO ()
hSetEncoding Handle
h TextEncoding
utf8
                  Handle -> IO String
hGetContents Handle
h

-- | Read a source file, make sure that the it all has been read before exiting the function.
-- | This is useful when we want to write the file again and need it to be closed.
readSourceStrict :: FilePath -> IO String
readSourceStrict :: String -> IO String
readSourceStrict String
f = String -> IOMode -> (Handle -> IO String) -> IO String
forall r. String -> IOMode -> (Handle -> IO r) -> IO r
withFile String
f IOMode
ReadMode ((Handle -> IO String) -> IO String)
-> (Handle -> IO String) -> IO String
forall a b. (a -> b) -> a -> b
$
                      \Handle
h ->  do
                          Handle -> TextEncoding -> IO ()
hSetEncoding Handle
h TextEncoding
utf8
                          String
src <- Handle -> IO String
hGetContents Handle
h
                          String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
src Int -> IO String -> IO String
forall a b. a -> b -> b
`seq` String -> IO String
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return String
src

-- | Write a source file, same as writeFile except the encoding is set to utf-8
writeSource :: FilePath -> String -> IO ()
writeSource :: String -> String -> IO ()
writeSource String
f String
s = String -> IOMode -> (Handle -> IO ()) -> IO ()
forall r. String -> IOMode -> (Handle -> IO r) -> IO r
withFile String
f IOMode
WriteMode (\Handle
h -> Handle -> TextEncoding -> IO ()
hSetEncoding Handle
h TextEncoding
utf8 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> String -> IO ()
hPutStr Handle
h String
s)

-- | Write a utf-8 source file from Text
writeSourceText :: FilePath -> T.Text -> IO ()
writeSourceText :: String -> Text -> IO ()
writeSourceText String
f Text
s = String -> IOMode -> (Handle -> IO ()) -> IO ()
forall r. String -> IOMode -> (Handle -> IO r) -> IO r
withFile String
f IOMode
WriteMode (\Handle
h -> Handle -> TextEncoding -> IO ()
hSetEncoding Handle
h TextEncoding
utf8 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> Text -> IO ()
TIO.hPutStr Handle
h Text
s)

foreign import ccall "isatty" isATTYRaw :: CInt -> IO CInt

isATTY :: IO Bool
isATTY :: IO Bool
isATTY = do
            CInt
tty    <- CInt -> IO CInt
isATTYRaw CInt
1 -- fd stdout
            Bool
mintty <- IO Bool
isMinTTY
            Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ (CInt
tty CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) Bool -> Bool -> Bool
|| Bool
mintty

-- | Return 'True' if the process's standard output is attached to a MinTTY
-- console (e.g., Cygwin or MSYS) on Windows. Return 'False' otherwise.
--
-- Unfortunately, we must check this separately since 'isATTY' always returns
-- 'False' on MinTTY consoles.
isMinTTY :: IO Bool
#ifdef mingw32_HOST_OS
isMinTTY = do
  h <- getStdHandle sTD_OUTPUT_HANDLE
  isMinTTYHandle h
#else
isMinTTY :: IO Bool
isMinTTY = Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
#endif

withTempdir :: String -> (FilePath -> IO a) -> IO a
withTempdir :: forall a. String -> (String -> IO a) -> IO a
withTempdir String
subdir String -> IO a
callback
  = do String
dir <- IO String
getTemporaryDirectory
       let tmpDir :: String
tmpDir = String -> String
normalise String
dir String -> String -> String
</> String
subdir
       Bool
removeLater <- IO Bool -> (IOError -> IO Bool) -> IO Bool
forall a. IO a -> (IOError -> IO a) -> IO a
catchIO (Bool -> String -> IO ()
createDirectoryIfMissing Bool
True String
tmpDir IO () -> IO Bool -> IO Bool
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True)
                              (\ IOError
ioError -> if IOError -> Bool
isAlreadyExistsError IOError
ioError then Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
                                            else IOError -> IO Bool
forall a e. Exception e => e -> a
throw IOError
ioError
                              )
       a
result <- String -> IO a
callback String
tmpDir
       Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
removeLater (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
removeDirectoryRecursive String
tmpDir
       a -> IO a
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
result

rmFile :: FilePath -> IO ()
rmFile :: String -> IO ()
rmFile String
f = do
  Either IOError ()
result <- IO () -> IO (Either IOError ())
forall e a. Exception e => IO a -> IO (Either e a)
try (String -> IO ()
removeFile String
f)
  case Either IOError ()
result of
    Right ()
_ -> String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Removed: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
f
    Left IOError
err -> IOError -> IO ()
handleExists IOError
err
     where handleExists :: IOError -> IO ()
handleExists IOError
e
            | IOError -> Bool
isDoesNotExistError IOError
e = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
            | Bool
otherwise = String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"WARNING: Cannot remove file "
                          String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
f String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", Error msg:" String -> String -> String
forall a. [a] -> [a] -> [a]
++ IOError -> String
forall a. Show a => a -> String
show IOError
e

setupBundledCC :: IO()
#ifdef FREESTANDING
setupBundledCC = when hasBundledToolchain
                    $ do
                        exePath <- getExecutablePath
                        path <- getEnv "PATH"
                        tcDir <- return getToolchainDir
                        absolute <- return $ isAbsolute tcDir
                        target <- return $
                                    if absolute
                                       then tcDir
                                       else dropFileName exePath ++ tcDir
                        present <- doesDirectoryExist target
                        when present $ do
                          newPath <- return $ intercalate [searchPathSeparator] [target, path]
                          setEnv "PATH" newPath
#else
setupBundledCC :: IO ()
setupBundledCC = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#endif