src: Lets: GetSetLens: Implement basic lens operators
Signed-off-by: Sanchayan Maity <maitysanchayan@gmail.com>
This commit is contained in:
parent
4c7da139cc
commit
1b68f0617f
1 changed files with 28 additions and 25 deletions
|
@ -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@.
|
||||||
(|||) ::
|
(|||) ::
|
||||||
|
|
Loading…
Reference in a new issue