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