+44 -28

src/Lets/GetSetLens.hs

reviewed

··· 142 142 -> (b -> b) 143 143 -> a 144 144 -> a 145 145 - modify = 146 146 - error "todo: modify" 145 145 + modify (Lens s g) f a = 146 146 + s a (f (g a)) 147 147 148 148 -- | An alias for @modify@. 149 149 (%~) :: ··· 172 172 -> b 173 173 -> a 174 174 -> a 175 175 - (.~) = 176 176 - error "todo: (.~)" 175 175 + (.~) l = 176 176 + modify l . const 177 177 178 178 infixl 5 .~ 179 179 ··· 193 193 -> (b -> f b) 194 194 -> a 195 195 -> f a 196 196 - fmodify = 197 197 - error "todo: fmodify" 196 196 + fmodify (Lens s g) f a = 197 197 + fmap (s a) (f (g a)) 198 198 199 199 -- | 200 200 -- ··· 209 209 -> f b 210 210 -> a 211 211 -> f a 212 212 - (|=) = 213 213 - error "todo: (|=)" 212 212 + (|=) l = 213 213 + fmodify l . const 214 214 215 215 infixl 5 |= 216 216 ··· 227 227 fstL :: 228 228 Lens (x, y) x 229 229 fstL = 230 230 - error "todo: fstL" 230 230 + Lens 231 231 + (\(_, y) x -> (x, y)) 232 232 + (\(x, _) -> x) 231 233 232 234 -- | 233 235 -- ··· 242 244 sndL :: 243 245 Lens (x, y) y 244 246 sndL = 245 245 - error "todo: sndL" 247 247 + Lens 248 248 + (\(x, _) y -> (x, y)) 249 249 + (\(_, y) -> y) 246 250 247 251 -- | 248 252 -- ··· 267 271 Ord k => 268 272 k 269 273 -> Lens (Map k v) (Maybe v) 270 270 - mapL = 271 271 - error "todo: mapL" 274 274 + mapL k = 275 275 + Lens 276 276 + (maybe . Map.delete k <*> (flip (Map.insert k))) 277 277 + (Map.lookup k) 272 278 273 279 -- | 274 280 -- ··· 293 299 Ord k => 294 300 k 295 301 -> Lens (Set k) Bool 296 296 - setL = 297 297 - error "todo: setL" 302 302 + setL k = 303 303 + Lens 304 304 + (bool . Set.delete k <*> Set.insert k) 305 305 + (Set.member k) 298 306 299 307 -- | 300 308 -- ··· 307 315 Lens b c 308 316 -> Lens a b 309 317 -> Lens a c 310 310 - compose = 311 311 - error "todo: compose" 318 318 + compose (Lens s1 g1) (Lens s2 g2) = 319 319 + Lens 320 320 + (\a -> s2 a . s1 (g2 a)) 321 321 + (g1 . g2) 312 322 313 323 -- | An alias for @compose@. 314 324 (|.) :: ··· 330 340 identity :: 331 341 Lens a a 332 342 identity = 333 333 - error "todo: identity" 343 343 + Lens 344 344 + (const id) 345 345 + id 334 346 335 347 -- | 336 348 -- ··· 343 355 Lens a b 344 356 -> Lens c d 345 357 -> Lens (a, c) (b, d) 346 346 - product = 347 347 - error "todo: product" 358 358 + product (Lens s1 g1) (Lens s2 g2) = 359 359 + Lens 360 360 + (\(a, c) (b, d) -> (s1 a b, s2 c d)) 361 361 + (\(a, c) -> (g1 a, g2 c)) 348 362 349 363 -- | An alias for @product@. 350 364 (***) :: ··· 373 387 Lens a x 374 388 -> Lens b x 375 389 -> Lens (Either a b) x 376 376 - choice = 377 377 - error "todo: choice" 390 390 + choice (Lens s1 g1) (Lens s2 g2) = 391 391 + Lens 392 392 + (\e x -> either (\a -> Left (s1 a x)) (\b -> Right (s2 b x)) e) 393 393 + (either g1 g2) 378 394 379 395 -- | An alias for @choice@. 380 396 (|||) :: ··· 462 478 Person 463 479 -> String 464 480 getSuburb = 465 465 - error "todo: getSuburb" 481 481 + get (suburbL |. addressL) 466 482 467 483 -- | 468 484 -- ··· 476 492 -> String 477 493 -> Person 478 494 setStreet = 479 479 - error "todo: setStreet" 495 495 + set (streetL |. addressL) 480 496 481 497 -- | 482 498 -- ··· 489 505 (Person, Locality) 490 506 -> (Int, String) 491 507 getAgeAndCountry = 492 492 - error "todo: getAgeAndCountry" 508 508 + get (ageL *** countryL) 493 509 494 510 -- | 495 511 -- ··· 501 517 setCityAndLocality :: 502 518 (Person, Address) -> (String, Locality) -> (Person, Address) 503 519 setCityAndLocality = 504 504 - error "todo: setCityAndLocality" 520 520 + set (cityL |. localityL |. addressL *** localityL) 505 521 506 522 -- | 507 523 -- ··· 514 530 Either Address Locality 515 531 -> String 516 532 getSuburbOrCity = 517 517 - error "todo: getSuburbOrCity" 533 533 + get (suburbL ||| cityL) 518 534 519 535 -- | 520 536 -- ··· 528 544 -> String 529 545 -> Either Person Locality 530 546 setStreetOrState = 531 531 - error "todo: setStreetOrState" 547 547 + set (streetL |. addressL ||| stateL) 532 548 533 549 -- | 534 550 -- ··· 541 557 Person 542 558 -> Person 543 559 modifyCityUppercase = 544 544 - error "todo: modifyCityUppercase" 560 560 + cityL |. localityL |. addressL %~ map toUpper

