Rename debounced -> unsafeDebounce
This commit is contained in:
parent
fe929fbe70
commit
26d11eea19
@ -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"
|
||||
|
@ -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 ""
|
||||
|
Loading…
Reference in New Issue
Block a user