microlens-ghc 0.4.0.0 → 0.4.1.0

raw patch · 4 files changed

+344/−92 lines, 4 filesdep +transformersdep ~microlensPVP ok

version bump matches the API change (PVP)

Dependencies added: transformers

Dependency ranges changed: microlens

API changes (from Hackage documentation)

Files

• CHANGELOG.md +6/−0
• microlens-ghc.cabal +8/−6
• src/Lens/Micro/GHC.hs +42/−86
• src/Lens/Micro/GHC/Internal.hs +288/−0

@@ -1,3 +1,9 @@+# 0.4.1.0++* Added `chars`, `packedBytes`, `packedChars`, `unpackedBytes`, `unpackedChars`.+* Added instances for `Strict`.+* New minor release (microlens-0.4.1).+ # 0.4.0.0  * New major release (microlens-0.4).

@@ -1,8 +1,8 @@ name:                microlens-ghc-version:             0.4.0.0-synopsis:            microlens + all features depending on packages coming with GHC (array, bytestring, containers)+version:             0.4.1.0+synopsis:            microlens + array, bytestring, containers, transformers description:-  Use this package instead of <http://hackage.haskell.org/package/microlens microlens> if you don't mind depending on all dependencies here – @Lens.Micro.GHC@ reexports everything from @Lens.Micro@ and additionally provides orphan instances of microlens classes for packages coming with GHC (<http://hackage.haskell.org/package/array array>, <http://hackage.haskell.org/package/bytestring bytestring>, <http://hackage.haskell.org/package/containers containers>).+  Use this package instead of <http://hackage.haskell.org/package/microlens microlens> if you don't mind depending on all dependencies here – @Lens.Micro.GHC@ reexports everything from @Lens.Micro@ and additionally provides orphan instances of microlens classes for packages coming with GHC (<http://hackage.haskell.org/package/array array>, <http://hackage.haskell.org/package/bytestring bytestring>, <http://hackage.haskell.org/package/containers containers>, <http://hackage.haskell.org/package/transfromers transformers>).   .   The minor and major versions of microlens-ghc are incremented whenever the minor and major versions of microlens are incremented, so you can depend on the exact version of microlens-ghc without specifying the version of microlens you need.   .@@ -25,13 +25,15 @@  library   exposed-modules:     Lens.Micro.GHC+                       Lens.Micro.GHC.Internal   -- other-modules:          -- other-extensions:    -  build-depends:       base >=4.5 && <5-                     , microlens ==0.4.0.*-                     , array >=0.3.0.2 && <0.6+  build-depends:       array >=0.3.0.2 && <0.6+                     , base >=4.5 && <5                      , bytestring >=0.9.1.10 && <0.11                      , containers >=0.4.0 && <0.6+                     , microlens ==0.4.1.*+                     , transformers >=0.2 && <0.6    ghc-options:     -Wall -fwarn-tabs

