microlens-platform-0.4.1/src/0000755000000000000000000000000013461057432014313 5ustar0000000000000000microlens-platform-0.4.1/src/Lens/0000755000000000000000000000000013461057432015214 5ustar0000000000000000microlens-platform-0.4.1/src/Lens/Micro/0000755000000000000000000000000013614145422016262 5ustar0000000000000000microlens-platform-0.4.1/src/Lens/Micro/Platform/0000755000000000000000000000000013461057432020051 5ustar0000000000000000microlens-platform-0.4.1/src/Lens/Micro/Platform.hs0000644000000000000000000002165013614145422020406 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE Trustworthy #-} {-# OPTIONS_GHC -fno-warn-orphans #-} #ifndef MIN_VERSION_base #define MIN_VERSION_base(x,y,z) 1 #endif {- | Module : Lens.Micro.Platform Copyright : (C) 2013-2016 Edward Kmett, 2015-2016 Artyom Kazak, 2018 Monadfix License : BSD-style (see the file LICENSE) This module is an approximation for @@ from ; by importing it you get all functions and instances from , , , as well as the following instances: * 'at' for 'HashMap' * 'each' and 'ix' for * 'HashMap' * 'Vector.Vector' and variants (unboxed vectors, etc) * strict 'T.Text' and lazy 'TL.Text' * '_head', '_tail', '_init', '_last' for * 'Vector.Vector' and variants * strict and lazy @Text@ * 'strict' and 'lazy' for @Text@ -} module Lens.Micro.Platform ( module Lens.Micro, module Lens.Micro.GHC, module Lens.Micro.Mtl, module Lens.Micro.TH, packed, unpacked, ) where import Lens.Micro.Internal import Lens.Micro import Lens.Micro.GHC import Lens.Micro.Mtl import Lens.Micro.TH import Lens.Micro.Platform.Internal import Data.Hashable import Data.Int import Data.Monoid import Data.HashMap.Lazy as HashMap import Data.Vector as Vector import Data.Vector.Primitive as Prim import Data.Vector.Storable as Storable import Data.Vector.Unboxed as Unboxed import Data.Vector.Generic as Generic import qualified Data.Text as T import qualified Data.Text.Lazy as TL #if !MIN_VERSION_base(4,8,0) import Control.Applicative #endif type instance Index (HashMap k a) = k type instance IxValue (HashMap k a) = a type instance Index (Vector.Vector a) = Int type instance IxValue (Vector.Vector a) = a type instance Index (Prim.Vector a) = Int type instance IxValue (Prim.Vector a) = a type instance Index (Storable.Vector a) = Int type instance IxValue (Storable.Vector a) = a type instance Index (Unboxed.Vector a) = Int type instance IxValue (Unboxed.Vector a) = a type instance Index T.Text = Int type instance IxValue T.Text = Char type instance Index TL.Text = Int64 type instance IxValue TL.Text = Char instance (Eq k, Hashable k) => Ixed (HashMap k a) where ix k f m = case HashMap.lookup k m of Just v -> f v <&> \v' -> HashMap.insert k v' m Nothing -> pure m {-# INLINE ix #-} instance (Eq k, Hashable k) => At (HashMap k a) where at k f m = f mv <&> \r -> case r of Nothing -> maybe m (const (HashMap.delete k m)) mv Just v' -> HashMap.insert k v' m where mv = HashMap.lookup k m {-# INLINE at #-} instance Ixed (Vector.Vector a) where ix i f v | 0 <= i && i < Vector.length v = f (v Vector.! i) <&> \a -> v Vector.// [(i, a)] | otherwise = pure v {-# INLINE ix #-} instance Prim a => Ixed (Prim.Vector a) where ix i f v | 0 <= i && i < Prim.length v = f (v Prim.! i) <&> \a -> v Prim.// [(i, a)] | otherwise = pure v {-# INLINE ix #-} instance Storable a => Ixed (Storable.Vector a) where ix i f v | 0 <= i && i < Storable.length v = f (v Storable.! i) <&> \a -> v Storable.// [(i, a)] | otherwise = pure v {-# INLINE ix #-} instance Unbox a => Ixed (Unboxed.Vector a) where ix i f v | 0 <= i && i < Unboxed.length v = f (v Unboxed.! i) <&> \a -> v Unboxed.// [(i, a)] | otherwise = pure v {-# INLINE ix #-} instance Ixed T.Text where ix e f s = case T.splitAt e s of (l, mr) -> case T.uncons mr of Nothing -> pure s Just (c, xs) -> f c <&> \d -> T.concat [l, T.singleton d, xs] {-# INLINE ix #-} instance Ixed TL.Text where ix e f s = case TL.splitAt e s of (l, mr) -> case TL.uncons mr of Nothing -> pure s Just (c, xs) -> f c <&> \d -> TL.append l (TL.cons d xs) {-# INLINE ix #-} instance Cons T.Text T.Text Char Char where _Cons f s = case T.uncons s of Just x -> uncurry T.cons <$> f x Nothing -> pure T.empty {-# INLINE _Cons #-} instance Cons TL.Text TL.Text Char Char where _Cons f s = case TL.uncons s of Just x -> uncurry TL.cons <$> f x Nothing -> pure TL.empty {-# INLINE _Cons #-} instance Snoc T.Text T.Text Char Char where _Snoc f s = if T.null s then pure T.empty else uncurry T.snoc <$> f (T.init s, T.last s) {-# INLINE _Snoc #-} instance Snoc TL.Text TL.Text Char Char where _Snoc f s = if TL.null s then pure TL.empty else uncurry TL.snoc <$> f (TL.init s, TL.last s) {-# INLINE _Snoc #-} instance Cons (Vector.Vector a) (Vector.Vector b) a b where _Cons f s = if Vector.null s then pure Vector.empty else uncurry Vector.cons <$> f (Vector.unsafeHead s, Vector.unsafeTail s) {-# INLINE _Cons #-} instance (Prim a, Prim b) => Cons (Prim.Vector a) (Prim.Vector b) a b where _Cons f s = if Prim.null s then pure Prim.empty else uncurry Prim.cons <$> f (Prim.unsafeHead s, Prim.unsafeTail s) {-# INLINE _Cons #-} instance (Storable a, Storable b) => Cons (Storable.Vector a) (Storable.Vector b) a b where _Cons f s = if Storable.null s then pure Storable.empty else uncurry Storable.cons <$> f (Storable.unsafeHead s, Storable.unsafeTail s) {-# INLINE _Cons #-} instance (Unbox a, Unbox b) => Cons (Unboxed.Vector a) (Unboxed.Vector b) a b where _Cons f s = if Unboxed.null s then pure Unboxed.empty else uncurry Unboxed.cons <$> f (Unboxed.unsafeHead s, Unboxed.unsafeTail s) {-# INLINE _Cons #-} instance Snoc (Vector.Vector a) (Vector.Vector b) a b where _Snoc f s = if Vector.null s then pure Vector.empty else uncurry Vector.snoc <$> f (Vector.unsafeInit s, Vector.unsafeLast s) {-# INLINE _Snoc #-} instance (Prim a, Prim b) => Snoc (Prim.Vector a) (Prim.Vector b) a b where _Snoc f s = if Prim.null s then pure Prim.empty else uncurry Prim.snoc <$> f (Prim.unsafeInit s, Prim.unsafeLast s) {-# INLINE _Snoc #-} instance (Storable a, Storable b) => Snoc (Storable.Vector a) (Storable.Vector b) a b where _Snoc f s = if Storable.null s then pure Storable.empty else uncurry Storable.snoc <$> f (Storable.unsafeInit s, Storable.unsafeLast s) {-# INLINE _Snoc #-} instance (Unbox a, Unbox b) => Snoc (Unboxed.Vector a) (Unboxed.Vector b) a b where _Snoc f s = if Unboxed.null s then pure Unboxed.empty else uncurry Unboxed.snoc <$> f (Unboxed.unsafeInit s, Unboxed.unsafeLast s) {-# INLINE _Snoc #-} instance Each (Vector.Vector a) (Vector.Vector b) a b where each = vectorTraverse {-# INLINE each #-} instance (Prim a, Prim b) => Each (Prim.Vector a) (Prim.Vector b) a b where each = vectorTraverse {-# INLINE each #-} instance (Storable a, Storable b) => Each (Storable.Vector a) (Storable.Vector b) a b where each = vectorTraverse {-# INLINE each #-} instance (Unbox a, Unbox b) => Each (Unboxed.Vector a) (Unboxed.Vector b) a b where each = vectorTraverse {-# INLINE each #-} instance (c ~ d) => Each (HashMap c a) (HashMap d b) a b where each = traversed {-# INLINE each #-} instance (a ~ Char, b ~ Char) => Each T.Text T.Text a b where each = strictText {-# INLINE each #-} instance (a ~ Char, b ~ Char) => Each TL.Text TL.Text a b where each = lazyText {-# INLINE each #-} strictUnpacked :: Lens' T.Text String strictUnpacked f t = T.pack <$> f (T.unpack t) {-# INLINE strictUnpacked #-} strictText :: Traversal' T.Text Char strictText = strictUnpacked . traversed {-# INLINE [0] strictText #-} {-# RULES "strict text -> map" strictText = sets T.map :: ASetter' T.Text Char; "strict text -> foldr" strictText = foldring T.foldr :: Getting (Endo r) T.Text Char; #-} lazyUnpacked :: Lens' TL.Text String lazyUnpacked f t = TL.pack <$> f (TL.unpack t) {-# INLINE lazyUnpacked #-} lazyText :: Traversal' TL.Text Char lazyText = lazyUnpacked . traversed {-# INLINE [0] lazyText #-} {-# RULES "lazy text -> map" lazyText = sets TL.map :: ASetter' TL.Text Char; "lazy text -> foldr" lazyText = foldring TL.foldr :: Getting (Endo r) TL.Text Char; #-} vectorTraverse :: (Generic.Vector v a, Generic.Vector w b) => Traversal (v a) (w b) a b vectorTraverse f v = Generic.fromListN (Generic.length v) <$> traversed f (Generic.toList v) {-# INLINE [0] vectorTraverse #-} {-# RULES "vectorTraverse -> mapped" vectorTraverse = sets Generic.map :: (Generic.Vector v a, Generic.Vector v b) => ASetter (v a) (v b) a b; "vectorTraverse -> foldr" vectorTraverse = foldring Generic.foldr :: Generic.Vector v a => Getting (Endo r) (v a) a; #-} instance Strict TL.Text T.Text where strict f s = TL.fromStrict <$> f (TL.toStrict s) {-# INLINE strict #-} lazy f s = TL.toStrict <$> f (TL.fromStrict s) {-# INLINE lazy #-} microlens-platform-0.4.1/src/Lens/Micro/Platform/Internal.hs0000644000000000000000000000240313461057432022160 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE Safe #-} {- | Module : Lens.Micro.Platform.Internal Copyright : (C) 2013-2016 Edward Kmett, 2015-2016 Artyom Kazak, 2018 Monadfix License : BSD-style (see the file LICENSE) -} module Lens.Micro.Platform.Internal ( IsText(..), ) where import Lens.Micro import qualified Data.Text as T import qualified Data.Text.Lazy as TL #if !MIN_VERSION_base(4,8,0) import Control.Applicative #endif class IsText t where {- | 'packed' lets you convert between 'String' and @Text@ (strict or lazy). It can be used as a replacement for @pack@ or as a way to modify some 'String' if you have a function like @Text -> Text@. -} packed :: Lens' String t {- | 'unpacked' is like 'packed' but works in the opposite direction. -} unpacked :: Lens' t String instance IsText String where packed = id {-# INLINE packed #-} unpacked = id {-# INLINE unpacked #-} instance IsText T.Text where packed f s = T.unpack <$> f (T.pack s) {-# INLINE packed #-} unpacked f s = T.pack <$> f (T.unpack s) {-# INLINE unpacked #-} instance IsText TL.Text where packed f s = TL.unpack <$> f (TL.pack s) {-# INLINE packed #-} unpacked f s = TL.pack <$> f (TL.unpack s) {-# INLINE unpacked #-} microlens-platform-0.4.1/LICENSE0000644000000000000000000000306513461057432014535 0ustar0000000000000000Copyright (c) 2012-2016 Edward Kmett, 2015-2016 Artyom Kazak, 2018 Monadfix 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 Monadfix 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-platform-0.4.1/Setup.hs0000644000000000000000000000005613461057432015161 0ustar0000000000000000import Distribution.Simple main = defaultMain microlens-platform-0.4.1/microlens-platform.cabal0000644000000000000000000000530413614145422020324 0ustar0000000000000000name: microlens-platform version: 0.4.1 synopsis: microlens + all batteries included (best for apps) description: This package exports a module which is the recommended starting point for using if you aren't trying to keep your dependencies minimal. By importing @Lens.Micro.Platform@ you get all functions and instances from , , , , as well as instances for @Vector@, @Text@, and @HashMap@. . The minor and major versions of microlens-platform are incremented whenever the minor and major versions of any other microlens package are incremented, so you can depend on the exact version of microlens-platform without specifying the version of microlens (microlens-mtl, etc) you need. . This package is a part of the family; see the readme . license: BSD3 license-file: LICENSE author: Edward Kmett, Artyom Kazak maintainer: Monadfix homepage: http://github.com/monadfix/microlens bug-reports: http://github.com/monadfix/microlens/issues category: Data, Lenses build-type: Simple extra-source-files: CHANGELOG.md cabal-version: >=1.10 tested-with: GHC==7.4.2 GHC==7.6.3 GHC==7.8.4 GHC==7.10.3 GHC==8.0.2 GHC==8.2.2 GHC==8.4.4 GHC==8.6.5 GHC==8.8.1 source-repository head type: git location: git://github.com/monadfix/microlens.git library exposed-modules: Lens.Micro.Platform Lens.Micro.Platform.Internal -- other-modules: -- other-extensions: build-depends: base >=4.5 && <5 , hashable >=1.1.2.3 && <1.4 , microlens ==0.4.11.* , microlens-ghc ==0.4.12.* , microlens-mtl ==0.2.0.* , microlens-th ==0.4.3.* , text >=0.11 && <1.3 , unordered-containers >=0.2.4 && <0.3 , vector >=0.9 && <0.13 ghc-options: -Wall -fwarn-tabs -O2 -fdicts-cheap -funbox-strict-fields -fmax-simplifier-iterations=10 hs-source-dirs: src default-language: Haskell2010 microlens-platform-0.4.1/CHANGELOG.md0000644000000000000000000000377513614145422015346 0ustar0000000000000000# 0.4.1 * New minor release (microlens-ghc-0.4.12). # 0.4.0 * New major release (microlens-0.4.11, microlens-ghc-0.4.11, microlens-th-0.4.3, microlens-mtl-0.2.0). # 0.3.11 * New minor release (microlens-0.4.10, microlens-ghc-0.4.10). # 0.3.10 * New minor release (microlens-0.4.9, microlens-ghc-0.4.9, microlens-th-0.4.2). # 0.3.9.0 * New minor release (microlens-mtl-0.1.11). # 0.3.8.0 * New minor release (microlens-0.4.8, microlens-ghc-0.4.8). # 0.3.7.1 * Bumped `vector` upper bound. # 0.3.7.0 * New minor release (microlens-th-0.4.1). # 0.3.6.0 * New minor release (microlens-0.4.7, microlens-ghc-0.4.7). # 0.3.5.0 * New minor release (microlens-mtl-0.1.10). # 0.3.4.0 * New minor release (microlens-0.4.6, microlens-ghc-0.4.6). # 0.3.3.0 * New minor release (microlens-mtl-0.1.9). # 0.3.2.0 * New minor release (microlens-0.4.5, microlens-ghc-0.4.5, microlens-th-0.1.8). # 0.3.1.1 * Reexport `Lens.Micro` explicitly to make it clearer that it's exported. # 0.3.1.0 * New minor release (microlens-0.4.4, microlens-ghc-0.4.4). # 0.3.0.0 * New major release (microlens-0.4.3, microlens-ghc-0.4.3, microlens-th-0.4). # 0.2.3.1 * Added forgotten copyright/authorship information. # 0.2.3.0 * New minor release (microlens-0.4.2, microlens-ghc-0.4.2). # 0.2.2.0 * New minor release (microlens-mtl-0.1.7). # 0.2.1.0 * Added `packed` and `unpacked`. * Added instances for `Strict`. * New minor release (microlens-0.4.1, microlens-ghc-0.4.1). # 0.2.0.0 * New major release (microlens-0.4, microlens-th-0.3, microlens-ghc-0.4). # 0.1.7.0 * New minor release (microlens-0.3.5, microlens-th-0.2.2, microlens-ghc-0.3.1). # 0.1.6.0 * A missing instance of `At` for `HashMap` has been added. # 0.1.5.0 * New minor release (microlens-mtl-0.1.6). # 0.1.4.0 * New minor release (microlens-0.3.4). # 0.1.3.0 * Added Safe Haskell pragmas. * New minor release (microlens-0.3.3). # 0.1.2.0 * New minor release (microlens-0.3.2). # 0.1.1.0 * New minor release (microlens-0.3.1). # 0.1.0.0 Initial release.