git.iko.soy/Idris-dev
on bfa39bf help sign in
Idris-dev/src/Util/System.hs
85 lines 2.7 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)
75getLibFlags = do dir <- getDataDir
76 return $ "-L" ++ (dir </> "rts") ++ " -lidris_rts -lgmp -lpthread"
78getIdrisLibDir = do dir <- getDataDir
79 return $ addTrailingPathSeparator dir
81getIncFlags = do dir <- getDataDir
82 return $ "-I" ++ dir </> "rts"
84getExecutablePom = do dir <- getDataDir
85 return $ dir </> "java" </> "executable_pom.xml"