From 1b68f0617f792fdb3d35129c8a7b0a42e5552b4d Mon Sep 17 00:00:00 2001
From: Sanchayan Maity <maitysanchayan@gmail.com>
Date: Fri, 8 Feb 2019 23:58:38 +0530
Subject: [PATCH] src: Lets: GetSetLens: Implement basic lens operators

Signed-off-by: Sanchayan Maity <maitysanchayan@gmail.com>
---
 src/Lets/GetSetLens.hs | 53 ++++++++++++++++++++++--------------------
 1 file changed, 28 insertions(+), 25 deletions(-)

diff --git a/src/Lets/GetSetLens.hs b/src/Lets/GetSetLens.hs
index 5d6d959..1866385 100644
--- a/src/Lets/GetSetLens.hs
+++ b/src/Lets/GetSetLens.hs
@@ -43,7 +43,7 @@ import Data.Char(toUpper)
 import Data.Map(Map)
 import qualified Data.Map as Map(insert, delete, lookup)
 import Data.Set(Set)
-import qualified Data.Set as Set(insert, delete, member)
+import qualified Data.Set as Set(insert, delete, member, fromList)
 import Lets.Data(Person(Person), Locality(Locality), Address(Address))
 import Prelude hiding (product)
 
@@ -144,8 +144,7 @@ modify ::
   -> (b -> b)
   -> a
   -> a
-modify =
-  error "todo: modify"
+modify = \(Lens f g) -> \bTob -> \a -> f a (bTob (g a))
 
 -- | An alias for @modify@.
 (%~) ::
@@ -174,8 +173,7 @@ infixr 4 %~
   -> b
   -> a
   -> a
-(.~) =
-  error "todo: (.~)"
+(.~) = \(Lens f _) -> \b -> \a -> f a b
 
 infixl 5 .~
 
@@ -195,8 +193,7 @@ fmodify ::
   -> (b -> f b)
   -> a
   -> f a
-fmodify =
-  error "todo: fmodify"
+fmodify = \(Lens f g) -> \bTofb -> \a -> (f a) <$> bTofb (g a)
 
 -- |
 --
@@ -211,8 +208,7 @@ fmodify =
   -> f b
   -> a
   -> f a
-(|=) =
-  error "todo: (|=)"
+(|=) = \(Lens f _) -> \fb -> \a -> (f a) <$> fb
 
 infixl 5 |=
 
@@ -228,8 +224,7 @@ infixl 5 |=
 -- prop> let types = (x :: Int, y :: String) in setsetLaw fstL (x, y) z
 fstL ::
   Lens (x, y) x
-fstL =
-  error "todo: fstL"
+fstL = Lens (\(_, y) -> \x -> (x, y)) (\(x, _) -> x)
 
 -- |
 --
@@ -243,8 +238,7 @@ fstL =
 -- prop> let types = (x :: Int, y :: String) in setsetLaw sndL (x, y) z
 sndL ::
   Lens (x, y) y
-sndL =
-  error "todo: sndL"
+sndL = Lens (\(x, _) -> \y -> (x, y)) (\(_, y) -> y)
 
 -- |
 --
@@ -269,8 +263,9 @@ mapL ::
   Ord k =>
   k
   -> Lens (Map k v) (Maybe v)
-mapL =
-  error "todo: mapL"
+-- Did not really understand this, taken from solutions
+mapL k = Lens (maybe . Map.delete k <*> (flip (Map.insert k)))
+         (Map.lookup k)
 
 -- |
 --
@@ -295,8 +290,12 @@ setL ::
   Ord k =>
   k
   -> Lens (Set k) Bool
-setL =
-  error "todo: setL"
+-- Set k -> Bool -> Set k
+-- Set k -> Bool
+setL k = Lens (\sk -> \bool -> case bool of
+                                True -> Set.insert k sk
+                                False -> Set.delete k sk)
+         (\sk -> Set.member k sk)
 
 -- |
 --
@@ -309,8 +308,7 @@ compose ::
   Lens b c
   -> Lens a b
   -> Lens a c
-compose =
-  error "todo: compose"
+compose (Lens f g) (Lens h i) = Lens (\a -> h a . f (i a)) (g . i)
 
 -- | An alias for @compose@.
 (|.) ::
@@ -331,8 +329,7 @@ infixr 9 |.
 -- 4
 identity ::
   Lens a a
-identity =
-  error "todo: identity"
+identity = Lens (\_ -> \b -> b) (\a -> a)
 
 -- |
 --
@@ -345,8 +342,9 @@ product ::
   Lens a b
   -> Lens c d
   -> Lens (a, c) (b, d)
-product =
-  error "todo: product"
+product (Lens f g) (Lens h i) = Lens
+                                (\(a, c) -> \(b, d) -> (f a b, h c d))
+                                (\(a, c) -> (g a, i c))
 
 -- | An alias for @product@.
 (***) ::
@@ -375,8 +373,13 @@ choice ::
   Lens a x
   -> Lens b x
   -> Lens (Either a b) x
-choice =
-  error "todo: choice"
+choice (Lens f g) (Lens h i) = Lens
+                               (\eab -> \x -> case eab of
+                                   Left a -> Left $ f a x
+                                   Right b -> Right $ h b x)
+                               (\eab -> case eab of
+                                          Left a -> g a
+                                          Right b -> i b)
 
 -- | An alias for @choice@.
 (|||) ::