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