git.iko.soy/Idris-dev
on 89c19be help sign in
Idris-dev/src/Util/System.hs
84 lines 3.2 kB history raw
1{-# LANGUAGE CPP #-}
2module Util.System(tempfile,withTempdir,rmFile,catchIO, isWindows,
3 writeSource, readSource, setupBundledCC) where
5-- System helper functions.
6import Control.Monad (when)
7import System.Directory (getTemporaryDirectory
8 , removeFile
9 , removeDirectoryRecursive
10 , createDirectoryIfMissing
11 , doesDirectoryExist
12 )
13import System.FilePath ((</>), normalise, isAbsolute, dropFileName)
14import System.IO
15import System.Info
16import System.IO.Error
17import Control.Exception as CE
19#ifdef FREESTANDING
20import Tools_idris
21import System.Environment (getEnv, setEnv, getExecutablePath)
22#endif
24catchIO :: IO a -> (IOError -> IO a) -> IO a
25catchIO = CE.catch
27throwIO :: IOError -> IO a
28throwIO = CE.throw
30isWindows :: Bool
31isWindows = os `elem` ["win32", "mingw32", "cygwin32"]
33tempfile :: IO (FilePath, Handle)
34tempfile = do dir <- getTemporaryDirectory
35 openTempFile (normalise dir) "idris"
37-- | Read a source file, same as readFile but make sure the encoding is utf-8.
38readSource :: FilePath -> IO String
39readSource f = do h <- openFile f ReadMode
40 hSetEncoding h utf8
41 hGetContents h
43-- | Write a source file, same as writeFile except the encoding is set to utf-8
44writeSource :: FilePath -> String -> IO ()
45writeSource f s = withFile f WriteMode (\h -> hSetEncoding h utf8 >> hPutStr h s)
47withTempdir :: String -> (FilePath -> IO a) -> IO a
48withTempdir subdir callback
49 = do dir <- getTemporaryDirectory
50 let tmpDir = (normalise dir) </> subdir
51 removeLater <- catchIO (createDirectoryIfMissing True tmpDir >> return True)
52 (\ ioError -> if isAlreadyExistsError ioError then return False
53 else throw ioError
54 )
55 result <- callback tmpDir
56 when removeLater $ removeDirectoryRecursive tmpDir
57 return result
59rmFile :: FilePath -> IO ()
60rmFile f = do putStrLn $ "Removing " ++ f
61 catchIO (removeFile f)
62 (\ioerr -> putStrLn $ "WARNING: Cannot remove file "
63 ++ f ++ ", Error msg:" ++ show ioerr)
65setupBundledCC :: IO()
66#ifdef FREESTANDING
67setupBundledCC = when hasBundledToolchain
68 $ do
69 exePath <- getExecutablePath
70 path <- getEnv "PATH"
71 tcDir <- return getToolchainDir
72 absolute <- return $ isAbsolute tcDir
73 target <- return $
74 if absolute
75 then tcDir
76 else dropFileName exePath ++ tcDir
77 let pathSep = if isWindows then ";" else ":"
78 present <- doesDirectoryExist target
79 when present
80 $ do newPath <- return $ target ++ pathSep ++ path
81 setEnv "PATH" newPath
82#else
83setupBundledCC = return ()
84#endif