th-context 0.22 → 0.23
raw patch · 3 files changed
+24/−23 lines, 3 filesdep ~mtl-unleasheddep ~th-contextdep ~th-typegraph
Dependency ranges changed: mtl-unleashed, th-context, th-typegraph
Files
- Language/Haskell/TH/Context.hs +7/−7
- test/Common.hs +8/−7
- th-context.cabal +9/−9
Language/Haskell/TH/Context.hs view
@@ -25,7 +25,7 @@ import Data.Maybe (isJust) import Control.Monad (filterM)-import Control.Monad.States (MonadStates, get, modify)+import Control.Monad.States (MonadStates, getPoly, modifyPoly) import Control.Monad.Writer (MonadWriter, tell) import Data.Generics (everywhere, mkT) import Data.List (intercalate)@@ -69,21 +69,21 @@ Name -> [Type] -> m [InstanceDec] reifyInstancesWithContext className typeParameters = do p <- expandType $ foldInstance className typeParameters- mp <- get :: m InstMap+ mp <- getPoly :: m InstMap case Map.lookup p mp of Just x -> return $ map instanceDec x Nothing -> do -- trace (" -> reifyInstancesWithContext " ++ pprint (foldInstance className typeParameters) ++ "...") (return ()) -- Add an entry with a bogus value to limit recursion on -- the predicate we are currently testing- modify (Map.insert p [] :: InstMap -> InstMap)+ modifyPoly (Map.insert p [] :: InstMap -> InstMap) -- Get all the instances of className that unify with the type parameters. insts <- qReifyInstances className typeParameters -- Filter out the ones that conflict with the instance context r <- filterM (testInstance className typeParameters) insts -- Now insert the correct value into the map and return it. Because -- this instance was discovered in the Q monad it is marked Declared.- modify (Map.insert p (map Declared r))+ modifyPoly (Map.insert p (map Declared r)) -- trace (" <- reifyInstancesWithContext " ++ pprint (foldInstance className typeParameters) ++ " -> " ++ pprint r) (return ()) return r @@ -166,14 +166,14 @@ tellInstance inst@(InstanceD _ instanceType _) = do let Just (className, typeParameters) = unfoldInstance instanceType p <- expandType $ foldInstance className typeParameters- (mp :: InstMap) <- get+ (mp :: InstMap) <- getPoly case Map.lookup p mp of Just (_ : _) -> return () -- Here we set the instance list to a singleton - there is -- no point associating multiple instances with a predicate, -- compiling the resulting set of declarations is an error -- (overlapping instances.)- _ -> modify (Map.insert p [Undeclared inst])+ _ -> modifyPoly (Map.insert p [Undeclared inst]) tellInstance inst = error $ "tellInstance - Not an instance: " ++ pprint inst -- | After all the declared and undeclared instances have been added@@ -182,7 +182,7 @@ -- reifyInstances, and tells them to the writer monad. tellUndeclared :: (MonadWriter [Dec] m, MonadStates InstMap m) => m () tellUndeclared =- get >>= \(mp :: InstMap) -> tell . mapMaybe undeclared . concat . Map.elems $ mp+ getPoly >>= \(mp :: InstMap) -> tell . mapMaybe undeclared . concat . Map.elems $ mp where undeclared :: DecStatus Dec -> Maybe Dec undeclared (Undeclared dec) = Just dec
test/Common.hs view
@@ -2,7 +2,8 @@ module Common where import Control.Lens (makeLenses, use, (.=))-import Control.Monad.States (evalStateT, MonadStates(get, put), StateT)+import Control.Monad.State (evalStateT, StateT)+import Control.Monad.States (MonadStates(getPoly, putPoly)) import Data.List as List (map) import Data.Map as Map (toList) import Data.Set as Set (Set, difference, empty, toList)@@ -60,16 +61,16 @@ $(makeLenses ''S) instance Monad m => MonadStates InstMap (StateT S m) where- get = use instMap- put s = instMap .= s+ getPoly = use instMap+ putPoly s = instMap .= s instance Monad m => MonadStates ExpandMap (StateT S m) where- get = use expanded- put s = expanded .= s+ getPoly = use expanded+ putPoly s = expanded .= s instance Monad m => MonadStates (Set TGV) (StateT S m) where- get = use visited- put s = visited .= s+ getPoly = use visited+ putPoly s = visited .= s evalS :: Monad m => StateT S m a -> m a evalS action = evalStateT action (S mempty mempty mempty)
th-context.cabal view
@@ -1,5 +1,5 @@ name: th-context-version: 0.22+version: 0.23 cabal-version: >= 1.10 build-type: Simple license: BSD3@@ -20,7 +20,10 @@ extra-source-files: test/Common.hs test/Context.hs test/Tests.hs test/Values.hs Library+ default-language: Haskell2010+ ghc-options: -Wall -O2 hs-source-dirs: .+ exposed-modules: Language.Haskell.TH.Context build-depends: base >= 4.8 && < 5, containers,@@ -28,15 +31,12 @@ haskell-src-exts, lens, mtl,- mtl-unleashed >= 0.2.1,+ mtl-unleashed >= 0.5, syb, template-haskell >= 2.10, th-desugar, th-orphans >= 0.10.0,- th-typegraph >= 0.27- ghc-options: -Wall -O2- exposed-modules: Language.Haskell.TH.Context- default-language: Haskell2010+ th-typegraph >= 0.31 test-suite th-context-tests type: exitcode-stdio-1.0@@ -54,15 +54,15 @@ hspec-core, lens, mtl,- mtl-unleashed,+ mtl-unleashed >= 0.5, syb, template-haskell, text,- th-context >= 0.19,+ th-context, th-desugar, th-orphans, th-reify-many,- th-typegraph >= 0.27+ th-typegraph default-language: Haskell2010 source-repository head