lensref 0.1.0.5 → 0.2

raw patch · 9 files changed

+137/−46 lines, 9 filesdep +lensrefdep ~transformersPVP ok

version bump matches the API change (PVP)

Dependencies added: lensref

Dependency ranges changed: transformers

API changes (from Hackage documentation)

Files

• changelog +7/−0
• lensref.cabal +25/−15
• runtests.hs +10/−0
• src/Control/Lens/Simple.hs +63/−0
• src/Data/LensRef.hs +1/−1
• src/Data/LensRef/Default.hs +0/−15
• src/Data/LensRef/Fast.hs +10/−1
• src/Data/LensRef/Pure.hs +17/−13
• src/Data/LensRef/TestEnv.hs +4/−1

@@ -1,4 +1,11 @@ += lensref-0.2 =++* Do not always build tests+* 'cabal test' support+* Eliminate dependency on lens, operational and containers packages+* Add lower bound to transformers package dependency+ = lensref-0.1.0.5 =  another bugfix for hackagedb

@@ -1,5 +1,5 @@ name:               lensref-version:            0.1.0.5+version:            0.2 category:           Control, Data synopsis:           References which can be joined and on which lenses can be applied description:@@ -43,7 +43,7 @@ homepage:           http://www.haskell.org/haskellwiki/LGtk bug-reports:        https://github.com/divipp/lensref/issues maintainer:         divipp@gmail.com-cabal-version:      >= 1.8+cabal-version:      >= 1.9.2 build-type:         Simple extra-source-files: changelog @@ -51,35 +51,36 @@   type:             git   location:         https://github.com/divipp/lensref.git -Flag Pure-  Description:      Use the pure but slow implementation+Flag tests+  Description:      Build the tests   Default:          False - library    hs-source-dirs:                     src   build-depends:                     base < 5-                  , transformers < 0.5+                  , transformers >= 0.3 && < 0.5                   , mtl < 2.3                   , monad-control < 0.4-                  , operational < 0.3-                  , lens < 4.2-                  , containers < 0.6-   exposed-modules:                     Data.LensRef                     Data.LensRef.Common-                    Data.LensRef.TestEnv-                    Data.LensRef.Test                     Data.LensRef.Pure                     Data.LensRef.Fast-                    Data.LensRef.Default-  if flag(Pure)+  other-modules:+                    Control.Lens.Simple+  if flag(tests)     cpp-options:-                    -D__PURE__+                    -D__TESTS__+    build-depends:+                    operational < 0.3+                  , containers < 0.6+                  , lens < 4.2+    exposed-modules:+                    Data.LensRef.TestEnv+                    Data.LensRef.Test    ghc-options:                      -Wall @@ -88,4 +89,13 @@                     -fno-warn-missing-signatures                      -fno-warn-orphans                     -fno-warn-type-defaults++test-suite runtests++  type:             exitcode-stdio-1.0+  main-is:          runtests.hs+  build-depends:+                    base < 5+                  , lensref+ 

@@ -0,0 +1,10 @@+module Main where++import qualified Data.LensRef.Pure as Pure+import qualified Data.LensRef.Fast as Fast++main :: IO ()+main = do+    Pure.runTests+    Fast.runTests+

@@ -0,0 +1,63 @@+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE FlexibleInstances #-}+-- | Minimalized lens dependency. Compatible with the lens package.+module Control.Lens.Simple where++import Control.Applicative+import Control.Monad.Identity+import Control.Monad.Reader+import Control.Monad.State++-----------++type Lens s t a b = forall f. Functor f => (a -> f b) -> s -> f t++type Lens' s a = Lens s s a a++lens :: (s -> a) -> (s -> b -> t) -> Lens s t a b+lens sa sbt afb s = sbt s <$> afb (sa s)++set :: Lens s t a b -> b -> s -> t+set l s = runIdentity . l (const $ Identity s)++united :: Lens' a ()+united f v = fmap (\() -> v) $ f ()++infixl 8 ^.++(^.) :: a -> Lens' a b -> b+a ^. l = getConst $ l Const a++view :: MonadReader s m => Lens' s a -> m a+view l = asks (^. l)++(.=) :: MonadState s m => Lens' s a -> a -> m ()+l .= a = modify $ set l a++magnify :: Monad m => Lens' a b -> ReaderT b m c -> ReaderT a m c+magnify l (ReaderT f) = ReaderT $ \a -> f $ a ^. l++class Field1 s t a b | s -> a, t -> b, s b -> t, t a -> s where+    _1 :: Lens s t a b++instance Field1 (a,b) (a',b) a a' where+  _1 k ~(a,b) = k a <&> \a' -> (a',b)++infixl 1 <&>++(<&>) :: Functor f => f a -> (a -> b) -> f b+as <&> f = f <$> as++class Field2 s t a b | s -> a, t -> b, s b -> t, t a -> s where+    _2 :: Lens s t a b++instance Field2 (a,b) (a,b') b b' where+  _2 k ~(a,b) = k b <&> \b' -> (a,b')++instance Field2 (a,b,c,d) (a,b',c,d) b b' where+  _2 k ~(a,b,c,d) = k b <&> \b' -> (a,b',c,d)++

@@ -50,7 +50,7 @@  import Control.Monad import Control.Monad.Identity-import Control.Lens (Lens', set, united)+import Control.Lens.Simple (Lens', set, united)  -------------------------------- 

