Merge remote-tracking branch 'origin/master' into docstrings-round2

.licenses/semantic/cabal/fused-effects.txt

@@ -1,7 +1,7 @@
 ---
 type: cabal
 name: fused-effects
-version: 0.1.0.0
+version: 0.1.1.0
 summary: 'A fast, flexible, fused effect system, à la Effect Handlers in Scope, Monad Transformers and Modular Algebraic Effects: What Binds Them Together, and Fusion for Free—Efficient Algebraic Effect Handlers.'
 homepage: https://github.com/robrix/fused-effects
 license: bsd-3-clause

src/Control/Abstract/Modules.hs

@@ -26,7 +26,6 @@ import Data.Abstract.Environment
 import Data.Abstract.BaseError
 import Data.Abstract.Module
 import Data.Abstract.ModuleTable as ModuleTable
-import Data.Coerce
 import Data.Language
 import Data.Semigroup.Foldable (foldMap1)
 import qualified Data.Set as Set

src/Control/Abstract/Value.hs

@@ -35,7 +35,6 @@ import Control.Abstract.Environment
 import Control.Abstract.Evaluator
 import Control.Abstract.Heap
 import Control.Effect.Carrier
-import Data.Coerce
 import Data.Abstract.BaseError
 import Data.Abstract.Environment as Env
 import Data.Abstract.Module

src/Control/Effect/REPL.hs

@@ -13,7 +13,6 @@ import Prologue
 import Control.Effect
 import Control.Effect.Carrier
 import Control.Effect.Sum
-import Data.Coerce
 import System.Console.Haskeline
 import qualified Data.Text as T
 

src/Data/Syntax.hs

@@ -13,7 +13,7 @@ import Data.Sum
 import Data.Term
 import GHC.Types (Constraint)
 import GHC.TypeLits
-import Diffing.Algorithm hiding (Empty)
+import Diffing.Algorithm
 import Prelude
 import Prologue
 import Reprinting.Tokenize hiding (Element)

src/Diffing/Algorithm.hs

