1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138

------------------------------------------------------------------------------
--- Library to access parts of the system environment.
---
--- @author Michael Hanus, Bernd Brassel, Bjoern Peemoeller
--- @version July 2012
--- @category general
------------------------------------------------------------------------------

module System
  ( getCPUTime,getElapsedTime
  , getArgs, getEnviron, setEnviron, unsetEnviron, getProgName
  , getHostname, getPID, system, exitWith, sleep
  , isPosix, isWindows
  ) where

import Global ( Global, GlobalSpec(..), global, readGlobal, writeGlobal )

--- Returns the current cpu time of the process in milliseconds.

getCPUTime :: IO Int
getCPUTime external

--- Returns the current elapsed time of the process in milliseconds.
--- This operation is not supported in KiCS2 (there it always returns 0),
--- but only included for compatibility reasons.

getElapsedTime :: IO Int
getElapsedTime external

--- Returns the list of the program's command line arguments.
--- The program name is not included.

getArgs :: IO [String]
getArgs external

--- Returns the value of an environment variable.
--- The empty string is returned for undefined environment variables.

getEnviron :: String -> IO String
getEnviron evar = do
  envs <- readGlobal environ
  maybe (prim_getEnviron $## evar) return (lookup evar envs)

prim_getEnviron :: String -> IO String
prim_getEnviron external

--- internal state of environment variables set via setEnviron
environ :: Global [(String,String)]
environ = global [] Temporary

--- Set an environment variable to a value.
--- The new value will be passed to subsequent shell commands
--- (see <code>system</code>) and visible to subsequent calls to
--- <code>getEnviron</code> (but it is not visible in the environment
--- of the process that started the program execution).

setEnviron :: String -> String -> IO ()
setEnviron evar val = do
  envs <- readGlobal environ
  writeGlobal environ ((evar,val) : filter ((/=evar) . fst) envs)

--- Removes an environment variable that has been set by
--- <code>setEnviron</code>.

unsetEnviron :: String -> IO ()
unsetEnviron evar = do
  envs <- readGlobal environ
  writeGlobal environ (filter ((/=evar) . fst) envs)

--- Returns the hostname of the machine running this process.

getHostname :: IO String
getHostname external

--- Returns the process identifier of the current Curry process.

getPID :: IO Int
getPID external

--- Returns the name of the current program, i.e., the name of the
--- main module currently executed.

getProgName :: IO String
getProgName external

--- Executes a shell command and return with the exit code of the command.
--- An exit status of zero means successful execution.

system :: String -> IO Int
system cmd = do
  envs <- readGlobal environ
  prim_system $## (concatMap envToExport envs ++ escapedCmd)
 where
  win       = isWindows
  -- This is a work around for GHC ticket #5376
  -- (http://hackage.haskell.org/trac/ghc/ticket/5376)
  escapedCmd = if win then '"'  : cmd ++ "\""
                      else cmd
  envToExport (var, val) =
    if win
      then "set " ++ var ++ "=" ++ concatMap escapeWinSpecials val ++ " && "
      else var ++ "='" ++ concatMap encodeShellSpecials val
           ++ "' ; export " ++ var ++ " ; "

  escapeWinSpecials c = if c `elem` "<>|&^" then ['^', c]
                                            else [c]
  encodeShellSpecials c = if c == '\'' then map chr [39,34,39,34,39]
                                       else [c]

prim_system :: String -> IO Int
prim_system external

--- Terminates the execution of the current Curry program
--- and returns the exit code given by the argument.
--- An exit code of zero means successful execution.

exitWith :: Int -> IO _
exitWith exitcode = prim_exitWith $# exitcode

prim_exitWith :: Int -> IO _
prim_exitWith external

--- The evaluation of the action (sleep n) puts the Curry process
--- asleep for n seconds.

sleep :: Int -> IO ()
sleep n = prim_sleep $# n

prim_sleep :: Int -> IO ()
prim_sleep external

--- Is the underlying operating system a POSIX system (unix, MacOS)?
isPosix :: Bool
isPosix = not isWindows

--- Is the underlying operating system a Windows system?
isWindows :: Bool
isWindows external