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