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 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@.
|
||||
(|||) ::
|
||||
|
|
Loading…
Reference in a new issue