blob: 432a8a8c7464bffa32e4f59b8d88d7911e0a79f3 (
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
|
{-# LANGUAGE LambdaCase #-}
module Coolbal.Target.Utils where
import Data.Char (ord)
import Data.List (intercalate)
import Data.Time.Clock (UTCTime)
import Numeric (showHex)
import System.Directory (doesFileExist, getModificationTime)
import System.Exit (ExitCode(..), die, exitWith)
import System.FilePath ((</>))
import System.IO.Error (catchIOError)
import Coolbal.Util
checkExitCode :: ExitCode -> IO ()
checkExitCode ExitSuccess = return ()
checkExitCode c@(ExitFailure _) = exitWith c
escapeFileName :: String -> FilePath
escapeFileName =
-- NTFS/POSIX not allows: 0x00-0x1F 0x7F- : / " * < > ? \ |
-- We use ! as an escape character, and hence disallow that too.
genericEscapeString
(\c -> let n = ord c
in n <= 0x1F || n >= 0x7F || c `elem` ":/\"*<>?\\|!")
(\c -> case (c, ord c) of
('!', _) -> "!!"
(_, n) | n <= 0xFF -> '!' : leftPad 2 '0' (showHex n "")
| n <= 0xFFFF -> '!' : 'u' : leftPad 4 '0' (showHex n "")
| n <= 0xFFFFFF -> '!' : 'U' : leftPad 6 '0' (showHex n "")
| otherwise -> error "Super-high unicode?")
where
leftPad n c s = replicate (max 0 (n - length s)) c ++ s
maybeModificationTime' :: FilePath -> IO UTCTime
maybeModificationTime' path = maybeModificationTime path >>= \case
Just tm -> return tm
Nothing -> die ("File not found: '" ++ path ++ "'")
maybeModificationTime :: FilePath -> IO (Maybe UTCTime)
maybeModificationTime path =
catchIOError (Just <$> getModificationTime path) (\_ -> return Nothing)
findSourceFile' :: [FilePath] -> [String] -> IO FilePath
findSourceFile' ds m = findSourceFile ds m >>= \case
Just fp -> return fp
Nothing -> die ("Module not found in source directories: " ++ intercalate "." m)
findSourceFile :: [FilePath] -> [String] -> IO (Maybe FilePath)
findSourceFile dirs modname = findFile dirs (foldr (</>) "" modname ++ ".hs")
findFile' :: [FilePath] -> FilePath -> IO FilePath
findFile' ds fname = findFile ds fname >>= \case
Just fp -> return fp
Nothing -> die ("File not found in source directories: '" ++ fname ++ "'")
findFile :: [FilePath] -> FilePath -> IO (Maybe FilePath)
findFile [] _ = return Nothing
findFile (dir:ds) fname = do
ok <- doesFileExist (dir </> fname)
if ok then return (Just (dir </> fname))
else findFile ds fname
anyNewerThan :: UTCTime -> [IO FilePath] -> IO Bool
anyNewerThan _ [] = return False
anyNewerThan reftm (fp:fps) = do
fp' <- fp
tm <- maybeModificationTime' fp'
if tm > reftm
then return True
else anyNewerThan reftm fps
|
