ether 0.2.0.0 → 0.2.1.0

raw patch · 5 files changed

+114/−34 lines, 5 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +6/−0
• ether.cabal +3/−1
• src/Control/Ether/Abbr.hs +60/−0
• src/Control/Ether/Implicit/Abbr.hs +25/−0
• test/Regression.hs +20/−33

@@ -1,3 +1,9 @@+0.2.1.0+-------++* Constraint abbreviations: `Control.Ether.Abbr` and `Control.Ether.Implicit.Abbr`.++ 0.2.0.0 ------- 

@@ -1,5 +1,5 @@ name:                ether-version:             0.2.0.0+version:             0.2.1.0 synopsis:            Monad transformers and classes description:     Ether is a Haskell library that extends @mtl@ and @transformers@ with@@ -26,6 +26,8 @@    exposed-modules:     Control.Ether.Tagged                        Control.Ether.Wrapped+                       Control.Ether.Abbr+                       Control.Ether.Implicit.Abbr                        Control.Ether.TH                        Control.Monad.Trans.Ether.Reader                        Control.Monad.Trans.Ether.Writer

@@ -0,0 +1,60 @@+{-# LANGUAGE EmptyDataDecls #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeFamilies #-}++-- | Abbreviations for constraints.++module Control.Ether.Abbr+    ( type (-->)+    , type (<--)+    , type (<->)+    , type (-!-)+    , Ether+    , ReifyAbbr+    ) where++import GHC.Exts (Constraint)++import Control.Monad.Ether++-- | Turns an abbreviation into an actual constraint.+type family ReifyAbbr (abbr :: *) (m :: * -> *) :: Constraint++-- | Denotes 'MonadReader'. The mnemonic is that you read values of type @r@+-- from the reader environment tagged by @tag@, thus the arrows points+-- from @tag@ to @r@.+data tag --> r+type instance ReifyAbbr (tag --> r) m = MonadReader tag r m++-- | Denotes 'MonadWriter'. The mnemonic is that you write values of @w@+-- to the writer accumulator tagged by @tag@, thus the arrows points+-- from @w@ to @tag@.+data tag <-- w+type instance ReifyAbbr (tag <-- w) m = MonadWriter tag w m++-- | Denotes 'MonadState'. The mnemonic is that you can both read from and+-- write into the state, thus the arrow points in both directions.+data tag <-> s+type instance ReifyAbbr (tag <-> s) m = MonadState  tag s m++-- | Denotes 'MonadExcept'.+data tag -!- e+type instance ReifyAbbr (tag -!- e) m = MonadExcept tag e m++-- | Reify a list of constraint abbreviations.+--+-- > f :: Ether '[Foo --> r, Bar <-- w, Baz <-> s, Quux -!- e] m => m a+--+-- expands into+--+-- > f :: ( MonadReader Foo  r m+-- >      , MonadWriter Bar  w m+-- >      , MonadState  Baz  s m+-- >      , MonadExcept Quux e m+-- >      ) => m a++type family Ether (abbrs :: [*]) m :: Constraint where+    Ether '[] m = ()+    Ether (abbr ': abbrs) m = (ReifyAbbr abbr m, Ether abbrs m)

@@ -0,0 +1,25 @@+{-# LANGUAGE TypeFamilies #-}++-- | See "Control.Ether.Abbr".++module Control.Ether.Implicit.Abbr (R, W, S, E) where++import Control.Ether.Abbr (ReifyAbbr)+import Control.Monad.Ether.Implicit++-- | Denotes 'MonadReader'.+data R r+type instance ReifyAbbr (R r) m = MonadReader r m++-- | Denotes 'MonadWriter'.+data W w+type instance ReifyAbbr (W w) m = MonadWriter w m++-- | Denotes 'MonadState'.+data S s+type instance ReifyAbbr (S s) m = MonadState s m++-- | Denotes 'MonadExcept'.+data E e+type instance ReifyAbbr (E e) m = MonadExcept e m+

@@ -4,6 +4,8 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeOperators #-} {-# LANGUAGE LambdaCase #-} module Main where @@ -12,12 +14,13 @@ import Control.Ether.Tagged import Control.Ether.TH import Control.Ether.Wrapped-import Control.Monad.Ether.Reader-import Control.Monad.Ether.State-import Control.Monad.Ether.Writer-import qualified Control.Monad.Ether.Implicit.Reader as I-import qualified Control.Monad.Ether.Implicit.State  as I-import qualified Control.Monad.Ether.Implicit.Except as I++import Control.Monad.Ether+import Control.Ether.Abbr++import qualified Control.Monad.Ether.Implicit as I+import qualified Control.Ether.Implicit.Abbr as I+ import qualified Control.Monad.Reader as T import qualified Control.Monad.Writer as T import qualified Control.Monad.State  as T@@ -59,7 +62,7 @@     (direct, indirect) = layeredLocalCore' k f a1 a2  layeredLocalCore-    :: (MonadReader R1 r1 m, MonadReader R2 r2 m)+    :: Ether '[R1 --> r1, R2 --> r2] m     => (r2 -> r2) -> (r1 -> r2 -> a) -> m a layeredLocalCore f g = do     n <- ask r1@@ -67,7 +70,7 @@     return (g n m)  layeredLocalCore'-    :: (MonadReader R1 Int m, MonadReader R2 Integer m)+    :: Ether '[R1 --> Int, R2 --> Integer] m     => Fun (Int, Integer) Integer     -> Fun Integer Integer     -> Int -> Integer -> (Integer, m Integer)@@ -76,27 +79,20 @@     direct = apply k (fromIntegral a1, apply f a2)     indirect = layeredLocalCore (apply f) (\n m -> apply k (fromIntegral n, m)) -implicitCore :: (I.MonadReader Int m, I.MonadReader Bool m) => m String+implicitCore :: Ether '[I.R Int, I.R Bool] m => m String implicitCore = I.local (succ :: Int -> Int) $ do     n :: Int <- I.ask     b <- I.local not I.ask     return (if b then "" else show n) -wrapCore-    :: ( T.MonadReader Int m-       , T.MonadState  Int m-       ) => m Int+wrapCore :: (T.MonadReader Int m, T.MonadState Int m) => m Int wrapCore = do     b <- T.get     a <- T.ask     T.put (a + b)     return (a * b) -wrapCore'-    :: ( MonadReader S1 Int m-       , MonadState S1 Int m-       , MonadReader R1 Int m-       ) => m Int+wrapCore' :: Ether '[S1 --> Int, S1 <-> Int, R1 --> Int] m => m Int wrapCore' = do     a <- ethered s1 wrapCore     c <- ask r1@@ -121,16 +117,14 @@                         print b                         print c -stateCore :: ( MonadState  S1 Int m-             , MonadReader R1 Int m-             , UniqueTags m ) => m ()-stateCore = do+stateCore :: (Ether '[S1 <-> Int, R1 --> Int] m, UniqueTags m) => m ()+stateCore = ensureUniqueTags $ do     a <- ask r1     n <- get s1     put s1 (n * a)     modify s1 (subtract 1) -recurseCore :: (Num a, Ord a) => (I.MonadReader a m, I.MonadState Int m)  => m a+recurseCore :: (Num a, Ord a) => Ether '[I.R a, I.S Int]m => m a recurseCore = do     a <- I.ask     if (a <= 0)@@ -156,8 +150,7 @@  exceptCore     :: ( Floating a, Ord a-       , I.MonadExcept DivideByZero m-       , I.MonadExcept (NegativeLog a) m+       , Ether '[I.E DivideByZero, I.E (NegativeLog a)] m        ) => a -> a -> m a exceptCore a b = do     T.when (b == 0) (I.throw DivideByZero)@@ -193,10 +186,7 @@ wrapState_g :: T.MonadState Bool m => m String wrapState_g = liftM show T.get -wrapState_useboth-    :: ( MonadState Foo Int  m-       , MonadState Bar Bool m-       ) => m String+wrapState_useboth :: Ether '[Foo <-> Int, Bar <-> Bool] m => m String wrapState_useboth = do     a <- ethered foo wrapState_f     b <- ethered bar wrapState_g@@ -216,10 +206,7 @@ wrapStateBad1 :: Int -> String wrapStateBad1 = evalState foo wrapStateBad1_useboth -wrapStateBad2-    :: ( T.MonadState Int m-       , MonadState Foo Int m-       ) => m Int+wrapStateBad2 :: (T.MonadState Int m , MonadState Foo Int m) => m Int wrapStateBad2 = do     modify foo (*100)     T.get