src: Lets: OpticPolyLens: Implement optic poly lens
Signed-off-by: Sanchayan Maity <maitysanchayan@gmail.com>
This commit is contained in:
parent
246f6b1302
commit
7c8a2f87bb
1 changed files with 30 additions and 33 deletions
|
|
@ -1,4 +1,5 @@
|
|||
{-# LANGUAGE RankNTypes #-}
|
||||
{-# LANGUAGE TupleSections #-}
|
||||
|
||||
module Lets.OpticPolyLens (
|
||||
Lens(..)
|
||||
|
|
@ -43,9 +44,10 @@ module Lets.OpticPolyLens (
|
|||
, modifyIntandLengthEven
|
||||
) where
|
||||
|
||||
import Data.Char(toUpper)
|
||||
import Data.Bool(bool)
|
||||
import Data.Char(toUpper, ord)
|
||||
import Data.Map(Map)
|
||||
import qualified Data.Map as Map(insert, delete, lookup)
|
||||
import qualified Data.Map as Map(insert, delete, lookup, fromList, alterF)
|
||||
import Data.Set(Set)
|
||||
import qualified Data.Set as Set(insert, delete, member)
|
||||
import Lets.Data(AlongsideLeft(AlongsideLeft, getAlongsideLeft), AlongsideRight(AlongsideRight, getAlongsideRight), Identity(Identity, getIdentity), Const(Const, getConst), IntAnd(IntAnd), Person(Person), Locality(Locality), Address(Address))
|
||||
|
|
@ -125,8 +127,9 @@ modify ::
|
|||
-> (a -> b)
|
||||
-> s
|
||||
-> t
|
||||
modify =
|
||||
error "todo: modify"
|
||||
modify (Lens r) f s = let idf = Identity . f in
|
||||
let ridf = r idf in
|
||||
let sidt = ridf s in getIdentity sidt
|
||||
|
||||
-- | An alias for @modify@.
|
||||
(%~) ::
|
||||
|
|
@ -155,8 +158,10 @@ infixr 4 %~
|
|||
-> b
|
||||
-> s
|
||||
-> t
|
||||
(.~) =
|
||||
error "todo: (.~)"
|
||||
-- modify :: Lens s t a b -> (a -> b) -> s -> t
|
||||
-- modify (Lens r) f s = let idf = Identity . f in
|
||||
-- let ridf = r idf in (getIdentity . ridf) s
|
||||
(.~) (Lens stab) b s = getIdentity (stab (\_ -> Identity b) s)
|
||||
|
||||
infixl 5 .~
|
||||
|
||||
|
|
@ -176,8 +181,7 @@ fmodify ::
|
|||
-> (a -> f b)
|
||||
-> s
|
||||
-> f t
|
||||
fmodify =
|
||||
error "todo: fmodify"
|
||||
fmodify (Lens stab) aTofb s = stab aTofb s
|
||||
|
||||
-- |
|
||||
--
|
||||
|
|
@ -192,8 +196,7 @@ fmodify =
|
|||
-> f b
|
||||
-> s
|
||||
-> f t
|
||||
(|=) =
|
||||
error "todo: (|=)"
|
||||
(|=) (Lens l) fb s = (l (\_ -> fb) s)
|
||||
|
||||
infixl 5 |=
|
||||
|
||||
|
|
@ -209,8 +212,7 @@ infixl 5 |=
|
|||
-- prop> let types = (x :: Int, y :: String) in setsetLaw fstL (x, y) z
|
||||
fstL ::
|
||||
Lens (a, x) (b, x) a b
|
||||
fstL =
|
||||
error "todo: fstL"
|
||||
fstL = Lens (\f -> \(a, x) -> let fb = f a in (, x) <$> fb)
|
||||
|
||||
-- |
|
||||
--
|
||||
|
|
@ -224,8 +226,7 @@ fstL =
|
|||
-- prop> let types = (x :: Int, y :: String) in setsetLaw sndL (x, y) z
|
||||
sndL ::
|
||||
Lens (x, a) (x, b) a b
|
||||
sndL =
|
||||
error "todo: sndL"
|
||||
sndL = Lens (\f -> \(x, a) -> let fb = f a in (x ,) <$> fb)
|
||||
|
||||
-- |
|
||||
--
|
||||
|
|
@ -250,8 +251,7 @@ mapL ::
|
|||
Ord k =>
|
||||
k
|
||||
-> Lens (Map k v) (Map k v) (Maybe v) (Maybe v)
|
||||
mapL =
|
||||
error "todo: mapL"
|
||||
mapL k = Lens (\f -> \mkv -> Map.alterF f k mkv)
|
||||
|
||||
-- |
|
||||
--
|
||||
|
|
@ -276,8 +276,8 @@ setL ::
|
|||
Ord k =>
|
||||
k
|
||||
-> Lens (Set k) (Set k) Bool Bool
|
||||
setL =
|
||||
error "todo: setL"
|
||||
setL k = Lens (\f -> \sk -> (\b -> bool (Set.delete k sk) (Set.insert k sk) b)
|
||||
<$> (f $ Set.member k sk))
|
||||
|
||||
-- |
|
||||
--
|
||||
|
|
@ -290,8 +290,7 @@ compose ::
|
|||
Lens s t a b
|
||||
-> Lens q r s t
|
||||
-> Lens q r a b
|
||||
compose =
|
||||
error "todo: compose"
|
||||
compose (Lens r) (Lens g) = Lens $ g . r
|
||||
|
||||
-- | An alias for @compose@.
|
||||
(|.) ::
|
||||
|
|
@ -312,8 +311,7 @@ infixr 9 |.
|
|||
-- 4
|
||||
identity ::
|
||||
Lens a b a b
|
||||
identity =
|
||||
error "todo: identity"
|
||||
identity = Lens (\f -> \a -> f a)
|
||||
|
||||
-- |
|
||||
--
|
||||
|
|
@ -356,8 +354,9 @@ choice ::
|
|||
Lens s t a b
|
||||
-> Lens q r a b
|
||||
-> Lens (Either s q) (Either t r) a b
|
||||
choice =
|
||||
error "todo: choice"
|
||||
choice (Lens l) (Lens g) = Lens (\f -> \esq -> case esq of
|
||||
Left s -> Left <$> l f s
|
||||
Right q -> Right <$> g f q)
|
||||
|
||||
-- | An alias for @choice@.
|
||||
(|||) ::
|
||||
|
|
@ -451,9 +450,7 @@ intAndL =
|
|||
getSuburb ::
|
||||
Person
|
||||
-> String
|
||||
getSuburb =
|
||||
error "todo: getSuburb"
|
||||
|
||||
getSuburb = get $ (compose suburbL addressL)
|
||||
|
||||
-- |
|
||||
--
|
||||
|
|
@ -466,8 +463,7 @@ setStreet ::
|
|||
Person
|
||||
-> String
|
||||
-> Person
|
||||
setStreet =
|
||||
error "todo: setStreet"
|
||||
setStreet = set $ (compose streetL addressL)
|
||||
|
||||
-- |
|
||||
--
|
||||
|
|
@ -479,8 +475,8 @@ setStreet =
|
|||
getAgeAndCountry ::
|
||||
(Person, Locality)
|
||||
-> (Int, String)
|
||||
getAgeAndCountry =
|
||||
error "todo: getAgeAndCountry"
|
||||
getAgeAndCountry (person, locality) = (get ageL person,
|
||||
get countryL locality)
|
||||
|
||||
-- |
|
||||
--
|
||||
|
|
@ -491,8 +487,9 @@ getAgeAndCountry =
|
|||
-- (Person 28 "Mary" (Address "83 Mary Ln" "Maryland" (Locality "Some Other City" "Western Mary" "Maristan")),Address "15 Fred St" "Fredville" (Locality "Mary Mary" "Western Mary" "Maristan"))
|
||||
setCityAndLocality ::
|
||||
(Person, Address) -> (String, Locality) -> (Person, Address)
|
||||
setCityAndLocality =
|
||||
error "todo: setCityAndLocality"
|
||||
setCityAndLocality (person, address) (city, locality) =
|
||||
(set (cityL |. localityL |. addressL) person city,
|
||||
set localityL address locality)
|
||||
|
||||
-- |
|
||||
--
|
||||
|
|
|
|||
Loading…
Reference in a new issue