git.iko.soy/Idris-dev
on cd87fcd help sign in
Idris-dev/src/Util/System.hs
144 lines 5.1 kB history raw
1{-|
2Module : Util.System
3Description : Utilities for interacting with the system.
5License : BSD3
6Maintainer : The Idris Community.
7-}
8{-# LANGUAGE CPP, ForeignFunctionInterface #-}
9module Util.System( tempfile
10 , withTempdir
11 , rmFile
12 , catchIO
13 , isWindows
14 , writeSource
15 , writeSourceText
16 , readSource
17 , readSourceStrict
18 , setupBundledCC
19 , isATTY
20 ) where
22import Control.Exception as CE
23import Control.Monad (when)
24import qualified Data.Text as T
25import qualified Data.Text.IO as TIO
26import Foreign.C
27import System.Directory (createDirectoryIfMissing, getTemporaryDirectory,
28 removeDirectoryRecursive, removeFile)
29import System.FilePath (normalise, (</>))
30import System.Info
31import System.IO
32import System.IO.Error
34#ifdef FREESTANDING
35import Data.List (intercalate)
36import System.Directory (doesDirectoryExist)
37import System.Environment (getEnv, getExecutablePath, setEnv)
38import System.FilePath (dropFileName, isAbsolute, searchPathSeparator)
39import Tools_idris
40#endif
42#ifdef mingw32_HOST_OS
43import Graphics.Win32.Misc (getStdHandle, sTD_OUTPUT_HANDLE)
44import System.Console.MinTTY (isMinTTYHandle)
45#endif
47catchIO :: IO a -> (IOError -> IO a) -> IO a
48catchIO = CE.catch
50isWindows :: Bool
51isWindows = os `elem` ["win32", "mingw32", "cygwin32"]
53-- | Create a temp file with the extensiom ext (in the format ".xxx")
54tempfile :: String -> IO (FilePath, Handle)
55tempfile ext = do dir <- getTemporaryDirectory
56 openTempFile (normalise dir) $ "idris" ++ ext
58-- | Read a source file, same as readFile but make sure the encoding is utf-8.
59readSource :: FilePath -> IO String
60readSource f = do h <- openFile f ReadMode
61 hSetEncoding h utf8
62 hGetContents h
64-- | Read a source file, make sure that the it all has been read before exiting the function.
65-- | This is useful when we want to write the file again and need it to be closed.
66readSourceStrict :: FilePath -> IO String
67readSourceStrict f = withFile f ReadMode $
68 \h -> do
69 hSetEncoding h utf8
70 src <- hGetContents h
71 length src `seq` return src
73-- | Write a source file, same as writeFile except the encoding is set to utf-8
74writeSource :: FilePath -> String -> IO ()
75writeSource f s = withFile f WriteMode (\h -> hSetEncoding h utf8 >> hPutStr h s)
77-- | Write a utf-8 source file from Text
78writeSourceText :: FilePath -> T.Text -> IO ()
79writeSourceText f s = withFile f WriteMode (\h -> hSetEncoding h utf8 >> TIO.hPutStr h s)
81foreign import ccall "isatty" isATTYRaw :: CInt -> IO CInt
83isATTY :: IO Bool
84isATTY = do
85 tty <- isATTYRaw 1 -- fd stdout
86 mintty <- isMinTTY
87 return $ (tty /= 0) || mintty
89-- | Return 'True' if the process's standard output is attached to a MinTTY
90-- console (e.g., Cygwin or MSYS) on Windows. Return 'False' otherwise.
91--
92-- Unfortunately, we must check this separately since 'isATTY' always returns
93-- 'False' on MinTTY consoles.
94isMinTTY :: IO Bool
95#ifdef mingw32_HOST_OS
96isMinTTY = do
97 h <- getStdHandle sTD_OUTPUT_HANDLE
98 isMinTTYHandle h
99#else
100isMinTTY = return False
101#endif
103withTempdir :: String -> (FilePath -> IO a) -> IO a
104withTempdir subdir callback
105 = do dir <- getTemporaryDirectory
106 let tmpDir = normalise dir </> subdir
107 removeLater <- catchIO (createDirectoryIfMissing True tmpDir >> return True)
108 (\ ioError -> if isAlreadyExistsError ioError then return False
109 else throw ioError
110 )
111 result <- callback tmpDir
112 when removeLater $ removeDirectoryRecursive tmpDir
113 return result
115rmFile :: FilePath -> IO ()
116rmFile f = do
117 result <- try (removeFile f)
118 case result of
119 Right _ -> putStrLn $ "Removed: " ++ f
120 Left err -> handleExists err
121 where handleExists e
122 | isDoesNotExistError e = return ()
123 | otherwise = putStrLn $ "WARNING: Cannot remove file "
124 ++ f ++ ", Error msg:" ++ show e
126setupBundledCC :: IO()
127#ifdef FREESTANDING
128setupBundledCC = when hasBundledToolchain
129 $ do
130 exePath <- getExecutablePath
131 path <- getEnv "PATH"
132 tcDir <- return getToolchainDir
133 absolute <- return $ isAbsolute tcDir
134 target <- return $
135 if absolute
136 then tcDir
137 else dropFileName exePath ++ tcDir
138 present <- doesDirectoryExist target
139 when present $ do
140 newPath <- return $ intercalate [searchPathSeparator] [target, path]
141 setEnv "PATH" newPath
142#else
143setupBundledCC = return ()
144#endif