blob: c0dac364488d6014d0ffda57349cfc77eee9214e (
plain)
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
|
----------------------------------------------------------------------
-- |
-- Module : Arch
-- Maintainer : AR
-- Stability : (stable)
-- Portability : (portable)
--
-- > CVS $Date: 2005/05/10 14:55:01 $
-- > CVS $Author: bringert $
-- > CVS $Revision: 1.8 $
--
-- architecture\/compiler dependent definitions for unix\/hbc
-----------------------------------------------------------------------------
module GF.System.Arch (
myStdGen, prCPU, selectLater, modifiedFiles, ModTime, getModTime,getNowTime,
welcomeArch, fetchCommand, laterModTime) where
import System.Time
import System.Random
import System.CPUTime
import Control.Monad (filterM)
import System.Directory
import GF.System.Readline (fetchCommand)
---- import qualified UnicodeF as U --(fudlogueWrite)
-- architecture/compiler dependent definitions for unix/hbc
myStdGen :: Int -> IO StdGen ---
--- myStdGen _ = newStdGen --- gives always the same result
myStdGen int0 = do
t0 <- getClockTime
cal <- toCalendarTime t0
let int = int0 + ctSec cal + fromInteger (div (ctPicosec cal) 10000000)
return $ mkStdGen int
prCPU :: Integer -> IO Integer
prCPU cpu = do
cpu' <- getCPUTime
putStrLn (show ((cpu' - cpu) `div` 1000000000) ++ " msec")
return cpu'
welcomeArch :: String
welcomeArch = "This is the system compiled with ghc."
-- | selects the one with the later modification time of two
selectLater :: FilePath -> FilePath -> IO FilePath
selectLater x y = do
ex <- doesFileExist x
if not ex
then return y --- which may not exist
else do
ey <- doesFileExist y
if not ey
then return x
else do
tx <- getModificationTime x
ty <- getModificationTime y
return $ if tx < ty then y else x
-- | a file is considered modified also if it has not been read yet
--
-- new 23\/2\/2004: the environment ofs has just module names
modifiedFiles :: [(FilePath,ModTime)] -> [FilePath] -> IO [FilePath]
modifiedFiles ofs fs = do
filterM isModified fs
where
isModified file = case lookup (justModName file) ofs of
Just to -> do
t <- getModificationTime file
return $ to < t
_ -> return True
justModName =
reverse . takeWhile (/='/') . tail . dropWhile (/='.') . reverse
type ModTime = ClockTime
laterModTime :: ModTime -> ModTime -> Bool
laterModTime = (>)
getModTime :: FilePath -> IO (Maybe ModTime)
getModTime f = do
b <- doesFileExist f
if b then (getModificationTime f >>= return . Just) else return Nothing
getNowTime :: IO ModTime
getNowTime = getClockTime
|
