(wip) Only reload on modifications

reserve.cabal

@@ -37,6 +37,9 @@ executable reserve
     , http-types
     , http-kit >= 0.5
     , bytestring
+    , filepath
+    , directory
+    , time
 
 test-suite spec
   type:
@@ -57,6 +60,9 @@ test-suite spec
     , http-types
     , http-kit
     , bytestring
+    , filepath
+    , directory
+    , time
 
     , hspec >= 1.5
     , QuickCheck

src/Reserve.hs

@@ -18,6 +18,7 @@ import           Util
 import           Options
 import           Interpreter (Interpreter)
 import qualified Interpreter
+import           Data.IORef
 
 data Session = Session Socket Interpreter
 
@@ -32,16 +33,23 @@ withSession :: Options -> (Session -> IO a) -> IO a
 withSession opts = bracket (openSession opts) closeSession
 
 run :: Options -> IO ()
-run opts = withSession opts $ \(Session s interpreter) -> forever $ do
-  (h, _, _) <- accept s
-  Interpreter.reload interpreter
-  Interpreter.start interpreter (optionsAppArgs opts)
-  c <- inputStreamFromHandle h
-  let send :: ByteString -> IO ()
-      send = ignoreResourceVanished . B.hPutStr h
-  readRequest True c >>= httpRequest (optionsPort opts) send
-  Interpreter.stop interpreter
-  ignoreResourceVanished $ hClose h
+run opts = withSession opts $ \(Session s int) -> do
+  Interpreter.start int (optionsAppArgs opts)
+  ref <- getModTime >>= newIORef
+  forever $ do
+    (h, _, _) <- accept s
+    t0 <- readIORef ref
+    t1 <- getModTime
+    when (t0 < t1) $ do
+      Interpreter.stop int
+      Interpreter.reload int
+      Interpreter.start int (optionsAppArgs opts)
+      writeIORef ref t1
+    c <- inputStreamFromHandle h
+    let send :: ByteString -> IO ()
+        send = ignoreResourceVanished . B.hPutStr h
+    readRequest True c >>= httpRequest (optionsPort opts) send
+    ignoreResourceVanished $ hClose h
 
 ignoreResourceVanished :: IO () -> IO ()
 ignoreResourceVanished action = catchJust (guard . (== ResourceVanished) . ioe_type) action return

src/Util.hs

@@ -1,9 +1,15 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 module Util where
 
+import           Control.Applicative
 import           Control.Concurrent
+import           Control.Monad
 import           Control.Exception
 import           System.IO
+import           System.FilePath
+import           System.Directory
+import           Data.Time.Clock
+import           Data.List
 import           Network
 
 connectRetry :: Int -> HostName ->  PortNumber -> (Maybe Handle -> IO a) -> IO a
@@ -17,3 +23,21 @@ connectRetry delay host port action = go 0
     tryConnect = try $ bracket connect hClose (action . Just)
     retry n = threadDelay delay >> go (succ n)
     connect = connectTo host $ PortNumber port
+
+getModTime :: IO UTCTime
+getModTime = maximum <$> (listFiles >>= mapM getModificationTime)
+  where
+    listFiles :: IO [FilePath]
+    listFiles = filter ((||) <$> isSuffixOf ".hs" <*> isSuffixOf ".lhs") <$> go "."
+      where
+        go dir = do
+          (dirs, files) <- getFilesAndDirectories dir
+          (files ++) . concat <$> mapM go (filter (`notElem` exclude) dirs)
+
+        exclude :: [FilePath]
+        exclude = ["./.git"]
+
+    getFilesAndDirectories :: FilePath -> IO ([FilePath], [FilePath])
+    getFilesAndDirectories dir = do
+      c <- map (dir </>) . filter (`notElem` ["..", "."]) <$> getDirectoryContents dir
+      (,) <$> filterM doesDirectoryExist c <*> filterM doesFileExist c