From cf6be85a53b9bde599da96a544ba4e596e409e4a Mon Sep 17 00:00:00 2001
From: Manu Phatak <manu@phatak.io>
Date: Sun, 10 Jan 2021 18:31:59 -0800
Subject: [PATCH] Practice with Lens

---
 AdventOfCode2020.cabal            |  4 +++
 package.yaml                      |  3 +-
 src/Practice/LensTutorial.hs      | 17 ++++++++++
 test/Practice/LensTutorialSpec.hs | 56 +++++++++++++++++++++++++++++++
 4 files changed, 79 insertions(+), 1 deletion(-)
 create mode 100644 src/Practice/LensTutorial.hs
 create mode 100644 test/Practice/LensTutorialSpec.hs

diff --git a/AdventOfCode2020.cabal b/AdventOfCode2020.cabal
index ddb5e5a..eaa6b23 100644
--- a/AdventOfCode2020.cabal
+++ b/AdventOfCode2020.cabal
@@ -54,6 +54,7 @@ library
       Day20.Solution
       Day21.Solution
       Practice.Foldable
+      Practice.LensTutorial
       Template.Solution
   other-modules:
       Paths_AdventOfCode2020
@@ -66,6 +67,7 @@ library
   build-depends:
       base >=4.7 && <5
     , containers
+    , lens
     , parsec
   default-language: Haskell2010
 
@@ -100,6 +102,7 @@ test-suite AdventOfCode2020-test
       Day20.SolutionSpec
       Day21.SolutionSpec
       Practice.FoldableSpec
+      Practice.LensTutorialSpec
       Template.SolutionSpec
       Paths_AdventOfCode2020
   hs-source-dirs:
@@ -116,5 +119,6 @@ test-suite AdventOfCode2020-test
     , hspec
     , hspec-discover
     , hspec-golden
+    , lens
     , parsec
   default-language: Haskell2010
diff --git a/package.yaml b/package.yaml
index 3bdf34c..34c927b 100644
--- a/package.yaml
+++ b/package.yaml
@@ -21,8 +21,9 @@ description:         Please see the README on GitHub at <https://github.com/manu
 
 dependencies:
 - base >= 4.7 && < 5
-- parsec
 - containers
+- lens
+- parsec
 
 library:
   source-dirs: src
diff --git a/src/Practice/LensTutorial.hs b/src/Practice/LensTutorial.hs
new file mode 100644
index 0000000..5f56f69
--- /dev/null
+++ b/src/Practice/LensTutorial.hs
@@ -0,0 +1,17 @@
+{-# LANGUAGE TemplateHaskell #-}
+
+module Practice.LensTutorial where
+
+import Control.Lens
+
+-- https://www.schoolofhaskell.com/school/to-infinity-and-beyond/pick-of-the-week/a-little-lens-starter-tutorial
+
+type Degrees = Double
+
+type Latitude = Degrees
+
+type Longitude = Degrees
+
+data Meetup = Meetup {_name :: String, _location :: (Latitude, Longitude)} deriving (Show, Eq)
+
+makeLenses ''Meetup
diff --git a/test/Practice/LensTutorialSpec.hs b/test/Practice/LensTutorialSpec.hs
new file mode 100644
index 0000000..e1343c3
--- /dev/null
+++ b/test/Practice/LensTutorialSpec.hs
@@ -0,0 +1,56 @@
+module Practice.LensTutorialSpec (spec) where
+
+import Control.Lens
+import Practice.LensTutorial
+import Test.Hspec
+
+spec :: Spec
+spec = parallel $ do
+  describe "lenses" $ do
+    it "can view a value" $ do
+      view _1 ("goal", "match") `shouldBe` "goal"
+    it "can modify a value" $ do
+      over _1 (++ "!!!") ("goal", "match") `shouldBe` ("goal!!!", "match")
+    it "can set a value" $ do
+      set _1 "SET" ("goal", "match") `shouldBe` ("SET", "match")
+
+    let epicMeetup = Meetup "After after party" (34.3705, -119.1391)
+
+    it "creates lens for custom types" $ do
+      view name epicMeetup `shouldBe` "After after party"
+
+    it "is composable" $ do
+      let meetupLongitude = location . _2
+      set meetupLongitude (-120) epicMeetup `shouldBe` epicMeetup {_location = (34.3705, -120)}
+
+    it "can access members" $ do
+      (epicMeetup ^. location . _1) `shouldBe` 34.3705
+
+    it "can set members" $ do
+      (location . _2 .~ 13 $ epicMeetup) `shouldBe` epicMeetup {_location = (34.3705, 13)}
+    it "can set members" $ do
+      (location . _2 %~ pred $ epicMeetup) `shouldBe` epicMeetup {_location = (34.3705, -120.1391)}
+
+  describe "prisms" $ do
+    it "" $ do
+      preview _Left (Left "Hello") `shouldBe` Just "Hello"
+    it "" $ do
+      preview _Left (Right "Hello" :: Either String String) `shouldBe` Nothing
+
+    it "" $ do
+      review _Left "Howdy" `shouldBe` (Left "Howdy" :: Either String String)
+
+    it "" $ do
+      Left "Hi" ^? _Left `shouldBe` Just "Hi"
+
+  describe "traversals" $ do
+    it "can include any or all elements" $ do
+      toListOf traverse [1 :: Int .. 5] `shouldBe` [1 .. 5]
+
+      [1 :: Int .. 5] ^.. traverse `shouldBe` [1 .. 5]
+
+    it "can get the first item" $ do
+      firstOf traverse [1 :: Int .. 5] `shouldBe` Just 1
+
+    it "can get the last item" $ do
+      lastOf traverse [1 :: Int .. 5] `shouldBe` Just 5