packages feed

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 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