1{-# LANGUAGE CPP #-} 2{-# LANGUAGE TypeFamilies #-} 3{-# LANGUAGE MultiParamTypeClasses #-} 4{-# LANGUAGE FlexibleInstances #-} 5{-# LANGUAGE UndecidableInstances #-} 6{-# LANGUAGE Trustworthy #-} 7 8{-# OPTIONS_GHC -fno-warn-orphans #-} 9 10#ifndef MIN_VERSION_base 11#define MIN_VERSION_base(x,y,z) 1 12#endif 13 14 15{- | 16Module : Lens.Micro.Platform 17Copyright : (C) 2013-2016 Edward Kmett, 2015-2016 Artyom Kazak, 2018 Monadfix 18License : BSD-style (see the file LICENSE) 19 20This module is an approximation for @<http://hackage.haskell.org/package/lens/docs/Control-Lens.html Control.Lens>@ from <http://hackage.haskell.org/package/lens lens>; by importing it you get all functions and instances from <http://hackage.haskell.org/package/microlens microlens>, <http://hackage.haskell.org/package/microlens-mtl microlens-mtl>, <http://hackage.haskell.org/package/microlens-ghc microlens-ghc>, as well as the following instances: 21 22* 'at' for 'HashMap' 23 24* 'each' and 'ix' for 25 26 * 'HashMap' 27 * 'Vector.Vector' and variants (unboxed vectors, etc) 28 * strict 'T.Text' and lazy 'TL.Text' 29 30* '_head', '_tail', '_init', '_last' for 31 32 * 'Vector.Vector' and variants 33 * strict and lazy @Text@ 34 35* 'strict' and 'lazy' for @Text@ 36-} 37module Lens.Micro.Platform 38( 39 module Lens.Micro, 40 module Lens.Micro.GHC, 41 module Lens.Micro.Mtl, 42 module Lens.Micro.TH, 43 packed, unpacked, 44) 45where 46 47 48import Lens.Micro.Internal 49import Lens.Micro 50import Lens.Micro.GHC 51import Lens.Micro.Mtl 52import Lens.Micro.TH 53import Lens.Micro.Platform.Internal 54 55import Data.Hashable 56import Data.Int 57import Data.Monoid 58 59import Data.HashMap.Lazy as HashMap 60import Data.Vector as Vector 61import Data.Vector.Primitive as Prim 62import Data.Vector.Storable as Storable 63import Data.Vector.Unboxed as Unboxed 64import Data.Vector.Generic as Generic 65 66import qualified Data.Text as T 67import qualified Data.Text.Lazy as TL 68 69#if !MIN_VERSION_base(4,8,0) 70import Control.Applicative 71#endif 72 73 74type instance Index (HashMap k a) = k 75type instance IxValue (HashMap k a) = a 76type instance Index (Vector.Vector a) = Int 77type instance IxValue (Vector.Vector a) = a 78type instance Index (Prim.Vector a) = Int 79type instance IxValue (Prim.Vector a) = a 80type instance Index (Storable.Vector a) = Int 81type instance IxValue (Storable.Vector a) = a 82type instance Index (Unboxed.Vector a) = Int 83type instance IxValue (Unboxed.Vector a) = a 84type instance Index T.Text = Int 85type instance IxValue T.Text = Char 86type instance Index TL.Text = Int64 87type instance IxValue TL.Text = Char 88 89instance (Eq k, Hashable k) => Ixed (HashMap k a) where 90 ix k f m = case HashMap.lookup k m of 91 Just v -> f v <&> \v' -> HashMap.insert k v' m 92 Nothing -> pure m 93 {-# INLINE ix #-} 94 95instance (Eq k, Hashable k) => At (HashMap k a) where 96 at k f m = f mv <&> \r -> case r of 97 Nothing -> maybe m (const (HashMap.delete k m)) mv 98 Just v' -> HashMap.insert k v' m 99 where mv = HashMap.lookup k m 100 {-# INLINE at #-} 101 102instance Ixed (Vector.Vector a) where 103 ix i f v 104 | 0 <= i && i < Vector.length v = f (v Vector.! i) <&> \a -> v Vector.// [(i, a)] 105 | otherwise = pure v 106 {-# INLINE ix #-} 107 108instance Prim a => Ixed (Prim.Vector a) where 109 ix i f v 110 | 0 <= i && i < Prim.length v = f (v Prim.! i) <&> \a -> v Prim.// [(i, a)] 111 | otherwise = pure v 112 {-# INLINE ix #-} 113 114instance Storable a => Ixed (Storable.Vector a) where 115 ix i f v 116 | 0 <= i && i < Storable.length v = f (v Storable.! i) <&> \a -> v Storable.// [(i, a)] 117 | otherwise = pure v 118 {-# INLINE ix #-} 119 120instance Unbox a => Ixed (Unboxed.Vector a) where 121 ix i f v 122 | 0 <= i && i < Unboxed.length v = f (v Unboxed.! i) <&> \a -> v Unboxed.// [(i, a)] 123 | otherwise = pure v 124 {-# INLINE ix #-} 125 126instance Ixed T.Text where 127 ix e f s = case T.splitAt e s of 128 (l, mr) -> case T.uncons mr of 129 Nothing -> pure s 130 Just (c, xs) -> f c <&> \d -> T.concat [l, T.singleton d, xs] 131 {-# INLINE ix #-} 132 133instance Ixed TL.Text where 134 ix e f s = case TL.splitAt e s of 135 (l, mr) -> case TL.uncons mr of 136 Nothing -> pure s 137 Just (c, xs) -> f c <&> \d -> TL.append l (TL.cons d xs) 138 {-# INLINE ix #-} 139 140instance Cons T.Text T.Text Char Char where 141 _Cons f s = case T.uncons s of 142 Just x -> uncurry T.cons <$> f x 143 Nothing -> pure T.empty 144 {-# INLINE _Cons #-} 145 146instance Cons TL.Text TL.Text Char Char where 147 _Cons f s = case TL.uncons s of 148 Just x -> uncurry TL.cons <$> f x 149 Nothing -> pure TL.empty 150 {-# INLINE _Cons #-} 151 152instance Snoc T.Text T.Text Char Char where 153 _Snoc f s = if T.null s 154 then pure T.empty 155 else uncurry T.snoc <$> f (T.init s, T.last s) 156 {-# INLINE _Snoc #-} 157 158instance Snoc TL.Text TL.Text Char Char where 159 _Snoc f s = if TL.null s 160 then pure TL.empty 161 else uncurry TL.snoc <$> f (TL.init s, TL.last s) 162 {-# INLINE _Snoc #-} 163 164instance Cons (Vector.Vector a) (Vector.Vector b) a b where 165 _Cons f s = if Vector.null s 166 then pure Vector.empty 167 else uncurry Vector.cons <$> f (Vector.unsafeHead s, Vector.unsafeTail s) 168 {-# INLINE _Cons #-} 169 170instance (Prim a, Prim b) => Cons (Prim.Vector a) (Prim.Vector b) a b where 171 _Cons f s = if Prim.null s 172 then pure Prim.empty 173 else uncurry Prim.cons <$> f (Prim.unsafeHead s, Prim.unsafeTail s) 174 {-# INLINE _Cons #-} 175 176instance (Storable a, Storable b) => Cons (Storable.Vector a) (Storable.Vector b) a b where 177 _Cons f s = if Storable.null s 178 then pure Storable.empty 179 else uncurry Storable.cons <$> f (Storable.unsafeHead s, Storable.unsafeTail s) 180 {-# INLINE _Cons #-} 181 182instance (Unbox a, Unbox b) => Cons (Unboxed.Vector a) (Unboxed.Vector b) a b where 183 _Cons f s = if Unboxed.null s 184 then pure Unboxed.empty 185 else uncurry Unboxed.cons <$> f (Unboxed.unsafeHead s, Unboxed.unsafeTail s) 186 {-# INLINE _Cons #-} 187 188instance Snoc (Vector.Vector a) (Vector.Vector b) a b where 189 _Snoc f s = if Vector.null s 190 then pure Vector.empty 191 else uncurry Vector.snoc <$> f (Vector.unsafeInit s, Vector.unsafeLast s) 192 {-# INLINE _Snoc #-} 193 194instance (Prim a, Prim b) => Snoc (Prim.Vector a) (Prim.Vector b) a b where 195 _Snoc f s = if Prim.null s 196 then pure Prim.empty 197 else uncurry Prim.snoc <$> f (Prim.unsafeInit s, Prim.unsafeLast s) 198 {-# INLINE _Snoc #-} 199 200instance (Storable a, Storable b) => Snoc (Storable.Vector a) (Storable.Vector b) a b where 201 _Snoc f s = if Storable.null s 202 then pure Storable.empty 203 else uncurry Storable.snoc <$> f (Storable.unsafeInit s, Storable.unsafeLast s) 204 {-# INLINE _Snoc #-} 205 206instance (Unbox a, Unbox b) => Snoc (Unboxed.Vector a) (Unboxed.Vector b) a b where 207 _Snoc f s = if Unboxed.null s 208 then pure Unboxed.empty 209 else uncurry Unboxed.snoc <$> f (Unboxed.unsafeInit s, Unboxed.unsafeLast s) 210 {-# INLINE _Snoc #-} 211 212instance Each (Vector.Vector a) (Vector.Vector b) a b where 213 each = vectorTraverse 214 {-# INLINE each #-} 215 216instance (Prim a, Prim b) => Each (Prim.Vector a) (Prim.Vector b) a b where 217 each = vectorTraverse 218 {-# INLINE each #-} 219 220instance (Storable a, Storable b) => Each (Storable.Vector a) (Storable.Vector b) a b where 221 each = vectorTraverse 222 {-# INLINE each #-} 223 224instance (Unbox a, Unbox b) => Each (Unboxed.Vector a) (Unboxed.Vector b) a b where 225 each = vectorTraverse 226 {-# INLINE each #-} 227 228instance (c ~ d) => Each (HashMap c a) (HashMap d b) a b where 229 each = traversed 230 {-# INLINE each #-} 231 232instance (a ~ Char, b ~ Char) => Each T.Text T.Text a b where 233 each = strictText 234 {-# INLINE each #-} 235 236instance (a ~ Char, b ~ Char) => Each TL.Text TL.Text a b where 237 each = lazyText 238 {-# INLINE each #-} 239 240strictUnpacked :: Lens' T.Text String 241strictUnpacked f t = T.pack <$> f (T.unpack t) 242{-# INLINE strictUnpacked #-} 243 244strictText :: Traversal' T.Text Char 245strictText = strictUnpacked . traversed 246{-# INLINE [0] strictText #-} 247 248{-# RULES 249"strict text -> map" strictText = sets T.map :: ASetter' T.Text Char; 250"strict text -> foldr" strictText = foldring T.foldr :: Getting (Endo r) T.Text Char; 251 #-} 252 253lazyUnpacked :: Lens' TL.Text String 254lazyUnpacked f t = TL.pack <$> f (TL.unpack t) 255{-# INLINE lazyUnpacked #-} 256 257lazyText :: Traversal' TL.Text Char 258lazyText = lazyUnpacked . traversed 259{-# INLINE [0] lazyText #-} 260 261{-# RULES 262"lazy text -> map" lazyText = sets TL.map :: ASetter' TL.Text Char; 263"lazy text -> foldr" lazyText = foldring TL.foldr :: Getting (Endo r) TL.Text Char; 264 #-} 265 266vectorTraverse :: (Generic.Vector v a, Generic.Vector w b) => Traversal (v a) (w b) a b 267vectorTraverse f v = Generic.fromListN (Generic.length v) <$> traversed f (Generic.toList v) 268{-# INLINE [0] vectorTraverse #-} 269 270{-# RULES 271"vectorTraverse -> mapped" vectorTraverse = sets Generic.map :: (Generic.Vector v a, Generic.Vector v b) => ASetter (v a) (v b) a b; 272"vectorTraverse -> foldr" vectorTraverse = foldring Generic.foldr :: Generic.Vector v a => Getting (Endo r) (v a) a; 273 #-} 274 275instance Strict TL.Text T.Text where 276 strict f s = TL.fromStrict <$> f (TL.toStrict s) 277 {-# INLINE strict #-} 278 lazy f s = TL.toStrict <$> f (TL.fromStrict s) 279 {-# INLINE lazy #-} 280