git.iko.soy/Idris-dev
on 0945fbf help sign in
Idris-dev/src/Util/System.hs
119 lines 4.1 kB history raw
1{-|
2Module : Util.System
3Description : Utilities for interacting with the system.
4Copyright :
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 , setupBundledCC
18 , isATTY
19 ) where
21import Control.Exception as CE
22import Control.Monad (when)
23import qualified Data.Text as T
24import qualified Data.Text.IO as TIO
26import Foreign.C
28import System.Directory (getTemporaryDirectory
29 , removeFile
30 , removeDirectoryRecursive
31 , createDirectoryIfMissing
32 )
33import System.FilePath ((</>), normalise)
34import System.IO
35import System.Info
36import System.IO.Error
38#ifdef FREESTANDING
39import Tools_idris
40import System.FilePath (isAbsolute, dropFileName)
41import System.Directory (doesDirectoryExist)
42import System.Environment (getEnv, setEnv, getExecutablePath)
43#endif
45catchIO :: IO a -> (IOError -> IO a) -> IO a
46catchIO = CE.catch
48isWindows :: Bool
49isWindows = os `elem` ["win32", "mingw32", "cygwin32"]
51-- | Create a temp file with the extensiom ext (in the format ".xxx")
52tempfile :: String -> IO (FilePath, Handle)
53tempfile ext = do dir <- getTemporaryDirectory
54 openTempFile (normalise dir) $ "idris" ++ ext
56-- | Read a source file, same as readFile but make sure the encoding is utf-8.
57readSource :: FilePath -> IO String
58readSource f = do h <- openFile f ReadMode
59 hSetEncoding h utf8
60 hGetContents h
62-- | Write a source file, same as writeFile except the encoding is set to utf-8
63writeSource :: FilePath -> String -> IO ()
64writeSource f s = withFile f WriteMode (\h -> hSetEncoding h utf8 >> hPutStr h s)
66-- | Write a utf-8 source file from Text
67writeSourceText :: FilePath -> T.Text -> IO ()
68writeSourceText f s = withFile f WriteMode (\h -> hSetEncoding h utf8 >> TIO.hPutStr h s)
70foreign import ccall "isatty" isATTYRaw :: CInt -> IO CInt
72isATTY :: IO Bool
73isATTY = do
74 tty <- isATTYRaw 1 -- fd stdout
75 return $ tty /= 0
77withTempdir :: String -> (FilePath -> IO a) -> IO a
78withTempdir subdir callback
79 = do dir <- getTemporaryDirectory
80 let tmpDir = normalise dir </> subdir
81 removeLater <- catchIO (createDirectoryIfMissing True tmpDir >> return True)
82 (\ ioError -> if isAlreadyExistsError ioError then return False
83 else throw ioError
84 )
85 result <- callback tmpDir
86 when removeLater $ removeDirectoryRecursive tmpDir
87 return result
89rmFile :: FilePath -> IO ()
90rmFile f = do
91 result <- try (removeFile f)
92 case result of
93 Right _ -> putStrLn $ "Removed: " ++ f
94 Left err -> handleExists err
95 where handleExists e
96 | isDoesNotExistError e = return ()
97 | otherwise = putStrLn $ "WARNING: Cannot remove file "
98 ++ f ++ ", Error msg:" ++ show e
100setupBundledCC :: IO()
101#ifdef FREESTANDING
102setupBundledCC = when hasBundledToolchain
103 $ do
104 exePath <- getExecutablePath
105 path <- getEnv "PATH"
106 tcDir <- return getToolchainDir
107 absolute <- return $ isAbsolute tcDir
108 target <- return $
109 if absolute
110 then tcDir
111 else dropFileName exePath ++ tcDir
112 let pathSep = if isWindows then ";" else ":"
113 present <- doesDirectoryExist target
114 when present
115 $ do newPath <- return $ target ++ pathSep ++ path
116 setEnv "PATH" newPath
117#else
118setupBundledCC = return ()
119#endif