git.iko.soy/Idris-dev
on da61891 help sign in
Idris-dev/src/Util/System.hs
105 lines 3.9 kB history raw
1{-# LANGUAGE CPP, ForeignFunctionInterface #-}
2module Util.System(tempfile,withTempdir,rmFile,catchIO, isWindows,
3 writeSource, writeSourceText, readSource,
4 setupBundledCC, isATTY) where
5-- System helper functions.
7import Control.Exception as CE
8import Control.Monad (when)
9import qualified Data.Text as T
10import qualified Data.Text.IO as TIO
12import Foreign.C
14import System.Directory (getTemporaryDirectory
15 , removeFile
16 , removeDirectoryRecursive
17 , createDirectoryIfMissing
18 )
19import System.FilePath ((</>), normalise)
20import System.IO
21import System.Info
22import System.IO.Error
24#ifdef FREESTANDING
25import Tools_idris
26import System.FilePath (isAbsolute, dropFileName)
27import System.Directory (doesDirectoryExist)
28import System.Environment (getEnv, setEnv, getExecutablePath)
29#endif
31catchIO :: IO a -> (IOError -> IO a) -> IO a
32catchIO = CE.catch
34isWindows :: Bool
35isWindows = os `elem` ["win32", "mingw32", "cygwin32"]
37-- | Create a temp file with the extensiom ext (in the format ".xxx")
38tempfile :: String -> IO (FilePath, Handle)
39tempfile ext = do dir <- getTemporaryDirectory
40 openTempFile (normalise dir) $ "idris" ++ ext
42-- | Read a source file, same as readFile but make sure the encoding is utf-8.
43readSource :: FilePath -> IO String
44readSource f = do h <- openFile f ReadMode
45 hSetEncoding h utf8
46 hGetContents h
48-- | Write a source file, same as writeFile except the encoding is set to utf-8
49writeSource :: FilePath -> String -> IO ()
50writeSource f s = withFile f WriteMode (\h -> hSetEncoding h utf8 >> hPutStr h s)
52-- | Write a utf-8 source file from Text
53writeSourceText :: FilePath -> T.Text -> IO ()
54writeSourceText f s = withFile f WriteMode (\h -> hSetEncoding h utf8 >> TIO.hPutStr h s)
56foreign import ccall "isatty" isATTYRaw :: CInt -> IO CInt
58isATTY :: IO Bool
59isATTY = do
60 tty <- isATTYRaw 1 -- fd stdout
61 return $ tty /= 0
63withTempdir :: String -> (FilePath -> IO a) -> IO a
64withTempdir subdir callback
65 = do dir <- getTemporaryDirectory
66 let tmpDir = normalise dir </> subdir
67 removeLater <- catchIO (createDirectoryIfMissing True tmpDir >> return True)
68 (\ ioError -> if isAlreadyExistsError ioError then return False
69 else throw ioError
70 )
71 result <- callback tmpDir
72 when removeLater $ removeDirectoryRecursive tmpDir
73 return result
75rmFile :: FilePath -> IO ()
76rmFile f = do
77 result <- try (removeFile f)
78 case result of
79 Right _ -> putStrLn $ "Removed: " ++ f
80 Left err -> handleExists err
81 where handleExists e
82 | isDoesNotExistError e = return ()
83 | otherwise = putStrLn $ "WARNING: Cannot remove file "
84 ++ f ++ ", Error msg:" ++ show e
86setupBundledCC :: IO()
87#ifdef FREESTANDING
88setupBundledCC = when hasBundledToolchain
89 $ do
90 exePath <- getExecutablePath
91 path <- getEnv "PATH"
92 tcDir <- return getToolchainDir
93 absolute <- return $ isAbsolute tcDir
94 target <- return $
95 if absolute
96 then tcDir
97 else dropFileName exePath ++ tcDir
98 let pathSep = if isWindows then ";" else ":"
99 present <- doesDirectoryExist target
100 when present
101 $ do newPath <- return $ target ++ pathSep ++ path
102 setEnv "PATH" newPath
103#else
104setupBundledCC = return ()
105#endif