@@ -1,15 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE RankNTypes #-}--- | Default implementation. Points to either to the pure or the fast implementation depending on the cabal flag @PURE@.-module Data.LensRef.Default-    ( Register-    , runRegister-    ) where--#ifdef __PURE__-import Data.LensRef.Pure-#else-import Data.LensRef.Fast-#endif--

@@ -6,6 +6,7 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE NoMonomorphismRestriction #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE CPP #-} --{-# OPTIONS_HADDOCK hide #-} {- | Fast implementation for the @MonadRefCreator@ interface.@@ -25,12 +26,14 @@ import Control.Applicative hiding (empty) import Control.Monad.State import Control.Monad.Reader-import Control.Lens+import Control.Lens.Simple  import Data.LensRef import Data.LensRef.Common+#ifdef __TESTS__ import Data.LensRef.TestEnv import Data.LensRef.Test+#endif  ---------------------- @@ -290,6 +293,7 @@  -------------------------- +#ifdef __TESTS__ instance MonadRegisterRun (Register (Prog TP)) where      type AsocT (Register (Prog TP)) = TP@@ -298,6 +302,7 @@  newtype TP = TP { unTP :: Wrap (Prog TP) () } +runTests :: IO () runTests = do     mkTests runTestSimple     tests runTest@@ -308,4 +313,8 @@  runTestSimple :: Register (Prog TP) () -> IO () runTestSimple m = runTest "" m $ return ((), return ())+#else+runTests :: IO ()+runTests = fail "enable the tests flag like \'cabal configure --enable-tests -ftests; cabal build; cabal test\'"+#endif 

@@ -8,6 +8,7 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE CPP #-} -- {-# OPTIONS_HADDOCK hide #-} {- | Register reference implementation for the @MonadRefCreator@ interface.@@ -24,17 +25,16 @@ import Control.Applicative import Control.Monad.State import Control.Monad.Reader-import Control.Arrow (second)-import qualified Data.Sequence as Seq-import Control.Lens hiding ((|>))-import Data.Foldable (toList)+import Control.Lens.Simple  import Unsafe.Coerce  import Data.LensRef import Data.LensRef.Common+#ifdef __TESTS__ import Data.LensRef.TestEnv import Data.LensRef.Test+#endif  ---------------------- @@ -44,12 +44,12 @@  ---------------------- -newtype Lens_ a b = Lens_ {unLens_ :: ALens' a b}+newtype Lens_ a b = Lens_ {unLens_ :: Lens' a b}  runLens_ :: Reader a (Lens_ a b) -> Lens' a b-runLens_ r f a = cloneLens (unLens_ $ runReader r a) f a+runLens_ r f a = unLens_ (runReader r a) f a -type LSt = Seq.Seq CC+type LSt = [CC]  data CC = forall a . CC (LSt -> a -> a) a @@ -70,7 +70,7 @@ instance RefClass (Lens_ LSt) where     type RefReaderSimple (Lens_ LSt) = Reader LSt -    readRefSimple = view . runLens_+    readRefSimple r = view $ runLens_ r     writeRefSimple r a = runLens_ r .= a     lensMap l r = return $ Lens_ $ runLens_ r . l     unitRef = return $ Lens_ united@@ -86,13 +86,13 @@         rk = set (runLens_ r) . (^. r2)         kr = set r2 . (^. runLens_ r) -        extend x0 = (return $ Lens_ $ lens get set, x0 Seq.|> CC kr (kr x0 a0))+        extend x0 = (return $ Lens_ $ lens get set, x0 ++ [CC kr (kr x0 a0)])           where-            limit = second toList . Seq.splitAt (Seq.length x0)+            limit = splitAt (length x0)              get = unsafeData . head . snd . limit -            set x a = foldl (\x -> (Seq.|>) x . ap_ x) (rk a zs Seq.|> CC kr a) ys where+            set x a = foldl (\x -> (x++) . (:[]) . ap_ x) (rk a zs ++ [CC kr a]) ys where                 (zs, _ : ys) = limit x          ap_ :: LSt -> CC -> CC@@ -251,6 +251,7 @@  ------------------------ +#ifdef __TESTS__ instance MonadRegisterRun (Register (Prog TP)) where      type AsocT (Register (Prog TP)) = TP@@ -259,6 +260,7 @@  newtype TP = TP { unTP :: SLSt (Prog TP) () } +runTests :: IO () runTests = do     mkTests runTestSimple     tests runTest@@ -269,6 +271,8 @@  runTestSimple :: Register (Prog TP) () -> IO () runTestSimple m = runTest "" m $ return ((), return ())--+#else+runTests :: IO ()+runTests = fail "enable the tests flag like \'cabal configure --enable-tests -ftests; cabal build; cabal test\'"+#endif 

@@ -244,12 +244,15 @@     -> tm a     -> Prog' (a, Prog' ())     -> IO ()-runTest_ name lift runRegister_ r p0 = putStr $ unlines $ handEr name $ flip evalStateT (ST [] [] 0 Seq.empty) $ do+runTest_ name lift runRegister_ r p0 = showError $ handEr name $ flip evalStateT (ST [] [] 0 Seq.empty) $ do     (Just (a1,c),pe) <- coeval_ lift (runRegister_ (singleton ReadI) (singleton . WriteI) r) p0     (a2,p) <- getProg' pe     when (a1 /= a2) $ fail' $ "results differ: " ++ show a1 ++ " vs " ++ show a2     (_, pr) <- coeval_ lift c p     getProg' pr++showError [] = return ()+showError xs = fail $ "\n" ++ unlines xs  ------------------------------------------------