@@ -2,10 +2,8 @@ CPP, MultiParamTypeClasses, TypeFamilies,-FlexibleContexts, FlexibleInstances, UndecidableInstances,-BangPatterns, Trustworthy   #-} @@ -33,16 +31,25 @@      * 'Seq'     * strict and lazy bytestrings++* 'strict' and 'lazy' for++    * bytestrings+    * @StateT@, @WriterT@, @RWST@ -} module Lens.Micro.GHC (   module Lens.Micro,+  packedBytes, unpackedBytes,+  packedChars, unpackedChars,+  chars, ) where   import Lens.Micro import Lens.Micro.Internal+import Lens.Micro.GHC.Internal  import qualified Data.Map as Map import           Data.Map (Map)@@ -53,26 +60,20 @@  import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as BL-import qualified Data.ByteString.Internal as BI-import qualified Data.ByteString.Unsafe as BU +import Control.Monad.Trans.State.Lazy as Lazy+import Control.Monad.Trans.State.Strict as Strict+import Control.Monad.Trans.Writer.Lazy as Lazy+import Control.Monad.Trans.Writer.Strict as Strict+import Control.Monad.Trans.RWS.Lazy as Lazy+import Control.Monad.Trans.RWS.Strict as Strict+ import Data.Tree import Data.Array.IArray as Array import Data.Array.Unboxed  import Data.Int import Data.Word-import Data.Monoid-import Foreign.Storable-import Foreign.Ptr-import Data.Bits-#if MIN_VERSION_base(4,8,0)-import Foreign.ForeignPtr-#else-import Foreign.ForeignPtr.Safe-#endif-import GHC.ForeignPtr (mallocPlainForeignPtrBytes)-import GHC.IO (unsafeDupablePerformIO)  #if !MIN_VERSION_base(4,8,0) import Control.Applicative@@ -236,77 +237,32 @@     else uncurry BL.snoc <$> f (BL.init s, BL.last s)   {-# INLINE _Snoc #-} ---------------------------------------------------------------------------------- Control.Lens.Internal.ByteString---------------------------------------------------------------------------------grain :: Int-grain = 32-{-# INLINE grain #-}--traversedStrictTree :: Traversal' B.ByteString Word8-traversedStrictTree afb bs = unsafeCreate len <$> go 0 len- where-   len = B.length bs-   go !i !j-     | i + grain < j, k <- i + shiftR (j - i) 1 = (\l r q -> l q >> r q) <$> go i k <*> go k j-     | otherwise = run i j-   run !i !j-     | i == j    = pure (\_ -> return ())-     | otherwise = let !x = BU.unsafeIndex bs i-                   in (\y ys q -> pokeByteOff q i y >> ys q) <$> afb x <*> run (i + 1) j-{-# INLINE [0] traversedStrictTree #-}--{-# RULES-"bytes -> map"-  traversedStrictTree = sets B.map :: ASetter' B.ByteString Word8;-"bytes -> foldr"-  traversedStrictTree = foldring B.foldr :: Getting (Endo r) B.ByteString Word8;-  #-}---- A way of creating ByteStrings outside the IO monad. The @Int@--- argument gives the final size of the ByteString. Unlike--- 'createAndTrim' the ByteString is not reallocated if the final size--- is less than the estimated size.-unsafeCreate :: Int -> (Ptr Word8 -> IO ()) -> B.ByteString-unsafeCreate l f = unsafeDupablePerformIO (create l f)-{-# INLINE unsafeCreate #-}---- Create ByteString of size @l@ and use action @f@ to fill it's contents.-create :: Int -> (Ptr Word8 -> IO ()) -> IO B.ByteString-create l f = do-    fp <- mallocPlainForeignPtrBytes l-    withForeignPtr fp $ \p -> f p-    return $! BI.PS fp 0 l-{-# INLINE create #-}--traversedLazy :: Traversal' BL.ByteString Word8-traversedLazy afb = \lbs -> foldrChunks go (pure BL.empty) lbs-  where-  go c fcs = BL.append . fromStrict-             <$> traversedStrictTree afb c-             <*> fcs-{-# INLINE [1] traversedLazy #-}+instance Strict BL.ByteString B.ByteString where+  strict f s = fromStrict <$> f (toStrict s)+  {-# INLINE strict #-}+  lazy f s = toStrict <$> f (fromStrict s)+  {-# INLINE lazy #-} -{-# RULES-"sets lazy bytestring"-  traversedLazy = sets BL.map :: ASetter' BL.ByteString Word8;-"gets lazy bytestring"-  traversedLazy = foldring BL.foldr :: Getting (Endo r) BL.ByteString Word8;-  #-}+instance Strict (Lazy.StateT s m a) (Strict.StateT s m a) where+  strict f s = Lazy.StateT . Strict.runStateT <$>+               f (Strict.StateT (Lazy.runStateT s))+  {-# INLINE strict #-}+  lazy f s = Strict.StateT . Lazy.runStateT <$>+             f (Lazy.StateT (Strict.runStateT s))+  {-# INLINE lazy #-} -fromStrict :: B.ByteString -> BL.ByteString-#if MIN_VERSION_bytestring(0,10,0)-fromStrict = BL.fromStrict-#else-fromStrict = \x -> BL.fromChunks [x]-#endif-{-# INLINE fromStrict #-}+instance Strict (Lazy.WriterT w m a) (Strict.WriterT w m a) where+  strict f s = Lazy.WriterT . Strict.runWriterT <$>+               f (Strict.WriterT (Lazy.runWriterT s))+  {-# INLINE strict #-}+  lazy f s = Strict.WriterT . Lazy.runWriterT <$>+             f (Lazy.WriterT (Strict.runWriterT s))+  {-# INLINE lazy #-} -foldrChunks :: (B.ByteString -> r -> r) -> r -> BL.ByteString -> r-#if MIN_VERSION_bytestring(0,10,0)-foldrChunks = BL.foldrChunks-#else-foldrChunks f z b = foldr f z (BL.toChunks b)-#endif-{-# INLINE foldrChunks #-}+instance Strict (Lazy.RWST r w s m a) (Strict.RWST r w s m a) where+  strict f s = Lazy.RWST . Strict.runRWST <$>+               f (Strict.RWST (Lazy.runRWST s))+  {-# INLINE strict #-}+  lazy f s = Strict.RWST . Lazy.runRWST <$>+             f (Lazy.RWST (Strict.runRWST s))+  {-# INLINE lazy #-}

