Second

1 files changed, 80 insertions, 14 deletions

diff --git a/Coolbal/Target.hs b/Coolbal/Target.hs
index c698ceb..761f19d 100644
--- a/Coolbal/Target.hs
+++ b/Coolbal/Target.hs
@@ -1,6 +1,6 @@
-{-# LANGUAGE ExistentialQuantification #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE RankNTypes #-}
-{-# LANGUAGE StandaloneDeriving #-}
 module Coolbal.Target (
     IsTarget(..),
     AnyTarget(..),
@@ -8,12 +8,16 @@ module Coolbal.Target (
     useAnyTarget,
 ) where
 
+import Data.Binary (Binary)
 import Data.Char (ord)
 import Data.List (intercalate)
+import Data.Time.Clock (UTCTime)
+import GHC.Generics (Generic)
 import Numeric (showHex)
-import System.Directory (createDirectoryIfMissing)
-import System.Exit (ExitCode(..), die)
+import System.Directory (createDirectoryIfMissing, doesFileExist, getModificationTime)
+import System.Exit (ExitCode(..), die, exitWith)
 import System.FilePath ((</>))
+import System.IO.Error (catchIOError)
 import System.Process (rawSystem)
 
 import Coolbal.Util
@@ -40,12 +44,18 @@ class IsTarget a where
     -- | Recompile the target. Argument is the root directory of the project.
     targetBuild :: FilePath -> a -> IO ()
 
-data AnyTarget = forall a. (Show a, IsTarget a) => AnyTarget a
+    -- | If the target is an executable target, return an IO action that runs
+    -- the executable with the specified arguments. The 'FilePath' is the root
+    -- directory of the project.
+    targetExecute :: a -> Maybe (FilePath -> [String] -> IO ())
 
-deriving instance Show AnyTarget
+data AnyTarget = AnyTargetExe ExeTarget
+  deriving (Show, Generic)
 
-useAnyTarget :: (forall a. (Show a, IsTarget a) => a -> r) -> AnyTarget -> r
-useAnyTarget f (AnyTarget x) = f x
+instance Binary AnyTarget
+
+useAnyTarget :: (forall a. (Show a, Binary a, IsTarget a) => a -> r) -> AnyTarget -> r
+useAnyTarget f (AnyTargetExe x) = f x
 
 data ExeTarget = ExeTarget
     { exeTargetName :: String
@@ -58,18 +68,29 @@ data ExeTarget = ExeTarget
       -- ^ Haskell language (e.g. Haskell2010)
     , exeTargetMain :: FilePath
       -- ^ Main file
+    , exeTargetSrcDirs :: [FilePath]
+      -- ^ Source directories
     , exeTargetModules :: [[String]]
       -- ^ Other modules in the target
     , exeTargetFlags :: [String]
       -- ^ User-specified compiler flags
     }
-  deriving (Show)
+  deriving (Show, Generic)
+
+instance Binary ExeTarget
 
 instance IsTarget ExeTarget where
     targetName = exeTargetName
     targetNameQualified e = "exe:" ++ targetName e
 
-    targetCheckOld _ _ = return True
+    targetCheckOld projdir tg = do
+        mbinTm <- maybeModificationTime (projdir </> "dist-coolbal/bin" </> escapeFileName (exeTargetName tg))
+        case mbinTm of
+          Just binTm -> do
+              anyNewerThan binTm (findFile' (exeTargetSrcDirs tg) (exeTargetMain tg)
+                                 : [findSourceFile' (exeTargetSrcDirs tg) m | m <- exeTargetModules tg])
+          Nothing ->
+              return True
 
     targetBuild projdir tg = do
         let buildDir = projdir </> "dist-coolbal/build"
@@ -81,7 +102,7 @@ instance IsTarget ExeTarget where
             [["--make", "-static"]
             ,concat [[flag, buildDir]
                     | flag <- ["-outputdir", "-odir", "-hidir", "-stubdir"]]
-            ,["-i" ++ buildDir, "-I" ++ buildDir]
+            ,["-i" ++ dir | dir <- exeTargetSrcDirs tg]
             ,["-hide-all-packages", "-Wmissing-home-modules", "-no-user-package-db"]
             ,["-package-db", exeTargetPkgDbDir tg]
             ,concat [["-package-id", dep] | dep <- exeTargetDeps tg]
@@ -92,6 +113,11 @@ instance IsTarget ExeTarget where
             ,exeTargetFlags tg])
           >>= checkExitCode "ghc"
 
+    targetExecute tg = Just $ \projdir args -> do
+        let filename = escapeFileName (exeTargetName tg)
+        rawSystem (projdir </> "dist-coolbal/bin" </> filename) args
+          >>= exitWith
+
 checkExitCode :: String -> ExitCode -> IO ()
 checkExitCode _ ExitSuccess = return ()
 checkExitCode procname (ExitFailure c) =
@@ -106,7 +132,47 @@ escapeFileName =
                in n <= 0x1F || n >= 0x7F || c `elem` ":/\"*<>?\\|!")
         (\c -> case (c, ord c) of
             ('!', _) -> "!!"
-            (_, n) | n <= 0xFF -> '!' : showHex n ""
-                   | n <= 0xFFFF -> '!' : 'u' : showHex n ""
-                   | n <= 0xFFFFFF -> '!' : 'U' : showHex n ""
+            (_, 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