{-# 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"
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
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
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
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)
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
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
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