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