git.iko.soy/Idris-dev
on 293c8a2 help sign in
Idris-dev/src/Util/System.hs
84 lines 2.8 kB history raw
1{-# LANGUAGE CPP #-}
2module Util.System(tempfile,withTempdir,environment,getCC,
3 getLibFlags,getIdrisLibDir,getIncFlags,rmFile,
4 getMvn,getExecutablePom,catchIO) where
6-- System helper functions.
7import Control.Monad (when)
8import Distribution.Text (display)
9import System.Directory (getTemporaryDirectory
10 , removeFile
11 , removeDirectoryRecursive
12 , createDirectoryIfMissing
13 )
14import System.FilePath ((</>), addTrailingPathSeparator, normalise)
15import System.Environment
16import System.IO
17import System.IO.Error
18import Control.Exception as CE
20import Paths_idris
22catchIO :: IO a -> (IOError -> IO a) -> IO a
23catchIO = CE.catch
25throwIO :: IOError -> IO a
26throwIO = CE.throw
30getCC :: IO String
31getCC = do env <- environment "IDRIS_CC"
32 case env of
33 Nothing -> return "gcc"
34 Just cc -> return cc
36getMvn :: IO String
37getMvn = do env <- environment "IDRIS_MVN"
38 case env of
39#ifdef mingw32_HOST_OS
40 Nothing -> return "mvn.bat"
41#else
42 Nothing -> return "mvn"
43#endif
44 Just mvn -> return mvn
46tempfile :: IO (FilePath, Handle)
47tempfile = do dir <- getTemporaryDirectory
48 openTempFile (normalise dir) "idris"
50withTempdir :: String -> (FilePath -> IO a) -> IO a
51withTempdir subdir callback
52 = do dir <- getTemporaryDirectory
53 let tmpDir = (normalise dir) </> subdir
54 removeLater <- catchIO (createDirectoryIfMissing True tmpDir >> return True)
55 (\ ioError -> if isAlreadyExistsError ioError then return False
56 else throw ioError
57 )
58 result <- callback tmpDir
59 when removeLater $ removeDirectoryRecursive tmpDir
60 return result
62environment :: String -> IO (Maybe String)
63environment x = catchIO (do e <- getEnv x
64 return (Just e))
65 (\_ -> return Nothing)
67rmFile :: FilePath -> IO ()
68rmFile f = do putStrLn $ "Removing " ++ f
69 catchIO (removeFile f)
70 (\ioerr -> putStrLn $ "WARNING: Cannot remove file "
71 ++ f ++ ", Error msg:" ++ show ioerr)
74getLibFlags = do dir <- getDataDir
75 return $ "-L" ++ (dir </> "rts") ++ " -lidris_rts -lgmp -lpthread"
77getIdrisLibDir = do dir <- getDataDir
78 return $ addTrailingPathSeparator dir
80getIncFlags = do dir <- getDataDir
81 return $ "-I" ++ dir </> "rts"
83getExecutablePom = do dir <- getDataDir
84 return $ dir </> "executable_pom.xml"