@@ -1,7 +1,7 @@
-{-# LANGUAGE DefaultSignatures, GADTs, TypeOperators, UndecidableInstances #-}
+{-# LANGUAGE DefaultSignatures, GeneralizedNewtypeDeriving, KindSignatures, TypeOperators, UndecidableInstances #-}
 module Diffing.Algorithm
-  ( AlgorithmF (..)
-  , Algorithm
+  ( Diff (..)
+  , Algorithm(..)
   , Diffable (..)
   , Equivalence (..)
   , diff
@@ -14,104 +14,100 @@ module Diffing.Algorithm
   , algorithmForTerms
   ) where
 
-import Control.Monad.Free.Freer
-import Data.Diff
+import Control.Effect hiding ((:+:))
+import Control.Effect.Carrier
+import Data.Coerce (coerce)
+import qualified Data.Diff as Diff
 import Data.Sum
 import Data.Term
 import GHC.Generics
 import Prologue
 
 -- | A single step in a diffing algorithm, parameterized by the types of terms, diffs, and the result of the applicable algorithm.
-data AlgorithmF term1 term2 result partial where
+data Diff term1 term2 diff (m :: * -> *) k
   -- | Diff two terms with the choice of algorithm left to the interpreter’s discretion.
-  Diff :: term1 -> term2 -> AlgorithmF term1 term2 result result
+  = Diff term1 term2 (diff -> k)
   -- | Diff two terms recursively in O(n) time, resulting in a single diff node.
-  Linear :: term1 -> term2 -> AlgorithmF term1 term2 result result
+  | Linear term1 term2 (diff -> k)
   -- | Diff two lists of terms by each element’s similarity in O(n³ log n), resulting in a list of diffs.
-  RWS :: [term1] -> [term2] -> AlgorithmF term1 term2 result [result]
+  | RWS [term1] [term2] ([diff] -> k)
   -- | Delete a term.
-  Delete :: term1 -> AlgorithmF term1 term2 result result
+  | Delete term1 (diff -> k)
   -- | Insert a term.
-  Insert :: term2 -> AlgorithmF term1 term2 result result
+  | Insert term2 (diff -> k)
   -- | Replace one term with another.
-  Replace :: term1 -> term2 -> AlgorithmF term1 term2 result result
-  -- | An 'Algorithm' that always fails.
-  Empty :: AlgorithmF term1 term2 result a
-  -- | An 'Algorithm' to try one of two alternatives.
-  Alt :: a -> a -> AlgorithmF term1 term2 result a
+  | Replace term1 term2 (diff -> k)
+  deriving (Functor)
 
--- | The free(r) monad for 'AlgorithmF'. This enables us to construct algorithms to diff using '<$>', '<*>', '>>=', and do-notation.
-type Algorithm term1 term2 result = Freer (AlgorithmF term1 term2 result)
+instance HFunctor (Diff term1 term2 diff) where
+  hmap _ = coerce
+  {-# INLINE hmap #-}
+
+instance Effect (Diff term1 term2 diff) where
+  handle state handler = coerce . fmap (handler . (<$ state))
+
+
+newtype Algorithm term1 term2 diff m a = Algorithm { runAlgorithm :: Eff m a }
+  deriving (Applicative, Functor, Monad)
+
+deriving instance (Carrier sig m, Member NonDet sig) => Alternative (Algorithm term1 term2 diff m)
+
+instance Carrier sig m => Carrier sig (Algorithm term1 term2 diff m) where
+  ret = Algorithm . ret
+  eff = Algorithm . eff . handleCoercible
 
 
 -- DSL
 
 -- | Diff two terms without specifying the algorithm to be used.
-diff :: term1 -> term2 -> Algorithm term1 term2 result result
-diff a1 a2 = Diffing.Algorithm.Diff a1 a2 `Then` return
+diff :: (Carrier sig m, Member (Diff term1 term2 diff) sig) => term1 -> term2 -> m diff
+diff a1 a2 = send (Diff a1 a2 ret)
 
 -- | Diff a These of terms without specifying the algorithm to be used.
-diffThese :: These term1 term2 -> Algorithm term1 term2 result result
+diffThese :: (Carrier sig m, Member (Diff term1 term2 diff) sig) => These term1 term2 -> Algorithm term1 term2 diff m diff
 diffThese = these byDeleting byInserting diff
 
 -- | Diff a pair of optional terms without specifying the algorithm to be used.
-diffMaybe :: Maybe term1 -> Maybe term2 -> Algorithm term1 term2 result (Maybe result)
+diffMaybe :: (Carrier sig m, Member (Diff term1 term2 diff) sig) => Maybe term1 -> Maybe term2 -> Algorithm term1 term2 diff m (Maybe diff)
 diffMaybe (Just a1) (Just a2) = Just <$> diff a1 a2
 diffMaybe (Just a1) _         = Just <$> byDeleting a1
 diffMaybe _         (Just a2) = Just <$> byInserting a2
 diffMaybe _         _         = pure Nothing
 
 -- | Diff two terms linearly.
-linearly :: term1 -> term2 -> Algorithm term1 term2 result result
-linearly f1 f2 = Linear f1 f2 `Then` return
+linearly :: (Carrier sig m, Member (Diff term1 term2 diff) sig) => term1 -> term2 -> Algorithm term1 term2 diff m diff
+linearly f1 f2 = send (Linear f1 f2 ret)
 
 -- | Diff two terms using RWS.
-byRWS :: [term1] -> [term2] -> Algorithm term1 term2 result [result]
-byRWS as1 as2 = RWS as1 as2 `Then` return
+byRWS :: (Carrier sig m, Member (Diff term1 term2 diff) sig) => [term1] -> [term2] -> Algorithm term1 term2 diff m [diff]
+byRWS as1 as2 = send (RWS as1 as2 ret)
 
 -- | Delete a term.
-byDeleting :: term1 -> Algorithm term1 term2 result result
-byDeleting a1 = Delete a1 `Then` return
+byDeleting :: (Carrier sig m, Member (Diff term1 term2 diff) sig) => term1 -> Algorithm term1 term2 diff m diff
+byDeleting a1 = sendDiff (Delete a1 ret)
 
 -- | Insert a term.
-byInserting :: term2 -> Algorithm term1 term2 result result
-byInserting a2 = Insert a2 `Then` return
+byInserting :: (Carrier sig m, Member (Diff term1 term2 diff) sig) => term2 -> Algorithm term1 term2 diff m diff
+byInserting a2 = sendDiff (Insert a2 ret)
 
 -- | Replace one term with another.
-byReplacing :: term1 -> term2 -> Algorithm term1 term2 result result
-byReplacing a1 a2 = Replace a1 a2 `Then` return
+byReplacing :: (Carrier sig m, Member (Diff term1 term2 diff) sig) => term1 -> term2 -> Algorithm term1 term2 diff m diff
+byReplacing a1 a2 = send (Replace a1 a2 ret)
 
-
-instance (Show term1, Show term2) => Show1 (AlgorithmF term1 term2 result) where
-  liftShowsPrec sp _ d algorithm = case algorithm of
-    Diffing.Algorithm.Diff t1 t2 -> showsBinaryWith showsPrec showsPrec "Diff" d t1 t2
-    Linear t1 t2 -> showsBinaryWith showsPrec showsPrec "Linear" d t1 t2
-    RWS as bs -> showsBinaryWith (liftShowsPrec showsPrec showList) (liftShowsPrec showsPrec showList) "RWS" d as bs
-    Delete t1 -> showsUnaryWith showsPrec "Delete" d t1
-    Insert t2 -> showsUnaryWith showsPrec "Insert" d t2
-    Replace t1 t2 -> showsBinaryWith showsPrec showsPrec "Replace" d t1 t2
-    Empty -> showString "Empty"
-    Alt a b -> showsBinaryWith sp sp "Alt" d a b
-
-
-instance Alternative (Algorithm term1 term2 result) where
-  empty = Empty `Then` return
-
-  (Empty `Then` _) <|> a2               = a2
-  a1               <|> (Empty `Then` _) = a1
-  a1               <|> a2               = Alt a1 a2 `Then` id
+sendDiff :: (Carrier sig m, Member (Diff term1 term2 diff) sig) => Diff term1 term2 diff (Eff m) (Eff m a) -> Algorithm term1 term2 diff m a
+sendDiff = Algorithm . send
 
 
 -- | Diff two terms based on their 'Diffable' instances, performing substructural comparisons iff the initial comparison fails.
-algorithmForTerms :: Diffable syntax
+algorithmForTerms :: (Carrier sig m, Diffable syntax, Member (Diff (Term syntax ann1) (Term syntax ann2) (Diff.Diff syntax ann1 ann2)) sig, Member NonDet sig)
                   => Term syntax ann1
                   -> Term syntax ann2
-                  -> Algorithm (Term syntax ann1) (Term syntax ann2) (Diff syntax ann1 ann2) (Diff syntax ann1 ann2)
+                  -> Algorithm (Term syntax ann1) (Term syntax ann2) (Diff.Diff syntax ann1 ann2) m (Diff.Diff syntax ann1 ann2)
 algorithmForTerms t1@(Term (In ann1 f1)) t2@(Term (In ann2 f2))
   =   mergeFor t1 t2
-  <|> deleteF . In ann1      <$> subalgorithmFor byDeleting  (`mergeFor` t2) f1
-  <|> insertF . In      ann2 <$> subalgorithmFor byInserting (mergeFor t1) f2
-  where mergeFor (Term (In ann1 f1)) (Term (In ann2 f2)) = merge (ann1, ann2) <$> algorithmFor f1 f2
+  <|> Diff.deleteF . In ann1      <$> subalgorithmFor byDeleting  (`mergeFor` t2) f1
+  <|> Diff.insertF . In      ann2 <$> subalgorithmFor byInserting (mergeFor t1) f2
+  where mergeFor (Term (In ann1 f1)) (Term (In ann2 f2)) = Diff.merge (ann1, ann2) <$> algorithmFor f1 f2
 
 -- | An O(1) relation on terms indicating their non-recursive comparability (i.e. are they of the same “kind” in a way that warrants comparison), defined in terms of the comparability of their respective syntax.
 comparableTerms :: Diffable syntax
@@ -146,14 +142,15 @@ instance Alternative Equivalence where
 -- | A type class for determining what algorithm to use for diffing two terms.
 class Diffable f where
   -- | Construct an algorithm to diff a pair of @f@s populated with disjoint terms.
-  algorithmFor :: f term1
+  algorithmFor :: (Carrier sig m, Member (Diff term1 term2 diff) sig, Member NonDet sig)
+               => f term1
                -> f term2
-               -> Algorithm term1 term2 result (f result)
+               -> Algorithm term1 term2 diff m (f diff)
   default
-    algorithmFor :: (Generic1 f, GDiffable (Rep1 f))
+    algorithmFor :: (Carrier sig m, Generic1 f, GDiffable (Rep1 f), Member (Diff term1 term2 diff) sig, Member NonDet sig)
                  => f term1
                  -> f term2
-                 -> Algorithm term1 term2 result (f result)
+                 -> Algorithm term1 term2 diff m (f diff)
   algorithmFor = genericAlgorithmFor
 
   tryAlignWith :: Alternative g => (These a1 a2 -> g b) -> f a1 -> f a2 -> g (f b)
@@ -170,7 +167,7 @@ class Diffable f where
   --   These two functions allow us to say e.g. that comparisons against 'Data.Syntax.Context' should also be made against its subject, but not against any of the comments, resulting in the insertion of both comments and context when documenting an existing function.
   --
   --   By default, 'subalgorithmFor' produces 'empty', rejecting substructural comparisons. This is important for performance, as alternations with 'empty' are eliminated at construction time.
-  -- ^ The 'Alternative' instance will in general be 'Algorithm', but left opaque to make it harder to shoot oneself in the foot.
+  -- ^ The 'Alternative' instance will in general be 'Diff', but left opaque to make it harder to shoot oneself in the foot.
   subalgorithmFor :: Alternative g
                   => (a -> g b)    -- ^ A “blur” function to traverse positions which should not be diffed against.
                   -> (a -> g b)    -- ^ A “focus” function to traverse positions which should be diffed against.
@@ -193,10 +190,10 @@ class Diffable f where
   default comparableTo :: (Generic1 f, GDiffable (Rep1 f)) => f term1 -> f term2 -> Bool
   comparableTo = genericComparableTo
 
-genericAlgorithmFor :: (Generic1 f, GDiffable (Rep1 f))
+genericAlgorithmFor :: (Carrier sig m, Generic1 f, GDiffable (Rep1 f), Member (Diff term1 term2 diff) sig, Member NonDet sig)
                     => f term1
                     -> f term2
-                    -> Algorithm term1 term2 result (f result)
+                    -> Algorithm term1 term2 diff m (f diff)
 genericAlgorithmFor a1 a2 = to1 <$> galgorithmFor (from1 a1) (from1 a2)
 
 genericComparableTo :: (Generic1 f, GDiffable (Rep1 f)) => f term1 -> f term2 -> Bool
@@ -241,7 +238,7 @@ instance Diffable NonEmpty where
 
 -- | A generic type class for diffing two terms defined by the Generic1 interface.
 class GDiffable f where
-  galgorithmFor :: f term1 -> f term2 -> Algorithm term1 term2 result (f result)
+  galgorithmFor :: (Carrier sig m, Member (Diff term1 term2 diff) sig, Member NonDet sig) => f term1 -> f term2 -> Algorithm term1 term2 diff m (f diff)
 
   gtryAlignWith :: Alternative g => (These a1 a2 -> g b) -> f a1 -> f a2 -> g (f b)
 

src/Diffing/Interpreter.hs

@@ -1,12 +1,15 @@
-{-# LANGUAGE GADTs, RankNTypes, TypeOperators #-}
+{-# LANGUAGE LambdaCase, TypeOperators, UndecidableInstances #-}
 module Diffing.Interpreter
 ( diffTerms
 , diffTermPair
 , stripDiff
 ) where
 
-import Control.Monad.Free.Freer
-import Data.Diff
+import Control.Effect
+import Control.Effect.Carrier
+import Control.Effect.NonDet
+import Control.Effect.Sum
+import qualified Data.Diff as Diff
 import Data.Term
 import Diffing.Algorithm
 import Diffing.Algorithm.RWS
@@ -16,36 +19,52 @@ import Prologue
 diffTerms :: (Diffable syntax, Eq1 syntax, Hashable1 syntax, Traversable syntax)
           => Term syntax ann
           -> Term syntax ann
-          -> Diff syntax ann ann
-diffTerms t1 t2 = stripDiff (fromMaybe (replacing t1' t2') (runAlgorithm (diff t1' t2')))
+          -> Diff.Diff syntax ann ann
+diffTerms t1 t2 = stripDiff (fromMaybe (Diff.replacing t1' t2') (run (runNonDetOnce (runDiff (algorithmForTerms t1' t2')))))
   where (t1', t2') = ( defaultFeatureVectorDecorator t1
                      , defaultFeatureVectorDecorator t2)
 
 -- | Strips the head annotation off a diff annotated with non-empty records.
 stripDiff :: Functor syntax
-          => Diff syntax (FeatureVector, ann) (FeatureVector, ann)
-          -> Diff syntax ann ann
+          => Diff.Diff syntax (FeatureVector, ann) (FeatureVector, ann)
+          -> Diff.Diff syntax ann ann
 stripDiff = bimap snd snd
 
 -- | Diff a 'These' of terms.
-diffTermPair :: (Diffable syntax, Eq1 syntax, Hashable1 syntax, Traversable syntax) => These (Term syntax ann) (Term syntax ann) -> Diff syntax ann ann
-diffTermPair = these deleting inserting diffTerms
+diffTermPair :: (Diffable syntax, Eq1 syntax, Hashable1 syntax, Traversable syntax) => These (Term syntax ann) (Term syntax ann) -> Diff.Diff syntax ann ann
+diffTermPair = these Diff.deleting Diff.inserting diffTerms
 
 
 -- | Run an 'Algorithm' to completion in an 'Alternative' context using the supplied comparability & equivalence relations.
-runAlgorithm :: (Diffable syntax, Eq1 syntax, Traversable syntax, Alternative m, Monad m)
-             => Algorithm
-                  (Term syntax (FeatureVector, ann))
-                  (Term syntax (FeatureVector, ann))
-                  (Diff syntax (FeatureVector, ann) (FeatureVector, ann))
-                  result
-             -> m result
-runAlgorithm = iterFreerA (\ yield step -> case step of
-  Diffing.Algorithm.Diff t1 t2 -> runAlgorithm (algorithmForTerms t1 t2) <|> pure (replacing t1 t2) >>= yield
-  Linear (Term (In ann1 f1)) (Term (In ann2 f2)) -> merge (ann1, ann2) <$> tryAlignWith (runAlgorithm . diffThese) f1 f2 >>= yield
-  RWS as bs -> traverse (runAlgorithm . diffThese) (rws comparableTerms equivalentTerms as bs) >>= yield
-  Delete a -> yield (deleting a)
-  Insert b -> yield (inserting b)
-  Replace a b -> yield (replacing a b)
-  Empty -> empty
-  Alt a b -> yield a <|> yield b)
+runDiff :: (Alternative m, Carrier sig m, Diffable syntax, Eq1 syntax, Member NonDet sig, Monad m, Traversable syntax)
+        => Algorithm
+             (Term syntax (FeatureVector, ann))
+             (Term syntax (FeatureVector, ann))
+             (Diff.Diff syntax (FeatureVector, ann) (FeatureVector, ann))
+             (DiffC (Term syntax (FeatureVector, ann)) (Term syntax (FeatureVector, ann)) (Diff.Diff syntax (FeatureVector, ann) (FeatureVector, ann)) m)
+             result
+        -> m result
+runDiff = runDiffC . interpret . runAlgorithm
+
+
+newtype DiffC term1 term2 diff m a = DiffC { runDiffC :: m a }
+
+instance ( Alternative m
+         , Carrier sig m
+         , Diffable syntax
+         , Eq1 syntax
+         , Member NonDet sig
+         , Monad m
+         , Traversable syntax
+         )
+      => Carrier
+        (Diff (Term syntax (FeatureVector, ann)) (Term syntax (FeatureVector, ann)) (Diff.Diff syntax (FeatureVector, ann) (FeatureVector, ann)) :+: sig)
+        (DiffC (Term syntax (FeatureVector, ann)) (Term syntax (FeatureVector, ann)) (Diff.Diff syntax (FeatureVector, ann) (FeatureVector, ann)) m) where
+  ret = DiffC . ret
+  eff = DiffC . handleSum (eff . handleCoercible) (\case
+    Diff t1 t2 k -> runDiff (algorithmForTerms t1 t2) <|> pure (Diff.replacing t1 t2) >>= runDiffC . k
+    Linear (Term (In ann1 f1)) (Term (In ann2 f2)) k -> Diff.merge (ann1, ann2) <$> tryAlignWith (runDiff . diffThese) f1 f2 >>= runDiffC . k
+    RWS as bs k -> traverse (runDiff . diffThese) (rws comparableTerms equivalentTerms as bs) >>= runDiffC . k
+    Delete a k -> runDiffC (k (Diff.deleting a))
+    Insert b k -> runDiffC (k (Diff.inserting b))
+    Replace a b k -> runDiffC (k (Diff.replacing a b)))

src/Prologue.hs

@@ -12,6 +12,7 @@ import Control.DeepSeq as X
 import Data.Bifunctor.Join as X
 import Data.Bits as X
 import Data.ByteString as X (ByteString)
+import Data.Coerce as X
 import Data.Functor.Both as X (Both, both, runBothWith)
 import Data.IntMap as X (IntMap)
 import Data.IntSet as X (IntSet)

src/Semantic/AST.hs

@@ -7,14 +7,18 @@ module Semantic.AST
   , runASTParse
   ) where
 
-import Control.Effect
-import Control.Monad
-import Data.AST
-import Data.Blob
-import Parsing.Parser
 import Prologue
-import Rendering.JSON (renderJSONAST)
-import Semantic.Task
+
+import Data.ByteString.Builder
+import Data.List (intersperse)
+
+import           Control.Effect
+import           Control.Effect.Error
+import           Data.AST
+import           Data.Blob
+import           Parsing.Parser
+import           Rendering.JSON (renderJSONAST)
+import           Semantic.Task
 import qualified Serializing.Format as F
 
 data SomeAST where
@@ -29,10 +33,17 @@ astParseBlob blob@Blob{..}
   | otherwise = noLanguageForBlob blobPath
 
 
-data ASTFormat = SExpression | JSON | Show
+data ASTFormat = SExpression | JSON | Show | Quiet
   deriving (Show)
 
-runASTParse :: (Member Distribute sig, Member (Error SomeException) sig, Member Task sig, Carrier sig m, Monad m) => ASTFormat -> [Blob] -> m F.Builder
+runASTParse :: (Member Distribute sig, Member (Error SomeException) sig, Member Task sig, Carrier sig m, MonadIO m) => ASTFormat -> [Blob] -> m F.Builder
 runASTParse SExpression = distributeFoldMap (astParseBlob >=> withSomeAST (serialize (F.SExpression F.ByShow)))
 runASTParse Show        = distributeFoldMap (astParseBlob >=> withSomeAST (serialize F.Show . fmap nodeSymbol))
 runASTParse JSON        = distributeFoldMap (\ blob -> astParseBlob blob >>= withSomeAST (render (renderJSONAST blob))) >=> serialize F.JSON
+runASTParse Quiet       = distributeFoldMap $ \blob -> do
+  result <- time' ((Right <$> astParseBlob blob) `catchError` (pure . Left @SomeException))
+  pure . mconcat . intersperse "\t" $ [ either (const "ERR") (const "OK") (fst result)
+                                      , stringUtf8 (show (blobLanguage blob))
+                                      , stringUtf8 (blobPath blob)
+                                      , doubleDec (snd result) <> " ms\n"
+                                      ]

src/Semantic/CLI.hs

@@ -89,7 +89,7 @@ parseCommand = command "parse" (info parseArgumentsParser (progDesc "Generate pa
                   <|> pure defaultSymbolFields)
               <|> flag'                                          (Parse.runParse DOTTermRenderer)         (long "dot"          <> help "Output DOT graph parse trees")
               <|> flag'                                          (Parse.runParse ShowTermRenderer)        (long "show"         <> help "Output using the Show instance (debug only, format subject to change without notice)")
-              <|> flag'                                          (Parse.runParse QuietTermRenderer)        (long "quiet"        <> help "Don't produce output, but show timing stats")
+              <|> flag'                                          (Parse.runParse QuietTermRenderer)       (long "quiet"        <> help "Don't produce output, but show timing stats")
       filesOrStdin <- Right <$> some (argument filePathReader (metavar "FILES...")) <|> pure (Left stdin)
       pure $ Task.readBlobs filesOrStdin >>= renderer
 
@@ -97,11 +97,12 @@ parseCommand = command "parse" (info parseArgumentsParser (progDesc "Generate pa
     symbolFieldsReader = eitherReader (Right . parseSymbolFields)
 
 tsParseCommand :: Mod CommandFields (Task.TaskEff Builder)
-tsParseCommand = command "ts-parse" (info tsParseArgumentsParser (progDesc "Print specialized tree-sitter ASTs for path(s)"))
+tsParseCommand = command "ts-parse" (info tsParseArgumentsParser (progDesc "Don't produce output, but show timing stats"))
   where
     tsParseArgumentsParser = do
       format <- flag  AST.SExpression AST.SExpression (long "sexpression" <> help "Output s-expression ASTs (default)")
             <|> flag'                 AST.JSON        (long "json"        <> help "Output JSON ASTs")
+            <|> flag'                 AST.Quiet       (long "quiet"       <> help "Don't produce output, but show timing stats")
             <|> flag'                 AST.Show        (long "show"        <> help "Output using the Show instance (debug only, format subject to change without notice)")
       filesOrStdin <- Right <$> some (argument filePathReader (metavar "FILES...")) <|> pure (Left stdin)
       pure $ Task.readBlobs filesOrStdin >>= AST.runASTParse format

test/Control/Abstract/Evaluator/Spec.hs

@@ -14,7 +14,6 @@ import Data.Abstract.Package
 import Data.Abstract.Value.Concrete as Value
 import Data.Algebra
 import Data.Bifunctor (first)
-import Data.Coerce
 import Data.Functor.Const
 import Data.Sum
 import SpecHelpers hiding (reassociate)

test/Rendering/TOC/Spec.hs

@@ -17,7 +17,7 @@ import Data.Sum
 import Data.Term
 import Data.Text (Text)
 import Data.Text.Encoding (encodeUtf8)
-import Diffing.Algorithm
+import Diffing.Algorithm hiding (Diff)
 import Diffing.Interpreter
 import Prelude
 import qualified Data.Syntax as Syntax

vendor/fused-effects

@@ -1 +1 @@
-Subproject commit 5f11d009d486b4e7e1741d0d031f8818818856ea
+Subproject commit 7421ffa4e2d05b961fb0347ddab5ebdef9e32f25