kaushikc.org / lets-lens
this repo has no description
0
fork

Configure Feed

Select the types of activity you want to include in your feed.

move modules around

Tony Morris f960fb1b e3f9926b

+792 -800
+2 -2
README.markdown
··· 16 16 to study the history of lenses, then build up to the most recent theories, it is 17 17 best to start at the `Lets.GetSetLens` module. If you wish to derive the 18 18 structure of lenses from first principles, then derive the more modern theories, 19 - start at the `Lets.Lens.Lens` module. 19 + start at the `Lets.Lens` module. 20 20 21 21 Exercises can be recognised by filling in a function body that has a placeholder 22 22 of `error "todo: <function-name>"`. ··· 49 49 described by Twan van Laarhoven. This representation also introduces a 50 50 generalisation of lenses to permit *polymorphic update* of structures. 51 51 52 - ##### `Lets.Lens.Lens` 52 + ##### `Lets.Lens` 53 53 54 54 This series of exercises starts at first principles to derive the concept of a 55 55 lens, as it was first described by Twan van Laarhoven. The derivation then goes
+2 -3
lets-lens.cabal
··· 39 39 hs-source-dirs: src 40 40 41 41 exposed-modules: Lets 42 + Lets.Choice 42 43 Lets.Data 43 44 Lets.GetSetLens 44 45 Lets.Lens 45 - Lets.Lens.Choice 46 - Lets.Lens.Lens 47 - Lets.Lens.Profunctor 48 46 Lets.OpticPolyLens 47 + Lets.Profunctor 49 48 Lets.StoreLens 50 49 51 50 test-suite doctests
+785 -4
src/Lets/Lens.hs
··· 1 + {-# LANGUAGE RankNTypes #-} 2 + 1 3 module Lets.Lens ( 2 - module L 4 + fmapT 5 + , over 6 + , fmapTAgain 7 + , Set 8 + , sets 9 + , mapped 10 + , set 11 + , foldMapT 12 + , foldMapOf 13 + , foldMapTAgain 14 + , Fold 15 + , folds 16 + , folded 17 + , Get 18 + , get 19 + , Traversal 20 + , both 21 + , traverseLeft 22 + , traverseRight 23 + , Traversal' 24 + , Lens 25 + , Prism 26 + , _Left 27 + , _Right 28 + , prism 29 + , _Just 30 + , _Nothing 31 + , setP 32 + , getP 33 + , Prism' 34 + , modify 35 + , (%~) 36 + , (.~) 37 + , fmodify 38 + , (|=) 39 + , fstL 40 + , sndL 41 + , mapL 42 + , setL 43 + , compose 44 + , (|.) 45 + , identity 46 + , product 47 + , (***) 48 + , choice 49 + , (|||) 50 + , Lens' 51 + , cityL 52 + , stateL 53 + , countryL 54 + , streetL 55 + , suburbL 56 + , localityL 57 + , ageL 58 + , nameL 59 + , addressL 60 + , intAndIntL 61 + , intAndL 62 + , getSuburb 63 + , setStreet 64 + , getAgeAndCountry 65 + , setCityAndLocality 66 + , getSuburbOrCity 67 + , setStreetOrState 68 + , modifyCityUppercase 69 + , modifyIntAndLengthEven 70 + , traverseLocality 71 + , intOrIntP 72 + , intOrP 73 + , intOrLengthEven 3 74 ) where 4 75 5 - import Lets.Lens.Choice as L 6 - import Lets.Lens.Lens as L 7 - import Lets.Lens.Profunctor as L 76 + import Control.Applicative(Applicative((<*>), pure)) 77 + import Data.Bool(bool) 78 + import Data.Char(toUpper) 79 + import Data.Foldable(Foldable(foldMap)) 80 + import Data.Functor((<$>)) 81 + import Data.Map(Map) 82 + import qualified Data.Map as Map(insert, delete, lookup) 83 + import Data.Monoid(Monoid) 84 + import qualified Data.Set as Set(Set, insert, delete, member) 85 + import Data.Traversable(Traversable(traverse)) 86 + import Lets.Data(AlongsideLeft(AlongsideLeft, getAlongsideLeft), AlongsideRight(AlongsideRight, getAlongsideRight), Identity(Identity, getIdentity), Const(Const, getConst), Tagged(Tagged, getTagged), IntOr(IntOrIs, IntOrIsNot), IntAnd(IntAnd), Person(Person), Locality(Locality), Address(Address)) 87 + import Lets.Choice(Choice(left, right)) 88 + import Lets.Profunctor(Profunctor(dimap)) 89 + import Prelude hiding (product) 90 + 91 + -- $setup 92 + -- >>> import qualified Data.Map as Map(fromList) 93 + -- >>> import qualified Data.Set as Set(fromList) 94 + -- >>> import Data.Char(ord) 95 + 96 + -- Let's remind ourselves of Traversable, noting Foldable and Functor. 97 + -- 98 + -- class (Foldable t, Functor t) => Traversable t where 99 + -- traverse :: 100 + -- Applicative f => 101 + -- (a -> f b) 102 + -- -> t a 103 + -- -> f (t b) 104 + 105 + -- | Observe that @fmap@ can be recovered from @traverse@ using @Identity@. 106 + -- 107 + -- /Reminder:/ fmap :: Functor t => (a -> b) -> t a -> t b 108 + fmapT :: 109 + Traversable t => 110 + (a -> b) 111 + -> t a 112 + -> t b 113 + fmapT = 114 + error "todo: fmapT" 115 + 116 + -- | Let's refactor out the call to @traverse@ as an argument to @fmapT@. 117 + over :: 118 + ((a -> Identity b) -> s -> Identity t) 119 + -> (a -> b) 120 + -> s 121 + -> t 122 + over = 123 + error "todo: over" 124 + 125 + -- | Here is @fmapT@ again, passing @traverse@ to @over@. 126 + fmapTAgain :: 127 + Traversable t => 128 + (a -> b) 129 + -> t a 130 + -> t b 131 + fmapTAgain = 132 + error "todo: fmapTAgain" 133 + 134 + -- | Let's create a type-alias for this type of function. 135 + type Set s t a b = 136 + (a -> Identity b) 137 + -> s 138 + -> Identity t 139 + 140 + -- | Let's write an inverse to @over@ that does the @Identity@ wrapping & 141 + -- unwrapping. 142 + sets :: 143 + ((a -> b) -> s -> t) 144 + -> Set s t a b 145 + sets = 146 + error "todo: sets" 147 + 148 + mapped :: 149 + Functor f => 150 + Set (f a) (f b) a b 151 + mapped = 152 + error "todo: mapped" 153 + 154 + set :: 155 + Set s t a b 156 + -> s 157 + -> b 158 + -> t 159 + set = 160 + error "todo: set" 161 + 162 + ---- 163 + 164 + -- | Observe that @fmap@ can be recovered from @traverse@ using @Identity@. 165 + -- 166 + -- /Reminder:/ foldMap :: (Foldable t, Monoid b) => (a -> b) -> t a -> b 167 + foldMapT :: 168 + (Traversable t, Monoid b) => 169 + (a -> b) 170 + -> t a 171 + -> b 172 + foldMapT = 173 + error "todo: foldMapT" 174 + 175 + -- | Let's refactor out the call to @traverse@ as an argument to @foldMapT@. 176 + foldMapOf :: 177 + ((a -> Const r b) -> s -> Const r t) 178 + -> (a -> r) 179 + -> s 180 + -> r 181 + foldMapOf = 182 + error "todo: foldMapOf" 183 + 184 + -- | Here is @foldMapT@ again, passing @traverse@ to @foldMapOf@. 185 + foldMapTAgain :: 186 + (Traversable t, Monoid b) => 187 + (a -> b) 188 + -> t a 189 + -> b 190 + foldMapTAgain = 191 + error "todo: foldMapTAgain" 192 + 193 + -- | Let's create a type-alias for this type of function. 194 + type Fold s t a b = 195 + forall r. 196 + Monoid r => 197 + (a -> Const r b) 198 + -> s 199 + -> Const r t 200 + 201 + -- | Let's write an inverse to @foldMapOf@ that does the @Const@ wrapping & 202 + -- unwrapping. 203 + folds :: 204 + ((a -> b) -> s -> t) 205 + -> (a -> Const b a) 206 + -> s 207 + -> Const t s 208 + folds = 209 + error "todo: folds" 210 + 211 + folded :: 212 + Foldable f => 213 + Fold (f a) (f a) a a 214 + folded = 215 + error "todo: folded" 216 + 217 + ---- 218 + 219 + -- | @Get@ is like @Fold@, but without the @Monoid@ constraint. 220 + type Get r s a = 221 + (a -> Const r a) 222 + -> s 223 + -> Const r s 224 + 225 + get :: 226 + Get a s a 227 + -> s 228 + -> a 229 + get = 230 + error "todo: get" 231 + 232 + ---- 233 + 234 + -- | Let's generalise @Identity@ and @Const r@ to any @Applicative@ instance. 235 + type Traversal s t a b = 236 + forall f. 237 + Applicative f => 238 + (a -> f b) 239 + -> s 240 + -> f t 241 + 242 + -- | Traverse both sides of a pair. 243 + both :: 244 + Traversal (a, a) (b, b) a b 245 + both = 246 + error "todo: both" 247 + 248 + -- | Traverse the left side of @Either@. 249 + traverseLeft :: 250 + Traversal (Either a x) (Either b x) a b 251 + traverseLeft = 252 + error "todo: traverseLeft" 253 + 254 + -- | Traverse the right side of @Either@. 255 + traverseRight :: 256 + Traversal (Either x a) (Either x b) a b 257 + traverseRight = 258 + error "todo: traverseRight" 259 + 260 + type Traversal' a b = 261 + Traversal a a b b 262 + 263 + ---- 264 + 265 + -- | @Const r@ is @Applicative@, if @Monoid r@, however, without the @Monoid@ 266 + -- constraint (as in @Get@), the only shared abstraction between @Identity@ and 267 + -- @Const r@ is @Functor@. 268 + -- 269 + -- Consequently, we arrive at our lens derivation: 270 + type Lens s t a b = 271 + forall f. 272 + Functor f => 273 + (a -> f b) 274 + -> s 275 + -> f t 276 + 277 + ---- 278 + 279 + -- | A prism is a less specific type of traversal. 280 + type Prism s t a b = 281 + forall p f. 282 + (Choice p, Applicative f) => 283 + p a (f b) 284 + -> p s (f t) 285 + 286 + _Left :: 287 + Prism (Either a x) (Either b x) a b 288 + _Left = 289 + error "todo: _Left" 290 + 291 + _Right :: 292 + Prism (Either x a) (Either x b) a b 293 + _Right = 294 + error "todo: _Right" 295 + 296 + prism :: 297 + (b -> t) 298 + -> (s -> Either t a) 299 + -> Prism s t a b 300 + prism = 301 + error "todo: prism" 302 + 303 + _Just :: 304 + Prism (Maybe a) (Maybe b) a b 305 + _Just = 306 + error "todo: _Just" 307 + 308 + _Nothing :: 309 + Prism (Maybe a) (Maybe a) () () 310 + _Nothing = 311 + error "todo: _Nothing" 312 + 313 + setP :: 314 + Prism s t a b 315 + -> s 316 + -> Either t a 317 + setP = 318 + error "todo: setP" 319 + 320 + getP :: 321 + Prism s t a b 322 + -> b 323 + -> t 324 + getP = 325 + error "todo: getP" 326 + 327 + type Prism' a b = 328 + Prism a a b b 329 + 330 + ---- 331 + 332 + -- | 333 + -- 334 + -- >>> modify fstL (+1) (0 :: Int, "abc") 335 + -- (1,"abc") 336 + -- 337 + -- >>> modify sndL (+1) ("abc", 0 :: Int) 338 + -- ("abc",1) 339 + -- 340 + -- prop> let types = (x :: Int, y :: String) in modify fstL id (x, y) == (x, y) 341 + -- 342 + -- prop> let types = (x :: Int, y :: String) in modify sndL id (x, y) == (x, y) 343 + modify :: 344 + Lens s t a b 345 + -> (a -> b) 346 + -> s 347 + -> t 348 + modify = 349 + error "todo: modify" 350 + 351 + -- | An alias for @modify@. 352 + (%~) :: 353 + Lens s t a b 354 + -> (a -> b) 355 + -> s 356 + -> t 357 + (%~) = 358 + modify 359 + 360 + infixr 4 %~ 361 + 362 + -- | 363 + -- 364 + -- >>> fstL .~ 1 $ (0 :: Int, "abc") 365 + -- (1,"abc") 366 + -- 367 + -- >>> sndL .~ 1 $ ("abc", 0 :: Int) 368 + -- ("abc",1) 369 + -- 370 + -- prop> let types = (x :: Int, y :: String) in set fstL (x, y) z == (fstL .~ z $ (x, y)) 371 + -- 372 + -- prop> let types = (x :: Int, y :: String) in set sndL (x, y) z == (sndL .~ z $ (x, y)) 373 + (.~) :: 374 + Lens s t a b 375 + -> b 376 + -> s 377 + -> t 378 + (.~) = 379 + error "todo: (.~)" 380 + 381 + infixl 5 .~ 382 + 383 + -- | 384 + -- 385 + -- >>> fmodify fstL (+) (5 :: Int, "abc") 8 386 + -- (13,"abc") 387 + -- 388 + -- >>> fmodify fstL (\n -> bool Nothing (Just (n * 2)) (even n)) (10, "abc") 389 + -- Just (20,"abc") 390 + -- 391 + -- >>> fmodify fstL (\n -> bool Nothing (Just (n * 2)) (even n)) (11, "abc") 392 + -- Nothing 393 + fmodify :: 394 + Functor f => 395 + Lens s t a b 396 + -> (a -> f b) 397 + -> s 398 + -> f t 399 + fmodify = 400 + error "todo: fmodify" 401 + 402 + -- | 403 + -- 404 + -- >>> fstL |= Just 3 $ (7, "abc") 405 + -- Just (3,"abc") 406 + -- 407 + -- >>> (fstL |= (+1) $ (3, "abc")) 17 408 + -- (18,"abc") 409 + (|=) :: 410 + Functor f => 411 + Lens s t a b 412 + -> f b 413 + -> s 414 + -> f t 415 + (|=) = 416 + error "todo: (|=)" 417 + 418 + infixl 5 |= 419 + 420 + -- | 421 + -- 422 + -- >>> modify fstL (*10) (3, "abc") 423 + -- (30,"abc") 424 + fstL :: 425 + Lens (a, x) (b, x) a b 426 + fstL = 427 + error "todo: fstL" 428 + 429 + -- | 430 + -- 431 + -- >>> modify sndL (++ "def") (13, "abc") 432 + -- (13,"abcdef") 433 + sndL :: 434 + Lens (x, a) (x, b) a b 435 + sndL = 436 + error "todo: sndL" 437 + 438 + -- | 439 + -- 440 + -- >>> get (mapL 3) (Map.fromList (map (\c -> (ord c - 96, c)) ['a'..'d'])) 441 + -- Just 'c' 442 + -- 443 + -- >>> get (mapL 33) (Map.fromList (map (\c -> (ord c - 96, c)) ['a'..'d'])) 444 + -- Nothing 445 + -- 446 + -- >>> set (mapL 3) (Map.fromList (map (\c -> (ord c - 96, c)) ['a'..'d'])) (Just 'X') 447 + -- fromList [(1,'a'),(2,'b'),(3,'X'),(4,'d')] 448 + -- 449 + -- >>> set (mapL 33) (Map.fromList (map (\c -> (ord c - 96, c)) ['a'..'d'])) (Just 'X') 450 + -- fromList [(1,'a'),(2,'b'),(3,'c'),(4,'d'),(33,'X')] 451 + -- 452 + -- >>> set (mapL 3) (Map.fromList (map (\c -> (ord c - 96, c)) ['a'..'d'])) Nothing 453 + -- fromList [(1,'a'),(2,'b'),(4,'d')] 454 + -- 455 + -- >>> set (mapL 33) (Map.fromList (map (\c -> (ord c - 96, c)) ['a'..'d'])) Nothing 456 + -- fromList [(1,'a'),(2,'b'),(3,'c'),(4,'d')] 457 + mapL :: 458 + Ord k => 459 + k 460 + -> Lens (Map k v) (Map k v) (Maybe v) (Maybe v) 461 + mapL = 462 + error "todo: mapL" 463 + 464 + -- | 465 + -- 466 + -- >>> get (setL 3) (Set.fromList [1..5]) 467 + -- True 468 + -- 469 + -- >>> get (setL 33) (Set.fromList [1..5]) 470 + -- False 471 + -- 472 + -- >>> set (setL 3) (Set.fromList [1..5]) True 473 + -- fromList [1,2,3,4,5] 474 + -- 475 + -- >>> set (setL 3) (Set.fromList [1..5]) False 476 + -- fromList [1,2,4,5] 477 + -- 478 + -- >>> set (setL 33) (Set.fromList [1..5]) True 479 + -- fromList [1,2,3,4,5,33] 480 + -- 481 + -- >>> set (setL 33) (Set.fromList [1..5]) False 482 + -- fromList [1,2,3,4,5] 483 + setL :: 484 + Ord k => 485 + k 486 + -> Lens (Set.Set k) (Set.Set k) Bool Bool 487 + setL = 488 + error "todo: setL" 489 + 490 + -- | 491 + -- 492 + -- >>> get (compose fstL sndL) ("abc", (7, "def")) 493 + -- 7 494 + -- 495 + -- >>> set (compose fstL sndL) ("abc", (7, "def")) 8 496 + -- ("abc",(8,"def")) 497 + compose :: 498 + Lens s t a b 499 + -> Lens q r s t 500 + -> Lens q r a b 501 + compose = 502 + error "todo: compose" 503 + 504 + -- | An alias for @compose@. 505 + (|.) :: 506 + Lens s t a b 507 + -> Lens q r s t 508 + -> Lens q r a b 509 + (|.) = 510 + compose 511 + 512 + infixr 9 |. 513 + 514 + -- | 515 + -- 516 + -- >>> get identity 3 517 + -- 3 518 + -- 519 + -- >>> set identity 3 4 520 + -- 4 521 + identity :: 522 + Lens a b a b 523 + identity = 524 + error "todo: identity" 525 + 526 + -- | 527 + -- 528 + -- >>> get (product fstL sndL) (("abc", 3), (4, "def")) 529 + -- ("abc","def") 530 + -- 531 + -- >>> set (product fstL sndL) (("abc", 3), (4, "def")) ("ghi", "jkl") 532 + -- (("ghi",3),(4,"jkl")) 533 + product :: 534 + Lens s t a b 535 + -> Lens q r c d 536 + -> Lens (s, q) (t, r) (a, c) (b, d) 537 + product = 538 + error "todo: product" 539 + 540 + -- | An alias for @product@. 541 + (***) :: 542 + Lens s t a b 543 + -> Lens q r c d 544 + -> Lens (s, q) (t, r) (a, c) (b, d) 545 + (***) = 546 + product 547 + 548 + infixr 3 *** 549 + 550 + -- | 551 + -- 552 + -- >>> get (choice fstL sndL) (Left ("abc", 7)) 553 + -- "abc" 554 + -- 555 + -- >>> get (choice fstL sndL) (Right ("abc", 7)) 556 + -- 7 557 + -- 558 + -- >>> set (choice fstL sndL) (Left ("abc", 7)) "def" 559 + -- Left ("def",7) 560 + -- 561 + -- >>> set (choice fstL sndL) (Right ("abc", 7)) 8 562 + -- Right ("abc",8) 563 + choice :: 564 + Lens s t a b 565 + -> Lens q r a b 566 + -> Lens (Either s q) (Either t r) a b 567 + choice = 568 + error "todo: choice" 569 + 570 + -- | An alias for @choice@. 571 + (|||) :: 572 + Lens s t a b 573 + -> Lens q r a b 574 + -> Lens (Either s q) (Either t r) a b 575 + (|||) = 576 + choice 577 + 578 + infixr 2 ||| 579 + 580 + ---- 581 + 582 + type Lens' a b = 583 + Lens a a b b 584 + 585 + cityL :: 586 + Lens' Locality String 587 + cityL p (Locality c t y) = 588 + fmap (\c' -> Locality c' t y) (p c) 589 + 590 + stateL :: 591 + Lens' Locality String 592 + stateL p (Locality c t y) = 593 + fmap (\t' -> Locality c t' y) (p t) 594 + 595 + countryL :: 596 + Lens' Locality String 597 + countryL p (Locality c t y) = 598 + fmap (\y' -> Locality c t y') (p y) 599 + 600 + streetL :: 601 + Lens' Address String 602 + streetL p (Address t s l) = 603 + fmap (\t' -> Address t' s l) (p t) 604 + 605 + suburbL :: 606 + Lens' Address String 607 + suburbL p (Address t s l) = 608 + fmap (\s' -> Address t s' l) (p s) 609 + 610 + localityL :: 611 + Lens' Address Locality 612 + localityL p (Address t s l) = 613 + fmap (\l' -> Address t s l') (p l) 614 + 615 + ageL :: 616 + Lens' Person Int 617 + ageL p (Person a n d) = 618 + fmap (\a' -> Person a' n d) (p a) 619 + 620 + nameL :: 621 + Lens' Person String 622 + nameL p (Person a n d) = 623 + fmap (\n' -> Person a n' d) (p n) 624 + 625 + addressL :: 626 + Lens' Person Address 627 + addressL p (Person a n d) = 628 + fmap (\d' -> Person a n d') (p d) 629 + 630 + intAndIntL :: 631 + Lens' (IntAnd a) Int 632 + intAndIntL p (IntAnd n a) = 633 + fmap (\n' -> IntAnd n' a) (p n) 634 + 635 + -- lens for polymorphic update 636 + intAndL :: 637 + Lens (IntAnd a) (IntAnd b) a b 638 + intAndL p (IntAnd n a) = 639 + fmap (\a' -> IntAnd n a') (p a) 640 + 641 + -- | 642 + -- 643 + -- >>> get (suburbL |. addressL) fred 644 + -- "Fredville" 645 + -- 646 + -- >>> get (suburbL |. addressL) mary 647 + -- "Maryland" 648 + getSuburb :: 649 + Person 650 + -> String 651 + getSuburb = 652 + error "todo: getSuburb" 653 + 654 + -- | 655 + -- 656 + -- >>> setStreet fred "Some Other St" 657 + -- Person 24 "Fred" (Address "Some Other St" "Fredville" (Locality "Fredmania" "New South Fred" "Fredalia")) 658 + -- 659 + -- >>> setStreet mary "Some Other St" 660 + -- Person 28 "Mary" (Address "Some Other St" "Maryland" (Locality "Mary Mary" "Western Mary" "Maristan")) 661 + setStreet :: 662 + Person 663 + -> String 664 + -> Person 665 + setStreet = 666 + error "todo: setStreet" 667 + 668 + -- | 669 + -- 670 + -- >>> getAgeAndCountry (fred, maryLocality) 671 + -- (24,"Maristan") 672 + -- 673 + -- >>> getAgeAndCountry (mary, fredLocality) 674 + -- (28,"Fredalia") 675 + getAgeAndCountry :: 676 + (Person, Locality) 677 + -> (Int, String) 678 + getAgeAndCountry = 679 + error "todo: getAgeAndCountry" 680 + 681 + -- | 682 + -- 683 + -- >>> setCityAndLocality (fred, maryAddress) ("Some Other City", fredLocality) 684 + -- (Person 24 "Fred" (Address "15 Fred St" "Fredville" (Locality "Some Other City" "New South Fred" "Fredalia")),Address "83 Mary Ln" "Maryland" (Locality "Fredmania" "New South Fred" "Fredalia")) 685 + -- 686 + -- >>> setCityAndLocality (mary, fredAddress) ("Some Other City", maryLocality) 687 + -- (Person 28 "Mary" (Address "83 Mary Ln" "Maryland" (Locality "Some Other City" "Western Mary" "Maristan")),Address "15 Fred St" "Fredville" (Locality "Mary Mary" "Western Mary" "Maristan")) 688 + setCityAndLocality :: 689 + (Person, Address) -> (String, Locality) -> (Person, Address) 690 + setCityAndLocality = 691 + error "todo: setCityAndLocality" 692 + 693 + -- | 694 + -- 695 + -- >>> getSuburbOrCity (Left maryAddress) 696 + -- "Maryland" 697 + -- 698 + -- >>> getSuburbOrCity (Right fredLocality) 699 + -- "Fredmania" 700 + getSuburbOrCity :: 701 + Either Address Locality 702 + -> String 703 + getSuburbOrCity = 704 + error "todo: getSuburbOrCity" 705 + 706 + -- | 707 + -- 708 + -- >>> setStreetOrState (Right maryLocality) "Some Other State" 709 + -- Right (Locality "Mary Mary" "Some Other State" "Maristan") 710 + -- 711 + -- >>> setStreetOrState (Left fred) "Some Other St" 712 + -- Left (Person 24 "Fred" (Address "Some Other St" "Fredville" (Locality "Fredmania" "New South Fred" "Fredalia"))) 713 + setStreetOrState :: 714 + Either Person Locality 715 + -> String 716 + -> Either Person Locality 717 + setStreetOrState = 718 + error "todo: setStreetOrState" 719 + 720 + -- | 721 + -- 722 + -- >>> modifyCityUppercase fred 723 + -- Person 24 "Fred" (Address "15 Fred St" "Fredville" (Locality "FREDMANIA" "New South Fred" "Fredalia")) 724 + -- 725 + -- >>> modifyCityUppercase mary 726 + -- Person 28 "Mary" (Address "83 Mary Ln" "Maryland" (Locality "MARY MARY" "Western Mary" "Maristan")) 727 + modifyCityUppercase :: 728 + Person 729 + -> Person 730 + modifyCityUppercase = 731 + error "todo: modifyCityUppercase" 732 + 733 + -- | 734 + -- 735 + -- >>> modifyIntAndLengthEven (IntAnd 10 "abc") 736 + -- IntAnd 10 False 737 + -- 738 + -- >>> modifyIntAndLengthEven (IntAnd 10 "abcd") 739 + -- IntAnd 10 True 740 + modifyIntAndLengthEven :: 741 + IntAnd [a] 742 + -> IntAnd Bool 743 + modifyIntAndLengthEven = 744 + error "todo: modifyIntAndLengthEven" 745 + 746 + ---- 747 + 748 + -- | 749 + -- 750 + -- >>> over traverseLocality (map toUpper) (Locality "abc" "def" "ghi") 751 + -- Locality "ABC" "DEF" "GHI" 752 + traverseLocality :: 753 + Traversal' Locality String 754 + traverseLocality = 755 + error "todo: traverseLocality" 756 + 757 + -- | 758 + -- 759 + -- >>> over intOrIntP (*10) (IntOrIs 3) 760 + -- IntOrIs 30 761 + -- 762 + -- >>> over intOrIntP (*10) (IntOrIsNot "abc") 763 + -- IntOrIsNot "abc" 764 + intOrIntP :: 765 + Prism' (IntOr a) Int 766 + intOrIntP = 767 + error "todo: intOrIntP" 768 + 769 + intOrP :: 770 + Prism (IntOr a) (IntOr b) a b 771 + intOrP = 772 + error "todo: intOrP" 773 + 774 + -- | 775 + -- 776 + -- >> over intOrP (even . length) (IntOrIsNot "abc") 777 + -- IntOrIsNot False 778 + -- 779 + -- >>> over intOrP (even . length) (IntOrIsNot "abcd") 780 + -- IntOrIsNot True 781 + -- 782 + -- >>> over intOrP (even . length) (IntOrIs 10) 783 + -- IntOrIs 10 784 + intOrLengthEven :: 785 + IntOr [a] 786 + -> IntOr Bool 787 + intOrLengthEven = 788 + error "todo: intOrLengthEven"
+2 -2
src/Lets/Lens/Choice.hs src/Lets/Choice.hs
··· 1 - module Lets.Lens.Choice ( 1 + module Lets.Choice ( 2 2 Choice(..) 3 3 ) where 4 4 5 5 import Lets.Data 6 - import Lets.Lens.Profunctor 6 + import Lets.Profunctor 7 7 8 8 diswap :: 9 9 Profunctor p =>
-788
src/Lets/Lens/Lens.hs
··· 1 - {-# LANGUAGE RankNTypes #-} 2 - 3 - module Lets.Lens.Lens ( 4 - fmapT 5 - , over 6 - , fmapTAgain 7 - , Set 8 - , sets 9 - , mapped 10 - , set 11 - , foldMapT 12 - , foldMapOf 13 - , foldMapTAgain 14 - , Fold 15 - , folds 16 - , folded 17 - , Get 18 - , get 19 - , Traversal 20 - , both 21 - , traverseLeft 22 - , traverseRight 23 - , Traversal' 24 - , Lens 25 - , Prism 26 - , _Left 27 - , _Right 28 - , prism 29 - , _Just 30 - , _Nothing 31 - , setP 32 - , getP 33 - , Prism' 34 - , modify 35 - , (%~) 36 - , (.~) 37 - , fmodify 38 - , (|=) 39 - , fstL 40 - , sndL 41 - , mapL 42 - , setL 43 - , compose 44 - , (|.) 45 - , identity 46 - , product 47 - , (***) 48 - , choice 49 - , (|||) 50 - , Lens' 51 - , cityL 52 - , stateL 53 - , countryL 54 - , streetL 55 - , suburbL 56 - , localityL 57 - , ageL 58 - , nameL 59 - , addressL 60 - , intAndIntL 61 - , intAndL 62 - , getSuburb 63 - , setStreet 64 - , getAgeAndCountry 65 - , setCityAndLocality 66 - , getSuburbOrCity 67 - , setStreetOrState 68 - , modifyCityUppercase 69 - , modifyIntAndLengthEven 70 - , traverseLocality 71 - , intOrIntP 72 - , intOrP 73 - , intOrLengthEven 74 - ) where 75 - 76 - import Control.Applicative(Applicative((<*>), pure)) 77 - import Data.Bool(bool) 78 - import Data.Char(toUpper) 79 - import Data.Foldable(Foldable(foldMap)) 80 - import Data.Functor((<$>)) 81 - import Data.Map(Map) 82 - import qualified Data.Map as Map(insert, delete, lookup) 83 - import Data.Monoid(Monoid) 84 - import qualified Data.Set as Set(Set, insert, delete, member) 85 - import Data.Traversable(Traversable(traverse)) 86 - import Lets.Data(AlongsideLeft(AlongsideLeft, getAlongsideLeft), AlongsideRight(AlongsideRight, getAlongsideRight), Identity(Identity, getIdentity), Const(Const, getConst), Tagged(Tagged, getTagged), IntOr(IntOrIs, IntOrIsNot), IntAnd(IntAnd), Person(Person), Locality(Locality), Address(Address)) 87 - import Lets.Lens.Choice(Choice(left, right)) 88 - import Lets.Lens.Profunctor(Profunctor(dimap)) 89 - import Prelude hiding (product) 90 - 91 - -- $setup 92 - -- >>> import qualified Data.Map as Map(fromList) 93 - -- >>> import qualified Data.Set as Set(fromList) 94 - -- >>> import Data.Char(ord) 95 - 96 - -- Let's remind ourselves of Traversable, noting Foldable and Functor. 97 - -- 98 - -- class (Foldable t, Functor t) => Traversable t where 99 - -- traverse :: 100 - -- Applicative f => 101 - -- (a -> f b) 102 - -- -> t a 103 - -- -> f (t b) 104 - 105 - -- | Observe that @fmap@ can be recovered from @traverse@ using @Identity@. 106 - -- 107 - -- /Reminder:/ fmap :: Functor t => (a -> b) -> t a -> t b 108 - fmapT :: 109 - Traversable t => 110 - (a -> b) 111 - -> t a 112 - -> t b 113 - fmapT = 114 - error "todo: fmapT" 115 - 116 - -- | Let's refactor out the call to @traverse@ as an argument to @fmapT@. 117 - over :: 118 - ((a -> Identity b) -> s -> Identity t) 119 - -> (a -> b) 120 - -> s 121 - -> t 122 - over = 123 - error "todo: over" 124 - 125 - -- | Here is @fmapT@ again, passing @traverse@ to @over@. 126 - fmapTAgain :: 127 - Traversable t => 128 - (a -> b) 129 - -> t a 130 - -> t b 131 - fmapTAgain = 132 - error "todo: fmapTAgain" 133 - 134 - -- | Let's create a type-alias for this type of function. 135 - type Set s t a b = 136 - (a -> Identity b) 137 - -> s 138 - -> Identity t 139 - 140 - -- | Let's write an inverse to @over@ that does the @Identity@ wrapping & 141 - -- unwrapping. 142 - sets :: 143 - ((a -> b) -> s -> t) 144 - -> Set s t a b 145 - sets = 146 - error "todo: sets" 147 - 148 - mapped :: 149 - Functor f => 150 - Set (f a) (f b) a b 151 - mapped = 152 - error "todo: mapped" 153 - 154 - set :: 155 - Set s t a b 156 - -> s 157 - -> b 158 - -> t 159 - set = 160 - error "todo: set" 161 - 162 - ---- 163 - 164 - -- | Observe that @fmap@ can be recovered from @traverse@ using @Identity@. 165 - -- 166 - -- /Reminder:/ foldMap :: (Foldable t, Monoid b) => (a -> b) -> t a -> b 167 - foldMapT :: 168 - (Traversable t, Monoid b) => 169 - (a -> b) 170 - -> t a 171 - -> b 172 - foldMapT = 173 - error "todo: foldMapT" 174 - 175 - -- | Let's refactor out the call to @traverse@ as an argument to @foldMapT@. 176 - foldMapOf :: 177 - ((a -> Const r b) -> s -> Const r t) 178 - -> (a -> r) 179 - -> s 180 - -> r 181 - foldMapOf = 182 - error "todo: foldMapOf" 183 - 184 - -- | Here is @foldMapT@ again, passing @traverse@ to @foldMapOf@. 185 - foldMapTAgain :: 186 - (Traversable t, Monoid b) => 187 - (a -> b) 188 - -> t a 189 - -> b 190 - foldMapTAgain = 191 - error "todo: foldMapTAgain" 192 - 193 - -- | Let's create a type-alias for this type of function. 194 - type Fold s t a b = 195 - forall r. 196 - Monoid r => 197 - (a -> Const r b) 198 - -> s 199 - -> Const r t 200 - 201 - -- | Let's write an inverse to @foldMapOf@ that does the @Const@ wrapping & 202 - -- unwrapping. 203 - folds :: 204 - ((a -> b) -> s -> t) 205 - -> (a -> Const b a) 206 - -> s 207 - -> Const t s 208 - folds = 209 - error "todo: folds" 210 - 211 - folded :: 212 - Foldable f => 213 - Fold (f a) (f a) a a 214 - folded = 215 - error "todo: folded" 216 - 217 - ---- 218 - 219 - -- | @Get@ is like @Fold@, but without the @Monoid@ constraint. 220 - type Get r s a = 221 - (a -> Const r a) 222 - -> s 223 - -> Const r s 224 - 225 - get :: 226 - Get a s a 227 - -> s 228 - -> a 229 - get = 230 - error "todo: get" 231 - 232 - ---- 233 - 234 - -- | Let's generalise @Identity@ and @Const r@ to any @Applicative@ instance. 235 - type Traversal s t a b = 236 - forall f. 237 - Applicative f => 238 - (a -> f b) 239 - -> s 240 - -> f t 241 - 242 - -- | Traverse both sides of a pair. 243 - both :: 244 - Traversal (a, a) (b, b) a b 245 - both = 246 - error "todo: both" 247 - 248 - -- | Traverse the left side of @Either@. 249 - traverseLeft :: 250 - Traversal (Either a x) (Either b x) a b 251 - traverseLeft = 252 - error "todo: traverseLeft" 253 - 254 - -- | Traverse the right side of @Either@. 255 - traverseRight :: 256 - Traversal (Either x a) (Either x b) a b 257 - traverseRight = 258 - error "todo: traverseRight" 259 - 260 - type Traversal' a b = 261 - Traversal a a b b 262 - 263 - ---- 264 - 265 - -- | @Const r@ is @Applicative@, if @Monoid r@, however, without the @Monoid@ 266 - -- constraint (as in @Get@), the only shared abstraction between @Identity@ and 267 - -- @Const r@ is @Functor@. 268 - -- 269 - -- Consequently, we arrive at our lens derivation: 270 - type Lens s t a b = 271 - forall f. 272 - Functor f => 273 - (a -> f b) 274 - -> s 275 - -> f t 276 - 277 - ---- 278 - 279 - -- | A prism is a less specific type of traversal. 280 - type Prism s t a b = 281 - forall p f. 282 - (Choice p, Applicative f) => 283 - p a (f b) 284 - -> p s (f t) 285 - 286 - _Left :: 287 - Prism (Either a x) (Either b x) a b 288 - _Left = 289 - error "todo: _Left" 290 - 291 - _Right :: 292 - Prism (Either x a) (Either x b) a b 293 - _Right = 294 - error "todo: _Right" 295 - 296 - prism :: 297 - (b -> t) 298 - -> (s -> Either t a) 299 - -> Prism s t a b 300 - prism = 301 - error "todo: prism" 302 - 303 - _Just :: 304 - Prism (Maybe a) (Maybe b) a b 305 - _Just = 306 - error "todo: _Just" 307 - 308 - _Nothing :: 309 - Prism (Maybe a) (Maybe a) () () 310 - _Nothing = 311 - error "todo: _Nothing" 312 - 313 - setP :: 314 - Prism s t a b 315 - -> s 316 - -> Either t a 317 - setP = 318 - error "todo: setP" 319 - 320 - getP :: 321 - Prism s t a b 322 - -> b 323 - -> t 324 - getP = 325 - error "todo: getP" 326 - 327 - type Prism' a b = 328 - Prism a a b b 329 - 330 - ---- 331 - 332 - -- | 333 - -- 334 - -- >>> modify fstL (+1) (0 :: Int, "abc") 335 - -- (1,"abc") 336 - -- 337 - -- >>> modify sndL (+1) ("abc", 0 :: Int) 338 - -- ("abc",1) 339 - -- 340 - -- prop> let types = (x :: Int, y :: String) in modify fstL id (x, y) == (x, y) 341 - -- 342 - -- prop> let types = (x :: Int, y :: String) in modify sndL id (x, y) == (x, y) 343 - modify :: 344 - Lens s t a b 345 - -> (a -> b) 346 - -> s 347 - -> t 348 - modify = 349 - error "todo: modify" 350 - 351 - -- | An alias for @modify@. 352 - (%~) :: 353 - Lens s t a b 354 - -> (a -> b) 355 - -> s 356 - -> t 357 - (%~) = 358 - modify 359 - 360 - infixr 4 %~ 361 - 362 - -- | 363 - -- 364 - -- >>> fstL .~ 1 $ (0 :: Int, "abc") 365 - -- (1,"abc") 366 - -- 367 - -- >>> sndL .~ 1 $ ("abc", 0 :: Int) 368 - -- ("abc",1) 369 - -- 370 - -- prop> let types = (x :: Int, y :: String) in set fstL (x, y) z == (fstL .~ z $ (x, y)) 371 - -- 372 - -- prop> let types = (x :: Int, y :: String) in set sndL (x, y) z == (sndL .~ z $ (x, y)) 373 - (.~) :: 374 - Lens s t a b 375 - -> b 376 - -> s 377 - -> t 378 - (.~) = 379 - error "todo: (.~)" 380 - 381 - infixl 5 .~ 382 - 383 - -- | 384 - -- 385 - -- >>> fmodify fstL (+) (5 :: Int, "abc") 8 386 - -- (13,"abc") 387 - -- 388 - -- >>> fmodify fstL (\n -> bool Nothing (Just (n * 2)) (even n)) (10, "abc") 389 - -- Just (20,"abc") 390 - -- 391 - -- >>> fmodify fstL (\n -> bool Nothing (Just (n * 2)) (even n)) (11, "abc") 392 - -- Nothing 393 - fmodify :: 394 - Functor f => 395 - Lens s t a b 396 - -> (a -> f b) 397 - -> s 398 - -> f t 399 - fmodify = 400 - error "todo: fmodify" 401 - 402 - -- | 403 - -- 404 - -- >>> fstL |= Just 3 $ (7, "abc") 405 - -- Just (3,"abc") 406 - -- 407 - -- >>> (fstL |= (+1) $ (3, "abc")) 17 408 - -- (18,"abc") 409 - (|=) :: 410 - Functor f => 411 - Lens s t a b 412 - -> f b 413 - -> s 414 - -> f t 415 - (|=) = 416 - error "todo: (|=)" 417 - 418 - infixl 5 |= 419 - 420 - -- | 421 - -- 422 - -- >>> modify fstL (*10) (3, "abc") 423 - -- (30,"abc") 424 - fstL :: 425 - Lens (a, x) (b, x) a b 426 - fstL = 427 - error "todo: fstL" 428 - 429 - -- | 430 - -- 431 - -- >>> modify sndL (++ "def") (13, "abc") 432 - -- (13,"abcdef") 433 - sndL :: 434 - Lens (x, a) (x, b) a b 435 - sndL = 436 - error "todo: sndL" 437 - 438 - -- | 439 - -- 440 - -- >>> get (mapL 3) (Map.fromList (map (\c -> (ord c - 96, c)) ['a'..'d'])) 441 - -- Just 'c' 442 - -- 443 - -- >>> get (mapL 33) (Map.fromList (map (\c -> (ord c - 96, c)) ['a'..'d'])) 444 - -- Nothing 445 - -- 446 - -- >>> set (mapL 3) (Map.fromList (map (\c -> (ord c - 96, c)) ['a'..'d'])) (Just 'X') 447 - -- fromList [(1,'a'),(2,'b'),(3,'X'),(4,'d')] 448 - -- 449 - -- >>> set (mapL 33) (Map.fromList (map (\c -> (ord c - 96, c)) ['a'..'d'])) (Just 'X') 450 - -- fromList [(1,'a'),(2,'b'),(3,'c'),(4,'d'),(33,'X')] 451 - -- 452 - -- >>> set (mapL 3) (Map.fromList (map (\c -> (ord c - 96, c)) ['a'..'d'])) Nothing 453 - -- fromList [(1,'a'),(2,'b'),(4,'d')] 454 - -- 455 - -- >>> set (mapL 33) (Map.fromList (map (\c -> (ord c - 96, c)) ['a'..'d'])) Nothing 456 - -- fromList [(1,'a'),(2,'b'),(3,'c'),(4,'d')] 457 - mapL :: 458 - Ord k => 459 - k 460 - -> Lens (Map k v) (Map k v) (Maybe v) (Maybe v) 461 - mapL = 462 - error "todo: mapL" 463 - 464 - -- | 465 - -- 466 - -- >>> get (setL 3) (Set.fromList [1..5]) 467 - -- True 468 - -- 469 - -- >>> get (setL 33) (Set.fromList [1..5]) 470 - -- False 471 - -- 472 - -- >>> set (setL 3) (Set.fromList [1..5]) True 473 - -- fromList [1,2,3,4,5] 474 - -- 475 - -- >>> set (setL 3) (Set.fromList [1..5]) False 476 - -- fromList [1,2,4,5] 477 - -- 478 - -- >>> set (setL 33) (Set.fromList [1..5]) True 479 - -- fromList [1,2,3,4,5,33] 480 - -- 481 - -- >>> set (setL 33) (Set.fromList [1..5]) False 482 - -- fromList [1,2,3,4,5] 483 - setL :: 484 - Ord k => 485 - k 486 - -> Lens (Set.Set k) (Set.Set k) Bool Bool 487 - setL = 488 - error "todo: setL" 489 - 490 - -- | 491 - -- 492 - -- >>> get (compose fstL sndL) ("abc", (7, "def")) 493 - -- 7 494 - -- 495 - -- >>> set (compose fstL sndL) ("abc", (7, "def")) 8 496 - -- ("abc",(8,"def")) 497 - compose :: 498 - Lens s t a b 499 - -> Lens q r s t 500 - -> Lens q r a b 501 - compose = 502 - error "todo: compose" 503 - 504 - -- | An alias for @compose@. 505 - (|.) :: 506 - Lens s t a b 507 - -> Lens q r s t 508 - -> Lens q r a b 509 - (|.) = 510 - compose 511 - 512 - infixr 9 |. 513 - 514 - -- | 515 - -- 516 - -- >>> get identity 3 517 - -- 3 518 - -- 519 - -- >>> set identity 3 4 520 - -- 4 521 - identity :: 522 - Lens a b a b 523 - identity = 524 - error "todo: identity" 525 - 526 - -- | 527 - -- 528 - -- >>> get (product fstL sndL) (("abc", 3), (4, "def")) 529 - -- ("abc","def") 530 - -- 531 - -- >>> set (product fstL sndL) (("abc", 3), (4, "def")) ("ghi", "jkl") 532 - -- (("ghi",3),(4,"jkl")) 533 - product :: 534 - Lens s t a b 535 - -> Lens q r c d 536 - -> Lens (s, q) (t, r) (a, c) (b, d) 537 - product = 538 - error "todo: product" 539 - 540 - -- | An alias for @product@. 541 - (***) :: 542 - Lens s t a b 543 - -> Lens q r c d 544 - -> Lens (s, q) (t, r) (a, c) (b, d) 545 - (***) = 546 - product 547 - 548 - infixr 3 *** 549 - 550 - -- | 551 - -- 552 - -- >>> get (choice fstL sndL) (Left ("abc", 7)) 553 - -- "abc" 554 - -- 555 - -- >>> get (choice fstL sndL) (Right ("abc", 7)) 556 - -- 7 557 - -- 558 - -- >>> set (choice fstL sndL) (Left ("abc", 7)) "def" 559 - -- Left ("def",7) 560 - -- 561 - -- >>> set (choice fstL sndL) (Right ("abc", 7)) 8 562 - -- Right ("abc",8) 563 - choice :: 564 - Lens s t a b 565 - -> Lens q r a b 566 - -> Lens (Either s q) (Either t r) a b 567 - choice = 568 - error "todo: choice" 569 - 570 - -- | An alias for @choice@. 571 - (|||) :: 572 - Lens s t a b 573 - -> Lens q r a b 574 - -> Lens (Either s q) (Either t r) a b 575 - (|||) = 576 - choice 577 - 578 - infixr 2 ||| 579 - 580 - ---- 581 - 582 - type Lens' a b = 583 - Lens a a b b 584 - 585 - cityL :: 586 - Lens' Locality String 587 - cityL p (Locality c t y) = 588 - fmap (\c' -> Locality c' t y) (p c) 589 - 590 - stateL :: 591 - Lens' Locality String 592 - stateL p (Locality c t y) = 593 - fmap (\t' -> Locality c t' y) (p t) 594 - 595 - countryL :: 596 - Lens' Locality String 597 - countryL p (Locality c t y) = 598 - fmap (\y' -> Locality c t y') (p y) 599 - 600 - streetL :: 601 - Lens' Address String 602 - streetL p (Address t s l) = 603 - fmap (\t' -> Address t' s l) (p t) 604 - 605 - suburbL :: 606 - Lens' Address String 607 - suburbL p (Address t s l) = 608 - fmap (\s' -> Address t s' l) (p s) 609 - 610 - localityL :: 611 - Lens' Address Locality 612 - localityL p (Address t s l) = 613 - fmap (\l' -> Address t s l') (p l) 614 - 615 - ageL :: 616 - Lens' Person Int 617 - ageL p (Person a n d) = 618 - fmap (\a' -> Person a' n d) (p a) 619 - 620 - nameL :: 621 - Lens' Person String 622 - nameL p (Person a n d) = 623 - fmap (\n' -> Person a n' d) (p n) 624 - 625 - addressL :: 626 - Lens' Person Address 627 - addressL p (Person a n d) = 628 - fmap (\d' -> Person a n d') (p d) 629 - 630 - intAndIntL :: 631 - Lens' (IntAnd a) Int 632 - intAndIntL p (IntAnd n a) = 633 - fmap (\n' -> IntAnd n' a) (p n) 634 - 635 - -- lens for polymorphic update 636 - intAndL :: 637 - Lens (IntAnd a) (IntAnd b) a b 638 - intAndL p (IntAnd n a) = 639 - fmap (\a' -> IntAnd n a') (p a) 640 - 641 - -- | 642 - -- 643 - -- >>> get (suburbL |. addressL) fred 644 - -- "Fredville" 645 - -- 646 - -- >>> get (suburbL |. addressL) mary 647 - -- "Maryland" 648 - getSuburb :: 649 - Person 650 - -> String 651 - getSuburb = 652 - error "todo: getSuburb" 653 - 654 - -- | 655 - -- 656 - -- >>> setStreet fred "Some Other St" 657 - -- Person 24 "Fred" (Address "Some Other St" "Fredville" (Locality "Fredmania" "New South Fred" "Fredalia")) 658 - -- 659 - -- >>> setStreet mary "Some Other St" 660 - -- Person 28 "Mary" (Address "Some Other St" "Maryland" (Locality "Mary Mary" "Western Mary" "Maristan")) 661 - setStreet :: 662 - Person 663 - -> String 664 - -> Person 665 - setStreet = 666 - error "todo: setStreet" 667 - 668 - -- | 669 - -- 670 - -- >>> getAgeAndCountry (fred, maryLocality) 671 - -- (24,"Maristan") 672 - -- 673 - -- >>> getAgeAndCountry (mary, fredLocality) 674 - -- (28,"Fredalia") 675 - getAgeAndCountry :: 676 - (Person, Locality) 677 - -> (Int, String) 678 - getAgeAndCountry = 679 - error "todo: getAgeAndCountry" 680 - 681 - -- | 682 - -- 683 - -- >>> setCityAndLocality (fred, maryAddress) ("Some Other City", fredLocality) 684 - -- (Person 24 "Fred" (Address "15 Fred St" "Fredville" (Locality "Some Other City" "New South Fred" "Fredalia")),Address "83 Mary Ln" "Maryland" (Locality "Fredmania" "New South Fred" "Fredalia")) 685 - -- 686 - -- >>> setCityAndLocality (mary, fredAddress) ("Some Other City", maryLocality) 687 - -- (Person 28 "Mary" (Address "83 Mary Ln" "Maryland" (Locality "Some Other City" "Western Mary" "Maristan")),Address "15 Fred St" "Fredville" (Locality "Mary Mary" "Western Mary" "Maristan")) 688 - setCityAndLocality :: 689 - (Person, Address) -> (String, Locality) -> (Person, Address) 690 - setCityAndLocality = 691 - error "todo: setCityAndLocality" 692 - 693 - -- | 694 - -- 695 - -- >>> getSuburbOrCity (Left maryAddress) 696 - -- "Maryland" 697 - -- 698 - -- >>> getSuburbOrCity (Right fredLocality) 699 - -- "Fredmania" 700 - getSuburbOrCity :: 701 - Either Address Locality 702 - -> String 703 - getSuburbOrCity = 704 - error "todo: getSuburbOrCity" 705 - 706 - -- | 707 - -- 708 - -- >>> setStreetOrState (Right maryLocality) "Some Other State" 709 - -- Right (Locality "Mary Mary" "Some Other State" "Maristan") 710 - -- 711 - -- >>> setStreetOrState (Left fred) "Some Other St" 712 - -- Left (Person 24 "Fred" (Address "Some Other St" "Fredville" (Locality "Fredmania" "New South Fred" "Fredalia"))) 713 - setStreetOrState :: 714 - Either Person Locality 715 - -> String 716 - -> Either Person Locality 717 - setStreetOrState = 718 - error "todo: setStreetOrState" 719 - 720 - -- | 721 - -- 722 - -- >>> modifyCityUppercase fred 723 - -- Person 24 "Fred" (Address "15 Fred St" "Fredville" (Locality "FREDMANIA" "New South Fred" "Fredalia")) 724 - -- 725 - -- >>> modifyCityUppercase mary 726 - -- Person 28 "Mary" (Address "83 Mary Ln" "Maryland" (Locality "MARY MARY" "Western Mary" "Maristan")) 727 - modifyCityUppercase :: 728 - Person 729 - -> Person 730 - modifyCityUppercase = 731 - error "todo: modifyCityUppercase" 732 - 733 - -- | 734 - -- 735 - -- >>> modifyIntAndLengthEven (IntAnd 10 "abc") 736 - -- IntAnd 10 False 737 - -- 738 - -- >>> modifyIntAndLengthEven (IntAnd 10 "abcd") 739 - -- IntAnd 10 True 740 - modifyIntAndLengthEven :: 741 - IntAnd [a] 742 - -> IntAnd Bool 743 - modifyIntAndLengthEven = 744 - error "todo: modifyIntAndLengthEven" 745 - 746 - ---- 747 - 748 - -- | 749 - -- 750 - -- >>> over traverseLocality (map toUpper) (Locality "abc" "def" "ghi") 751 - -- Locality "ABC" "DEF" "GHI" 752 - traverseLocality :: 753 - Traversal' Locality String 754 - traverseLocality = 755 - error "todo: traverseLocality" 756 - 757 - -- | 758 - -- 759 - -- >>> over intOrIntP (*10) (IntOrIs 3) 760 - -- IntOrIs 30 761 - -- 762 - -- >>> over intOrIntP (*10) (IntOrIsNot "abc") 763 - -- IntOrIsNot "abc" 764 - intOrIntP :: 765 - Prism' (IntOr a) Int 766 - intOrIntP = 767 - error "todo: intOrIntP" 768 - 769 - intOrP :: 770 - Prism (IntOr a) (IntOr b) a b 771 - intOrP = 772 - error "todo: intOrP" 773 - 774 - -- | 775 - -- 776 - -- >> over intOrP (even . length) (IntOrIsNot "abc") 777 - -- IntOrIsNot False 778 - -- 779 - -- >>> over intOrP (even . length) (IntOrIsNot "abcd") 780 - -- IntOrIsNot True 781 - -- 782 - -- >>> over intOrP (even . length) (IntOrIs 10) 783 - -- IntOrIs 10 784 - intOrLengthEven :: 785 - IntOr [a] 786 - -> IntOr Bool 787 - intOrLengthEven = 788 - error "todo: intOrLengthEven"
+1 -1
src/Lets/Lens/Profunctor.hs src/Lets/Profunctor.hs
··· 1 - module Lets.Lens.Profunctor ( 1 + module Lets.Profunctor ( 2 2 Profunctor(dimap) 3 3 ) where 4 4