src: Lets: GetSetLens: Implement basic lens operators

Signed-off-by: Sanchayan Maity <maitysanchayan@gmail.com>
This commit is contained in:
Sanchayan Maity 2019-02-08 23:58:38 +05:30
parent 4c7da139cc
commit 1b68f0617f

View file

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