diff --git a/.licenses/semantic/cabal/fused-effects.txt b/.licenses/semantic/cabal/fused-effects.txt index f9130ee89..5980dcd33 100644 --- a/.licenses/semantic/cabal/fused-effects.txt +++ b/.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 diff --git a/semantic.cabal b/semantic.cabal index 54852df6e..65e9e7bb7 100644 --- a/semantic.cabal +++ b/semantic.cabal @@ -49,6 +49,7 @@ library , Control.Abstract.Value -- Effects , Control.Effect.Interpose + , Control.Effect.REPL -- Matching and rewriting DSLs , Control.Matching , Control.Rewriting @@ -331,12 +332,17 @@ test-suite test , Assigning.Assignment.Spec , Control.Abstract.Evaluator.Spec , Control.Rewriting.Spec + , Data.Abstract.Environment.Spec , Data.Abstract.Path.Spec + , Data.Abstract.Name.Spec , Data.Diff.Spec , Data.Functor.Classes.Generic.Spec , Data.Functor.Listable + , Data.Graph.Spec , Data.Mergeable + , Data.Range.Spec , Data.Scientific.Spec + , Data.Semigroup.App.Spec , Data.Source.Spec , Data.Term.Spec , Diffing.Algorithm.RWS.Spec @@ -428,15 +434,6 @@ test-suite parse-examples default-extensions: RecordWildCards , FlexibleContexts -test-suite doctests - type: exitcode-stdio-1.0 - hs-source-dirs: test - main-is: Doctests.hs - default-language: Haskell2010 - ghc-options: -dynamic -threaded -j - build-depends: base - , doctest - benchmark evaluation hs-source-dirs: bench/evaluation type: exitcode-stdio-1.0 diff --git a/src/Control/Abstract/Modules.hs b/src/Control/Abstract/Modules.hs index e1daa7e74..ad37e05be 100644 --- a/src/Control/Abstract/Modules.hs +++ b/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 diff --git a/src/Control/Abstract/Value.hs b/src/Control/Abstract/Value.hs index 61389ca80..0af3214b2 100644 --- a/src/Control/Abstract/Value.hs +++ b/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 diff --git a/src/Control/Effect/REPL.hs b/src/Control/Effect/REPL.hs new file mode 100644 index 000000000..25ab983e6 --- /dev/null +++ b/src/Control/Effect/REPL.hs @@ -0,0 +1,52 @@ +{-# LANGUAGE KindSignatures, LambdaCase, TypeOperators, UndecidableInstances #-} + +module Control.Effect.REPL + ( REPL (..) + , REPLC (..) + , prompt + , output + , runREPL + ) where + +import Prologue + +import Control.Effect +import Control.Effect.Carrier +import Control.Effect.Sum +import System.Console.Haskeline +import qualified Data.Text as T + +data REPL (m :: * -> *) k + = Prompt Text (Maybe Text -> k) + | Output Text k + deriving (Functor) + +instance HFunctor REPL where + hmap _ = coerce + +instance Effect REPL where + handle state handler (Prompt p k) = Prompt p (handler . (<$ state) . k) + handle state handler (Output s k) = Output s (handler (k <$ state)) + +prompt :: (Member REPL sig, Carrier sig m) => Text -> m (Maybe Text) +prompt p = send (Prompt p ret) + +output :: (Member REPL sig, Carrier sig m) => Text -> m () +output s = send (Output s (ret ())) + +runREPL :: (MonadIO m, Carrier sig m) => Prefs -> Settings IO -> Eff (REPLC m) a -> m a +runREPL prefs settings = flip runREPLC (prefs, settings) . interpret + +newtype REPLC m a = REPLC { runREPLC :: (Prefs, Settings IO) -> m a } + +instance (Carrier sig m, MonadIO m) => Carrier (REPL :+: sig) (REPLC m) where + ret = REPLC . const . ret + eff op = REPLC (\ args -> handleSum (eff . handleReader args runREPLC) (\case + Prompt p k -> liftIO (uncurry runInputTWithPrefs args (fmap (fmap T.pack) (getInputLine (cyan <> T.unpack p <> plain)))) >>= flip runREPLC args . k + Output s k -> liftIO (uncurry runInputTWithPrefs args (outputStrLn (T.unpack s))) *> runREPLC k args) op) + +cyan :: String +cyan = "\ESC[1;36m\STX" + +plain :: String +plain = "\ESC[0m\STX" diff --git a/src/Data/Abstract/Environment.hs b/src/Data/Abstract/Environment.hs index d0a9741d7..1e0ecfaf1 100644 --- a/src/Data/Abstract/Environment.hs +++ b/src/Data/Abstract/Environment.hs @@ -33,11 +33,6 @@ import qualified Data.Map as Map import Prelude hiding (head, lookup) import Prologue --- $setup --- >>> import Data.Abstract.Address.Precise --- >>> let bright = push (insertEnv (name "foo") (Precise 0) lowerBound) --- >>> let shadowed = insertEnv (name "foo") (Precise 1) bright - -- | A map of names to values. Represents a single scope level of an environment chain. newtype Bindings address = Bindings { unBindings :: Map.Map Name address } deriving stock (Eq, Ord, Generic) @@ -119,9 +114,6 @@ lookup :: Name -> Bindings address -> Maybe address lookup name = Map.lookup name . unBindings -- | Lookup a 'Name' in the environment. --- --- >>> lookupEnv' (name "foo") shadowed --- Just (Precise 1) lookupEnv' :: Name -> Environment address -> Maybe address lookupEnv' name = foldMapA (lookup name) . unEnvironment @@ -134,9 +126,6 @@ insertEnv :: Name -> address -> Environment address -> Environment address insertEnv name addr (Environment (Bindings a :| as)) = Environment (Bindings (Map.insert name addr a) :| as) -- | Remove a 'Name' from the environment. --- --- >>> delete (name "foo") shadowed --- Environment [] delete :: Name -> Environment address -> Environment address delete name = trim . Environment . fmap (Bindings . Map.delete name . unBindings) . unEnvironment diff --git a/src/Data/Abstract/Name.hs b/src/Data/Abstract/Name.hs index a17ebed6d..dc6cd96a0 100644 --- a/src/Data/Abstract/Name.hs +++ b/src/Data/Abstract/Name.hs @@ -48,17 +48,13 @@ nameI :: Int -> Name nameI = I -- | Extract a human-readable 'Text' from a 'Name'. +-- Sample outputs can be found in @Data.Abstract.Name.Spec@. formatName :: Name -> Text formatName (Name name) = name formatName (I i) = Text.pack $ '_' : (alphabet !! a) : replicate n 'ʹ' where alphabet = ['a'..'z'] (n, a) = i `divMod` length alphabet --- $ --- >>> I 0 --- "_a" --- >>> I 26 --- "_aʹ" instance Show Name where showsPrec _ = prettyShowString . Text.unpack . formatName where prettyShowString str = showChar '"' . foldr ((.) . prettyChar) id str . showChar '"' diff --git a/src/Data/Graph.hs b/src/Data/Graph.hs index 9bb53d220..e48ce0a95 100644 --- a/src/Data/Graph.hs +++ b/src/Data/Graph.hs @@ -34,28 +34,7 @@ simplify :: Ord vertex => Graph vertex -> Graph vertex simplify (Graph graph) = Graph (G.simplify graph) --- | Sort a graph’s vertices topologically. --- --- >>> topologicalSort (Class.path "ab") --- "ba" --- --- >>> topologicalSort (Class.path "abc") --- "cba" --- --- >>> topologicalSort ((vertex 'a' `connect` vertex 'b') `connect` vertex 'c') --- "cba" --- --- >>> topologicalSort (vertex 'a' `connect` (vertex 'b' `connect` vertex 'c')) --- "cba" --- --- >>> topologicalSort ((vertex 'a' `connect` vertex 'b') <> (vertex 'a' `connect` vertex 'c')) --- "cba" --- --- >>> topologicalSort (Class.path "abd" <> Class.path "acd") --- "dcba" --- --- >>> topologicalSort (Class.path "aba") --- "ab" +-- | Sort a graph’s vertices topologically. Specced in @Data.Graph.Spec@. topologicalSort :: forall v . Ord v => Graph v -> [v] topologicalSort = go . Class.toAdjacencyMap . G.transpose . unGraph where go :: A.AdjacencyMap v -> [v] diff --git a/src/Data/Range.hs b/src/Data/Range.hs index 3771ab699..7465c0130 100644 --- a/src/Data/Range.hs +++ b/src/Data/Range.hs @@ -40,13 +40,7 @@ subtractRange range1 range2 = Range (start range1) (end range1 - rangeLength (Ra -- Instances --- $setup --- >>> import Test.QuickCheck --- >>> instance Arbitrary Range where arbitrary = Range <$> arbitrary <*> arbitrary - --- $ --- Associativity: --- prop> \ a b c -> a <> (b <> c) == (a <> b) <> (c :: Range) +-- | The associativity of this instance is specced in @Data.Range.Spec@. instance Semigroup Range where Range start1 end1 <> Range start2 end2 = Range (min start1 start2) (max end1 end2) diff --git a/src/Data/Semigroup/App.hs b/src/Data/Semigroup/App.hs index c11ff1a08..54455a986 100644 --- a/src/Data/Semigroup/App.hs +++ b/src/Data/Semigroup/App.hs @@ -6,33 +6,20 @@ module Data.Semigroup.App import Control.Applicative --- $setup --- >>> import Test.QuickCheck --- >>> instance Arbitrary (f a) => Arbitrary (App f a) where arbitrary = App <$> arbitrary ; shrink = map App . shrink . runApp --- >>> instance Arbitrary (f a) => Arbitrary (AppMerge f a) where arbitrary = AppMerge <$> arbitrary ; shrink = map AppMerge . shrink . runAppMerge - -- | 'Semigroup' under '*>'. newtype App f a = App { runApp :: f a } deriving (Alternative, Applicative, Bounded, Enum, Eq, Foldable, Functor, Monad, Ord, Show, Traversable) --- $ Associativity: --- prop> \ a b c -> a <> (b <> c) == (a <> b) <> (c :: App Maybe Integer) instance Applicative f => Semigroup (App f a) where App a <> App b = App (a *> b) - -- | 'Semigroup' and 'Monoid' under '<*>' and '<>'. newtype AppMerge f a = AppMerge { runAppMerge :: f a } deriving (Alternative, Applicative, Bounded, Enum, Eq, Foldable, Functor, Monad, Ord, Show, Traversable) --- $ Associativity: --- prop> \ a b c -> a <> (b <> c) == (a <> b) <> (c :: AppMerge Maybe String) instance (Applicative f, Semigroup a) => Semigroup (AppMerge f a) where AppMerge a <> AppMerge b = AppMerge ((<>) <$> a <*> b) --- $ Identity: --- prop> \ a -> mempty <> a == (a :: AppMerge Maybe String) --- prop> \ a -> a <> mempty == (a :: AppMerge Maybe String) instance (Applicative f, Monoid a, Semigroup a) => Monoid (AppMerge f a) where mempty = AppMerge (pure mempty) mappend = (<>) diff --git a/src/Data/Syntax.hs b/src/Data/Syntax.hs index 436b213cc..4c6047687 100644 --- a/src/Data/Syntax.hs +++ b/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) diff --git a/src/Diffing/Algorithm.hs b/src/Diffing/Algorithm.hs index 4497567c0..f7012ea66 100644 --- a/src/Diffing/Algorithm.hs +++ b/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) diff --git a/src/Diffing/Interpreter.hs b/src/Diffing/Interpreter.hs index e071273a2..4bf13612f 100644 --- a/src/Diffing/Interpreter.hs +++ 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))) diff --git a/src/Prologue.hs b/src/Prologue.hs index 4f37a9185..ee174bfeb 100644 --- a/src/Prologue.hs +++ 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) diff --git a/src/Semantic/CLI.hs b/src/Semantic/CLI.hs index 730c8b32f..b82e1f600 100644 --- a/src/Semantic/CLI.hs +++ b/src/Semantic/CLI.hs @@ -6,6 +6,7 @@ module Semantic.CLI , Parse.runParse ) where +import Control.Exception as Exc (displayException) import Data.File import Data.Language (ensureLanguage, languageForFilePath) import Data.List (intercalate, uncons) @@ -24,12 +25,17 @@ import qualified Semantic.Task as Task import Semantic.Task.Files import qualified Semantic.Telemetry.Log as Log import Semantic.Version +import System.Exit (die) import System.FilePath import Serializing.Format hiding (Options) import Text.Read main :: IO () -main = customExecParser (prefs showHelpOnEmpty) arguments >>= uncurry Task.runTaskWithOptions +main = do + (options, task) <- customExecParser (prefs showHelpOnEmpty) arguments + res <- Task.withOptions options $ \ config logger statter -> + Task.runTaskWithConfig config { configSHA = Just buildSHA } logger statter task + either (die . displayException) pure res -- | A parser for the application's command-line arguments. -- diff --git a/src/Semantic/Config.hs b/src/Semantic/Config.hs index 257f2807f..75523aa94 100644 --- a/src/Semantic/Config.hs +++ b/src/Semantic/Config.hs @@ -23,7 +23,6 @@ import Semantic.Env import Semantic.Telemetry import qualified Semantic.Telemetry.Haystack as Haystack import qualified Semantic.Telemetry.Stat as Stat -import Semantic.Version import System.Environment import System.IO (hIsTerminalDevice, stdout) import System.Posix.Process @@ -44,6 +43,7 @@ data Config , configIsTerminal :: Bool -- ^ Whether a terminal is attached (set automaticaly at runtime). , configLogPrintSource :: Bool -- ^ Whether to print the source reference when logging errors (set automatically at runtime). , configLogFormatter :: LogFormatter -- ^ Log formatter to use (set automaticaly at runtime). + , configSHA :: Maybe String -- ^ Optional SHA to include in log messages. , configOptions :: Options -- ^ Options configurable via command line arguments. } @@ -88,6 +88,7 @@ defaultConfig options@Options{..} = do , configIsTerminal = isTerminal , configLogPrintSource = isTerminal , configLogFormatter = if isTerminal then terminalFormatter else logfmtFormatter + , configSHA = Nothing , configOptions = options } @@ -109,8 +110,9 @@ logOptionsFromConfig Config{..} = LogOptions False -> [ ("app", configAppName) , ("pid", show configProcessID) , ("hostname", configHostName) - , ("sha", buildSHA) - ] <> [("request_id", x) | x <- toList (optionsRequestID configOptions) ] + , ("sha", fromMaybe "development" configSHA) + ] + <> [("request_id", x) | x <- toList (optionsRequestID configOptions) ] _ -> [] diff --git a/src/Semantic/REPL.hs b/src/Semantic/REPL.hs index 3934a15e0..e8db23577 100644 --- a/src/Semantic/REPL.hs +++ b/src/Semantic/REPL.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE GADTs, KindSignatures, LambdaCase, TypeOperators, UndecidableInstances #-} +{-# LANGUAGE GADTs, LambdaCase, TypeOperators, UndecidableInstances #-} {-# OPTIONS_GHC -Wno-missing-signatures #-} module Semantic.REPL ( rubyREPL @@ -8,6 +8,7 @@ import Control.Abstract hiding (Continue, List, string) import Control.Effect.Carrier import Control.Effect.Resource import Control.Effect.Sum +import Control.Effect.REPL import Data.Abstract.Address.Precise as Precise import Data.Abstract.Environment as Env import Data.Abstract.Evaluatable hiding (string) @@ -16,7 +17,6 @@ import Data.Abstract.ModuleTable as ModuleTable import Data.Abstract.Package import Data.Abstract.Value.Concrete as Concrete import Data.Blob (Blob(..)) -import Data.Coerce import Data.Error (showExcerpt) import Data.File (File (..), readBlobFromFile) import Data.Graph (topologicalSort) @@ -25,6 +25,7 @@ import Data.List (uncons) import Data.Project import Data.Quieterm import Data.Span +import qualified Data.Text as T import qualified Data.Time.Clock.POSIX as Time (getCurrentTime) import qualified Data.Time.LocalTime as LocalTime import Numeric (readDec) @@ -45,43 +46,11 @@ import System.Console.Haskeline import System.Directory (createDirectoryIfMissing, getHomeDirectory) import System.FilePath -data REPL (m :: * -> *) k - = Prompt (Maybe String -> k) - | Output String k - deriving (Functor) - -prompt :: (Member REPL sig, Carrier sig m) => m (Maybe String) -prompt = send (Prompt ret) - -output :: (Member REPL sig, Carrier sig m) => String -> m () -output s = send (Output s (ret ())) - - data Quit = Quit deriving Show instance Exception Quit - -instance HFunctor REPL where - hmap _ = coerce - -instance Effect REPL where - handle state handler (Prompt k) = Prompt (handler . (<$ state) . k) - handle state handler (Output s k) = Output s (handler (k <$ state)) - - -runREPL :: (MonadIO m, Carrier sig m) => Prefs -> Settings IO -> Eff (REPLC m) a -> m a -runREPL prefs settings = flip runREPLC (prefs, settings) . interpret - -newtype REPLC m a = REPLC { runREPLC :: (Prefs, Settings IO) -> m a } - -instance (Carrier sig m, MonadIO m) => Carrier (REPL :+: sig) (REPLC m) where - ret = REPLC . const . ret - eff op = REPLC (\ args -> handleSum (eff . handleReader args runREPLC) (\case - Prompt k -> liftIO (uncurry runInputTWithPrefs args (getInputLine (cyan <> "repl: " <> plain))) >>= flip runREPLC args . k - Output s k -> liftIO (uncurry runInputTWithPrefs args (outputStrLn s)) *> runREPLC k args) op) - rubyREPL = repl (Proxy @'Language.Ruby) rubyParser repl proxy parser paths = defaultConfig debugOptions >>= \ config -> runM . runDistribute . runResource (runM . runDistribute) . runTimeout (runM . runDistribute . runResource (runM . runDistribute)) . runError @_ @_ @SomeException . runTelemetryIgnoringStat (logOptionsFromConfig config) . runTraceInTelemetry . runReader config . Files.runFiles . runResolution . runTaskF $ do @@ -162,7 +131,7 @@ step blobs recur0 recur term = do where list = do path <- asks modulePath span <- ask - maybe (pure ()) (\ blob -> output (showExcerpt True span blob "")) (Prelude.lookup path blobs) + maybe (pure ()) (\ blob -> output (T.pack (showExcerpt True span blob ""))) (Prelude.lookup path blobs) help = do output "Commands available from the prompt:" output "" @@ -174,12 +143,12 @@ step blobs recur0 recur term = do output " :quit, :q, :abandon abandon the current evaluation and exit the repl" showBindings = do bindings <- Env.head <$> getEnv - output $ unlines (uncurry showBinding <$> Env.pairs bindings) + output . T.pack $ unlines (uncurry showBinding <$> Env.pairs bindings) showBinding name addr = show name <> " = " <> show addr runCommand run [":step"] = local (const Step) run runCommand run [":continue"] = local (const Continue) run runCommand run [":break", s] - | [(i, "")] <- readDec s = modify (OnLine i :) >> runCommands run + | [(i, "")] <- readDec (T.unpack s) = modify (OnLine i :) >> runCommands run -- TODO: :show breakpoints -- TODO: :delete breakpoints runCommand run [":list"] = list >> runCommands run @@ -190,10 +159,10 @@ step blobs recur0 recur term = do runCommand run [":help"] = help >> runCommands run runCommand run [":?"] = help >> runCommands run runCommand run [] = runCommands run - runCommand run other = output ("unknown command '" <> unwords other <> "'") >> output "use :? for help" >> runCommands run + runCommand run other = output ("unknown command '" <> T.unwords other <> "'") >> output "use :? for help" >> runCommands run runCommands run = do - str <- prompt - maybe (runCommands run) (runCommand run . words) str + str <- prompt "repl: " + maybe (runCommands run) (runCommand run . T.words) str newtype Breakpoint @@ -224,10 +193,3 @@ shouldBreak = do | n >= posLine spanStart , n <= posLine spanEnd = True | otherwise = False - - -cyan :: String -cyan = "\ESC[1;36m\STX" - -plain :: String -plain = "\ESC[0m\STX" diff --git a/test/Control/Abstract/Evaluator/Spec.hs b/test/Control/Abstract/Evaluator/Spec.hs index 6267f3086..fa1b5b027 100644 --- a/test/Control/Abstract/Evaluator/Spec.hs +++ b/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) diff --git a/test/Data/Abstract/Environment/Spec.hs b/test/Data/Abstract/Environment/Spec.hs new file mode 100644 index 000000000..cb1345ef9 --- /dev/null +++ b/test/Data/Abstract/Environment/Spec.hs @@ -0,0 +1,21 @@ +module Data.Abstract.Environment.Spec where + +import Prelude hiding (head) +import SpecHelpers + +import Data.Abstract.Environment +import Data.Abstract.Address.Precise + +spec :: Spec +spec = describe "Environment" $ do + let bright = push (insertEnv (name "foo") (Precise 0) lowerBound) + let shadowed = insertEnv (name "foo") (Precise 1) bright + + it "can extract bindings" $ + pairs (head shadowed) `shouldBe` [("foo", Precise 1)] + + it "should extract the outermost binding given shadowing" $ + lookupEnv' (name "foo") shadowed `shouldBe` Just (Precise 1) + + it "can delete bindings" $ + delete (name "foo") shadowed `shouldBe` Environment (pure lowerBound) diff --git a/test/Data/Abstract/Name/Spec.hs b/test/Data/Abstract/Name/Spec.hs new file mode 100644 index 000000000..ab65902ff --- /dev/null +++ b/test/Data/Abstract/Name/Spec.hs @@ -0,0 +1,11 @@ +module Data.Abstract.Name.Spec where + +import SpecHelpers + +import Data.Abstract.Name + +spec :: Spec +spec = describe "Data.Abstract.Name" $ + it "should format anonymous names correctly" $ do + show (nameI 0) `shouldBe` "\"_a\"" + show (nameI 26) `shouldBe` "\"_aʹ\"" diff --git a/test/Data/Functor/Listable.hs b/test/Data/Functor/Listable.hs index 724a72f17..1076eb393 100644 --- a/test/Data/Functor/Listable.hs +++ b/test/Data/Functor/Listable.hs @@ -31,6 +31,7 @@ import Data.Patch import Data.Range import Data.Location import Data.Semigroup (Semigroup(..)) +import Data.Semigroup.App import Data.Source import Data.Blob import Data.Span @@ -527,6 +528,12 @@ instance Listable Language.Language where \/ cons0 Language.Ruby \/ cons0 Language.TypeScript +instance Listable (f a) => Listable (App f a) where + tiers = cons1 App + +instance Listable (f a) => Listable (AppMerge f a) where + tiers = cons1 AppMerge + instance Listable Location where tiers = cons2 Location diff --git a/test/Data/Graph/Spec.hs b/test/Data/Graph/Spec.hs new file mode 100644 index 000000000..47a749616 --- /dev/null +++ b/test/Data/Graph/Spec.hs @@ -0,0 +1,20 @@ +{-# LANGUAGE PackageImports #-} + +module Data.Graph.Spec where + +import SpecHelpers + +import "semantic" Data.Graph +import qualified Algebra.Graph.Class as Class + +spec :: Spec +spec = describe "Data.Graph" $ + it "has a valid topological sort" $ do + let topo = topologicalSort + topo (Class.path "ab") `shouldBe` "ba" + topo (Class.path "abc") `shouldBe` "cba" + topo ((vertex 'a' `connect` vertex 'b') `connect` vertex 'c') `shouldBe` "cba" + topo (vertex 'a' `connect` (vertex 'b' `connect` vertex 'c')) `shouldBe` "cba" + topo ((vertex 'a' `connect` vertex 'b') <> (vertex 'a' `connect` vertex 'c')) `shouldBe` "cba" + topo (Class.path "abd" <> Class.path "acd") `shouldBe` "dcba" + topo (Class.path "aba") `shouldBe` "ab" diff --git a/test/Data/Range/Spec.hs b/test/Data/Range/Spec.hs new file mode 100644 index 000000000..b6c4e2af2 --- /dev/null +++ b/test/Data/Range/Spec.hs @@ -0,0 +1,11 @@ +{-# LANGUAGE ScopedTypeVariables #-} + +module Data.Range.Spec where + +import Data.Range +import SpecHelpers + +spec :: Spec +spec = describe "Data.Range" $ + prop "should have an associative Semigroup instance" $ + \(a, b, c) -> a <> (b <> c) `shouldBe` (a <> b) <> (c :: Range) diff --git a/test/Data/Semigroup/App/Spec.hs b/test/Data/Semigroup/App/Spec.hs new file mode 100644 index 000000000..e3acf4bc1 --- /dev/null +++ b/test/Data/Semigroup/App/Spec.hs @@ -0,0 +1,20 @@ +module Data.Semigroup.App.Spec where + +import SpecHelpers +import Data.Semigroup.App + +spec :: Spec +spec = do + describe "App" $ + prop "should be associative" $ + \a b c -> a <> (b <> c) == (a <> b) <> (c :: App Maybe Integer) + + describe "AppMerge" $ do + prop "should be associative" $ + \ a b c -> a <> (b <> c) == (a <> b) <> (c :: AppMerge Maybe String) + + prop "identity/left" $ + \ a -> mempty <> a == (a :: AppMerge Maybe String) + + prop "identity/right" $ + \ a -> a <> mempty == (a :: AppMerge Maybe String) diff --git a/test/Doctests.hs b/test/Doctests.hs deleted file mode 100644 index 22218bc8e..000000000 --- a/test/Doctests.hs +++ /dev/null @@ -1,37 +0,0 @@ -module Main -( main -) where - -import System.Environment -import Test.DocTest - -defaultFiles = - [ "src/Data/Abstract/Address/Precise.hs" - , "src/Data/Abstract/Environment.hs" - , "src/Data/Abstract/Name.hs" - , "src/Data/Graph.hs" - , "src/Data/Range.hs" - , "src/Data/Semigroup/App.hs" - ] - -main :: IO () -main = do - args <- getArgs - doctest (map ("-X" ++) extensions ++ "-isrc" : "--fast" : if null args then defaultFiles else args) - -extensions :: [String] -extensions = - [ "DataKinds" - , "DeriveFoldable" - , "DeriveFunctor" - , "DeriveGeneric" - , "DeriveTraversable" - , "FlexibleContexts" - , "FlexibleInstances" - , "MultiParamTypeClasses" - , "OverloadedStrings" - , "RecordWildCards" - , "StandaloneDeriving" - , "StrictData" - , "TypeApplications" - ] diff --git a/test/Graphing/Calls/Spec.hs b/test/Graphing/Calls/Spec.hs index 89890be84..36b7bfa62 100644 --- a/test/Graphing/Calls/Spec.hs +++ b/test/Graphing/Calls/Spec.hs @@ -18,7 +18,7 @@ import Semantic.Config (defaultOptions) import Semantic.Graph import Semantic.IO -callGraphPythonProject paths = runTaskWithOptions defaultOptions $ do +callGraphPythonProject paths = runTask $ do let proxy = Proxy @'Language.Python let lang = Language.Python blobs <- catMaybes <$> traverse readBlobFromFile (flip File lang <$> paths) diff --git a/test/Rendering/TOC/Spec.hs b/test/Rendering/TOC/Spec.hs index 237f6a6ae..d6669f667 100644 --- a/test/Rendering/TOC/Spec.hs +++ b/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 diff --git a/test/Spec.hs b/test/Spec.hs index 77394d5a8..844621665 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -9,9 +9,14 @@ import qualified Assigning.Assignment.Spec import qualified Control.Abstract.Evaluator.Spec import qualified Control.Rewriting.Spec import qualified Data.Diff.Spec +import qualified Data.Abstract.Environment.Spec +import qualified Data.Abstract.Name.Spec import qualified Data.Abstract.Path.Spec import qualified Data.Functor.Classes.Generic.Spec +import qualified Data.Graph.Spec +import qualified Data.Range.Spec import qualified Data.Scientific.Spec +import qualified Data.Semigroup.App.Spec import qualified Data.Source.Spec import qualified Data.Term.Spec import qualified Diffing.Algorithm.RWS.Spec @@ -48,9 +53,14 @@ main = do describe "Control.Abstract.Evaluator" Control.Abstract.Evaluator.Spec.spec describe "Control.Rewriting.Spec" Control.Rewriting.Spec.spec describe "Data.Diff" Data.Diff.Spec.spec + describe "Data.Graph" Data.Graph.Spec.spec + describe "Data.Abstract.Environment.Spec" Data.Abstract.Environment.Spec.spec describe "Data.Abstract.Path" Data.Abstract.Path.Spec.spec + describe "Data.Abstract.Name" Data.Abstract.Name.Spec.spec describe "Data.Functor.Classes.Generic" Data.Functor.Classes.Generic.Spec.spec + describe "Data.Range" Data.Range.Spec.spec describe "Data.Scientific" Data.Scientific.Spec.spec + describe "Data.Semigroup.App" Data.Semigroup.App.Spec.spec describe "Data.Source" Data.Source.Spec.spec describe "Data.Term" Data.Term.Spec.spec describe "Diffing.Algorithm.RWS" Diffing.Algorithm.RWS.Spec.spec diff --git a/vendor/fused-effects b/vendor/fused-effects index 5f11d009d..7421ffa4e 160000 --- a/vendor/fused-effects +++ b/vendor/fused-effects @@ -1 +1 @@ -Subproject commit 5f11d009d486b4e7e1741d0d031f8818818856ea +Subproject commit 7421ffa4e2d05b961fb0347ddab5ebdef9e32f25