Rename debounced -> unsafeDebounce

This commit is contained in:
Kirill Andreev 2020-08-14 15:49:42 +04:00
parent fe929fbe70
commit 26d11eea19
No known key found for this signature in database
GPG Key ID: CF7DA79DE4785A47
2 changed files with 64 additions and 66 deletions

View File

@ -1,5 +1,5 @@
module Debouncer (debounced) where
module Debouncer (unsafeDebounce) where
import Control.Monad.Catch
import Control.Monad
@ -9,14 +9,14 @@ import System.IO.Unsafe
-- | Ensure the function is run in single thread, w/o overlapping.
--
-- If called concurently, everyone will get results of the winner.
-- If called concurently, everyone will get result of the winner.
--
-- If called, waits for next result to arrive.
--
-- If function throws an error, will rethrow it in caller thread.
--
debounced :: forall s r. (s -> IO r) -> (s -> IO r)
debounced act = unsafePerformIO do
unsafeDebounce :: forall s r. (s -> IO r) -> (s -> IO r)
unsafeDebounce act = unsafePerformIO do
i <- newEmptyMVar
o <- newEmptyMVar
@ -34,7 +34,7 @@ debounced act = unsafePerformIO do
readMVar o >>= either throwM return
_test :: [Int] -> IO Int
_test = debounced \s -> do
_test = unsafeDebounce \s -> do
threadDelay 2000000
unless (odd (length s)) do
error "even"

View File

@ -50,7 +50,7 @@ import Range
foreign import ccall unsafe tree_sitter_PascaLigo :: Ptr Language
foreign import ccall unsafe tree_sitter_ReasonLigo :: Ptr Language
foreign import ccall unsafe tree_sitter_CamlLigo :: Ptr Language
foreign import ccall unsafe tree_sitter_CameLigo :: Ptr Language
data Source
= Path { srcPath :: FilePath }
@ -105,12 +105,10 @@ instance Pretty1 ParseTree where
-- | Feed file contents into PascaLIGO grammar recogniser.
toParseTree :: Source -> IO RawTree
toParseTree = debounced inner
where
inner fin = do
toParseTree = unsafeDebounce \fin -> do
language <- onExt ElimExt
{ eePascal = tree_sitter_PascaLigo
, eeCaml = tree_sitter_CamlLigo
, eeCaml = tree_sitter_CameLigo
, eeReason = tree_sitter_ReasonLigo
} (srcPath fin)
@ -122,11 +120,11 @@ toParseTree = debounced inner
BS.useAsCStringLen src \(str, len) -> do
tree <- ts_parser_parse_string parser nullPtr str len
withRootNode tree (peek >=> go src)
withRootNode tree (peek >=> go fin src)
where
go :: ByteString -> Node -> IO RawTree
go src node = do
go :: Source -> ByteString -> Node -> IO RawTree
go fin src node = do
let count = fromIntegral $ nodeChildCount node
allocaArray count $ \children -> do
alloca $ \tsNodePtr -> do
@ -136,7 +134,7 @@ toParseTree = debounced inner
peekElemOff children i
trees <- for nodes \node' -> do
(only -> (r :> _, tree :: ParseTree RawTree)) <- go src node'
(only -> (r :> _, tree :: ParseTree RawTree)) <- go fin src node'
field <-
if nodeFieldName node' == nullPtr
then return ""