From 4bad0324cf772dc2a1e8e4d66928d16910619dce Mon Sep 17 00:00:00 2001 From: Timothy Clem Date: Thu, 24 May 2018 21:07:05 -0700 Subject: [PATCH 1/9] Attempt to always set gitHash --- semantic.cabal | 3 +++ src/Semantic/CLI.hs | 3 +++ 2 files changed, 6 insertions(+) diff --git a/semantic.cabal b/semantic.cabal index 21a28c40a..acea2f265 100644 --- a/semantic.cabal +++ b/semantic.cabal @@ -240,6 +240,9 @@ library else ghc-options: -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints -fno-warn-name-shadowing -O0 -j ghc-prof-options: -fprof-auto + default-extensions: CPP + if flag(release) + CPP-Options: -DRELEASE executable semantic hs-source-dirs: app diff --git a/src/Semantic/CLI.hs b/src/Semantic/CLI.hs index 88cd521f1..75c8650c4 100644 --- a/src/Semantic/CLI.hs +++ b/src/Semantic/CLI.hs @@ -1,3 +1,6 @@ +#ifdef RELEASE +{-# OPTIONS_GHC -fforce-recomp #-} -- So that gitHash is correct. +#endif {-# LANGUAGE ApplicativeDo, RankNTypes, TemplateHaskell #-} module Semantic.CLI ( main From 7e63f87bc48f50093c3f813393770334097ea281 Mon Sep 17 00:00:00 2001 From: Timothy Clem Date: Thu, 24 May 2018 21:22:09 -0700 Subject: [PATCH 2/9] Too slow --- semantic.cabal | 3 --- src/Semantic/CLI.hs | 2 -- 2 files changed, 5 deletions(-) diff --git a/semantic.cabal b/semantic.cabal index acea2f265..21a28c40a 100644 --- a/semantic.cabal +++ b/semantic.cabal @@ -240,9 +240,6 @@ library else ghc-options: -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints -fno-warn-name-shadowing -O0 -j ghc-prof-options: -fprof-auto - default-extensions: CPP - if flag(release) - CPP-Options: -DRELEASE executable semantic hs-source-dirs: app diff --git a/src/Semantic/CLI.hs b/src/Semantic/CLI.hs index 75c8650c4..6a9ac8427 100644 --- a/src/Semantic/CLI.hs +++ b/src/Semantic/CLI.hs @@ -1,6 +1,4 @@ -#ifdef RELEASE {-# OPTIONS_GHC -fforce-recomp #-} -- So that gitHash is correct. -#endif {-# LANGUAGE ApplicativeDo, RankNTypes, TemplateHaskell #-} module Semantic.CLI ( main From 0254ad676a14e3d5a7dc863b25ec4477f57023f8 Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Wed, 23 May 2018 14:23:31 -0400 Subject: [PATCH 3/9] WIP: this works, but doesn't bracket or rethrow correctly. --- src/Parsing/TreeSitter.hs | 20 ++++++++++++++------ src/Semantic/IO.hs | 25 +++++++++++++++++++++++++ src/Semantic/Task.hs | 4 ++-- 3 files changed, 41 insertions(+), 8 deletions(-) diff --git a/src/Parsing/TreeSitter.hs b/src/Parsing/TreeSitter.hs index d81c7876f..4e12b891a 100644 --- a/src/Parsing/TreeSitter.hs +++ b/src/Parsing/TreeSitter.hs @@ -8,6 +8,8 @@ import Prologue import Control.Concurrent.Async import Control.Monad +import Control.Monad.Effect +import Control.Monad.IO.Class import Data.AST (AST, Node (Node)) import Data.Blob import Data.ByteString.Unsafe (unsafeUseAsCStringLen) @@ -27,6 +29,10 @@ import qualified TreeSitter.Tree as TS newtype Timeout = Milliseconds Int +data ParseException = TimedOut deriving (Show, Typeable) + +instance Exception ParseException + -- Change this to putStrLn if you want to debug the locking/cancellation code. -- TODO: Someday we should run this all in Eff so that we can 'trace'. dbg :: String -> IO () @@ -49,13 +55,14 @@ runParser parser blobSource = unsafeUseAsCStringLen (sourceBytes blobSource) $ then pure Nothing else do TS.ts_tree_root_node_p treePtr rootPtr - fmap Just (peek rootPtr >>= anaM toAST) + ptr <- peek rootPtr + runM (fmap Just (anaM toAST ptr)) bracket acquire release go) -- | Parse 'Source' with the given 'TS.Language' and return its AST. -- Returns Nothing if the operation timed out. -parseToAST :: (Bounded grammar, Enum grammar) => Timeout -> Ptr TS.Language -> Blob -> IO (Maybe (AST [] grammar)) -parseToAST (Milliseconds s) language Blob{..} = bracket TS.ts_parser_new TS.ts_parser_delete $ \ parser -> do +parseToAST :: (Bounded grammar, Enum grammar, Members '[Exc SomeException, IO] effects) => Timeout -> Ptr TS.Language -> Blob -> Eff effects (Maybe (AST [] grammar)) +parseToAST (Milliseconds s) language Blob{..} = liftIO $ bracket TS.ts_parser_new TS.ts_parser_delete $ \ parser -> do let parserTimeout = s * 1000 TS.ts_parser_halt_on_error parser (CBool 1) @@ -68,13 +75,14 @@ parseToAST (Milliseconds s) language Blob{..} = bracket TS.ts_parser_new TS.ts_p -- If we get a Nothing back, then we failed, so we need to disable the parser, which -- will let the call to runParser terminate, cleaning up appropriately - when (isNothing res) (TS.ts_parser_set_enabled parser (CBool 0)) + when (isNothing res) $ + TS.ts_parser_set_enabled parser (CBool 0) pure (join res) -toAST :: forall grammar . (Bounded grammar, Enum grammar) => TS.Node -> IO (Base (AST [] grammar) TS.Node) -toAST node@TS.Node{..} = do +toAST :: forall grammar effects . (Bounded grammar, Enum grammar, Member IO effects) => TS.Node -> Eff effects (Base (AST [] grammar) TS.Node) +toAST node@TS.Node{..} = liftIO $ do let count = fromIntegral nodeChildCount children <- allocaArray count $ \ childNodesPtr -> do _ <- with nodeTSNode (\ nodePtr -> TS.ts_node_copy_child_nodes nodePtr childNodesPtr (fromIntegral count)) diff --git a/src/Semantic/IO.hs b/src/Semantic/IO.hs index 76131337c..c6cd40d8e 100644 --- a/src/Semantic/IO.hs +++ b/src/Semantic/IO.hs @@ -274,6 +274,31 @@ catchException :: ( Exc.Exception e -> Eff r a catchException m handler = interpose pure (\ m yield -> send (Exc.try m) >>= either handler yield) m +-- type Arrow m (effects :: [* -> *]) a b = a -> m effects b +-- raiseHandler :: Effectful m => (Eff effectsA a -> Eff effectsB b) -> m effectsA a -> m effectsB b +-- send :: (Effectful m, Member eff e) => eff b -> m e b +-- interpose :: (Member eff e, Effectful m) +-- => Arrow m e a b +-- -> (forall v. eff v -> Arrow m e v b -> m e b) +-- -> m e a -> m e b + +masking :: Member IO r => Eff r a -> Eff r a +masking = interpose pure $ \m yield -> do + res <- send (Exc.mask_ m) + yield res + +bracket' :: (Members [Exc SomeException, IO] r) + => Eff r a + -> (a -> Eff r b) + -> (a -> Eff r c) + -> Eff r c +bracket' before after thing = do + a <- before + r <- thing a `catchError` (\(SomeException e) -> after a *> throwError (SomeException e)) + r <$ after a + + + -- | Lift an 'IO' action into 'Eff', catching and rethrowing any exceptions it throws into an 'Exc' effect. rethrowing :: ( Member (Exc SomeException) r , Member IO r diff --git a/src/Semantic/Task.hs b/src/Semantic/Task.hs index 20132f7a9..08562da47 100644 --- a/src/Semantic/Task.hs +++ b/src/Semantic/Task.hs @@ -194,8 +194,8 @@ defaultTimeout = Milliseconds 5000 runParser :: Members '[Reader Options, Telemetry, Exc SomeException, IO, Trace] effs => Blob -> Parser term -> Eff effs term runParser blob@Blob{..} parser = case parser of ASTParser language -> - time "parse.tree_sitter_ast_parse" languageTag $ - IO.rethrowing (parseToAST defaultTimeout language blob) + time "parse.tree_sitter_ast_parse" languageTag $ do + parseToAST defaultTimeout language blob >>= maybeM (throwError (SomeException ParserTimedOut)) AssignmentParser parser assignment -> do From 6bd6e71d75c8822e77fb6a6ea416fdc7b656b2db Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Fri, 25 May 2018 11:37:16 -0400 Subject: [PATCH 4/9] Implement a correct bracket. --- src/Parsing/TreeSitter.hs | 20 +++++++-- src/Semantic/IO.hs | 86 ++++++++++++++------------------------- 2 files changed, 48 insertions(+), 58 deletions(-) diff --git a/src/Parsing/TreeSitter.hs b/src/Parsing/TreeSitter.hs index 4e12b891a..a56267f80 100644 --- a/src/Parsing/TreeSitter.hs +++ b/src/Parsing/TreeSitter.hs @@ -4,9 +4,10 @@ module Parsing.TreeSitter , parseToAST ) where -import Prologue +import Prologue hiding (catchError, throwError) import Control.Concurrent.Async +import Control.Exception (throwIO) import Control.Monad import Control.Monad.Effect import Control.Monad.IO.Class @@ -20,6 +21,7 @@ import Data.Term import Foreign import Foreign.C.Types (CBool (..)) import Foreign.Marshal.Array (allocaArray) +import Semantic.IO hiding (Source) import System.Timeout import qualified TreeSitter.Language as TS @@ -59,10 +61,22 @@ runParser parser blobSource = unsafeUseAsCStringLen (sourceBytes blobSource) $ runM (fmap Just (anaM toAST ptr)) bracket acquire release go) +-- | The semantics of @bracket before after handler@ are as follows: +-- * Exceptions in @before@ and @after@ are thrown in IO. +-- * @after@ is called on IO exceptions in @handler@, and then rethrown in IO. +-- * If @handler@ completes successfully, @after@ is called +-- Call 'catchException' at the call site if you want to recover. +bracket' :: (Member IO r) => IO a -> (a -> IO b) -> (a -> Eff r c) -> Eff r c +bracket' before after action = do + a <- liftIO before + let cleanup = liftIO (after a) + res <- action a `catchException` (\(e :: SomeException) -> cleanup >> liftIO (throwIO e)) + res <$ cleanup + -- | Parse 'Source' with the given 'TS.Language' and return its AST. -- Returns Nothing if the operation timed out. -parseToAST :: (Bounded grammar, Enum grammar, Members '[Exc SomeException, IO] effects) => Timeout -> Ptr TS.Language -> Blob -> Eff effects (Maybe (AST [] grammar)) -parseToAST (Milliseconds s) language Blob{..} = liftIO $ bracket TS.ts_parser_new TS.ts_parser_delete $ \ parser -> do +parseToAST :: (Bounded grammar, Enum grammar, Member IO effects) => Timeout -> Ptr TS.Language -> Blob -> Eff effects (Maybe (AST [] grammar)) +parseToAST (Milliseconds s) language Blob{..} = bracket' TS.ts_parser_new TS.ts_parser_delete $ \ parser -> liftIO $ do let parserTimeout = s * 1000 TS.ts_parser_halt_on_error parser (CBool 1) diff --git a/src/Semantic/IO.hs b/src/Semantic/IO.hs index c6cd40d8e..6e9a1f43c 100644 --- a/src/Semantic/IO.hs +++ b/src/Semantic/IO.hs @@ -1,35 +1,36 @@ {-# LANGUAGE DeriveAnyClass, DeriveDataTypeable, DuplicateRecordFields, GADTs, ScopedTypeVariables, TypeOperators, UndecidableInstances #-} module Semantic.IO -( readFile -, readFilePair -, isDirectory -, readBlobPairsFromHandle -, readBlobsFromHandle -, readProjectFromPaths -, readBlobsFromDir -, findFiles -, languageForFilePath -, NoLanguageForBlob(..) -, noLanguageForBlob -, readBlob -, readBlobs -, readBlobPairs -, readProject -, findFilesInDir -, write -, Handle(..) -, getHandle -, IO.IOMode(..) -, stdin -, stdout -, stderr -, openFileForReading -, Source(..) -, Destination(..) -, Files -, runFiles -, rethrowing -) where + ( Destination(..) + , Files + , Handle(..) + , IO.IOMode(..) + , NoLanguageForBlob(..) + , Source(..) + , catchException + , findFiles + , findFilesInDir + , getHandle + , isDirectory + , languageForFilePath + , noLanguageForBlob + , openFileForReading + , readBlob + , readBlobPairs + , readBlobPairsFromHandle + , readBlobs + , readBlobsFromDir + , readBlobsFromHandle + , readFile + , readFilePair + , readProject + , readProjectFromPaths + , rethrowing + , runFiles + , stderr + , stdin + , stdout + , write + ) where import qualified Control.Exception as Exc import Control.Monad.Effect @@ -274,31 +275,6 @@ catchException :: ( Exc.Exception e -> Eff r a catchException m handler = interpose pure (\ m yield -> send (Exc.try m) >>= either handler yield) m --- type Arrow m (effects :: [* -> *]) a b = a -> m effects b --- raiseHandler :: Effectful m => (Eff effectsA a -> Eff effectsB b) -> m effectsA a -> m effectsB b --- send :: (Effectful m, Member eff e) => eff b -> m e b --- interpose :: (Member eff e, Effectful m) --- => Arrow m e a b --- -> (forall v. eff v -> Arrow m e v b -> m e b) --- -> m e a -> m e b - -masking :: Member IO r => Eff r a -> Eff r a -masking = interpose pure $ \m yield -> do - res <- send (Exc.mask_ m) - yield res - -bracket' :: (Members [Exc SomeException, IO] r) - => Eff r a - -> (a -> Eff r b) - -> (a -> Eff r c) - -> Eff r c -bracket' before after thing = do - a <- before - r <- thing a `catchError` (\(SomeException e) -> after a *> throwError (SomeException e)) - r <$ after a - - - -- | Lift an 'IO' action into 'Eff', catching and rethrowing any exceptions it throws into an 'Exc' effect. rethrowing :: ( Member (Exc SomeException) r , Member IO r From b2aa29e6c6b1254afc5b53bae095f19db7604d6c Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Fri, 25 May 2018 12:28:56 -0400 Subject: [PATCH 5/9] :fire: dbg and just use `trace`. --- src/Parsing/TreeSitter.hs | 55 +++++++++++++++++++-------------------- 1 file changed, 27 insertions(+), 28 deletions(-) diff --git a/src/Parsing/TreeSitter.hs b/src/Parsing/TreeSitter.hs index a56267f80..ee2d8fe99 100644 --- a/src/Parsing/TreeSitter.hs +++ b/src/Parsing/TreeSitter.hs @@ -4,12 +4,14 @@ module Parsing.TreeSitter , parseToAST ) where -import Prologue hiding (catchError, throwError) +import Prologue import Control.Concurrent.Async +import Control.Concurrent.MVar import Control.Exception (throwIO) import Control.Monad import Control.Monad.Effect +import Control.Monad.Effect.Trace import Control.Monad.IO.Class import Data.AST (AST, Node (Node)) import Data.Blob @@ -31,34 +33,28 @@ import qualified TreeSitter.Tree as TS newtype Timeout = Milliseconds Int -data ParseException = TimedOut deriving (Show, Typeable) +data Result grammar + = Failed + | Succeeded (AST [] grammar) -instance Exception ParseException - --- Change this to putStrLn if you want to debug the locking/cancellation code. --- TODO: Someday we should run this all in Eff so that we can 'trace'. -dbg :: String -> IO () -dbg = const (pure ()) - -runParser :: (Enum grammar, Bounded grammar) => Ptr TS.Parser -> Source -> IO (Maybe (AST [] grammar)) -runParser parser blobSource = unsafeUseAsCStringLen (sourceBytes blobSource) $ \ (source, len) -> +runParser :: (Enum grammar, Bounded grammar) => Ptr TS.Parser -> Source -> IO (Result grammar) +runParser parser blobSource = unsafeUseAsCStringLen (sourceBytes blobSource) $ \ (source, len) -> do alloca (\ rootPtr -> do let acquire = do - dbg "Starting parse" -- Change this to TS.ts_parser_loop_until_cancelled if you want to test out cancellation TS.ts_parser_parse_string parser nullPtr source len let release t - | t == nullPtr = dbg "Parse failed" - | otherwise = dbg "Parse completed" *> TS.ts_tree_delete t + | t == nullPtr = pure () + | otherwise = TS.ts_tree_delete t let go treePtr = do if treePtr == nullPtr - then pure Nothing + then pure Failed else do TS.ts_tree_root_node_p treePtr rootPtr ptr <- peek rootPtr - runM (fmap Just (anaM toAST ptr)) + runM (fmap Succeeded (anaM toAST ptr)) bracket acquire release go) -- | The semantics of @bracket before after handler@ are as follows: @@ -75,24 +71,27 @@ bracket' before after action = do -- | Parse 'Source' with the given 'TS.Language' and return its AST. -- Returns Nothing if the operation timed out. -parseToAST :: (Bounded grammar, Enum grammar, Member IO effects) => Timeout -> Ptr TS.Language -> Blob -> Eff effects (Maybe (AST [] grammar)) -parseToAST (Milliseconds s) language Blob{..} = bracket' TS.ts_parser_new TS.ts_parser_delete $ \ parser -> liftIO $ do +parseToAST :: (Bounded grammar, Enum grammar, Members '[Trace, IO] effects) => Timeout -> Ptr TS.Language -> Blob -> Eff effects (Maybe (AST [] grammar)) +parseToAST (Milliseconds s) language Blob{..} = bracket' TS.ts_parser_new TS.ts_parser_delete $ \ parser -> do let parserTimeout = s * 1000 - TS.ts_parser_halt_on_error parser (CBool 1) - TS.ts_parser_set_language parser language + liftIO $ do + TS.ts_parser_halt_on_error parser (CBool 1) + TS.ts_parser_set_language parser language - parsing <- async (runParser parser blobSource) + trace "tree-sitter: beginning parsing" + + parsing <- liftIO . async $ runParser parser blobSource -- Kick the parser off asynchronously and wait according to the provided timeout. - res <- timeout parserTimeout (wait parsing) + res <- liftIO . timeout parserTimeout $ wait parsing - -- If we get a Nothing back, then we failed, so we need to disable the parser, which - -- will let the call to runParser terminate, cleaning up appropriately - when (isNothing res) $ - TS.ts_parser_set_enabled parser (CBool 0) - - pure (join res) + case res of + Just Failed -> Nothing <$ trace "tree-sitter: parsing failed" + Just (Succeeded ast) -> Just ast <$ trace "tree-sitter: parsing succeeded" + Nothing -> do + trace "tree-sitter: parsing timed out" + Nothing <$ liftIO (TS.ts_parser_set_enabled parser (CBool 0)) toAST :: forall grammar effects . (Bounded grammar, Enum grammar, Member IO effects) => TS.Node -> Eff effects (Base (AST [] grammar) TS.Node) From 3e02366d143ff512433013a040ce8998a66059ff Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Fri, 25 May 2018 12:34:04 -0400 Subject: [PATCH 6/9] don't use Eff in `toAST` since it's just being called from IO. --- src/Parsing/TreeSitter.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/Parsing/TreeSitter.hs b/src/Parsing/TreeSitter.hs index ee2d8fe99..8b7b327ed 100644 --- a/src/Parsing/TreeSitter.hs +++ b/src/Parsing/TreeSitter.hs @@ -54,7 +54,7 @@ runParser parser blobSource = unsafeUseAsCStringLen (sourceBytes blobSource) $ else do TS.ts_tree_root_node_p treePtr rootPtr ptr <- peek rootPtr - runM (fmap Succeeded (anaM toAST ptr)) + Succeeded <$> anaM toAST ptr bracket acquire release go) -- | The semantics of @bracket before after handler@ are as follows: @@ -94,8 +94,8 @@ parseToAST (Milliseconds s) language Blob{..} = bracket' TS.ts_parser_new TS.ts_ Nothing <$ liftIO (TS.ts_parser_set_enabled parser (CBool 0)) -toAST :: forall grammar effects . (Bounded grammar, Enum grammar, Member IO effects) => TS.Node -> Eff effects (Base (AST [] grammar) TS.Node) -toAST node@TS.Node{..} = liftIO $ do +toAST :: forall grammar effects . (Bounded grammar, Enum grammar) => TS.Node -> IO (Base (AST [] grammar) TS.Node) +toAST node@TS.Node{..} = do let count = fromIntegral nodeChildCount children <- allocaArray count $ \ childNodesPtr -> do _ <- with nodeTSNode (\ nodePtr -> TS.ts_node_copy_child_nodes nodePtr childNodesPtr (fromIntegral count)) From bec56ece821e8b3052c4b3d33081d58ce3a86206 Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Fri, 25 May 2018 12:35:16 -0400 Subject: [PATCH 7/9] otiose 'do' --- src/Semantic/Task.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Semantic/Task.hs b/src/Semantic/Task.hs index 08562da47..406df5bfd 100644 --- a/src/Semantic/Task.hs +++ b/src/Semantic/Task.hs @@ -194,7 +194,7 @@ defaultTimeout = Milliseconds 5000 runParser :: Members '[Reader Options, Telemetry, Exc SomeException, IO, Trace] effs => Blob -> Parser term -> Eff effs term runParser blob@Blob{..} parser = case parser of ASTParser language -> - time "parse.tree_sitter_ast_parse" languageTag $ do + time "parse.tree_sitter_ast_parse" languageTag $ parseToAST defaultTimeout language blob >>= maybeM (throwError (SomeException ParserTimedOut)) From 9b68986a93ddae7554f9915cedf991381dd7212b Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Fri, 25 May 2018 12:36:48 -0400 Subject: [PATCH 8/9] warnings --- src/Parsing/TreeSitter.hs | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/src/Parsing/TreeSitter.hs b/src/Parsing/TreeSitter.hs index 8b7b327ed..20e4a3ead 100644 --- a/src/Parsing/TreeSitter.hs +++ b/src/Parsing/TreeSitter.hs @@ -7,9 +7,7 @@ module Parsing.TreeSitter import Prologue import Control.Concurrent.Async -import Control.Concurrent.MVar import Control.Exception (throwIO) -import Control.Monad import Control.Monad.Effect import Control.Monad.Effect.Trace import Control.Monad.IO.Class @@ -94,7 +92,7 @@ parseToAST (Milliseconds s) language Blob{..} = bracket' TS.ts_parser_new TS.ts_ Nothing <$ liftIO (TS.ts_parser_set_enabled parser (CBool 0)) -toAST :: forall grammar effects . (Bounded grammar, Enum grammar) => TS.Node -> IO (Base (AST [] grammar) TS.Node) +toAST :: forall grammar . (Bounded grammar, Enum grammar) => TS.Node -> IO (Base (AST [] grammar) TS.Node) toAST node@TS.Node{..} = do let count = fromIntegral nodeChildCount children <- allocaArray count $ \ childNodesPtr -> do From 18723b2c1e4cc42dafda4b837cef77c6fd8f989f Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Fri, 25 May 2018 13:02:03 -0400 Subject: [PATCH 9/9] dedent import list --- src/Semantic/IO.hs | 62 +++++++++++++++++++++++----------------------- 1 file changed, 31 insertions(+), 31 deletions(-) diff --git a/src/Semantic/IO.hs b/src/Semantic/IO.hs index 6e9a1f43c..a4ccd5314 100644 --- a/src/Semantic/IO.hs +++ b/src/Semantic/IO.hs @@ -1,36 +1,36 @@ {-# LANGUAGE DeriveAnyClass, DeriveDataTypeable, DuplicateRecordFields, GADTs, ScopedTypeVariables, TypeOperators, UndecidableInstances #-} module Semantic.IO - ( Destination(..) - , Files - , Handle(..) - , IO.IOMode(..) - , NoLanguageForBlob(..) - , Source(..) - , catchException - , findFiles - , findFilesInDir - , getHandle - , isDirectory - , languageForFilePath - , noLanguageForBlob - , openFileForReading - , readBlob - , readBlobPairs - , readBlobPairsFromHandle - , readBlobs - , readBlobsFromDir - , readBlobsFromHandle - , readFile - , readFilePair - , readProject - , readProjectFromPaths - , rethrowing - , runFiles - , stderr - , stdin - , stdout - , write - ) where +( Destination(..) +, Files +, Handle(..) +, IO.IOMode(..) +, NoLanguageForBlob(..) +, Source(..) +, catchException +, findFiles +, findFilesInDir +, getHandle +, isDirectory +, languageForFilePath +, noLanguageForBlob +, openFileForReading +, readBlob +, readBlobPairs +, readBlobPairsFromHandle +, readBlobs +, readBlobsFromDir +, readBlobsFromHandle +, readFile +, readFilePair +, readProject +, readProjectFromPaths +, rethrowing +, runFiles +, stderr +, stdin +, stdout +, write +) where import qualified Control.Exception as Exc import Control.Monad.Effect