summaryrefslogtreecommitdiff
path: root/Coolbal/Target/Utils.hs
diff options
context:
space:
mode:
Diffstat (limited to 'Coolbal/Target/Utils.hs')
-rw-r--r--Coolbal/Target/Utils.hs72
1 files changed, 72 insertions, 0 deletions
diff --git a/Coolbal/Target/Utils.hs b/Coolbal/Target/Utils.hs
new file mode 100644
index 0000000..432a8a8
--- /dev/null
+++ b/Coolbal/Target/Utils.hs
@@ -0,0 +1,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