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.

fix Lens module with answers

Tony Morris 25af5620 4ddd582d

+98 -72
+98 -72
src/Lets/Lens.hs
··· 110 110 (a -> b) 111 111 -> t a 112 112 -> t b 113 - fmapT = 114 - error "todo: fmapT" 113 + fmapT f = 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 - over = 123 - error "todo: over" 122 + over t f = 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 - error "todo: fmapTAgain" 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 - sets = 146 - error "todo: sets" 145 + sets t f = 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 - error "todo: mapped" 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 - set = 160 - error "todo: set" 159 + set t s b = 160 + over t (const b) s 161 161 162 162 ---- 163 163 ··· 169 169 (a -> b) 170 170 -> t a 171 171 -> b 172 - foldMapT = 173 - error "todo: foldMapT" 172 + foldMapT f = 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 - foldMapOf = 182 - error "todo: foldMapOf" 181 + foldMapOf t f = 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 - error "todo: foldMapTAgain" 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 - folds = 209 - error "todo: folds" 208 + folds t f = 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 - error "todo: folded" 215 + folds foldMap 216 216 217 217 ---- 218 218 ··· 226 226 Get a s a 227 227 -> s 228 228 -> a 229 - get = 230 - error "todo: get" 229 + get t = 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 - both = 246 - error "todo: both" 245 + both f (a, b) = 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 - traverseLeft = 252 - error "todo: traverseLeft" 251 + traverseLeft f (Left a) = 252 + Left <$> f a 253 + traverseLeft _ (Right x) = 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 - traverseRight = 258 - error "todo: traverseRight" 259 + traverseRight _ (Left x) = 260 + pure (Left x) 261 + traverseRight f (Right a) = 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 - error "todo: _Left" 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 - error "todo: _Right" 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 - prism = 301 - error "todo: prism" 304 + prism to fr = 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 - error "todo: _Just" 310 + prism 311 + Just 312 + (maybe (Left Nothing) Right) 307 313 308 314 _Nothing :: 309 315 Prism (Maybe a) (Maybe a) () () 310 316 _Nothing = 311 - error "todo: _Nothing" 317 + prism 318 + (\() -> Nothing) 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 - setP = 318 - error "todo: setP" 325 + setP p = 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 - getP = 325 - error "todo: getP" 332 + getP p = 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 - modify = 349 - error "todo: modify" 356 + modify r f = 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 - (.~) = 379 - error "todo: (.~)" 386 + (.~) l = 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 - fmodify = 400 - error "todo: fmodify" 407 + fmodify l = 408 + l 401 409 402 410 -- | 403 411 -- ··· 412 420 -> f b 413 421 -> s 414 422 -> f t 415 - (|=) = 416 - error "todo: (|=)" 423 + (|=) l = 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 - fstL = 427 - error "todo: fstL" 434 + fstL p (x, y) = 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 - sndL = 436 - error "todo: sndL" 443 + sndL p (x, y) = 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 - mapL = 462 - error "todo: mapL" 469 + mapL k p m = 470 + let z = Map.lookup k m 471 + in fmap (\y -> case y of 472 + Just v -> Map.insert k v m 473 + Nothing -> case z of 474 + Just _ -> Map.delete k m 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 - setL = 488 - error "todo: setL" 500 + setL k = 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 - compose = 502 - error "todo: compose" 514 + compose r1 r2 = 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 - error "todo: identity" 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 - product = 538 - error "todo: product" 550 + product r1 r2 p (a, c) = 551 + getAlongsideRight (r2 (\b2 -> AlongsideRight ( 552 + getAlongsideLeft (r1 (\b1 -> AlongsideLeft ( 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 - choice = 568 - error "todo: choice" 582 + choice r1 r2 = 583 + 584 + (\p e -> case e of 585 + Left a -> fmap Left (r1 p a) 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 - error "todo: getSuburb" 670 + get (suburbL |. addressL) 653 671 654 672 -- | 655 673 -- ··· 663 681 -> String 664 682 -> Person 665 683 setStreet = 666 - error "todo: setStreet" 684 + set (streetL |. addressL) 667 685 668 686 -- | 669 687 -- ··· 676 694 (Person, Locality) 677 695 -> (Int, String) 678 696 getAgeAndCountry = 679 - error "todo: getAgeAndCountry" 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 - error "todo: setCityAndLocality" 709 + set (cityL |. localityL |. addressL *** localityL) 692 710 693 711 -- | 694 712 -- ··· 701 719 Either Address Locality 702 720 -> String 703 721 getSuburbOrCity = 704 - error "todo: getSuburbOrCity" 722 + get (suburbL ||| cityL) 705 723 706 724 -- | 707 725 -- ··· 715 733 -> String 716 734 -> Either Person Locality 717 735 setStreetOrState = 718 - error "todo: setStreetOrState" 736 + set (streetL |. addressL ||| stateL) 719 737 720 738 -- | 721 739 -- ··· 728 746 Person 729 747 -> Person 730 748 modifyCityUppercase = 731 - error "todo: modifyCityUppercase" 749 + cityL |. localityL |. addressL %~ map toUpper 732 750 733 751 -- | 734 752 -- ··· 741 759 IntAnd [a] 742 760 -> IntAnd Bool 743 761 modifyIntAndLengthEven = 744 - error "todo: modifyIntAndLengthEven" 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 - traverseLocality = 755 - error "todo: traverseLocality" 772 + traverseLocality f (Locality c t y) = 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 - error "todo: intOrIntP" 785 + prism 786 + IntOrIs 787 + (\i -> case i of 788 + IntOrIs n -> Right n 789 + IntOrIsNot a -> Left (IntOrIsNot a)) 768 790 769 791 intOrP :: 770 792 Prism (IntOr a) (IntOr b) a b 771 793 intOrP = 772 - error "todo: intOrP" 794 + prism 795 + IntOrIsNot 796 + (\i -> case i of 797 + IntOrIs n -> Left (IntOrIs n) 798 + IntOrIsNot a -> Right a) 773 799 774 800 -- | 775 801 -- ··· 785 811 IntOr [a] 786 812 -> IntOr Bool 787 813 intOrLengthEven = 788 - error "todo: intOrLengthEven" 814 + over intOrP (even . length)