git.iko.soy/Idris-dev
on 031ffb4 help sign in
Idris-dev/src/Util/System.hs
91 lines 2.9 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#ifdef mingw32_HOST_OS
47 Nothing -> return "mvn.bat"
48#else
49 Nothing -> return "mvn"
50#endif
51 Just mvn -> return mvn
53tempfile :: IO (FilePath, Handle)
54tempfile = do dir <- getTemporaryDirectory
55 openTempFile (normalise dir) "idris"
57withTempdir :: String -> (FilePath -> IO a) -> IO a
58withTempdir subdir callback
59 = do dir <- getTemporaryDirectory
60 let tmpDir = (normalise dir) </> subdir
61 removeLater <- catchIO (createDirectoryIfMissing True tmpDir >> return True)
62 (\ ioError -> if isAlreadyExistsError ioError then return False
63 else throw ioError
64 )
65 result <- callback tmpDir
66 when removeLater $ removeDirectoryRecursive tmpDir
67 return result
69environment :: String -> IO (Maybe String)
70environment x = catchIO (do e <- getEnv x
71 return (Just e))
72 (\_ -> return Nothing)
74rmFile :: FilePath -> IO ()
75rmFile f = do putStrLn $ "Removing " ++ f
76 catchIO (removeFile f)
77 (\ioerr -> putStrLn $ "WARNING: Cannot remove file "
78 ++ f ++ ", Error msg:" ++ show ioerr)
81getLibFlags = do dir <- getDataDir
82 return $ "-L" ++ (dir </> "rts") ++ " -lidris_rts -lgmp -lpthread"
84getIdrisLibDir = do dir <- getDataDir
85 return $ addTrailingPathSeparator dir
87getIncFlags = do dir <- getDataDir
88 return $ "-I" ++ dir </> "rts"
90getExecutablePom = do dir <- getDataDir
91 return $ dir </> "executable_pom.xml"