microlens-ghc-0.4.8.0/0000755000000000000000000000000013057536135012611 5ustar0000000000000000microlens-ghc-0.4.8.0/microlens-ghc.cabal0000644000000000000000000000423513057536135016333 0ustar0000000000000000name: microlens-ghc version: 0.4.8.0 synopsis: microlens + array, bytestring, containers, transformers description: Use this package instead of 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 (, , , ). . 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. . This package is a part of the family; see the readme . license: BSD3 license-file: LICENSE author: Edward Kmett, Artyom maintainer: Artyom homepage: http://github.com/aelve/microlens bug-reports: http://github.com/aelve/microlens/issues category: Data, Lenses build-type: Simple extra-source-files: CHANGELOG.md cabal-version: >=1.10 source-repository head type: git location: git://github.com/aelve/microlens.git library exposed-modules: Lens.Micro.GHC Lens.Micro.GHC.Internal -- other-modules: -- other-extensions: 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.8.* , transformers >=0.2 && <0.6 ghc-options: -Wall -fwarn-tabs -O2 -fdicts-cheap -funbox-strict-fields -fmax-simplifier-iterations=10 hs-source-dirs: src default-language: Haskell2010microlens-ghc-0.4.8.0/LICENSE0000644000000000000000000000302013057536135013611 0ustar0000000000000000Copyright (c) 2013-2016 Edward Kmett, 2015-2016 Artyom All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of Artyom nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. microlens-ghc-0.4.8.0/CHANGELOG.md0000644000000000000000000000167713057536135014435 0ustar0000000000000000# 0.4.8.0 * New minor release (microlens-0.4.8). # 0.4.7.0 * New minor release (microlens-0.4.7). # 0.4.6.0 * New minor release (microlens-0.4.6). # 0.4.5.0 * New minor release (microlens-0.4.5). # 0.4.4.0 * New minor release (microlens-0.4.4). # 0.4.3.0 * New minor release (microlens-0.4.3). # 0.4.2.1 * Added forgotten copyright/authorship information. # 0.4.2.0 * New minor release (microlens-0.4.2). # 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). # 0.3.1.0 * New minor release (microlens-0.3.5). # 0.3.0.0 * Made `Lens.Micro.GHC` export `Lens.Micro` (so, now microlens-ghc works like microlens-platform). # 0.2.1.0 * Added Safe Haskell pragmas. # 0.2.0.0 * Added instances for `Cons` and `Snoc`. # 0.1.0.1 * Bumped microlens version. # 0.1.0.0 Initial release. microlens-ghc-0.4.8.0/Setup.hs0000644000000000000000000000005613057536135014246 0ustar0000000000000000import Distribution.Simple main = defaultMain microlens-ghc-0.4.8.0/src/0000755000000000000000000000000013057536135013400 5ustar0000000000000000microlens-ghc-0.4.8.0/src/Lens/0000755000000000000000000000000013057536135014301 5ustar0000000000000000microlens-ghc-0.4.8.0/src/Lens/Micro/0000755000000000000000000000000013057536135015352 5ustar0000000000000000microlens-ghc-0.4.8.0/src/Lens/Micro/GHC.hs0000644000000000000000000001717513057536135016322 0ustar0000000000000000{-# LANGUAGE CPP, MultiParamTypeClasses, TypeFamilies, FlexibleInstances, UndecidableInstances, Trustworthy #-} {-# OPTIONS_GHC -fno-warn-orphans #-} #ifndef MIN_VERSION_base #define MIN_VERSION_base(x,y,z) 1 #endif {- | Module : Lens.Micro.GHC Copyright : (C) 2013-2016 Edward Kmett, 2015-2016 Artyom License : BSD-style (see the file LICENSE) By importing this module you get all functions and types from , as well as the following instances: * 'at' for 'Map' and 'IntMap' * 'each' and 'ix' for * 'Map' and 'IntMap' * 'Array' and 'UArray' * 'Seq' * strict 'B.ByteString' and lazy 'BL.ByteString' * 'Tree' * '_head', '_tail', '_init', '_last' for * '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) import qualified Data.IntMap as IntMap import Data.IntMap (IntMap) import qualified Data.Sequence as Seq import Data.Sequence (Seq) import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as BL 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 #if !MIN_VERSION_base(4,8,0) import Control.Applicative import Data.Traversable #endif type instance Index (Map k a) = k type instance IxValue (Map k a) = a type instance Index (IntMap a) = Int type instance IxValue (IntMap a) = a type instance Index (Seq a) = Int type instance IxValue (Seq a) = a type instance Index (Tree a) = [Int] type instance IxValue (Tree a) = a type instance Index (Array.Array i e) = i type instance IxValue (Array.Array i e) = e type instance Index (UArray i e) = i type instance IxValue (UArray i e) = e type instance Index B.ByteString = Int type instance IxValue B.ByteString = Word8 type instance Index BL.ByteString = Int64 type instance IxValue BL.ByteString = Word8 instance Ord k => Ixed (Map k a) where ix k f m = case Map.lookup k m of Just v -> f v <&> \v' -> Map.insert k v' m Nothing -> pure m {-# INLINE ix #-} instance Ixed (IntMap a) where ix k f m = case IntMap.lookup k m of Just v -> f v <&> \v' -> IntMap.insert k v' m Nothing -> pure m {-# INLINE ix #-} instance Ixed (Seq a) where ix i f m | 0 <= i && i < Seq.length m = f (Seq.index m i) <&> \a -> Seq.update i a m | otherwise = pure m {-# INLINE ix #-} instance Ixed (Tree a) where ix xs0 f = go xs0 where go [] (Node a as) = f a <&> \a' -> Node a' as go (i:is) t@(Node a as) | i < 0 = pure t | otherwise = Node a <$> ix i (go is) as {-# INLINE ix #-} instance Ix i => Ixed (Array.Array i e) where ix i f arr | inRange (bounds arr) i = f (arr Array.! i) <&> \e -> arr Array.// [(i,e)] | otherwise = pure arr {-# INLINE ix #-} instance (IArray UArray e, Ix i) => Ixed (UArray i e) where ix i f arr | inRange (bounds arr) i = f (arr Array.! i) <&> \e -> arr Array.// [(i,e)] | otherwise = pure arr {-# INLINE ix #-} instance Ixed B.ByteString where ix e f s = case B.splitAt e s of (l, mr) -> case B.uncons mr of Nothing -> pure s Just (c, xs) -> f c <&> \d -> B.concat [l, B.singleton d, xs] {-# INLINE ix #-} instance Ixed BL.ByteString where -- TODO: we could be lazier, returning each chunk as it is passed ix e f s = case BL.splitAt e s of (l, mr) -> case BL.uncons mr of Nothing -> pure s Just (c, xs) -> f c <&> \d -> BL.append l (BL.cons d xs) {-# INLINE ix #-} instance At (IntMap a) where at k f m = f mv <&> \r -> case r of Nothing -> maybe m (const (IntMap.delete k m)) mv Just v' -> IntMap.insert k v' m where mv = IntMap.lookup k m {-# INLINE at #-} instance Ord k => At (Map k a) where at k f m = f mv <&> \r -> case r of Nothing -> maybe m (const (Map.delete k m)) mv Just v' -> Map.insert k v' m where mv = Map.lookup k m {-# INLINE at #-} instance (c ~ d) => Each (Map c a) (Map d b) a b where each = traversed {-# INLINE each #-} instance Each (IntMap a) (IntMap b) a b where each = traversed {-# INLINE each #-} instance Each (Seq a) (Seq b) a b where each = traversed {-# INLINE each #-} instance Each (Tree a) (Tree b) a b where each = traversed {-# INLINE each #-} instance (Ix i, i ~ j) => Each (Array i a) (Array j b) a b where each f arr = array (bounds arr) <$> traverse (\(i,a) -> (,) i <$> f a) (Array.assocs arr) {-# INLINE each #-} instance (Ix i, IArray UArray a, IArray UArray b, i ~ j) => Each (UArray i a) (UArray j b) a b where each f arr = array (bounds arr) <$> traverse (\(i,a) -> (,) i <$> f a) (Array.assocs arr) {-# INLINE each #-} instance (a ~ Word8, b ~ Word8) => Each B.ByteString B.ByteString a b where each = traversedStrictTree {-# INLINE each #-} instance (a ~ Word8, b ~ Word8) => Each BL.ByteString BL.ByteString a b where each = traversedLazy {-# INLINE each #-} instance Cons (Seq a) (Seq b) a b where _Cons f s = case Seq.viewl s of x Seq.:< xs -> uncurry (Seq.<|) <$> f (x, xs) Seq.EmptyL -> pure Seq.empty {-# INLINE _Cons #-} instance Snoc (Seq a) (Seq b) a b where _Snoc f s = case Seq.viewr s of xs Seq.:> x -> uncurry (Seq.|>) <$> f (xs, x) Seq.EmptyR -> pure Seq.empty {-# INLINE _Snoc #-} instance Cons B.ByteString B.ByteString Word8 Word8 where _Cons f s = case B.uncons s of Just x -> uncurry B.cons <$> f x Nothing -> pure B.empty {-# INLINE _Cons #-} instance Cons BL.ByteString BL.ByteString Word8 Word8 where _Cons f s = case BL.uncons s of Just x -> uncurry BL.cons <$> f x Nothing -> pure BL.empty {-# INLINE _Cons #-} instance Snoc B.ByteString B.ByteString Word8 Word8 where _Snoc f s = if B.null s then pure B.empty else uncurry B.snoc <$> f (B.init s, B.last s) {-# INLINE _Snoc #-} instance Snoc BL.ByteString BL.ByteString Word8 Word8 where _Snoc f s = if BL.null s then pure BL.empty else uncurry BL.snoc <$> f (BL.init s, BL.last s) {-# INLINE _Snoc #-} 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 #-} 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 #-} 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 #-} 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 #-} microlens-ghc-0.4.8.0/src/Lens/Micro/GHC/0000755000000000000000000000000013057536135015753 5ustar0000000000000000microlens-ghc-0.4.8.0/src/Lens/Micro/GHC/Internal.hs0000644000000000000000000002054313057536135020067 0ustar0000000000000000{-# LANGUAGE CPP, BangPatterns, Unsafe #-} {- | Module : Lens.Micro.GHC.Internal Copyright : (C) 2013-2016 Edward Kmett, 2015-2016 Artyom License : BSD-style (see the file LICENSE) -} 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 #-}