Implement better caching for target options

Language/Haskell/GhcMod/CabalHelper.hs

@@ -22,6 +22,7 @@ module Language.Haskell.GhcMod.CabalHelper (
 import Control.Applicative
 import Control.Monad
 import Data.Monoid
+import Data.Version
 import Distribution.Helper
 import qualified Language.Haskell.GhcMod.Types as T
 import Language.Haskell.GhcMod.Types hiding (ghcProgram, ghcPkgProgram,
@@ -52,16 +53,31 @@ helperProgs opts = Programs {
 --
 -- The Component\'s 'gmcHomeModuleGraph' will be empty and has to be resolved by
 -- 'resolveGmComponents'.
-getComponents :: (MonadIO m, GmEnv m) => m [GmComponent ChEntrypoint]
+getComponents :: (MonadIO m, GmEnv m, GmLog m)
-getComponents = withCabal $ do
+              => m [GmComponent GMCRaw ChEntrypoint]
-    Cradle {..} <- cradle
+getComponents = do
-    let distdir = cradleRootDir </> "dist"
+  opt <- options
-    opt <- options
+  Cradle {..} <- cradle
+  let gmVer = GhcMod.version
+      chVer = VERSION_cabal_helper
+      d = (helperProgs opt
+          , cradleRootDir </> "dist"
+          , (gmVer, chVer)
+          )
+  withCabal $ cached cradleRootDir cabalHelperCache d
 
-    runQuery' (helperProgs opt) distdir $ do
+cabalHelperCache :: MonadIO m => Cached m
-      q <- liftM4 join4 ghcOptions ghcSrcOptions entrypoints sourceDirs
+                      (Programs, FilePath, (Version, String))
-      return $ flip map q $ \(cn, (opts, (srcOpts, (ep, srcDirs)))) ->
+                      [GmComponent GMCRaw ChEntrypoint]
-          GmComponent cn opts srcOpts ep ep srcDirs mempty
+cabalHelperCache = Cached {
+    cacheFile = cabalHelperCacheFile,
+    cachedAction = \ _ (progs, root, _) ->
+      runQuery' progs root $ do
+        q <- liftM4 join4 ghcOptions ghcSrcOptions entrypoints sourceDirs
+        let cs = flip map q $ \(cn, (opts, (srcOpts, (ep, srcDirs)))) ->
+                   GmComponent cn opts srcOpts ep ep srcDirs mempty
+        return ([setupConfigPath], cs)
+  }
  where
    join4 a b c = join' a . join' b . join' c
    join' :: Eq a => [(a,b)] -> [(a,c)] -> [(a,(b,c))]

Language/Haskell/GhcMod/Caching.hs

@@ -0,0 +1,83 @@
+module Language.Haskell.GhcMod.Caching where
+
+import Control.Monad.Trans.Maybe
+import Data.Maybe
+import Data.Serialize
+import qualified Data.ByteString as BS
+import System.FilePath
+
+import Language.Haskell.GhcMod.Monad.Types
+import Language.Haskell.GhcMod.Logging
+
+import Utils
+
+data Cached m d a =
+     Cached { cacheFile       :: FilePath,
+              cachedAction    :: TimedCacheFiles -> d -> m ([FilePath], a)
+              -- ^ The cached action, will only run if
+              -- * The cache doesn\'t exist yet
+              -- * The cache exists and 'inputData' changed
+              -- * any files in 'inputFiles' are older than 'cacheFile'.
+            }
+
+data TimedCacheFiles =
+     TimedCacheFiles { tcCacheFile :: Maybe TimedFile,
+                       tcFiles     :: [TimedFile]
+                     }
+
+-- | Cache a MonadIO action with proper invalidation.
+cached :: forall m a d. (MonadIO m, GmLog m, Serialize a, Eq d, Serialize d)
+       => FilePath -- ^ Directory to prepend to 'cacheFile'
+       -> Cached m d a -- ^ Cache descriptor
+       -> d
+       -> m a
+cached dir cd d = do
+    mcc <- readCache
+    tcfile <- liftIO $ timeMaybe (cacheFile cd)
+    let defTcf = TimedCacheFiles tcfile []
+
+    case mcc of
+      Nothing -> writeCache defTcf "cache missing"
+      Just (ifs, d', _) | d /= d' -> do
+          tcf <- timeCacheInput dir (cacheFile cd) ifs
+          writeCache tcf "input data changed"
+      Just (ifs, _, a) -> do
+                    tcf <- timeCacheInput dir (cacheFile cd) ifs
+                    let invifs = invalidatingInputFiles tcf
+                    case invifs of
+                      Nothing -> writeCache tcf "cache missing, existed a sec ago WTF?"
+                      Just [] -> return a
+                      Just _ -> writeCache tcf "input files changed"
+
+ where
+   writeCache tcf cause = do
+     (ifs', a) <- (cachedAction cd) tcf d
+     gmLog GmDebug "" $ (text "regenerating cache") <+>: text (cacheFile cd)
+                                                    <+> parens (text cause)
+     liftIO $ BS.writeFile (dir </> cacheFile cd) $ encode (ifs', d, a)
+     return a
+
+   readCache :: m (Maybe ([FilePath], d, a))
+   readCache = runMaybeT $ do
+       f <- MaybeT $ liftIO $ mightExist $ cacheFile cd
+       MaybeT $ readCache' f
+    where
+       readCache' f = do
+         gmLog GmDebug "" $ (text "reading cache") <+>: text (cacheFile cd)
+         cc <- liftIO $ BS.readFile f
+         return $ either (const Nothing) Just $ decode cc
+
+timeCacheInput :: MonadIO m => FilePath -> FilePath -> [FilePath] -> m TimedCacheFiles
+timeCacheInput dir cfile ifs = liftIO $ do
+    -- TODO: is checking the times this way around race free?
+    ins <- (timeMaybe . (dir </>)) `mapM` ifs
+    mtcfile <- timeMaybe cfile
+    return $ TimedCacheFiles mtcfile (catMaybes ins)
+
+invalidatingInputFiles :: TimedCacheFiles -> Maybe [FilePath]
+invalidatingInputFiles tcf =
+    case tcCacheFile tcf of
+      Nothing -> Nothing
+      Just tcfile -> Just $ map tfPath $
+                     -- get input files older than tcfile
+                     filter (tcfile<) $ tcFiles tcf

Language/Haskell/GhcMod/Monad/Types.hs

@@ -129,7 +129,7 @@ data GmGhcSession = GmGhcSession {
 
 data GhcModState = GhcModState {
       gmGhcSession   :: !(Maybe GmGhcSession)
-    , gmComponents   :: !(Map ChComponentName (GmComponent (Set ModulePath)))
+    , gmComponents   :: !(Map ChComponentName (GmComponent GMCResolved (Set ModulePath)))
     , gmCompilerMode :: !CompilerMode
     }
 

Language/Haskell/GhcMod/PathsAndFiles.hs

@@ -14,27 +14,26 @@
 -- You should have received a copy of the GNU Affero General Public License
 -- along with this program.  If not, see <http://www.gnu.org/licenses/>.
 
-module Language.Haskell.GhcMod.PathsAndFiles where
+module Language.Haskell.GhcMod.PathsAndFiles (
+    module Language.Haskell.GhcMod.PathsAndFiles
+  , module Language.Haskell.GhcMod.Caching
+  ) where
 
 import Config (cProjectVersion)
 import Control.Applicative
 import Control.Monad
-import Control.Monad.Trans.Maybe
 import Data.List
 import Data.Char
 import Data.Maybe
-import Data.Version
 import Data.Traversable (traverse)
-import Distribution.Helper
 import System.Directory
 import System.FilePath
 import System.IO.Unsafe
 
 import Language.Haskell.GhcMod.Types
-import Language.Haskell.GhcMod.Monad.Types
 import Language.Haskell.GhcMod.Error
-import Language.Haskell.GhcMod.Read
 import Language.Haskell.GhcMod.Utils hiding (dropWhileEnd)
+import Language.Haskell.GhcMod.Caching
 import qualified Language.Haskell.GhcMod.Utils as U
 
 -- | Guaranteed to be a path to a directory with no trailing slash.
@@ -43,12 +42,6 @@ type DirPath = FilePath
 -- | Guaranteed to be the name of a file only (no slashes).
 type FileName = String
 
-data Cached d a = Cached {
-      inputFiles :: [FilePath],
-      inputData  :: d,
-      cacheFile  :: FilePath
-    }
-
 newtype UnString = UnString { unString :: String }
 
 instance Show UnString where
@@ -57,43 +50,6 @@ instance Show UnString where
 instance Read UnString where
     readsPrec _ = \str -> [(UnString str, "")]
 
--- |
---
--- >>> any (Just 3 <) [Just 1, Nothing, Just 2]
--- False
---
--- >>> any (Just 0 <) [Just 1, Nothing, Just 2]
--- True
---
--- >>> any (Just 0 <) [Nothing]
--- False
---
--- >>> any (Just 0 <) []
--- False
-cached :: forall a d. (Read a, Show a, Eq d, Read d, Show d)
-       => DirPath -> Cached d a -> IO a -> IO a
-cached dir Cached {..} ma = do
-    ins <- (maybeTimeFile . (dir </>)) `mapM` inputFiles
-    c <- maybeTimeFile (dir </> cacheFile)
-    if any (c<) ins || isNothing c
-       then writeCache
-       else maybe ma return =<< readCache
- where
-   maybeTimeFile :: FilePath -> IO (Maybe TimedFile)
-   maybeTimeFile f = traverse timeFile =<< mightExist f
-
-   writeCache = do
-     a <- ma
-     writeFile (dir </> cacheFile) $ unlines [show inputData, show a]
-     return a
-
-   readCache :: IO (Maybe a)
-   readCache = runMaybeT $ do
-     hdr:c:_ <- lines <$> liftIO (readFile $ dir </> cacheFile)
-     if inputData /= read hdr
-       then liftIO $ writeCache
-       else MaybeT $ return $ readMaybe c
-
 -- | @findCabalFiles dir@. Searches for a @.cabal@ files in @dir@'s parent
 -- directories. The first parent directory containing more than one cabal file
 -- is assumed to be the project directory. If only one cabal file exists in this
@@ -235,13 +191,6 @@ cabalBuildPlatform = dropWhileEnd isSpace $ unsafePerformIO $
 packageCache :: String
 packageCache = "package.cache"
 
-cabalHelperCache :: Version -> [String]
-                 -> Cached (Version, [String]) [GmComponent ChEntrypoint]
-cabalHelperCache cabalHelperVer cmds = Cached {
-    inputFiles = [setupConfigPath],
-    inputData  = (cabalHelperVer, cmds),
-    cacheFile  = setupConfigPath <.> "ghc-mod.cabal-helper"
-  }
 
 -- | Filename of the symbol table cache file.
 symbolCache :: Cradle -> FilePath
@@ -249,3 +198,9 @@ symbolCache crdl = cradleTempDir crdl </> symbolCacheFile
 
 symbolCacheFile :: String
 symbolCacheFile = "ghc-mod.symbol-cache"
+
+resolvedComponentsCacheFile :: String
+resolvedComponentsCacheFile = setupConfigPath <.> "ghc-mod.resolved-components"
+
+cabalHelperCacheFile :: String
+cabalHelperCacheFile = setupConfigPath <.> "ghc-mod.cabal-helper"

Language/Haskell/GhcMod/Target.hs

@@ -32,6 +32,7 @@ import Language.Haskell.GhcMod.DynFlags
 import Language.Haskell.GhcMod.Monad.Types
 import Language.Haskell.GhcMod.CabalHelper
 import Language.Haskell.GhcMod.HomeModuleGraph
+import Language.Haskell.GhcMod.PathsAndFiles
 import Language.Haskell.GhcMod.GhcPkg
 import Language.Haskell.GhcMod.Error
 import Language.Haskell.GhcMod.Logging
@@ -154,7 +155,7 @@ runGmlTWith efnmns' mdf wrapper action = do
       loadTargets (map moduleNameString mns ++ rfns)
       action
 
-targetGhcOptions :: IOish m
+targetGhcOptions :: forall m. IOish m
                   => Cradle
                   -> Set (Either FilePath ModuleName)
                   -> GhcModT m [GHCOption]
@@ -162,12 +163,15 @@ targetGhcOptions crdl sefnmn = do
     when (Set.null sefnmn) $ error "targetGhcOptions: no targets given"
 
     case cradleCabalFile crdl of
-      Just _ -> cabalOpts
+      Just _ -> cabalOpts crdl
       Nothing -> sandboxOpts crdl
  where
    zipMap f l = l `zip` (f `map` l)
-   cabalOpts = do
+
-       mcs <- resolveGmComponents Nothing =<< getComponents
+   cabalOpts :: Cradle -> GhcModT m [String]
+   cabalOpts Cradle{..} = do
+       comps <- mapM (resolveEntrypoint crdl) =<< getComponents
+       mcs <- cached cradleRootDir resolvedComponentsCache comps
 
        let mdlcs = moduleComponents mcs `zipMap` Set.toList sefnmn
            candidates = Set.unions $ map snd mdlcs
@@ -186,7 +190,36 @@ targetGhcOptions crdl sefnmn = do
             let cn = pickComponent candidates
             return $ gmcGhcOpts $ fromJust $ Map.lookup cn mcs
 
-moduleComponents :: Map ChComponentName (GmComponent (Set ModulePath))
+resolvedComponentsCache :: IOish m => Cached (GhcModT m)
+    [GmComponent GMCRaw(Set.Set ModulePath)]
+    (Map.Map ChComponentName (GmComponent GMCResolved (Set.Set ModulePath)))
+resolvedComponentsCache = Cached {
+    cacheFile  = resolvedComponentsCacheFile,
+    cachedAction = \tcfs comps -> do
+        Cradle {..} <- cradle
+        let changedFiles =
+                filter (/= cradleRootDir </> setupConfigPath) $ map tfPath $ tcFiles tcfs
+            mums = if null changedFiles
+                     then Nothing
+                     else Just $ map Left changedFiles
+
+        mcs <- resolveGmComponents mums comps
+        return (setupConfigPath:flatten mcs , mcs)
+ }
+
+ where
+   flatten :: Map.Map ChComponentName (GmComponent t (Set.Set ModulePath))
+           -> [FilePath]
+   flatten = Map.elems
+      >>> map (gmcHomeModuleGraph >>> gmgGraph
+               >>> Map.elems
+               >>> map (Set.map mpPath)
+               >>> Set.unions
+              )
+      >>> Set.unions
+      >>> Set.toList
+
+moduleComponents :: Map ChComponentName (GmComponent t (Set ModulePath))
                  -> Either FilePath ModuleName
                  -> Set ChComponentName
 moduleComponents m efnmn =
@@ -216,52 +249,57 @@ packageGhcOptions = do
       Nothing -> sandboxOpts crdl
 
 sandboxOpts :: Monad m => Cradle -> m [String]
-sandboxOpts crdl = return $ ["-i" ++ d | d <- [wdir,rdir]] ++ pkgOpts
+sandboxOpts crdl =
+    return $ ["-i" ++ d | d <- [wdir,rdir]] ++ pkgOpts ++ ["-Wall"]
   where
     pkgOpts = ghcDbStackOpts $ cradlePkgDbStack crdl
     (wdir, rdir) = (cradleCurrentDir crdl, cradleRootDir crdl)
 
 resolveGmComponent :: (IOish m, GmLog m, GmEnv m)
     => Maybe [Either FilePath ModuleName] -- ^ Updated modules
-    -> GmComponent ChEntrypoint
+    -> GmComponent GMCRaw (Set ModulePath)
-    -> m (GmComponent (Set ModulePath))
+    -> m (GmComponent GMCResolved (Set ModulePath))
-resolveGmComponent mums c@GmComponent {..} =
+resolveGmComponent mums c@GmComponent {..} = do
   withLightHscEnv gmcGhcSrcOpts $ \env -> do
-    let srcDirs = gmcSourceDirs
+    let srcDirs = if null gmcSourceDirs then [""] else gmcSourceDirs
-        mg = gmcHomeModuleGraph
+    let mg = gmcHomeModuleGraph
-
+    let simp = gmcEntrypoints
-    Cradle { cradleRootDir } <- cradle
+    sump <- case mums of
-
-    eps <- liftIO $ resolveChEntrypoints cradleRootDir gmcEntrypoints
-    simp <- liftIO $ resolveEntrypoints env srcDirs eps
-    sump <- liftIO $ case mums of
         Nothing -> return simp
-        Just ums -> resolveEntrypoints env srcDirs ums
+        Just ums -> Set.fromList . catMaybes <$> mapM (resolveModule env srcDirs) ums
 
     mg' <- updateHomeModuleGraph env mg simp sump
 
     return $ c { gmcEntrypoints = simp, gmcHomeModuleGraph = mg' }
 
-resolveEntrypoints :: MonadIO m
+resolveEntrypoint :: IOish m
-    => HscEnv -> [FilePath] -> [Either FilePath ModuleName] -> m (Set ModulePath)
+    => Cradle
-resolveEntrypoints env srcDirs ms =
+    -> GmComponent GMCRaw ChEntrypoint
-    liftIO $ Set.fromList . catMaybes <$> resolve `mapM` ms
+    -> m (GmComponent GMCRaw (Set ModulePath))
+resolveEntrypoint Cradle {..} c@GmComponent {..} =
+    withLightHscEnv gmcGhcSrcOpts $ \env -> do
+      let srcDirs = if null gmcSourceDirs then [""] else gmcSourceDirs
+      eps <- liftIO $ resolveChEntrypoints cradleRootDir gmcEntrypoints
+      rms <- resolveModule env srcDirs `mapM` eps
+      return c { gmcEntrypoints = Set.fromList $ catMaybes rms }
+
+resolveModule :: MonadIO m =>
+    HscEnv -> [FilePath] -> Either FilePath ModuleName -> m (Maybe ModulePath)
+resolveModule env _srcDirs (Right mn) = liftIO $ findModulePath env mn
+resolveModule env srcDirs (Left fn') = liftIO $ do
+    mfn <- findFile' srcDirs fn'
+    case mfn of
+      Nothing -> return Nothing
+      Just fn'' -> do
+          let fn = normalise fn''
+          emn <- fileModuleName env fn
+          return $ case emn of
+              Left _ -> Nothing
+              Right mmn -> Just $
+                  case mmn of
+                    Nothing -> mkMainModulePath fn
+                    Just mn -> ModulePath mn fn
  where
-   resolve :: Either FilePath ModuleName -> IO (Maybe ModulePath)
-   resolve (Right mn) = findModulePath env mn
-   resolve (Left fn') = do
-       mfn <- findFile' srcDirs fn'
-       case mfn of
-         Nothing -> return Nothing
-         Just fn'' -> do
-             let fn = normalise fn''
-             emn <- fileModuleName env fn
-             return $ case emn of
-                 Left _ -> Nothing
-                 Right mmn -> Just $
-                     case mmn of
-                       Nothing -> mkMainModulePath fn
-                       Just mn -> ModulePath mn fn
    findFile' dirs file =
        mconcat <$> mapM (mightExist . (</>file)) dirs
 
@@ -284,11 +322,11 @@ resolveChEntrypoints srcDir ChSetupEntrypoint = do
 chModToMod :: ChModuleName -> ModuleName
 chModToMod (ChModuleName mn) = mkModuleName mn
 
-resolveGmComponents :: (IOish m, GmState m, GmLog m, GmEnv m)
+resolveGmComponents :: (IOish m, GmState m, GmLog m, GmEnv m) =>
-                    => Maybe [Either FilePath ModuleName]
+    Maybe [Either FilePath ModuleName]
-                        -- ^ Updated modules
+        -- ^ Updated modules
-                    -> [GmComponent ChEntrypoint]
+    -> [GmComponent GMCRaw (Set ModulePath)]
-                    -> m (Map ChComponentName (GmComponent (Set ModulePath)))
+    -> m (Map ChComponentName (GmComponent GMCResolved (Set ModulePath)))
 resolveGmComponents mumns cs = do
     s <- gmsGet
     m' <- foldrM' (gmComponents s) cs $ \c m -> do
@@ -307,11 +345,10 @@ resolveGmComponents mumns cs = do
      return $ Map.insert (gmcName rc) rc m
 
    same :: Eq b
-        => (forall a. GmComponent a -> b)
+        => (forall t a. GmComponent t a -> b)
-        -> GmComponent c -> GmComponent d -> Bool
+        -> GmComponent u c -> GmComponent v d -> Bool
    same f a b = (f a) == (f b)
 
-
 -- | Set the files as targets and load them.
 loadTargets :: IOish m => [String] -> GmlT m ()
 loadTargets filesOrModules = do

Language/Haskell/GhcMod/Types.hs

@@ -1,4 +1,5 @@
-{-# LANGUAGE DeriveDataTypeable, GADTs, StandaloneDeriving, DataKinds #-}
+{-# LANGUAGE DeriveDataTypeable, DeriveFunctor, DeriveGeneric, StandaloneDeriving,
+             DefaultSignatures #-}
 {-# OPTIONS_GHC -fno-warn-orphans -fno-warn-deprecations #-}
 module Language.Haskell.GhcMod.Types (
     module Language.Haskell.GhcMod.Types
@@ -10,18 +11,24 @@ module Language.Haskell.GhcMod.Types (
 import Control.Monad.Trans.Control (MonadBaseControl)
 import Control.Monad.Error (Error(..))
 import Control.Exception (Exception)
+import Control.Applicative
+import Control.Arrow
+import Data.Serialize
+import Data.Version
 import Data.List (intercalate)
 import Data.Map (Map)
 import qualified Data.Map as Map
 import Data.Set (Set)
 import qualified Data.Set as Set
 import Data.Monoid
+import Data.Maybe
 import Data.Typeable (Typeable)
 import Distribution.Helper
 import Exception (ExceptionMonad)
 import MonadUtils (MonadIO)
 import GHC (ModuleName, moduleNameString, mkModuleName)
 import PackageConfig (PackageConfig)
+import GHC.Generics
 
 -- | A constraint alias (-XConstraintKinds) to make functions dealing with
 -- 'GhcModT' somewhat cleaner.
@@ -158,14 +165,42 @@ data GmModuleGraph = GmModuleGraph {
       gmgFileMap    :: Map FilePath ModulePath,
       gmgModuleMap  :: Map ModuleName ModulePath,
       gmgGraph      :: Map ModulePath (Set ModulePath)
-    } deriving (Eq, Ord, Show, Read, Typeable)
+    } deriving (Eq, Ord, Show, Read, Generic, Typeable)
+
+instance Serialize GmModuleGraph where
+    put GmModuleGraph {..} = let
+        mpim :: Map ModulePath Integer
+        graph :: Map Integer (Set Integer)
+
+        mpim = Map.fromList $
+                (Map.keys gmgGraph) `zip` [0..]
+        mpToInt :: ModulePath -> Integer
+        mpToInt mp = fromJust $ Map.lookup mp mpim
+
+        graph = Map.map (Set.map mpToInt) $ Map.mapKeys mpToInt gmgGraph
+        in put (mpim, graph)
+
+    get = do
+     (mpim :: Map ModulePath Integer, graph :: Map Integer (Set Integer)) <- get
+     let
+         swapMap = Map.fromList . map swap . Map.toList
+         swap (a,b) = (b,a)
+         impm = swapMap mpim
+         intToMp i = fromJust $ Map.lookup i impm
+         mpGraph :: Map ModulePath (Set ModulePath)
+         mpGraph = Map.map (Set.map intToMp) $ Map.mapKeys intToMp graph
+         mpFm = Map.fromList $ map (mpPath &&& id) $ Map.keys mpim
+         mpMn = Map.fromList $ map (mpModule &&& id) $ Map.keys mpim
+     return $ GmModuleGraph mpFm mpMn mpGraph
 
 instance Monoid GmModuleGraph where
     mempty  = GmModuleGraph mempty mempty mempty
     mappend (GmModuleGraph a b c) (GmModuleGraph a' b' c') =
         GmModuleGraph (a <> a') (b <> b') (Map.unionWith Set.union c c')
 
-data GmComponent eps = GmComponent {
+data GmComponentType = GMCRaw
+                     | GMCResolved
+data GmComponent (t :: GmComponentType) eps = GmComponent {
       gmcName            :: ChComponentName,
       gmcGhcOpts         :: [GHCOption],
       gmcGhcSrcOpts      :: [GHCOption],
@@ -173,10 +208,17 @@ data GmComponent eps = GmComponent {
       gmcEntrypoints     :: eps,
       gmcSourceDirs      :: [FilePath],
       gmcHomeModuleGraph :: GmModuleGraph
-    } deriving (Eq, Ord, Show, Read, Typeable)
+    } deriving (Eq, Ord, Show, Read, Generic, Typeable, Functor)
+
+instance Serialize eps => Serialize (GmComponent t eps)
 
 data ModulePath = ModulePath { mpModule :: ModuleName, mpPath :: FilePath }
-    deriving (Eq, Ord, Show, Read, Typeable)
+    deriving (Eq, Ord, Show, Read, Generic, Typeable)
+instance Serialize ModulePath
+
+instance Serialize ModuleName where
+    get = mkModuleName <$> get
+    put mn = put (moduleNameString mn)
 
 instance Show ModuleName where
     show mn = "ModuleName " ++ show (moduleNameString mn)
@@ -235,3 +277,12 @@ data GMConfigStateFileError
     | GMConfigStateFileMissing
 --    | GMConfigStateFileBadVersion PackageIdentifier PackageIdentifier (Either ConfigStateFileError LocalBuildInfo)
   deriving (Eq, Show, Read, Typeable)
+
+
+deriving instance Generic Version
+instance Serialize Version
+
+instance Serialize Programs
+instance Serialize ChModuleName
+instance Serialize ChComponentName
+instance Serialize ChEntrypoint

Utils.hs

@@ -1,7 +1,6 @@
 {-# LANGUAGE CPP #-}
 module Utils where
 
-import Control.Monad
 import Control.Applicative
 import Data.Traversable
 import System.Directory
@@ -18,7 +17,8 @@ type ModTime = UTCTime
 type ModTime = ClockTime
 #endif
 
-data TimedFile = TimedFile FilePath ModTime deriving (Eq, Show)
+data TimedFile = TimedFile { tfPath :: FilePath, tfTime :: ModTime }
+                 deriving (Eq, Show)
 
 instance Ord TimedFile where
     compare (TimedFile _ a) (TimedFile _ b) = compare a b
@@ -32,5 +32,4 @@ mightExist f = do
   return $ if exists then (Just f) else (Nothing)
 
 timeMaybe :: FilePath -> IO (Maybe TimedFile)
-timeMaybe f = do
+timeMaybe f = traverse timeFile =<< mightExist f
-  join $ (timeFile `traverse`) <$> mightExist f