git.iko.soy/Idris-dev
on f9a905e help sign in
Idris-dev/src/Util/System.hs
103 lines 3.8 kB history raw
1{-# LANGUAGE CPP, ForeignFunctionInterface #-}
2module Util.System(tempfile,withTempdir,rmFile,catchIO, isWindows,
3 writeSource, writeSourceText, readSource,
4 setupBundledCC, isATTY) where
6-- System helper functions.
8import Control.Exception as CE
9import Control.Monad (when)
10import qualified Data.Text as T
11import qualified Data.Text.IO as TIO
13import Foreign.C
15import System.Directory (getTemporaryDirectory
16 , removeFile
17 , removeDirectoryRecursive
18 , createDirectoryIfMissing
19 , doesDirectoryExist
20 )
21import System.FilePath ((</>), normalise, isAbsolute, dropFileName)
22import System.IO
23import System.Info
24import System.IO.Error
26#ifdef FREESTANDING
27import Tools_idris
28import System.Environment (getEnv, setEnv, getExecutablePath)
29#endif
31catchIO :: IO a -> (IOError -> IO a) -> IO a
32catchIO = CE.catch
34throwIO :: IOError -> IO a
35throwIO = CE.throw
37isWindows :: Bool
38isWindows = os `elem` ["win32", "mingw32", "cygwin32"]
40-- | Create a temp file with the extensiom ext (in the format ".xxx")
41tempfile :: String -> IO (FilePath, Handle)
42tempfile ext = do dir <- getTemporaryDirectory
43 openTempFile (normalise dir) $ "idris" ++ ext
45-- | Read a source file, same as readFile but make sure the encoding is utf-8.
46readSource :: FilePath -> IO String
47readSource f = do h <- openFile f ReadMode
48 hSetEncoding h utf8
49 hGetContents h
51-- | Write a source file, same as writeFile except the encoding is set to utf-8
52writeSource :: FilePath -> String -> IO ()
53writeSource f s = withFile f WriteMode (\h -> hSetEncoding h utf8 >> hPutStr h s)
55-- | Write a utf-8 source file from Text
56writeSourceText :: FilePath -> T.Text -> IO ()
57writeSourceText f s = withFile f WriteMode (\h -> hSetEncoding h utf8 >> TIO.hPutStr h s)
59foreign import ccall "isatty" isATTYRaw :: CInt -> IO CInt
61isATTY :: IO Bool
62isATTY = do
63 tty <- isATTYRaw 1 -- fd stdout
64 return $ tty /= 0
66withTempdir :: String -> (FilePath -> IO a) -> IO a
67withTempdir subdir callback
68 = do dir <- getTemporaryDirectory
69 let tmpDir = (normalise dir) </> subdir
70 removeLater <- catchIO (createDirectoryIfMissing True tmpDir >> return True)
71 (\ ioError -> if isAlreadyExistsError ioError then return False
72 else throw ioError
73 )
74 result <- callback tmpDir
75 when removeLater $ removeDirectoryRecursive tmpDir
76 return result
78rmFile :: FilePath -> IO ()
79rmFile f = do putStrLn $ "Removing " ++ f
80 catchIO (removeFile f)
81 (\ioerr -> putStrLn $ "WARNING: Cannot remove file "
82 ++ f ++ ", Error msg:" ++ show ioerr)
84setupBundledCC :: IO()
85#ifdef FREESTANDING
86setupBundledCC = when hasBundledToolchain
87 $ do
88 exePath <- getExecutablePath
89 path <- getEnv "PATH"
90 tcDir <- return getToolchainDir
91 absolute <- return $ isAbsolute tcDir
92 target <- return $
93 if absolute
94 then tcDir
95 else dropFileName exePath ++ tcDir
96 let pathSep = if isWindows then ";" else ":"
97 present <- doesDirectoryExist target
98 when present
99 $ do newPath <- return $ target ++ pathSep ++ path
100 setEnv "PATH" newPath
101#else
102setupBundledCC = return ()
103#endif