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