Merge remote-tracking branch 'origin/master' into fix/987

parser-typechecker/src/Unison/Codebase/Watch.hs

@@ -6,17 +6,19 @@ module Unison.Codebase.Watch where
 
 import Unison.Prelude
 
+import qualified UnliftIO                       as UnliftIO
 import           UnliftIO.Concurrent            ( forkIO
                                                 , threadDelay
                                                 , killThread
                                                 )
 import           UnliftIO                       ( MonadUnliftIO
-                                                , withRunInIO )
+                                                , withRunInIO
+                                                , unliftIO )
 import           UnliftIO.Directory             ( getModificationTime
                                                 , listDirectory
                                                 )
 import           UnliftIO.MVar                  ( newEmptyMVar, takeMVar
-                                                , tryTakeMVar, putMVar )
+                                                , tryTakeMVar, tryPutMVar, putMVar )
 import           UnliftIO.STM                   ( atomically )
 import           UnliftIO.Exception             ( catch, IOException)
 import           UnliftIO.IORef                 ( newIORef
@@ -29,12 +31,11 @@ import qualified Data.Text.IO
 import           Data.Time.Clock                ( UTCTime
                                                 , diffUTCTime
                                                 )
-import           System.FSNotify                ( Event(Added, Modified)
-                                                , watchDir
-                                                , withManager
-                                                )
+import           System.FSNotify                ( Event(Added, Modified))
+import qualified System.FSNotify               as FSNotify
 import           Unison.Util.TQueue             ( TQueue )
 import qualified Unison.Util.TQueue            as TQueue
+import qualified Control.Concurrent.STM        as STM
 
 untilJust :: Monad m => m (Maybe a) -> m a
 untilJust act = act >>= maybe (untilJust act) return
@@ -54,9 +55,12 @@ watchDirectory' d = do
     -- janky: used to store the cancellation action returned
     -- by `watchDir`, which is created asynchronously
     cleanupRef <- newEmptyMVar
+    -- we don't like FSNotify's debouncing (it seems to drop later events) 
+    -- so we will be doing our own instead
+    let config = FSNotify.defaultConfig { FSNotify.confDebounce = FSNotify.NoDebounce } 
     cancel <- forkIO $ withRunInIO $ \inIO ->
-      withManager $ \mgr -> do
-        cancelInner <- watchDir mgr d (const True) (inIO . handler) <|> (pure (pure ()))
+      FSNotify.withManagerConf config $ \mgr -> do
+        cancelInner <- FSNotify.watchDir mgr d (const True) (inIO . handler) <|> (pure (pure ()))
         putMVar cleanupRef $ liftIO cancelInner
         forever $ threadDelay 1000000
     let cleanup :: m ()
@@ -83,7 +87,7 @@ watchDirectory :: forall m. MonadUnliftIO m
   => FilePath -> (FilePath -> Bool) -> m (m (), m (FilePath, Text))
 watchDirectory dir allow = do
   previousFiles <- newIORef Map.empty
-  (cancel, watcher) <- watchDirectory' dir
+  (cancelWatch, watcher) <- watchDirectory' dir
   let
     existingFiles :: MonadIO m => m [(FilePath, UTCTime)]
     existingFiles = do
@@ -102,22 +106,46 @@ watchDirectory dir allow = do
           contents <- Data.Text.IO.readFile file
           prevs    <- readIORef previousFiles
           case Map.lookup file prevs of
-            -- if the file's content's haven't changed and less than a second has passed,
-            -- wait for the next update
+            -- if the file's content's haven't changed and less than .5s
+            -- have elapsed, wait for the next update
             Just (contents0, t0)
-              | contents == contents0 && (t `diffUTCTime` t0) < 1 ->
+              | contents == contents0 && (t `diffUTCTime` t0) < 0.5 ->
                 return Nothing
             _ ->
               Just (file, contents) <$
                 writeIORef previousFiles (Map.insert file (contents, t) prevs)
         in catch go (\e -> Nothing <$ handle e)
       else return Nothing
+  queue <- TQueue.newIO
+  gate <- liftIO newEmptyMVar
+  ctx <- UnliftIO.askUnliftIO
+  -- We spawn a separate thread to siphon the file change events
+  -- into a queue, which can be debounced using `collectUntilPause`
+  enqueuer <- liftIO . forkIO $ do 
+    takeMVar gate -- wait until gate open before starting
+    forever $ do
+      event@(file, _) <- UnliftIO.unliftIO ctx watcher
+      when (allow file) $
+        STM.atomically $ TQueue.enqueue queue event
   pending <- newIORef =<< existingFiles
   let
     await :: MonadIO m => m (FilePath, Text)
     await = untilJust $ readIORef pending >>= \case
-      [] -> uncurry process =<< watcher
+      [] -> do
+        -- open the gate
+        tryPutMVar gate ()
+        -- this debounces the events, waits for 50ms pause
+        -- in file change events
+        events <- collectUntilPause queue 50000
+        -- traceM $ "Collected file change events" <> show events
+        case events of
+          [] -> pure Nothing 
+          -- we pick the last of the events within the 50ms window 
+          -- TODO: consider enqueing other events if there are 
+          -- multiple events for different files
+          _ -> uncurry process $ last events
       ((file, t):rest) -> do
         writeIORef pending rest
         process file t
+    cancel = cancelWatch >> killThread enqueuer
   pure (cancel, await)

parser-typechecker/unison-parser-typechecker.cabal

@@ -34,8 +34,6 @@ library
   hs-source-dirs: src
 
   exposed-modules:
-    Unison.ABT
-    Unison.Blank
     Unison.Builtin
     Unison.Codecs
     Unison.Codebase
@@ -68,7 +66,6 @@ library
     Unison.Codebase.Patch
     Unison.Codebase.Reflog
     Unison.Codebase.Runtime
-    Unison.Codebase.SearchResult
     Unison.Codebase.Serialization
     Unison.Codebase.Serialization.PutT
     Unison.Codebase.Serialization.V1
@@ -83,35 +80,18 @@ library
     Unison.CommandLine.InputPatterns
     Unison.CommandLine.Main
     Unison.CommandLine.OutputMessages
-    Unison.ConstructorType
-    Unison.DataDeclaration
     Unison.DeclPrinter
     Unison.FileParser
     Unison.FileParsers
-    Unison.Hash
-    Unison.Hashable
-    Unison.HashQualified
-    Unison.HashQualified'
-    Unison.Kind
-    Unison.LabeledDependency
     Unison.Lexer
-    Unison.Name
-    Unison.Names2
-    Unison.Names3
     Unison.NamePrinter
     Unison.Parser
     Unison.Parsers
     Unison.Path
     Unison.Paths
-    Unison.Pattern
-    Unison.PatternP
-    Unison.Prelude
     Unison.PrettyPrintEnv
     Unison.PrettyTerminal
     Unison.PrintError
-    Unison.Reference
-    Unison.Reference.Util
-    Unison.Referent
     Unison.Result
     Unison.Runtime.ANF
     Unison.Runtime.IR
@@ -120,16 +100,10 @@ library
     Unison.Runtime.IOSource
     Unison.Runtime.Vector
     Unison.Runtime.SparseVector
-    Unison.Settings
-    Unison.ShortHash
-    Unison.Symbol
-    Unison.Term
     Unison.TermParser
     Unison.TermPrinter
-    Unison.Type
     Unison.TypeParser
     Unison.TypePrinter
-    Unison.TypeVar
     Unison.Typechecker
     Unison.Typechecker.Components
     Unison.Typechecker.Context
@@ -140,18 +114,14 @@ library
     Unison.Util.AnnotatedText
     Unison.Util.Bytes
     Unison.Util.ColorText
-    Unison.Util.Components
     Unison.Util.Exception
     Unison.Util.Free
     Unison.Util.Find
     Unison.Util.Less
     Unison.Util.Logger
-    Unison.Util.List
     Unison.Util.Menu
-    Unison.Util.Monoid
     Unison.Util.Pretty
     Unison.Util.Range
-    Unison.Util.Relation
     Unison.Util.Star3
     Unison.Util.SyntaxText
     Unison.Util.TQueue
@@ -159,7 +129,6 @@ library
     Unison.Util.CycleTable
     Unison.Util.CyclicEq
     Unison.Util.CyclicOrd
-    Unison.Var
 
   build-depends:
     ansi-terminal,
@@ -178,7 +147,6 @@ library
     guid,
     data-memocombinators,
     edit-distance,
-    either,
     errors,
     exceptions,
     extra,
@@ -206,14 +174,11 @@ library
     network-simple,
     non-empty-sequence,
     process,
-    prelude-extras,
     random,
     raw-strings-qq,
-    rfc5051,
     regex-base,
     regex-tdfa,
     safe,
-    sandi,
     shellmet,
     split,
     stm,
@@ -222,6 +187,7 @@ library
     text,
     time,
     transformers,
+    unison-core,
     unliftio,
     util,
     vector
@@ -265,6 +231,7 @@ executable unison
     template-haskell,
     temporary,
     text,
+    unison-core,
     unison-parser-typechecker
 
 executable prettyprintdemo
@@ -328,6 +295,7 @@ executable tests
     temporary,
     text,
     transformers,
+    unison-core,
     unison-parser-typechecker
 
 executable transcripts
@@ -342,4 +310,5 @@ executable transcripts
     filepath,
     shellmet,
     text,
+    unison-core,
     unison-parser-typechecker

stack.yaml

@@ -8,6 +8,7 @@ packages:
 - yaks/easytest
 - yaks/haskeline
 - parser-typechecker
+- unison-core
 
 #compiler-check: match-exact
 resolver: lts-14.7

unison-core/LICENSE

@@ -0,0 +1,19 @@
+Copyright (c) 2013, Paul Chiusano and contributors
+
+Permission is hereby granted, free of charge, to any person obtaining a copy
+of this software and associated documentation files (the "Software"), to deal
+in the Software without restriction, including without limitation the rights
+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+copies of the Software, and to permit persons to whom the Software is
+furnished to do so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in
+all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
+THE SOFTWARE.

unison-core/unison-core.cabal

@@ -0,0 +1,102 @@
+name:          unison-core
+category:      Compiler
+version:       0.1
+license:       MIT
+cabal-version: >= 1.8
+license-file:  LICENSE
+author:        Unison Computing, public benefit corp
+maintainer:    Paul Chiusano <paul.chiusano@gmail.com>, Runar Bjarnason <runarorama@gmail.com>, Arya Irani <arya.irani@gmail.com>
+stability:     provisional
+homepage:      http://unisonweb.org
+bug-reports:   https://github.com/unisonweb/unison/issues
+copyright:     Copyright (C) 2013-2018 Unison Computing, PBC and contributors
+synopsis:      Parser and typechecker for the Unison language
+description:
+
+build-type:    Simple
+extra-source-files:
+data-files:
+
+source-repository head
+  type: git
+  location: git://github.com/unisonweb/unison.git
+
+-- `cabal install -foptimized` enables optimizations
+flag optimized
+  manual: True
+  default: False
+
+flag quiet
+  manual: True
+  default: False
+
+library
+  hs-source-dirs: src
+
+  exposed-modules:
+    Unison.ABT
+    Unison.Blank
+    Unison.Codebase.SearchResult
+    Unison.ConstructorType
+    Unison.DataDeclaration
+    Unison.Hash
+    Unison.HashQualified
+    Unison.HashQualified'
+    Unison.Hashable
+    Unison.Kind
+    Unison.LabeledDependency
+    Unison.Name
+    Unison.Names2
+    Unison.Names3
+    Unison.Pattern
+    Unison.PatternP
+    Unison.Prelude
+    Unison.Reference
+    Unison.Reference.Util
+    Unison.Referent
+    Unison.Settings
+    Unison.ShortHash
+    Unison.Symbol
+    Unison.Term
+    Unison.Type
+    Unison.TypeVar
+    Unison.Util.Components
+    Unison.Util.List
+    Unison.Util.Monoid
+    Unison.Util.Relation
+    Unison.Var
+
+  build-depends:
+    base,
+    bytestring,
+    containers,
+    cryptonite,
+    either,
+    extra,
+    lens,
+    prelude-extras,
+    memory,
+    mtl,
+    rfc5051,
+    safe,
+    sandi,
+    text,
+    transformers,
+    vector
+
+  ghc-options: -Wall -O0 -fno-warn-name-shadowing -fno-warn-missing-pattern-synonym-signatures
+
+  default-extensions:
+    DeriveFunctor
+    FlexibleContexts
+    FlexibleInstances
+    LambdaCase
+    ScopedTypeVariables
+    TupleSections
+    TypeSynonymInstances
+
+  if flag(optimized)
+    ghc-options: -funbox-strict-fields
+
+  if flag(quiet)
+    ghc-options: -v0