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@. (|||) ::