diff --git a/.gitmodules b/.gitmodules index 4d87b13d8..0df34351a 100644 --- a/.gitmodules +++ b/.gitmodules @@ -13,18 +13,9 @@ [submodule "vendor/effects"] path = vendor/effects url = https://github.com/joshvera/effects.git -[submodule "languages/c/vendor/tree-sitter-c"] - path = languages/c/vendor/tree-sitter-c - url = https://github.com/tree-sitter/tree-sitter-c.git -[submodule "languages/javascript/vendor/tree-sitter-javascript"] - path = languages/javascript/vendor/tree-sitter-javascript - url = https://github.com/tree-sitter/tree-sitter-javascript.git [submodule "vendor/haskell-tree-sitter"] path = vendor/haskell-tree-sitter url = https://github.com/tree-sitter/haskell-tree-sitter.git [submodule "vendor/freer-cofreer"] path = vendor/freer-cofreer url = https://github.com/robrix/freer-cofreer.git -[submodule "vendor/ghc-mod"] - path = vendor/ghc-mod - url = https://github.com/joshvera/ghc-mod diff --git a/.stylish-haskell.yaml b/.stylish-haskell.yaml index c924bf512..a18a1954b 100644 --- a/.stylish-haskell.yaml +++ b/.stylish-haskell.yaml @@ -225,6 +225,8 @@ language_extensions: - FlexibleContexts - FlexibleInstances - MultiParamTypeClasses + - StandaloneDeriving + - DataKinds - OverloadedStrings - RecordWildCards - StrictData diff --git a/semantic.cabal b/semantic.cabal index e9ceff6e0..4f40a06d7 100644 --- a/semantic.cabal +++ b/semantic.cabal @@ -182,14 +182,17 @@ library , tree-sitter-ruby , tree-sitter-typescript default-language: Haskell2010 - default-extensions: DeriveFoldable + default-extensions: DataKinds + , DeriveFoldable , DeriveFunctor , DeriveGeneric , DeriveTraversable , FlexibleContexts , FlexibleInstances + , MultiParamTypeClasses , OverloadedStrings , RecordWildCards + , StandaloneDeriving , StrictData ghc-options: -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints -fno-warn-name-shadowing -O -j ghc-prof-options: -fprof-auto @@ -258,7 +261,15 @@ test-suite test , these ghc-options: -threaded -rtsopts -with-rtsopts=-N -j default-language: Haskell2010 - default-extensions: DeriveFunctor, DeriveGeneric, FlexibleContexts, FlexibleInstances, OverloadedStrings, RecordWildCards + default-extensions: DataKinds + , DeriveFunctor + , DeriveGeneric + , FlexibleContexts + , FlexibleInstances + , MultiParamTypeClasses + , OverloadedStrings + , RecordWildCards + , StandaloneDeriving test-suite doctests type: exitcode-stdio-1.0 diff --git a/src/Analysis/Abstract/Caching.hs b/src/Analysis/Abstract/Caching.hs index 0d0d3f3e4..f04dbdeef 100644 --- a/src/Analysis/Abstract/Caching.hs +++ b/src/Analysis/Abstract/Caching.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE DataKinds, GeneralizedNewtypeDeriving, MultiParamTypeClasses, ScopedTypeVariables, StandaloneDeriving, TypeFamilies, TypeOperators, UndecidableInstances #-} +{-# LANGUAGE GeneralizedNewtypeDeriving, ScopedTypeVariables, TypeFamilies, TypeOperators, UndecidableInstances #-} module Analysis.Abstract.Caching ( type Caching ) where @@ -13,7 +13,7 @@ import Prologue -- | The effects necessary for caching analyses. type CachingEffects term value effects = Fresh -- For 'MonadFresh'. - ': NonDetEff -- For 'Alternative' and 'MonadNonDet'. + ': NonDet -- For 'Alternative' and 'MonadNonDet'. ': Reader (CacheFor term value) -- The in-cache used as an oracle while converging on a result. ': State (CacheFor term value) -- The out-cache used to record results in each iteration of convergence. ': effects diff --git a/src/Analysis/Abstract/Collecting.hs b/src/Analysis/Abstract/Collecting.hs index 54a975688..82bf9051f 100644 --- a/src/Analysis/Abstract/Collecting.hs +++ b/src/Analysis/Abstract/Collecting.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE DataKinds, GeneralizedNewtypeDeriving, MultiParamTypeClasses, StandaloneDeriving, TypeFamilies, TypeOperators, UndecidableInstances #-} +{-# LANGUAGE GeneralizedNewtypeDeriving, TypeFamilies, TypeOperators, UndecidableInstances #-} module Analysis.Abstract.Collecting ( type Collecting ) where diff --git a/src/Analysis/Abstract/Dead.hs b/src/Analysis/Abstract/Dead.hs index cf004925d..b1d9be521 100644 --- a/src/Analysis/Abstract/Dead.hs +++ b/src/Analysis/Abstract/Dead.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE DataKinds, GeneralizedNewtypeDeriving, MultiParamTypeClasses, StandaloneDeriving, TypeFamilies, TypeOperators #-} +{-# LANGUAGE GeneralizedNewtypeDeriving, TypeFamilies, TypeOperators #-} module Analysis.Abstract.Dead ( type DeadCode ) where diff --git a/src/Analysis/Abstract/Evaluating.hs b/src/Analysis/Abstract/Evaluating.hs index ad21ae6ec..216a59bfd 100644 --- a/src/Analysis/Abstract/Evaluating.hs +++ b/src/Analysis/Abstract/Evaluating.hs @@ -9,9 +9,7 @@ module Analysis.Abstract.Evaluating import Control.Abstract.Evaluator import Control.Monad.Effect -import Control.Monad.Effect.Fail -import Control.Monad.Effect.Reader -import Control.Monad.Effect.State +import Control.Monad.Effect.Resumable import Data.Abstract.Configuration import qualified Data.Abstract.Environment as Env import Data.Abstract.Environment (Environment) @@ -25,7 +23,7 @@ import qualified Data.IntMap as IntMap import Data.Language import Data.List.Split (splitWhen) import Prelude hiding (fail) -import Prologue +import Prologue hiding (throwError) import qualified Data.ByteString.Char8 as BC import qualified Data.Map as Map import System.FilePath.Posix @@ -118,12 +116,13 @@ newtype Evaluating term value effects a = Evaluating (Eff effects a) deriving instance Member Fail effects => MonadFail (Evaluating term value effects) deriving instance Member Fresh effects => MonadFresh (Evaluating term value effects) -deriving instance Member NonDetEff effects => Alternative (Evaluating term value effects) -deriving instance Member NonDetEff effects => MonadNonDet (Evaluating term value effects) +deriving instance Member NonDet effects => Alternative (Evaluating term value effects) +deriving instance Member NonDet effects => MonadNonDet (Evaluating term value effects) -- | Effects necessary for evaluating (whether concrete or abstract). type EvaluatingEffects term value - = '[ Fail -- Failure with an error message + = '[ Resumable Prelude.String value + , Fail -- Failure with an error message , State (EnvironmentFor value) -- Environments (both local and global) , State (HeapFor value) -- The heap , Reader (ModuleTable [term]) -- Cache of unevaluated modules @@ -132,6 +131,10 @@ type EvaluatingEffects term value , State (IntMap.IntMap term) -- For jumps ] + +instance Members '[Resumable Prelude.String value] effects => MonadThrow Prelude.String value (Evaluating term value effects) where + throwException = raise . throwError + instance Members '[Fail, State (IntMap.IntMap term)] effects => MonadControl term (Evaluating term value effects) where label term = do m <- raise get @@ -180,4 +183,4 @@ instance ( Evaluatable (Base term) => MonadAnalysis term value (Evaluating term value effects) where type RequiredEffects term value (Evaluating term value effects) = EvaluatingEffects term value - analyzeTerm = eval + analyzeTerm term = resumeException @value (eval term) (\yield exc -> string (BC.pack exc) >>= yield) diff --git a/src/Analysis/Abstract/Tracing.hs b/src/Analysis/Abstract/Tracing.hs index d21f8b3c3..f00405cdb 100644 --- a/src/Analysis/Abstract/Tracing.hs +++ b/src/Analysis/Abstract/Tracing.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE DataKinds, GeneralizedNewtypeDeriving, MultiParamTypeClasses, StandaloneDeriving, TypeFamilies, TypeOperators, UndecidableInstances #-} +{-# LANGUAGE GeneralizedNewtypeDeriving, TypeFamilies, TypeOperators, UndecidableInstances #-} module Analysis.Abstract.Tracing ( type Tracing ) where diff --git a/src/Analysis/ConstructorName.hs b/src/Analysis/ConstructorName.hs index 94e8dfd0b..6e49780a1 100644 --- a/src/Analysis/ConstructorName.hs +++ b/src/Analysis/ConstructorName.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE DataKinds, MultiParamTypeClasses, ScopedTypeVariables, TypeFamilies, TypeOperators, UndecidableInstances #-} +{-# LANGUAGE ScopedTypeVariables, TypeFamilies, TypeOperators, UndecidableInstances #-} module Analysis.ConstructorName ( ConstructorName(..) , ConstructorLabel(..) diff --git a/src/Analysis/Declaration.hs b/src/Analysis/Declaration.hs index c83a0d6a1..1ac1f98f8 100644 --- a/src/Analysis/Declaration.hs +++ b/src/Analysis/Declaration.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE DataKinds, MultiParamTypeClasses, TypeOperators, ScopedTypeVariables, TypeFamilies, UndecidableInstances #-} +{-# LANGUAGE TypeOperators, ScopedTypeVariables, TypeFamilies, UndecidableInstances #-} module Analysis.Declaration ( Declaration(..) , HasDeclaration diff --git a/src/Analysis/IdentifierName.hs b/src/Analysis/IdentifierName.hs index f9176316c..13374a9f2 100644 --- a/src/Analysis/IdentifierName.hs +++ b/src/Analysis/IdentifierName.hs @@ -1,17 +1,17 @@ -{-# LANGUAGE DataKinds, MultiParamTypeClasses, ScopedTypeVariables, TypeFamilies, TypeOperators, UndecidableInstances #-} +{-# LANGUAGE ScopedTypeVariables, TypeFamilies, TypeOperators, UndecidableInstances #-} module Analysis.IdentifierName ( IdentifierName(..) , IdentifierLabel(..) , identifierLabel ) where -import Data.Abstract.FreeVariables -import Data.Aeson -import Data.JSON.Fields -import Data.Term -import Data.Text.Encoding (decodeUtf8) -import Prologue +import Data.Abstract.FreeVariables +import Data.Aeson +import Data.JSON.Fields import qualified Data.Syntax +import Data.Term +import Data.Text.Encoding (decodeUtf8) +import Prologue -- | Compute a 'IdentifierLabel' label for a 'Term'. identifierLabel :: IdentifierName syntax => TermF syntax a b -> Maybe IdentifierLabel diff --git a/src/Analysis/ModuleDef.hs b/src/Analysis/ModuleDef.hs index 25de84043..925cb7cc4 100644 --- a/src/Analysis/ModuleDef.hs +++ b/src/Analysis/ModuleDef.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE DataKinds, MultiParamTypeClasses, ScopedTypeVariables, TypeFamilies, UndecidableInstances #-} +{-# LANGUAGE ScopedTypeVariables, TypeFamilies, UndecidableInstances #-} module Analysis.ModuleDef ( ModuleDef(..) , HasModuleDef diff --git a/src/Control/Abstract/Analysis.hs b/src/Control/Abstract/Analysis.hs index d9620042a..1d59a4e35 100644 --- a/src/Control/Abstract/Analysis.hs +++ b/src/Control/Abstract/Analysis.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE DataKinds, MultiParamTypeClasses, TypeFamilies #-} +{-# LANGUAGE TypeFamilies #-} {-# OPTIONS_GHC -Wno-redundant-constraints #-} -- For runAnalysis module Control.Abstract.Analysis ( MonadAnalysis(..) diff --git a/src/Control/Abstract/Evaluator.hs b/src/Control/Abstract/Evaluator.hs index f99b8b565..9d0bc7f42 100644 --- a/src/Control/Abstract/Evaluator.hs +++ b/src/Control/Abstract/Evaluator.hs @@ -13,6 +13,7 @@ module Control.Abstract.Evaluator , MonadModuleTable(..) , modifyModuleTable , MonadControl(..) + , MonadThrow(..) ) where import Data.Abstract.Address @@ -147,3 +148,6 @@ class Monad m => MonadControl term m where label :: term -> m Label -- | “Jump” to a previously-allocated 'Label' (retrieving the @term@ at which it points, which can then be evaluated in e.g. a 'MonadAnalysis' instance). goto :: Label -> m term + +class Monad m => MonadThrow exc v m | m -> exc where + throwException :: exc -> m v diff --git a/src/Control/Effect.hs b/src/Control/Effect.hs index 9709615ae..570cafb16 100644 --- a/src/Control/Effect.hs +++ b/src/Control/Effect.hs @@ -1,13 +1,13 @@ -{-# LANGUAGE DataKinds, MultiParamTypeClasses, TypeFamilies, TypeOperators, UndecidableInstances #-} +{-# LANGUAGE TypeFamilies, TypeOperators, UndecidableInstances, ScopedTypeVariables #-} module Control.Effect where -import qualified Control.Monad.Effect as Effect +import Control.Monad.Effect as Effect import Control.Monad.Effect.Fail -import Control.Monad.Effect.Internal -import Control.Monad.Effect.NonDetEff +import Control.Monad.Effect.NonDet import Control.Monad.Effect.Reader import Control.Monad.Effect.State import Control.Monad.Effect.Writer +import Control.Monad.Effect.Resumable import Data.Semigroup.Reducer import Prologue @@ -58,12 +58,18 @@ instance Monoid w => RunEffect (Writer w) a where type Result (Writer w) a = (a, w) runEffect = runWriter --- | 'NonDetEff' effects are interpreted into a nondeterministic set of result values. -instance Ord a => RunEffect NonDetEff a where - type Result NonDetEff a = Set a - runEffect = relay (pure . unit) (\ m k -> case m of - MZero -> pure mempty - MPlus -> mappend <$> k True <*> k False) +-- | 'NonDet' effects are interpreted into a nondeterministic set of result values. +instance Ord a => RunEffect NonDet a where + type Result NonDet a = Set a + runEffect = runNonDet unit + +-- | 'Resumable' effects are interpreted into 'Either' s.t. failures are in 'Left' and successful results are in 'Right'. +instance RunEffect (Resumable exc v) a where + type Result (Resumable exc v) a = Either exc a + runEffect = runError + +resumeException :: forall v m exc e a. (Effectful m, Resumable exc v :< e) => m e a -> ((v -> m e a) -> exc -> m e a) -> m e a +resumeException m handle = raise (resumeError (lower m) (\yield -> lower . handle (raise . yield))) -- | Types wrapping 'Eff' actions. diff --git a/src/Control/Effect/NonDet.hs b/src/Control/Effect/NonDet.hs index 34c23f74d..4d1da86a1 100644 --- a/src/Control/Effect/NonDet.hs +++ b/src/Control/Effect/NonDet.hs @@ -1,11 +1,11 @@ {-# LANGUAGE TypeFamilies, TypeOperators, UndecidableInstances #-} module Control.Effect.NonDet ( MonadNonDet(..) -, NonDetEff +, NonDet ) where import Control.Monad.Effect.Internal -import Control.Monad.Effect.NonDetEff +import Control.Monad.Effect.NonDet as NonDet import Prologue -- | 'Monad's offering local isolation of nondeterminism effects. @@ -16,8 +16,6 @@ class (Alternative m, Monad m) => MonadNonDet m where -> m a -- ^ The computation to run locally-nondeterministically. -> m b -- ^ A _deterministic_ computation producing the 'Monoid'al accumulation of the _locally-nondeterministic_ result values. --- | Effect stacks containing 'NonDetEff' offer a 'MonadNonDet' instance which implements 'gather' by interpreting the requests for nondeterminism locally, without removing 'NonDetEff' from the stack—i.e. the _capacity_ for nondeterminism is still present in the effect stack, but any local nondeterminism has been applied. -instance (NonDetEff :< fs) => MonadNonDet (Eff fs) where - gather f = interpose (pure . f) (\ m k -> case m of - MZero -> pure mempty - MPlus -> mappend <$> k True <*> k False) +-- | Effect stacks containing 'NonDet' offer a 'MonadNonDet' instance which implements 'gather' by interpreting the requests for nondeterminism locally, without removing 'NonDet' from the stack—i.e. the _capacity_ for nondeterminism is still present in the effect stack, but any local nondeterminism has been applied. +instance (NonDet :< fs) => MonadNonDet (Eff fs) where + gather = NonDet.gather diff --git a/src/Data/Abstract/Evaluatable.hs b/src/Data/Abstract/Evaluatable.hs index c4cb0ff63..6f2fbcf4b 100644 --- a/src/Data/Abstract/Evaluatable.hs +++ b/src/Data/Abstract/Evaluatable.hs @@ -18,7 +18,6 @@ import Data.Proxy import Data.Semigroup.Foldable import Data.Semigroup.App import Data.Term -import Prelude hiding (fail) import Prologue @@ -29,10 +28,11 @@ class Evaluatable constr where , MonadAnalysis term value m , MonadValue value m , Show (LocationFor value) + , MonadThrow Prelude.String value m ) => SubtermAlgebra constr term (m value) - default eval :: (MonadFail m, Show1 constr) => SubtermAlgebra constr term (m value) - eval expr = fail $ "Eval unspecialized for " ++ liftShowsPrec (const (const id)) (const id) 0 expr "" + default eval :: (MonadThrow Prelude.String value m, Show1 constr) => SubtermAlgebra constr term (m value) + eval expr = throwException $ "Eval unspecialized for " ++ liftShowsPrec (const (const id)) (const id) 0 expr "" -- | If we can evaluate any syntax which can occur in a 'Union', we can evaluate the 'Union'. instance Apply Evaluatable fs => Evaluatable (Union fs) where diff --git a/src/Data/Term.hs b/src/Data/Term.hs index 38353b54d..953ac25a4 100644 --- a/src/Data/Term.hs +++ b/src/Data/Term.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE DataKinds, MultiParamTypeClasses, RankNTypes, TypeFamilies, TypeOperators #-} +{-# LANGUAGE RankNTypes, TypeFamilies, TypeOperators #-} module Data.Term ( Term(..) , termIn diff --git a/src/Prologue.hs b/src/Prologue.hs index aa991c474..d927a1a4a 100644 --- a/src/Prologue.hs +++ b/src/Prologue.hs @@ -10,64 +10,48 @@ module Prologue import Data.Bifunctor.Join as X import Data.Bits as X import Data.ByteString as X (ByteString) -import Data.Functor.Both as X (Both, runBothWith, both) +import Data.Functor.Both as X (Both, both, runBothWith) import Data.IntMap as X (IntMap) import Data.IntSet as X (IntSet) -import Data.Ix as X (Ix(..)) +import Data.Ix as X (Ix (..)) +import Data.List.NonEmpty as X (NonEmpty (..), nonEmpty, some1) import Data.Map as X (Map) -import Data.Monoid (Alt(..)) import Data.Maybe as X +import Data.Monoid (Alt (..)) import Data.Sequence as X (Seq) import Data.Set as X (Set) import Data.Text as X (Text) import Data.These as X import Data.Union as X -import Data.List.NonEmpty as X ( - NonEmpty(..) - , nonEmpty - , some1 - ) import Debug.Trace as X -import Control.Exception as X hiding ( - evaluate - , throw - , throwIO - , throwTo - , assert - , Handler(..) - ) +import Control.Exception as X hiding (Handler (..), assert, evaluate, throw, throwIO, throwTo) -- Typeclasses import Control.Applicative as X import Control.Arrow as X ((&&&), (***)) import Control.Monad as X hiding (fail, return, unless, when) -import Control.Monad.Except as X (MonadError(..)) -import Control.Monad.Fail as X (MonadFail(..)) +import Control.Monad.Except as X (MonadError (..)) +import Control.Monad.Fail as X (MonadFail (..)) import Data.Algebra as X import Data.Align.Generic as X (GAlign) import Data.Bifoldable as X -import Data.Bifunctor as X (Bifunctor(..)) +import Data.Bifunctor as X (Bifunctor (..)) import Data.Bitraversable as X -import Data.Foldable as X hiding (product , sum) -import Data.Functor as X (($>), void) +import Data.Foldable as X hiding (product, sum) import Data.Function as X (fix, on, (&)) +import Data.Functor as X (void, ($>)) import Data.Functor.Classes as X import Data.Functor.Classes.Generic as X -import Data.Functor.Foldable as X (Base, Recursive(..), Corecursive(..)) +import Data.Functor.Foldable as X (Base, Corecursive (..), Recursive (..)) +import Data.Hashable as X (Hashable, hash, hashUsing, hashWithSalt) import Data.Mergeable as X (Mergeable) -import Data.Monoid as X (Monoid(..), First(..), Last(..)) -import Data.Proxy as X (Proxy(..)) -import Data.Semigroup as X (Semigroup(..)) +import Data.Monoid as X (First (..), Last (..), Monoid (..)) +import Data.Proxy as X (Proxy (..)) +import Data.Semigroup as X (Semigroup (..)) import Data.Traversable as X import Data.Typeable as X (Typeable) -import Data.Hashable as X ( - Hashable - , hash - , hashWithSalt - , hashUsing - ) -- Generics import GHC.Generics as X hiding (moduleName) diff --git a/src/Rendering/Imports.hs b/src/Rendering/Imports.hs index 4e1e28e4b..c3a5fc563 100644 --- a/src/Rendering/Imports.hs +++ b/src/Rendering/Imports.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE DataKinds, MultiParamTypeClasses, RankNTypes, ScopedTypeVariables, TypeFamilies, TypeOperators, UndecidableInstances #-} +{-# LANGUAGE RankNTypes, ScopedTypeVariables, TypeFamilies, TypeOperators, UndecidableInstances #-} module Rendering.Imports ( renderToImports , ImportSummary(..) diff --git a/src/Rendering/Symbol.hs b/src/Rendering/Symbol.hs index 9fe11ad71..0bf87d1f8 100644 --- a/src/Rendering/Symbol.hs +++ b/src/Rendering/Symbol.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE DataKinds, MultiParamTypeClasses, RankNTypes, ScopedTypeVariables, TypeFamilies, TypeOperators, UndecidableInstances #-} +{-# LANGUAGE RankNTypes, ScopedTypeVariables, TypeFamilies, TypeOperators, UndecidableInstances #-} module Rendering.Symbol ( renderSymbolTerms , renderToSymbols diff --git a/test/Analysis/Go/Spec.hs b/test/Analysis/Go/Spec.hs index 6436af0dc..6980b710e 100644 --- a/test/Analysis/Go/Spec.hs +++ b/test/Analysis/Go/Spec.hs @@ -3,6 +3,7 @@ module Analysis.Go.Spec (spec) where import Data.Abstract.Value import Data.Map +import Data.Either import SpecHelpers diff --git a/test/Analysis/Python/Spec.hs b/test/Analysis/Python/Spec.hs index 64a76a9d5..ab0c92f6c 100644 --- a/test/Analysis/Python/Spec.hs +++ b/test/Analysis/Python/Spec.hs @@ -36,11 +36,11 @@ spec = parallel $ do it "subclasses" $ do res <- evaluate' "subclass.py" - fst res `shouldBe` Right (injValue (String "\"bar\"")) + join (fst res) `shouldBe` Right (injValue (String "\"bar\"")) it "handles multiple inheritance left-to-right" $ do res <- evaluate' "multiple_inheritance.py" - fst res `shouldBe` Right (injValue (String "\"foo!\"")) + join (fst res) `shouldBe` Right (injValue (String "\"foo!\"")) where addr = Address . Precise diff --git a/test/Analysis/Ruby/Spec.hs b/test/Analysis/Ruby/Spec.hs index 52eab9fd2..8bdee6c28 100644 --- a/test/Analysis/Ruby/Spec.hs +++ b/test/Analysis/Ruby/Spec.hs @@ -28,7 +28,7 @@ spec = parallel $ do it "subclass" $ do res <- evaluate' "subclass.rb" - fst res `shouldBe` Right (injValue (String "\"\"")) + join (fst res) `shouldBe` Right (injValue (String "\"\"")) where addr = Address . Precise diff --git a/test/Data/Functor/Listable.hs b/test/Data/Functor/Listable.hs index 944e6c4de..344d6e671 100644 --- a/test/Data/Functor/Listable.hs +++ b/test/Data/Functor/Listable.hs @@ -156,7 +156,7 @@ instance Listable1 f => Listable2 (FreeF f) where instance (Listable1 f, Listable a) => Listable1 (FreeF f a) where liftTiers = liftTiers2 tiers -instance (Functor f, Listable1 f) => Listable1 (Free.Free f) where +instance Listable1 f => Listable1 (Free.Free f) where liftTiers pureTiers = go where go = liftCons1 (liftTiers2 pureTiers go) free free (FreeF.Free f) = Free.Free f diff --git a/test/Doctests.hs b/test/Doctests.hs index 1fa391e81..b5108f932 100644 --- a/test/Doctests.hs +++ b/test/Doctests.hs @@ -12,13 +12,16 @@ main = do extensions :: [String] extensions = - [ "DeriveFoldable" + [ "DataKinds" + , "DeriveFoldable" , "DeriveFunctor" , "DeriveGeneric" , "DeriveTraversable" , "FlexibleContexts" , "FlexibleInstances" + , "MultiParamTypeClasses" , "OverloadedStrings" , "RecordWildCards" + , "StandaloneDeriving" , "StrictData" ] diff --git a/test/SpecHelpers.hs b/test/SpecHelpers.hs index d2f819c6a..f1708065e 100644 --- a/test/SpecHelpers.hs +++ b/test/SpecHelpers.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE DataKinds, GADTs, ScopedTypeVariables, TypeFamilies, TypeOperators, TypeApplications #-} +{-# LANGUAGE GADTs, ScopedTypeVariables, TypeFamilies, TypeOperators, TypeApplications #-} module SpecHelpers ( module X , diffFilePaths @@ -34,6 +34,7 @@ import Data.Functor.Both as X (Both, runBothWith, both) import Data.Maybe as X import Data.Monoid as X (Monoid(..), First(..), Last(..)) import Data.Semigroup as X (Semigroup(..)) +import Control.Monad as X import Test.Hspec as X (Spec, SpecWith, context, describe, it, xit, parallel, pendingWith, around, runIO) import Test.Hspec.Expectations.Pretty as X diff --git a/vendor/effects b/vendor/effects index 6aaaa39f1..7d4525db7 160000 --- a/vendor/effects +++ b/vendor/effects @@ -1 +1 @@ -Subproject commit 6aaaa39f18f38628a91d3ffd155c7f4099131d9e +Subproject commit 7d4525db7b6a12c0a34da5f70a97db137c144c60 diff --git a/vendor/ghc-mod b/vendor/ghc-mod deleted file mode 160000 index 7fb380dae..000000000 --- a/vendor/ghc-mod +++ /dev/null @@ -1 +0,0 @@ -Subproject commit 7fb380dae0ae877a24ac8258fcd193cd6256a171