git.iko.soy/Idris-dev
on 97e39ca help sign in
Idris-dev/src/Util/System.hs
102 lines 3.0 kB history raw
1{-# LANGUAGE CPP #-}
2module Util.System(tempfile,withTempdir,getTargetDir,getCC,
3 getLibFlags,getIdrisLibDir,getIncFlags,rmFile,
4 getMvn,getExecutablePom,catchIO) where
6-- System helper functions.
7import Control.Monad (when)
8import Control.Applicative ((<$>))
9import Data.Maybe (fromMaybe)
10import Distribution.Text (display)
11import System.Directory (getTemporaryDirectory
12 , removeFile
13 , removeDirectoryRecursive
14 , createDirectoryIfMissing
15 )
16import System.FilePath ((</>), addTrailingPathSeparator, normalise)
17import System.Environment
18import System.IO
19import System.IO.Error
20import Control.Exception as CE
22import Paths_idris
24catchIO :: IO a -> (IOError -> IO a) -> IO a
25catchIO = CE.catch
27throwIO :: IOError -> IO a
28throwIO = CE.throw
31getCC :: IO String
32getCC = fromMaybe "gcc" <$> environment "IDRIS_CC"
34mvnCommand :: String
35#ifdef mingw32_HOST_OS
36mvnCommand = "mvn.bat"
37#else
38mvnCommand = "mvn"
39#endif
41getMvn :: IO String
42getMvn = fromMaybe mvnCommand <$> environment "IDRIS_MVN"
44tempfile :: IO (FilePath, Handle)
45tempfile = do dir <- getTemporaryDirectory
46 openTempFile (normalise dir) "idris"
48withTempdir :: String -> (FilePath -> IO a) -> IO a
49withTempdir subdir callback
50 = do dir <- getTemporaryDirectory
51 let tmpDir = (normalise dir) </> subdir
52 removeLater <- catchIO (createDirectoryIfMissing True tmpDir >> return True)
53 (\ ioError -> if isAlreadyExistsError ioError then return False
54 else throw ioError
55 )
56 result <- callback tmpDir
57 when removeLater $ removeDirectoryRecursive tmpDir
58 return result
60environment :: String -> IO (Maybe String)
61environment x = catchIO (do e <- getEnv x
62 return (Just e))
63 (\_ -> return Nothing)
65getTargetDir :: IO String
66getTargetDir = environment "TARGET" >>= maybe getDataDir return
68rmFile :: FilePath -> IO ()
69rmFile f = do putStrLn $ "Removing " ++ f
70 catchIO (removeFile f)
71 (\ioerr -> putStrLn $ "WARNING: Cannot remove file "
72 ++ f ++ ", Error msg:" ++ show ioerr)
74#ifdef FREEBSD
75extraLib = " -L/usr/local/lib"
76#else
77extraLib = ""
78#endif
80#ifdef IDRIS_GMP
81gmpLib = " -lgmp"
82#else
83gmpLib = ""
84#endif
86getLibFlags = do dir <- getDataDir
87 return $ "-L" ++ (dir </> "rts") ++
88 " -lidris_rts" ++ extraLib ++ gmpLib ++ " -lpthread"
90getIdrisLibDir = do dir <- getDataDir
91 return $ addTrailingPathSeparator dir
93#ifdef FREEBSD
94extraInclude = " -I/usr/local/include"
95#else
96extraInclude = ""
97#endif
98getIncFlags = do dir <- getDataDir
99 return $ "-I" ++ dir </> "rts" ++ extraInclude
101getExecutablePom = do dir <- getDataDir
102 return $ dir </> "java" </> "executable_pom.xml"