Lens.hs: Complete the easier part of this Lens exercise

Signed-off-by: Sanchayan Maity <maitysanchayan@gmail.com>
This commit is contained in:
Sanchayan Maity 2019-08-27 20:37:20 +05:30
parent b0f7bf2c06
commit 9c83801470

View file

@ -98,7 +98,7 @@ import Prelude hiding (product)
--
-- class (Foldable t, Functor t) => Traversable t where
-- traverse ::
-- Applicative f =>
-- Applicative f =>
-- (a -> f b)
-- -> t a
-- -> f (t b)
@ -111,17 +111,15 @@ fmapT ::
(a -> b)
-> t a
-> t b
fmapT =
error "todo: fmapT"
fmapT f = getIdentity . traverse (Identity . f)
-- | Let's refactor out the call to @traverse@ as an argument to @fmapT@.
over ::
over ::
((a -> Identity b) -> s -> Identity t)
-> (a -> b)
-> s
-> t
over =
error "todo: over"
over t f = getIdentity . t (Identity . f)
-- | Here is @fmapT@ again, passing @traverse@ to @over@.
fmapTAgain ::
@ -129,8 +127,7 @@ fmapTAgain ::
(a -> b)
-> t a
-> t b
fmapTAgain =
error "todo: fmapTAgain"
fmapTAgain = over traverse
-- | Let's create a type-alias for this type of function.
type Set s t a b =
@ -142,23 +139,20 @@ type Set s t a b =
-- unwrapping.
sets ::
((a -> b) -> s -> t)
-> Set s t a b
sets =
error "todo: sets"
-> Set s t a b
sets f g = Identity . f (getIdentity . g)
mapped ::
Functor f =>
Set (f a) (f b) a b
mapped =
error "todo: mapped"
mapped f g = Identity (getIdentity . f <$> g)
set ::
Set s t a b
-> s
-> b
-> t
set =
error "todo: set"
set f s b = over f (const b) s
----
@ -170,8 +164,7 @@ foldMapT ::
(a -> b)
-> t a
-> b
foldMapT =
error "todo: foldMapT"
foldMapT f = getConst . traverse (Const . f)
-- | Let's refactor out the call to @traverse@ as an argument to @foldMapT@.
foldMapOf ::
@ -179,8 +172,7 @@ foldMapOf ::
-> (a -> r)
-> s
-> r
foldMapOf =
error "todo: foldMapOf"
foldMapOf t f = getConst . t (Const . f)
-- | Here is @foldMapT@ again, passing @traverse@ to @foldMapOf@.
foldMapTAgain ::
@ -188,8 +180,7 @@ foldMapTAgain ::
(a -> b)
-> t a
-> b
foldMapTAgain =
error "todo: foldMapTAgain"
foldMapTAgain = foldMapOf traverse
-- | Let's create a type-alias for this type of function.
type Fold s t a b =
@ -206,14 +197,12 @@ folds ::
-> (a -> Const b a)
-> s
-> Const t s
folds =
error "todo: folds"
folds f g s = let t = (f (getConst . g) s) in Const t
folded ::
Foldable f =>
Fold (f a) (f a) a a
folded =
error "todo: folded"
folded = folds foldMap
----
@ -227,8 +216,7 @@ get ::
Get a s a
-> s
-> a
get =
error "todo: get"
get f = getConst . f Const
----
@ -243,20 +231,20 @@ type Traversal s t a b =
-- | Traverse both sides of a pair.
both ::
Traversal (a, a) (b, b) a b
both =
error "todo: both"
-- both :: (a -> f b) -> (a , a) -> f (b , b)
both f (a, b) = (,) <$> f a <*> f b
-- | Traverse the left side of @Either@.
traverseLeft ::
Traversal (Either a x) (Either b x) a b
traverseLeft =
error "todo: traverseLeft"
traverseLeft f (Left a) = Left <$> f a
traverseLeft _ (Right x) = pure $ Right x
-- | Traverse the right side of @Either@.
traverseRight ::
Traversal (Either x a) (Either x b) a b
traverseRight =
error "todo: traverseRight"
traverseRight _ (Left x) = pure $ Left x
traverseRight f (Right b) = Right <$> f b
type Traversal' a b =
Traversal a a b b
@ -286,11 +274,10 @@ type Prism s t a b =
_Left ::
Prism (Either a x) (Either b x) a b
_Left =
error "todo: _Left"
_Left = _
_Right ::
Prism (Either x a) (Either x b) a b
Prism (Either x a) (Either x b) a b
_Right =
error "todo: _Right"
@ -396,7 +383,7 @@ fmodify ::
Lens s t a b
-> (a -> f b)
-> s
-> f t
-> f t
fmodify _ _ _ =
error "todo: fmodify"
@ -700,7 +687,7 @@ setCityAndLocality ::
(Person, Address) -> (String, Locality) -> (Person, Address)
setCityAndLocality =
error "todo: setCityAndLocality"
-- |
--
-- >>> getSuburbOrCity (Left maryAddress)