+98 -72

src/Lets/Lens/Lens.hs

reviewed

··· 110 110 (a -> b) 111 111 -> t a 112 112 -> t b 113 113 - fmapT = 114 114 - error "todo: fmapT" 113 113 + fmapT f = 114 114 + getIdentity . traverse (Identity . f) 115 115 116 116 -- | Let's refactor out the call to @traverse@ as an argument to @fmapT@. 117 117 over :: ··· 119 119 -> (a -> b) 120 120 -> s 121 121 -> t 122 122 - over = 123 123 - error "todo: over" 122 122 + over t f = 123 123 + getIdentity . t (Identity . f) 124 124 125 125 -- | Here is @fmapT@ again, passing @traverse@ to @over@. 126 126 fmapTAgain :: ··· 129 129 -> t a 130 130 -> t b 131 131 fmapTAgain = 132 132 - error "todo: fmapTAgain" 132 132 + over traverse 133 133 134 134 -- | Let's create a type-alias for this type of function. 135 135 type Set s t a b = ··· 142 142 sets :: 143 143 ((a -> b) -> s -> t) 144 144 -> Set s t a b 145 145 - sets = 146 146 - error "todo: sets" 145 145 + sets t f = 146 146 + Identity . t (getIdentity . f) 147 147 148 148 mapped :: 149 149 Functor f => 150 150 Set (f a) (f b) a b 151 151 mapped = 152 152 - error "todo: mapped" 152 152 + sets fmap 153 153 154 154 set :: 155 155 Set s t a b 156 156 -> s 157 157 -> b 158 158 -> t 159 159 - set = 160 160 - error "todo: set" 159 159 + set t s b = 160 160 + over t (const b) s 161 161 162 162 ---- 163 163 ··· 169 169 (a -> b) 170 170 -> t a 171 171 -> b 172 172 - foldMapT = 173 173 - error "todo: foldMapT" 172 172 + foldMapT f = 173 173 + getConst . traverse (Const . f) 174 174 175 175 -- | Let's refactor out the call to @traverse@ as an argument to @foldMapT@. 176 176 foldMapOf :: ··· 178 178 -> (a -> r) 179 179 -> s 180 180 -> r 181 181 - foldMapOf = 182 182 - error "todo: foldMapOf" 181 181 + foldMapOf t f = 182 182 + getConst . t (Const . f) 183 183 184 184 -- | Here is @foldMapT@ again, passing @traverse@ to @foldMapOf@. 185 185 foldMapTAgain :: ··· 188 188 -> t a 189 189 -> b 190 190 foldMapTAgain = 191 191 - error "todo: foldMapTAgain" 191 191 + foldMapOf traverse 192 192 193 193 -- | Let's create a type-alias for this type of function. 194 194 type Fold s t a b = ··· 205 205 -> (a -> Const b a) 206 206 -> s 207 207 -> Const t s 208 208 - folds = 209 209 - error "todo: folds" 208 208 + folds t f = 209 209 + Const . t (getConst . f) 210 210 211 211 folded :: 212 212 Foldable f => 213 213 Fold (f a) (f a) a a 214 214 folded = 215 215 - error "todo: folded" 215 215 + folds foldMap 216 216 217 217 ---- 218 218 ··· 226 226 Get a s a 227 227 -> s 228 228 -> a 229 229 - get = 230 230 - error "todo: get" 229 229 + get t = 230 230 + getConst . t Const 231 231 232 232 ---- 233 233 ··· 242 242 -- | Traverse both sides of a pair. 243 243 both :: 244 244 Traversal (a, a) (b, b) a b 245 245 - both = 246 246 - error "todo: both" 245 245 + both f (a, b) = 246 246 + (,) <$> f a <*> f b 247 247 248 248 -- | Traverse the left side of @Either@. 249 249 traverseLeft :: 250 250 Traversal (Either a x) (Either b x) a b 251 251 - traverseLeft = 252 252 - error "todo: traverseLeft" 251 251 + traverseLeft f (Left a) = 252 252 + Left <$> f a 253 253 + traverseLeft _ (Right x) = 254 254 + pure (Right x) 253 255 254 256 -- | Traverse the right side of @Either@. 255 257 traverseRight :: 256 258 Traversal (Either x a) (Either x b) a b 257 257 - traverseRight = 258 258 - error "todo: traverseRight" 259 259 + traverseRight _ (Left x) = 260 260 + pure (Left x) 261 261 + traverseRight f (Right a) = 262 262 + Right <$> f a 259 263 260 264 type Traversal' a b = 261 265 Traversal a a b b ··· 286 290 _Left :: 287 291 Prism (Either a x) (Either b x) a b 288 292 _Left = 289 289 - error "todo: _Left" 293 293 + dimap (either Right (Left . Right)) (either pure (fmap Left)) . right 290 294 291 295 _Right :: 292 296 Prism (Either x a) (Either x b) a b 293 297 _Right = 294 294 - error "todo: _Right" 298 298 + dimap (either (Left . Left) Right) (either pure (fmap Right)) . right 295 299 296 300 prism :: 297 301 (b -> t) 298 302 -> (s -> Either t a) 299 303 -> Prism s t a b 300 300 - prism = 301 301 - error "todo: prism" 304 304 + prism to fr = 305 305 + dimap fr (either pure (fmap to)) . right 302 306 303 307 _Just :: 304 308 Prism (Maybe a) (Maybe b) a b 305 309 _Just = 306 306 - error "todo: _Just" 310 310 + prism 311 311 + Just 312 312 + (maybe (Left Nothing) Right) 307 313 308 314 _Nothing :: 309 315 Prism (Maybe a) (Maybe a) () () 310 316 _Nothing = 311 311 - error "todo: _Nothing" 317 317 + prism 318 318 + (\() -> Nothing) 319 319 + (maybe (Right ()) (Left . Just)) 312 320 313 321 setP :: 314 322 Prism s t a b 315 323 -> s 316 324 -> Either t a 317 317 - setP = 318 318 - error "todo: setP" 325 325 + setP p = 326 326 + either Right Left . p Left 319 327 320 328 getP :: 321 329 Prism s t a b 322 330 -> b 323 331 -> t 324 324 - getP = 325 325 - error "todo: getP" 332 332 + getP p = 333 333 + getIdentity . getTagged . p . Tagged . Identity 326 334 327 335 type Prism' a b = 328 336 Prism a a b b ··· 345 353 -> (a -> b) 346 354 -> s 347 355 -> t 348 348 - modify = 349 349 - error "todo: modify" 356 356 + modify r f = 357 357 + getIdentity . r (Identity . f) 350 358 351 359 -- | An alias for @modify@. 352 360 (%~) :: ··· 375 383 -> b 376 384 -> s 377 385 -> t 378 378 - (.~) = 379 379 - error "todo: (.~)" 386 386 + (.~) l = 387 387 + modify l . const 380 388 381 389 infixl 5 .~ 382 390 ··· 396 404 -> (a -> f b) 397 405 -> s 398 406 -> f t 399 399 - fmodify = 400 400 - error "todo: fmodify" 407 407 + fmodify l = 408 408 + l 401 409 402 410 -- | 403 411 -- ··· 412 420 -> f b 413 421 -> s 414 422 -> f t 415 415 - (|=) = 416 416 - error "todo: (|=)" 423 423 + (|=) l = 424 424 + fmodify l . const 417 425 418 426 infixl 5 |= 419 427 ··· 423 431 -- (30,"abc") 424 432 fstL :: 425 433 Lens (a, x) (b, x) a b 426 426 - fstL = 427 427 - error "todo: fstL" 434 434 + fstL p (x, y) = 435 435 + fmap (\x' -> (x', y)) (p x) 428 436 429 437 -- | 430 438 -- ··· 432 440 -- (13,"abcdef") 433 441 sndL :: 434 442 Lens (x, a) (x, b) a b 435 435 - sndL = 436 436 - error "todo: sndL" 443 443 + sndL p (x, y) = 444 444 + fmap (\y' -> (x, y')) (p y) 437 445 438 446 -- | 439 447 -- ··· 458 466 Ord k => 459 467 k 460 468 -> Lens (Map k v) (Map k v) (Maybe v) (Maybe v) 461 461 - mapL = 462 462 - error "todo: mapL" 469 469 + mapL k p m = 470 470 + let z = Map.lookup k m 471 471 + in fmap (\y -> case y of 472 472 + Just v -> Map.insert k v m 473 473 + Nothing -> case z of 474 474 + Just _ -> Map.delete k m 475 475 + Nothing -> m) (p z) 463 476 464 477 -- | 465 478 -- ··· 484 497 Ord k => 485 498 k 486 499 -> Lens (Set.Set k) (Set.Set k) Bool Bool 487 487 - setL = 488 488 - error "todo: setL" 500 500 + setL k = 501 501 + (\p s -> fmap (\b -> bool Set.delete Set.insert b k s) (p (Set.member k s))) 489 502 490 503 -- | 491 504 -- ··· 498 511 Lens s t a b 499 512 -> Lens q r s t 500 513 -> Lens q r a b 501 501 - compose = 502 502 - error "todo: compose" 514 514 + compose r1 r2 = 515 515 + r2 . r1 503 516 504 517 -- | An alias for @compose@. 505 518 (|.) :: ··· 521 534 identity :: 522 535 Lens a b a b 523 536 identity = 524 524 - error "todo: identity" 537 537 + id 525 538 526 539 -- | 527 540 -- ··· 534 547 Lens s t a b 535 548 -> Lens q r c d 536 549 -> Lens (s, q) (t, r) (a, c) (b, d) 537 537 - product = 538 538 - error "todo: product" 550 550 + product r1 r2 p (a, c) = 551 551 + getAlongsideRight (r2 (\b2 -> AlongsideRight ( 552 552 + getAlongsideLeft (r1 (\b1 -> AlongsideLeft ( 553 553 + p (b1,b2))) a))) c) 539 554 540 555 -- | An alias for @product@. 541 556 (***) :: ··· 564 579 Lens s t a b 565 580 -> Lens q r a b 566 581 -> Lens (Either s q) (Either t r) a b 567 567 - choice = 568 568 - error "todo: choice" 582 582 + choice r1 r2 = 583 583 + 584 584 + (\p e -> case e of 585 585 + Left a -> fmap Left (r1 p a) 586 586 + Right b -> fmap Right (r2 p b)) 569 587 570 588 -- | An alias for @choice@. 571 589 (|||) :: ··· 649 667 Person 650 668 -> String 651 669 getSuburb = 652 652 - error "todo: getSuburb" 670 670 + get (suburbL |. addressL) 653 671 654 672 -- | 655 673 -- ··· 663 681 -> String 664 682 -> Person 665 683 setStreet = 666 666 - error "todo: setStreet" 684 684 + set (streetL |. addressL) 667 685 668 686 -- | 669 687 -- ··· 676 694 (Person, Locality) 677 695 -> (Int, String) 678 696 getAgeAndCountry = 679 679 - error "todo: getAgeAndCountry" 697 697 + get (ageL *** countryL) 680 698 681 699 -- | 682 700 -- ··· 688 706 setCityAndLocality :: 689 707 (Person, Address) -> (String, Locality) -> (Person, Address) 690 708 setCityAndLocality = 691 691 - error "todo: setCityAndLocality" 709 709 + set (cityL |. localityL |. addressL *** localityL) 692 710 693 711 -- | 694 712 -- ··· 701 719 Either Address Locality 702 720 -> String 703 721 getSuburbOrCity = 704 704 - error "todo: getSuburbOrCity" 722 722 + get (suburbL ||| cityL) 705 723 706 724 -- | 707 725 -- ··· 715 733 -> String 716 734 -> Either Person Locality 717 735 setStreetOrState = 718 718 - error "todo: setStreetOrState" 736 736 + set (streetL |. addressL ||| stateL) 719 737 720 738 -- | 721 739 -- ··· 728 746 Person 729 747 -> Person 730 748 modifyCityUppercase = 731 731 - error "todo: modifyCityUppercase" 749 749 + cityL |. localityL |. addressL %~ map toUpper 732 750 733 751 -- | 734 752 -- ··· 741 759 IntAnd [a] 742 760 -> IntAnd Bool 743 761 modifyIntAndLengthEven = 744 744 - error "todo: modifyIntAndLengthEven" 762 762 + intAndL %~ even . length 745 763 746 764 ---- 747 765 ··· 751 769 -- Locality "ABC" "DEF" "GHI" 752 770 traverseLocality :: 753 771 Traversal' Locality String 754 754 - traverseLocality = 755 755 - error "todo: traverseLocality" 772 772 + traverseLocality f (Locality c t y) = 773 773 + Locality <$> f c <*> f t <*> f y 756 774 757 775 -- | 758 776 -- ··· 764 782 intOrIntP :: 765 783 Prism' (IntOr a) Int 766 784 intOrIntP = 767 767 - error "todo: intOrIntP" 785 785 + prism 786 786 + IntOrIs 787 787 + (\i -> case i of 788 788 + IntOrIs n -> Right n 789 789 + IntOrIsNot a -> Left (IntOrIsNot a)) 768 790 769 791 intOrP :: 770 792 Prism (IntOr a) (IntOr b) a b 771 793 intOrP = 772 772 - error "todo: intOrP" 794 794 + prism 795 795 + IntOrIsNot 796 796 + (\i -> case i of 797 797 + IntOrIs n -> Left (IntOrIs n) 798 798 + IntOrIsNot a -> Right a) 773 799 774 800 -- | 775 801 -- ··· 785 811 IntOr [a] 786 812 -> IntOr Bool 787 813 intOrLengthEven = 788 788 - error "todo: intOrLengthEven" 814 814 + over intOrP (even . length)

