git.iko.soy/Idris-dev
on 308efea help sign in
Idris-dev/src/Util/System.hs
87 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
18#if MIN_VERSION_base(4,0,0)
19import Control.Exception as CE
20#endif
22import Paths_idris
24#if MIN_VERSION_base(4,0,0)
25catchIO :: IO a -> (IOError -> IO a) -> IO a
26catchIO = CE.catch
28throwIO :: IOError -> IO a
29throwIO = CE.throw
30#else
31catchIO = catch
32throwIO = throw
33#endif
37getCC :: IO String
38getCC = do env <- environment "IDRIS_CC"
39 case env of
40 Nothing -> return "gcc"
41 Just cc -> return cc
43getMvn :: IO String
44getMvn = do env <- environment "IDRIS_MVN"
45 case env of
46 Nothing -> return "mvn"
47 Just mvn -> return mvn
49tempfile :: IO (FilePath, Handle)
50tempfile = do dir <- getTemporaryDirectory
51 openTempFile (normalise dir) "idris"
53withTempdir :: String -> (FilePath -> IO a) -> IO a
54withTempdir subdir callback
55 = do dir <- getTemporaryDirectory
56 let tmpDir = (normalise dir) </> subdir
57 removeLater <- catchIO (createDirectoryIfMissing True tmpDir >> return True)
58 (\ ioError -> if isAlreadyExistsError ioError then return False
59 else throw ioError
60 )
61 result <- callback tmpDir
62 when removeLater $ removeDirectoryRecursive tmpDir
63 return result
65environment :: String -> IO (Maybe String)
66environment x = catchIO (do e <- getEnv x
67 return (Just e))
68 (\_ -> return Nothing)
70rmFile :: FilePath -> IO ()
71rmFile f = do putStrLn $ "Removing " ++ f
72 catchIO (removeFile f)
73 (\ioerr -> putStrLn $ "WARNING: Cannot remove file "
74 ++ f ++ ", Error msg:" ++ show ioerr)
77getLibFlags = do dir <- getDataDir
78 return $ "-L" ++ (dir </> "rts") ++ " -lidris_rts -lgmp -lpthread"
80getIdrisLibDir = do dir <- getDataDir
81 return $ addTrailingPathSeparator dir
83getIncFlags = do dir <- getDataDir
84 return $ "-I" ++ dir </> "rts"
86getExecutablePom = do dir <- getDataDir
87 return $ dir </> "executable_pom.xml"