delta 0.2.0.0 → 0.2.1.0

raw patch · 6 files changed

+146/−8 lines, 6 filesdep +optparse-applicativedep +processnew-component:exe:delta-runPVP ok

version bump matches the API change (PVP)

Dependencies added: optparse-applicative, process

API changes (from Hackage documentation)

Files

• delta.cabal +24/−5
• src/System/Delta.hs +1/−1
• src/System/Delta/Callback.hs +3/−0
• src/System/Delta/FRPUtils.hs +21/−0
• src/System/Delta/Poll.hs +4/−2
• src/delta-run/Main.hs +93/−0

@@ -10,7 +10,7 @@ -- PVP summary:      +-+------- breaking API changes --                   | | +----- non-breaking API additions --                   | | | +--- code changes with no API change-version:             0.2.0.0+version:             0.2.1.0  -- A short (one-line) description of the package. synopsis:            A library for detecting file changes@@ -67,16 +67,17 @@                      , System.Delta.Poll                      , System.Delta.Callback                      , System.Delta.Class+                     , System.Delta.FRPUtils                      , System.Delta -  if os(darwin)+  if (os(darwin) && flag(build_fs_events))     exposed-modules: System.Delta.FSEvents    -- Modules included in this library but not exported.-  -- other-modules:       +  -- other-modules:      -- LANGUAGE extensions used by modules in this package.-  -- other-extensions:    +  -- other-extensions:      -- Other library packages from which modules are imported.   build-depends:       base >=4.6 && <4.9@@ -85,7 +86,8 @@                      , filepath >= 1.3                      , time >= 1.5                      , sodium >= 0.11-  if os(darwin)++  if (os(darwin) && flag(build_fs_events))     build-depends:     hfsevents >= 0.1.5    -- Directories containing source files.@@ -104,3 +106,20 @@   main-is:             Main.hs    default-language:    Haskell2010++executable delta-run++  build-depends:       base >= 4.6 && < 4.9+                     , delta+                     , optparse-applicative >= 0.10+                     , directory >= 1.2+                     , process >= 1.2+                     , sodium >= 0.11++  hs-source-dirs:      src/delta-run++  main-is:             Main.hs++  default-language:    Haskell2010++  ghc-options:       -threaded -rtsopts -with-rtsopts=-N

@@ -74,7 +74,7 @@ #if defined(__APPLE__)   createFSEventsWatcher path #else-  createPollWatcher 10 path+  createPollWatcher 5 path #endif  -- | Build a file watcher that allows to register callbacks

@@ -16,6 +16,9 @@                               -- * Closing the watcher                              , closeCallbackWatcher++                             -- * Helper functions+                             , callbackOnEvent                              )where  import FRP.Sodium

@@ -0,0 +1,21 @@+module System.Delta.FRPUtils where++import Control.Concurrent+import Control.Monad++import FRP.Sodium++data Ticker a = Ticker{ tickerInterval  :: Int+                      , tickerEvent     :: Event a+                      , tickerTerminate :: IO ()+                      }++periodical :: Int -- ^ Milliseconds+           -> a   -- ^ Item that is sent periodically+           -> IO (Ticker a)+periodical ms v = do+  (e,push) <- sync $ newEvent+  tId <- forkIO . forever $ do+    threadDelay $ 1000 * ms+    sync $ push v    +  return $ Ticker ms e (killThread tId)

@@ -33,7 +33,9 @@  -- | Recursively traverse a folder, follow symbolic links but don't -- visit a file twice.-recursiveDescent path = recursiveDescent' M.empty path+recursiveDescent path =+  M.filterWithKey (\_ -> not . fileInfoIsDir) <$> -- files only+    recursiveDescent' M.empty path  -- | Recursively traverse a folder, follows symbolic links, -- doesn't loop however.@@ -95,6 +97,6 @@       threadDelay $ secs * 1000 * 1000       curr <- recursiveDescent path       sync $ mapM_ (pushChanged) (fileInfoPath <$> diffChangedFiles last curr)-      sync $ mapM_ (pushNew    ) (fileInfoPath <$> diffNewFiles last curr)+      sync $ mapM_ (pushNew    ) (fileInfoPath <$> diffNewFiles last curr    )       sync $ mapM_ (pushDeleted) (fileInfoPath <$> diffDeletedFiles last curr)       go curr

@@ -0,0 +1,93 @@+{-# LANGUAGE RecursiveDo #-}+module Main where++import Control.Concurrent+import Control.Exception+import Control.Monad++import FRP.Sodium hiding (value)+import FRP.Sodium.IO+import Options.Applicative++import System.Exit+import System.Delta+import System.Delta.FRPUtils+import System.Directory+import System.IO+import System.Process++data Input = Input { inputSeconds :: Int+                   , inputDir     :: FilePath+                   , inputCommand :: String+                   }+                   deriving Show+main = do+  input <- execParser opts+  inputDirExists <- doesDirectoryExist $ inputDir input++  when (not inputDirExists)+       (do+           hPutStrLn stderr $ inputDir input  ++ " doesn't exist"+           exitFailure+       )++  bracket (deltaDir $ inputDir input)+          cleanUpAndClose -- Will run after Ctrl-C+          (\watcher -> do++              let mergedEvent = (newFiles     watcher) `merge`+                                (deletedFiles watcher) `merge`+                                (changedFiles watcher)++              ticker <- periodical (1000 * (inputSeconds input)) ()++              runE <- sync $+                       mkRunEvent mergedEvent (tickerEvent ticker) (runCmd input)++              sync $ listen runE (\_ -> runCmd input)+                                            +              threadDelay $ 15 * 1000 * 1000+          )+  where+    opts  = info (helper <*> optsP) (fullDesc)+    optsP = Input+            <$> option auto  ( long "interval"+                               <> short 'i'+                               <> metavar "INTERVAL"+                               <> help "Run at most every n seconds"+                               <> value 1+                             )+            <*> argument str ( metavar "FILE"+                               <> help "The directory that is watched"+                             )+            <*> argument str (  metavar "CMD"+                             <> help "The command to run"+                             )+    runCmd input = do+      (_,_,_,procHandle) <-+        createProcess $ (shell $ inputCommand input){ std_in  = Inherit+                                                    , std_out = Inherit+                                                    , std_err = Inherit+                                                    }+      waitForProcess procHandle+      return ()+              +            +mkRunEvent :: Event FilePath  -- ^ Changed / Deleted / New file event+           -> Event ()        -- ^ The periodical event+           -> IO ()           -- ^ Execute the input command+           -> Reactive (Event (IO ()))+mkRunEvent change ticker run = do+  rec+    enabled <- hold True $ (const False <$> fire) `merge` (const True <$> ticker)+    fireDue <- hold False $ (const True <$> change) `merge` (const False <$> fire)+    let firable = (&&) <$> enabled <*> fireDue++    -- Only when we have become firable after not being firable+    fire <- filterE (id) <$> (collectE (\c -> \p -> ((c /= p) && c,c))+                              True+                              (updates firable)+                             )++  return (const run <$> fire)+