+42 -26

src/Lets/OpticPolyLens.hs

reviewed

··· 123 123 -> (a -> b) 124 124 -> s 125 125 -> t 126 126 - modify = 127 127 - error "todo: modify" 126 126 + modify (Lens r) f = 127 127 + getIdentity . r (Identity . f) 128 128 129 129 -- | An alias for @modify@. 130 130 (%~) :: ··· 153 153 -> b 154 154 -> s 155 155 -> t 156 156 - (.~) = 157 157 - error "todo: (.~)" 156 156 + (.~) l = 157 157 + modify l . const 158 158 159 159 infixl 5 .~ 160 160 ··· 174 174 -> (a -> f b) 175 175 -> s 176 176 -> f t 177 177 - fmodify = 178 178 - error "todo: fmodify" 177 177 + fmodify (Lens r) f a = 178 178 + r f a 179 179 180 180 -- | 181 181 -- ··· 190 190 -> f b 191 191 -> s 192 192 -> f t 193 193 - (|=) = 194 194 - error "todo: (|=)" 193 193 + (|=) l = 194 194 + fmodify l . const 195 195 196 196 infixl 5 |= 197 197 ··· 208 208 fstL :: 209 209 Lens (a, x) (b, x) a b 210 210 fstL = 211 211 - error "todo: fstL" 211 211 + Lens 212 212 + (\p (x, y) -> fmap (\x' -> (x', y)) (p x)) 212 213 213 214 -- | 214 215 -- ··· 223 224 sndL :: 224 225 Lens (x, a) (x, b) a b 225 226 sndL = 226 226 - error "todo: sndL" 227 227 + Lens 228 228 + (\p (x, y) -> fmap (\y' -> (x, y')) (p y)) 227 229 228 230 -- | 229 231 -- ··· 248 250 Ord k => 249 251 k 250 252 -> Lens (Map k v) (Map k v) (Maybe v) (Maybe v) 251 251 - mapL = 252 252 - error "todo: mapL" 253 253 + mapL k = 254 254 + Lens 255 255 + (\p m -> let z = Map.lookup k m 256 256 + in fmap (\y -> case y of 257 257 + Just v -> Map.insert k v m 258 258 + Nothing -> case z of 259 259 + Just _ -> Map.delete k m 260 260 + Nothing -> m) (p z)) 253 261 254 262 -- | 255 263 -- ··· 274 282 Ord k => 275 283 k 276 284 -> Lens (Set k) (Set k) Bool Bool 277 277 - setL = 278 278 - error "todo: setL" 285 285 + setL k = 286 286 + Lens 287 287 + (\p s -> fmap (\b -> bool Set.delete Set.insert b k s) (p (Set.member k s))) 279 288 280 289 -- | 281 290 -- ··· 288 297 Lens s t a b 289 298 -> Lens q r s t 290 299 -> Lens q r a b 291 291 - compose = 292 292 - error "todo: compose" 300 300 + compose (Lens r1) (Lens r2) = 301 301 + Lens 302 302 + (r2 . r1) 293 303 294 304 -- | An alias for @compose@. 295 305 (|.) :: ··· 311 321 identity :: 312 322 Lens a b a b 313 323 identity = 314 314 - error "todo: identity" 324 324 + Lens 325 325 + id 315 326 316 327 -- | 317 328 -- ··· 324 335 Lens s t a b 325 336 -> Lens q r c d 326 337 -> Lens (s, q) (t, r) (a, c) (b, d) 327 327 - product = 328 328 - error "todo: product" 338 338 + product (Lens r1) (Lens r2) = 339 339 + Lens 340 340 + (\p (a, c) -> getAlongsideRight (r2 (\b2 -> AlongsideRight ( 341 341 + getAlongsideLeft (r1 (\b1 -> AlongsideLeft ( 342 342 + p (b1,b2))) a))) c)) 329 343 330 344 -- | An alias for @product@. 331 345 (***) :: ··· 354 368 Lens s t a b 355 369 -> Lens q r a b 356 370 -> Lens (Either s q) (Either t r) a b 357 357 - choice = 358 358 - error "todo: choice" 371 371 + choice (Lens r1) (Lens r2) = 372 372 + Lens 373 373 + (\p e -> case e of 374 374 + Left a -> fmap Left (r1 p a) 375 375 + Right b -> fmap Right (r2 p b)) 359 376 360 377 -- | An alias for @choice@. 361 378 (|||) :: ··· 450 467 Person 451 468 -> String 452 469 getSuburb = 453 453 - error "todo: getSuburb" 454 454 - 470 470 + get (suburbL |. addressL) 455 471 456 472 -- | 457 473 -- ··· 465 481 -> String 466 482 -> Person 467 483 setStreet = 468 468 - error "todo: setStreet" 484 484 + set (streetL |. addressL) 469 485 470 486 -- | 471 487 -- ··· 478 494 (Person, Locality) 479 495 -> (Int, String) 480 496 getAgeAndCountry = 481 481 - error "todo: getAgeAndCountry" 497 497 + get (ageL *** countryL) 482 498 483 499 -- | 484 500 -- ··· 490 506 setCityAndLocality :: 491 507 (Person, Address) -> (String, Locality) -> (Person, Address) 492 508 setCityAndLocality = 493 493 - error "todo: setCityAndLocality" 509 509 + set (cityL |. localityL |. addressL *** localityL) 494 510 495 511 -- | 496 512 --

