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