@@ -0,0 +1,288 @@+{-# LANGUAGE+CPP,+BangPatterns,+Unsafe+  #-}+++module Lens.Micro.GHC.Internal+(+  IsByteString(..),+  -- * Unpacking bytestrings+  unpackStrict,+  unpackStrict8,+  unpackLazy,+  unpackLazy8,+  -- * Converting bytestrings between strict and lazy+  fromStrict,+  toStrict,+  -- * Traversing bytestrings+  traversedStrictTree,+  traversedStrictTree8,+  traversedLazy,+  traversedLazy8,+)+where+++import Lens.Micro+import Lens.Micro.Internal++import qualified Data.ByteString            as B+import qualified Data.ByteString.Lazy       as BL+import qualified Data.ByteString.Char8      as B8+import qualified Data.ByteString.Lazy.Char8 as BL8+import qualified Data.ByteString.Internal   as BI+import qualified Data.ByteString.Unsafe     as BU++import Data.Int+import Data.Word+import Data.Char+import Data.Monoid+import Foreign.Storable+import Foreign.Ptr+import Data.Bits+#if MIN_VERSION_base(4,8,0)+import Foreign.ForeignPtr+#else+import Foreign.ForeignPtr.Safe+#endif+import GHC.ForeignPtr (mallocPlainForeignPtrBytes)+#if !MIN_VERSION_bytestring(0,10,4)+import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr)+#endif+import GHC.IO (unsafeDupablePerformIO)+import GHC.Base (unsafeChr)++#if !MIN_VERSION_base(4,8,0)+import Control.Applicative+#endif+++class IsByteString t where+  {- |+Treat a list of bytes as a strict or lazy @ByteString@.+  -}+  packedBytes :: Lens' [Word8] t+  {- |+Treat a strict or lazy @ByteString@ as a list of bytes.+  -}+  unpackedBytes :: Lens' t [Word8]+  {- |+Treat a 'String' as a strict or lazy @ByteString@. (Note that it will garble characters above 0xFF, same as 'B8.pack' does.)+  -}+  packedChars :: Lens' String t+  {- |+Treat a strict or lazy @ByteString@ as a 'String'. (Just as 'packedChars', it will garble characters above 0xFF.)+  -}+  unpackedChars :: Lens' t String+  {- |+Traverse characters in a strict or lazy @ByteString@ (to traverse bytes instead of characters, use 'each').+  -}+  chars :: Traversal' t Char++-- When writing back to the 'ByteString' it is assumed that every 'Char'+-- lies between @'\x00'@ and @'\xff'@.++instance IsByteString B.ByteString where+  packedBytes f s = unpackStrict <$> f (B.pack s)+  {-# INLINE packedBytes #-}+  unpackedBytes f s = B.pack <$> f (unpackStrict s)+  {-# INLINE unpackedBytes #-}+  packedChars f s = unpackStrict8 <$> f (B8.pack s)+  {-# INLINE packedChars #-}+  unpackedChars f s = B8.pack <$> f (unpackStrict8 s)+  {-# INLINE unpackedChars #-}+  chars = traversedStrictTree8+  {-# INLINE chars #-}++instance IsByteString BL.ByteString where+  packedBytes f s = unpackLazy <$> f (BL.pack s)+  {-# INLINE packedBytes #-}+  unpackedBytes f s = BL.pack <$> f (unpackLazy s)+  {-# INLINE unpackedBytes #-}+  packedChars f s = unpackLazy8 <$> f (BL8.pack s)+  {-# INLINE packedChars #-}+  unpackedChars f s = BL8.pack <$> f (unpackLazy8 s)+  {-# INLINE unpackedChars #-}+  chars = traversedLazy8+  {-# INLINE chars #-}++-- unpacking++unpackStrict :: B.ByteString -> [Word8]+#if MIN_VERSION_bytestring(0,10,4)+unpackStrict = B.unpack+#else+unpackStrict (BI.PS fp off len) =+      let p = unsafeForeignPtrToPtr fp+       in go (p `plusPtr` off) (p `plusPtr` (off+len))+    where+      go !p !q | p == q    = []+               | otherwise = let !x = BI.inlinePerformIO $ do+                                        x' <- peek p+                                        touchForeignPtr fp+                                        return x'+                             in x : go (p `plusPtr` 1) q+#endif+{-# INLINE unpackStrict #-}++unpackStrict8 :: B.ByteString -> String+#if MIN_VERSION_bytestring(0,10,4)+unpackStrict8 = B8.unpack+#else+unpackStrict8 (BI.PS fp off len) =+      let p = unsafeForeignPtrToPtr fp+       in go (p `plusPtr` off) (p `plusPtr` (off+len))+    where+      go !p !q | p == q    = []+               | otherwise = let !x = BI.inlinePerformIO $ do+                                        x' <- peek p+                                        touchForeignPtr fp+                                        return x'+                             in w2c x : go (p `plusPtr` 1) q+#endif+{-# INLINE unpackStrict8 #-}++unpackLazy :: BL.ByteString -> [Word8]+unpackLazy = BL.unpack+{-# INLINE unpackLazy #-}++unpackLazy8 :: BL.ByteString -> String+unpackLazy8 = BL8.unpack+{-# INLINE unpackLazy8 #-}++-- converting between strict and lazy++fromStrict :: B.ByteString -> BL.ByteString+#if MIN_VERSION_bytestring(0,10,0)+fromStrict = BL.fromStrict+#else+fromStrict = \x -> BL.fromChunks [x]+#endif+{-# INLINE fromStrict #-}++toStrict :: BL.ByteString -> B.ByteString+#if MIN_VERSION_bytestring(0,10,0)+toStrict = BL.toStrict+#else+toStrict = B.concat . BL.toChunks+#endif+{-# INLINE toStrict #-}++-- traversing++grain :: Int+grain = 32+{-# INLINE grain #-}++traversedStrictTree :: Traversal' B.ByteString Word8+traversedStrictTree afb bs = unsafeCreate len <$> go 0 len+ where+   len = B.length bs+   go !i !j+     | i + grain < j, k <- i + shiftR (j - i) 1 = (\l r q -> l q >> r q) <$> go i k <*> go k j+     | otherwise = run i j+   run !i !j+     | i == j    = pure (\_ -> return ())+     | otherwise = let !x = BU.unsafeIndex bs i+                   in (\y ys q -> pokeByteOff q i y >> ys q) <$> afb x <*> run (i + 1) j+{-# INLINE [0] traversedStrictTree #-}++{-# RULES+"bytes -> map"+  traversedStrictTree = sets B.map :: ASetter' B.ByteString Word8;+"bytes -> foldr"+  traversedStrictTree = foldring B.foldr :: Getting (Endo r) B.ByteString Word8;+  #-}++traversedStrictTree8 :: Traversal' B.ByteString Char+traversedStrictTree8 pafb bs = unsafeCreate len <$> go 0 len+ where+   len = B.length bs+   go !i !j+     | i + grain < j    = let k = i + shiftR (j - i) 1+                          in (\l r q -> l q >> r q) <$> go i k <*> go k j+     | otherwise        = run i j+   run !i !j+     | i == j           = pure (\_ -> return ())+     | otherwise        = let !x = BU.unsafeIndex bs i+                          in (\y ys q -> pokeByteOff q i (c2w y) >> ys q)+                         <$> pafb (w2c x)+                         <*> run (i + 1) j+{-# INLINE [0] traversedStrictTree8 #-}++{-# RULES+"chars -> map"+  traversedStrictTree8 = sets B8.map :: ASetter' B.ByteString Char;+"chars -> foldr"+  traversedStrictTree8 = foldring B8.foldr :: Getting (Endo r) B.ByteString Char;+  #-}++traversedLazy :: Traversal' BL.ByteString Word8+traversedLazy pafb = \lbs -> foldrChunks go (\_ -> pure BL.empty) lbs 0+  where+  go c fcs acc = BL.append . fromStrict+             <$> traversedStrictTree pafb c+             <*> fcs acc'+    where+    acc' :: Int64+    !acc' = acc + fromIntegral (B.length c)+{-# INLINE [1] traversedLazy #-}++{-# RULES+"sets lazy bytestring"+  traversedLazy = sets BL.map :: ASetter' BL.ByteString Word8;+"gets lazy bytestring"+  traversedLazy = foldring BL.foldr :: Getting (Endo r) BL.ByteString Word8;+  #-}++traversedLazy8 :: Traversal' BL.ByteString Char+traversedLazy8 pafb = \lbs -> foldrChunks go (\_ -> pure BL.empty) lbs 0+  where+  go c fcs acc = BL.append . fromStrict+             <$> traversedStrictTree8 pafb c+             <*> fcs acc'+    where+    acc' :: Int64+    !acc' = acc + fromIntegral (B.length c)+{-# INLINE [1] traversedLazy8 #-}++{-# RULES+"sets lazy bytestring"+  traversedLazy8 = sets BL8.map :: ASetter' BL8.ByteString Char;+"gets lazy bytestring"+  traversedLazy8 = foldring BL8.foldr :: Getting (Endo r) BL8.ByteString Char;+  #-}++-- A way of creating ByteStrings outside the IO monad. The @Int@+-- argument gives the final size of the ByteString. Unlike+-- 'createAndTrim' the ByteString is not reallocated if the final size+-- is less than the estimated size.+unsafeCreate :: Int -> (Ptr Word8 -> IO ()) -> B.ByteString+unsafeCreate l f = unsafeDupablePerformIO (create l f)+{-# INLINE unsafeCreate #-}++-- Create ByteString of size @l@ and use action @f@ to fill its contents.+create :: Int -> (Ptr Word8 -> IO ()) -> IO B.ByteString+create l f = do+    fp <- mallocPlainForeignPtrBytes l+    withForeignPtr fp $ \p -> f p+    return $! BI.PS fp 0 l+{-# INLINE create #-}++foldrChunks :: (B.ByteString -> r -> r) -> r -> BL.ByteString -> r+#if MIN_VERSION_bytestring(0,10,0)+foldrChunks = BL.foldrChunks+#else+foldrChunks f z b = foldr f z (BL.toChunks b)+#endif+{-# INLINE foldrChunks #-}++w2c :: Word8 -> Char+w2c = unsafeChr . fromIntegral+{-# INLINE w2c #-}++c2w :: Char -> Word8+c2w = fromIntegral . ord+{-# INLINE c2w #-}