+51 -36

src/Lets/StoreLens.hs

reviewed

··· 77 77 (a -> b) 78 78 -> Store s a 79 79 -> Store s b 80 80 - mapS = 81 81 - error "todo: mapS" 80 80 + mapS f (Store s g) = 81 81 + Store (f . s) g 82 82 83 83 duplicateS :: 84 84 Store s a 85 85 -> Store s (Store s a) 86 86 - duplicateS = 87 87 - error "todo: duplicateS" 86 86 + duplicateS (Store s g) = 87 87 + Store (Store s) g 88 88 89 89 extendS :: 90 90 (Store s a -> b) 91 91 -> Store s a 92 92 -> Store s b 93 93 - extendS = 94 94 - error "todo: extendS" 93 93 + extendS f = 94 94 + mapS f . duplicateS 95 95 96 96 extractS :: 97 97 Store s a 98 98 -> a 99 99 - extractS = 100 100 - error "todo: extractS" 99 99 + extractS (Store s g) = 100 100 + s g 101 101 102 102 ---- 103 103 ··· 190 190 -> (b -> b) 191 191 -> a 192 192 -> a 193 193 - modify = 194 194 - error "todo: modify" 193 193 + modify (Lens r) f a = 194 194 + let Store s g = r a 195 195 + in s (f g) 195 196 196 197 -- | An alias for @modify@. 197 198 (%~) :: ··· 220 221 -> b 221 222 -> a 222 223 -> a 223 223 - (.~) = 224 224 - error "todo: (.~)" 224 224 + (.~) l = 225 225 + modify l . const 225 226 226 227 infixl 5 .~ 227 228 ··· 241 242 -> (b -> f b) 242 243 -> a 243 244 -> f a 244 244 - fmodify = 245 245 - error "todo: fmodify" 245 245 + fmodify (Lens r) f a = 246 246 + let Store s g = r a 247 247 + in fmap s (f g) 246 248 247 249 -- | 248 250 -- ··· 257 259 -> f b 258 260 -> a 259 261 -> f a 260 260 - (|=) = 261 261 - error "todo: (|=)" 262 262 + (|=) l = 263 263 + fmodify l . const 262 264 263 265 infixl 5 |= 264 266 ··· 275 277 fstL :: 276 278 Lens (x, y) x 277 279 fstL = 278 278 - error "todo: fstL" 280 280 + Lens 281 281 + (\(x, y) -> Store (\x' -> (x', y)) x) 279 282 280 283 -- | 281 284 -- ··· 290 293 sndL :: 291 294 Lens (x, y) y 292 295 sndL = 293 293 - error "todo: sndL" 296 296 + Lens 297 297 + (\(x, y) -> Store (\y' -> (x, y')) y) 294 298 295 299 -- | 296 300 -- ··· 315 319 Ord k => 316 320 k 317 321 -> Lens (Map k v) (Maybe v) 318 318 - mapL = 319 319 - error "todo: mapL" 322 322 + mapL k = 323 323 + Lens 324 324 + (Store <$> (maybe . Map.delete k <*> (flip (Map.insert k))) <*> Map.lookup k) 320 325 321 326 -- | 322 327 -- ··· 341 346 Ord k => 342 347 k 343 348 -> Lens (Set k) Bool 344 344 - setL = 345 345 - error "todo: setL" 349 349 + setL k = 350 350 + Lens 351 351 + (Store <$> (bool . Set.delete k <*> Set.insert k) <*> Set.member k) 346 352 347 353 -- | 348 354 -- ··· 355 361 Lens b c 356 362 -> Lens a b 357 363 -> Lens a c 358 358 - compose = 359 359 - error "todo: compose" 364 364 + compose (Lens r1) (Lens r2) = 365 365 + Lens 366 366 + (\a -> let Store s2 g2 = r2 a 367 367 + Store s1 g1 = r1 g2 368 368 + in Store (s2 . s1) g1) 360 369 361 370 -- | An alias for @compose@. 362 371 (|.) :: ··· 378 387 identity :: 379 388 Lens a a 380 389 identity = 381 381 - error "todo: identity" 390 390 + Lens (Store id) 382 391 383 392 -- | 384 393 -- ··· 391 400 Lens a b 392 401 -> Lens c d 393 402 -> Lens (a, c) (b, d) 394 394 - product = 395 395 - error "todo: product" 403 403 + product (Lens r1) (Lens r2) = 404 404 + Lens (\(a, c) -> 405 405 + let Store s1 g1 = r1 a 406 406 + Store s2 g2 = r2 c 407 407 + in Store (\(b, d) -> (s1 b, s2 d)) (g1, g2)) 396 408 397 409 -- | An alias for @product@. 398 410 (***) :: ··· 421 433 Lens a x 422 434 -> Lens b x 423 435 -> Lens (Either a b) x 424 424 - choice = 425 425 - error "todo: choice" 436 436 + choice (Lens r1) (Lens r2) = 437 437 + Lens (\e -> 438 438 + case e of 439 439 + Left a -> mapS Left (r1 a) 440 440 + Right b -> mapS Right (r2 b)) 426 441 427 442 -- | An alias for @choice@. 428 443 (|||) :: ··· 510 525 Person 511 526 -> String 512 527 getSuburb = 513 513 - error "todo: getSuburb" 528 528 + get (suburbL |. addressL) 514 529 515 530 -- | 516 531 -- ··· 524 539 -> String 525 540 -> Person 526 541 setStreet = 527 527 - error "todo: setStreet" 542 542 + set (streetL |. addressL) 528 543 529 544 -- | 530 545 -- ··· 537 552 (Person, Locality) 538 553 -> (Int, String) 539 554 getAgeAndCountry = 540 540 - error "todo: getAgeAndCountry" 555 555 + get (ageL *** countryL) 541 556 542 557 -- | 543 558 -- ··· 549 564 setCityAndLocality :: 550 565 (Person, Address) -> (String, Locality) -> (Person, Address) 551 566 setCityAndLocality = 552 552 - error "todo: setCityAndLocality" 567 567 + set (cityL |. localityL |. addressL *** localityL) 553 568 554 569 -- | 555 570 -- ··· 562 577 Either Address Locality 563 578 -> String 564 579 getSuburbOrCity = 565 565 - error "todo: getSuburbOrCity" 580 580 + get (suburbL ||| cityL) 566 581 567 582 -- | 568 583 -- ··· 576 591 -> String 577 592 -> Either Person Locality 578 593 setStreetOrState = 579 579 - error "todo: setStreetOrState" 594 594 + set (streetL |. addressL ||| stateL) 580 595 581 596 -- | 582 597 -- ··· 589 604 Person 590 605 -> Person 591 606 modifyCityUppercase = 592 592 - error "todo: modifyCityUppercase" 607 607 + cityL |. localityL |. addressL %~ map toUpper