.gitignore

@@ -30,7 +30,3 @@ TAGS
 
 *.swp
 
-# STACK
-.stack-work
-stack.yaml.lock
-tags

src/Lets/GetSetLens.hs

@@ -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, fromList)
+import qualified Data.Set as Set(insert, delete, member)
 import Lets.Data(Person(Person), Locality(Locality), Address(Address))
 import Prelude hiding (product)
 
@@ -144,7 +144,8 @@ modify ::
   -> (b -> b)
   -> a
   -> a
-modify = \(Lens f g) -> \bTob -> \a -> f a (bTob (g a))
+modify =
+  error "todo: modify"
 
 -- | An alias for @modify@.
 (%~) ::
@@ -173,7 +174,8 @@ infixr 4 %~
   -> b
   -> a
   -> a
-(.~) = \(Lens f _) -> \b -> \a -> f a b
+(.~) =
+  error "todo: (.~)"
 
 infixl 5 .~
 
@@ -193,7 +195,8 @@ fmodify ::
   -> (b -> f b)
   -> a
   -> f a
-fmodify = \(Lens f g) -> \bTofb -> \a -> (f a) <$> bTofb (g a)
+fmodify =
+  error "todo: fmodify"
 
 -- |
 --
@@ -208,7 +211,8 @@ fmodify = \(Lens f g) -> \bTofb -> \a -> (f a) <$> bTofb (g a)
   -> f b
   -> a
   -> f a
-(|=) = \(Lens f _) -> \fb -> \a -> (f a) <$> fb
+(|=) =
+  error "todo: (|=)"
 
 infixl 5 |=
 
@@ -224,7 +228,8 @@ infixl 5 |=
 -- prop> let types = (x :: Int, y :: String) in setsetLaw fstL (x, y) z
 fstL ::
   Lens (x, y) x
-fstL = Lens (\(_, y) -> \x -> (x, y)) (\(x, _) -> x)
+fstL =
+  error "todo: fstL"
 
 -- |
 --
@@ -238,7 +243,8 @@ fstL = Lens (\(_, y) -> \x -> (x, y)) (\(x, _) -> x)
 -- prop> let types = (x :: Int, y :: String) in setsetLaw sndL (x, y) z
 sndL ::
   Lens (x, y) y
-sndL = Lens (\(x, _) -> \y -> (x, y)) (\(_, y) -> y)
+sndL =
+  error "todo: sndL"
 
 -- |
 --
@@ -263,9 +269,8 @@ mapL ::
   Ord k =>
   k
   -> Lens (Map k v) (Maybe v)
--- Did not really understand this, taken from solutions
-mapL k = Lens (maybe . Map.delete k <*> (flip (Map.insert k)))
-         (Map.lookup k)
+mapL =
+  error "todo: mapL"
 
 -- |
 --
@@ -290,12 +295,8 @@ setL ::
   Ord k =>
   k
   -> Lens (Set k) Bool
--- 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)
+setL =
+  error "todo: setL"
 
 -- |
 --
@@ -308,7 +309,8 @@ compose ::
   Lens b c
   -> Lens a b
   -> Lens a c
-compose (Lens f g) (Lens h i) = Lens (\a -> h a . f (i a)) (g . i)
+compose =
+  error "todo: compose"
 
 -- | An alias for @compose@.
 (|.) ::
@@ -329,7 +331,8 @@ infixr 9 |.
 -- 4
 identity ::
   Lens a a
-identity = Lens (\_ -> \b -> b) (\a -> a)
+identity =
+  error "todo: identity"
 
 -- |
 --
@@ -342,9 +345,8 @@ product ::
   Lens a b
   -> Lens c d
   -> Lens (a, c) (b, d)
-product (Lens f g) (Lens h i) = Lens
-                                (\(a, c) -> \(b, d) -> (f a b, h c d))
-                                (\(a, c) -> (g a, i c))
+product =
+  error "todo: product"
 
 -- | An alias for @product@.
 (***) ::
@@ -373,13 +375,8 @@ choice ::
   Lens a x
   -> Lens b x
   -> Lens (Either a b) x
-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)
+choice =
+  error "todo: choice"
 
 -- | An alias for @choice@.
 (|||) ::
@@ -466,7 +463,8 @@ addressL =
 getSuburb ::
   Person
   -> String
-getSuburb = get $ (compose suburbL addressL)
+getSuburb =
+  error "todo: getSuburb"
 
 -- |
 --
@@ -479,7 +477,8 @@ setStreet ::
   Person
   -> String
   -> Person
-setStreet = set $ (compose streetL addressL)
+setStreet =
+  error "todo: setStreet"
 
 -- |
 --
@@ -491,8 +490,8 @@ setStreet = set $ (compose streetL addressL)
 getAgeAndCountry ::
   (Person, Locality)
   -> (Int, String)
-getAgeAndCountry (person, locality) = (get ageL person,
-                                       get countryL locality)
+getAgeAndCountry =
+  error "todo: getAgeAndCountry"
 
 -- |
 --
@@ -503,9 +502,8 @@ getAgeAndCountry (person, locality) = (get ageL person,
 -- (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 (person, address) (city, locality) =
-  (set (cityL |. localityL |. addressL) person city,
-   set localityL address locality)
+setCityAndLocality =
+  error "todo: setCityAndLocality"
   
 -- |
 --
@@ -517,9 +515,8 @@ setCityAndLocality (person, address) (city, locality) =
 getSuburbOrCity ::
   Either Address Locality
   -> String
-getSuburbOrCity = \soc -> case soc of
-                            Left address -> get suburbL address
-                            Right locality -> get cityL locality
+getSuburbOrCity =
+  error "todo: getSuburbOrCity"
 
 -- |
 --
@@ -532,9 +529,8 @@ setStreetOrState ::
   Either Person Locality
   -> String
   -> Either Person Locality
-setStreetOrState = \sos -> \ipsos -> case sos of
-  Left person -> Left $ set (streetL |. addressL) person ipsos
-  Right locality -> Right $ set stateL locality ipsos
+setStreetOrState =
+  error "todo: setStreetOrState"
 
 -- |
 --
@@ -546,4 +542,5 @@ setStreetOrState = \sos -> \ipsos -> case sos of
 modifyCityUppercase ::
   Person
   -> Person
-modifyCityUppercase = (cityL |. localityL |. addressL) %~ map toUpper
+modifyCityUppercase =
+  error "todo: modifyCityUppercase"

src/Lets/Lens.hs

@@ -78,7 +78,7 @@ import Data.Char(toUpper)
 import Data.Foldable(Foldable(foldMap))
 import Data.Functor((<$>))
 import Data.Map(Map)
-import qualified Data.Map as Map(insert, delete, lookup, alterF)
+import qualified Data.Map as Map(insert, delete, lookup)
 import Data.Monoid(Monoid)
 import qualified Data.Set as Set(Set, insert, delete, member)
 import Data.Traversable(Traversable(traverse))
@@ -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,15 +111,17 @@ fmapT ::
   (a -> b)
   -> t a
   -> t b
-fmapT f = getIdentity . traverse (Identity . f)
+fmapT =
+  error "todo: fmapT"
 
 -- | 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 t f = getIdentity . t (Identity . f)
+over =
+  error "todo: over"
 
 -- | Here is @fmapT@ again, passing @traverse@ to @over@.
 fmapTAgain ::
@@ -127,7 +129,8 @@ fmapTAgain ::
   (a -> b)
   -> t a
   -> t b
-fmapTAgain = over traverse
+fmapTAgain =
+  error "todo: fmapTAgain"
 
 -- | Let's create a type-alias for this type of function.
 type Set s t a b =
@@ -139,20 +142,23 @@ type Set s t a b =
 -- unwrapping.
 sets ::
   ((a -> b) -> s -> t)
-  -> Set s t a b
-sets f g = Identity . f (getIdentity . g)
+  -> Set s t a b  
+sets =
+  error "todo: sets"
 
 mapped ::
   Functor f =>
   Set (f a) (f b) a b
-mapped f g = Identity (getIdentity . f <$> g)
+mapped =
+  error "todo: mapped"
 
 set ::
   Set s t a b
   -> s
   -> b
   -> t
-set f s b = over f (const b) s
+set =
+  error "todo: set"
 
 ----
 
@@ -164,7 +170,8 @@ foldMapT ::
   (a -> b)
   -> t a
   -> b
-foldMapT f = getConst . traverse (Const . f)
+foldMapT =
+  error "todo: foldMapT"
 
 -- | Let's refactor out the call to @traverse@ as an argument to @foldMapT@.
 foldMapOf ::
@@ -172,7 +179,8 @@ foldMapOf ::
   -> (a -> r)
   -> s
   -> r
-foldMapOf t f = getConst . t (Const . f)
+foldMapOf =
+  error "todo: foldMapOf"
 
 -- | Here is @foldMapT@ again, passing @traverse@ to @foldMapOf@.
 foldMapTAgain ::
@@ -180,7 +188,8 @@ foldMapTAgain ::
   (a -> b)
   -> t a
   -> b
-foldMapTAgain = foldMapOf traverse
+foldMapTAgain =
+  error "todo: foldMapTAgain"
 
 -- | Let's create a type-alias for this type of function.
 type Fold s t a b =
@@ -197,12 +206,14 @@ folds ::
   -> (a -> Const b a)
   -> s
   -> Const t s
-folds f g s = let t = (f (getConst . g) s) in Const t
+folds =
+  error "todo: folds"
 
 folded ::
   Foldable f =>
   Fold (f a) (f a) a a
-folded = folds foldMap
+folded =
+  error "todo: folded"
 
 ----
 
@@ -216,7 +227,8 @@ get ::
   Get a s a
   -> s
   -> a
-get f = getConst . f Const
+get =
+  error "todo: get"
 
 ----
 
@@ -231,20 +243,20 @@ type Traversal s t a b =
 -- | Traverse both sides of a pair.
 both ::
   Traversal (a, a) (b, b) a b
--- both :: (a -> f b) -> (a , a) -> f (b , b)
-both f (a, b) = (,) <$> f a <*> f b
+both =
+  error "todo: both"
 
 -- | Traverse the left side of @Either@.
 traverseLeft ::
   Traversal (Either a x) (Either b x) a b
-traverseLeft f (Left a) = Left <$> f a
-traverseLeft _ (Right x) = pure $ Right x
+traverseLeft =
+  error "todo: traverseLeft"
 
 -- | Traverse the right side of @Either@.
 traverseRight ::
   Traversal (Either x a) (Either x b) a b
-traverseRight _ (Left x) = pure $ Left x
-traverseRight f (Right b) = Right <$> f b
+traverseRight =
+  error "todo: traverseRight"
 
 type Traversal' a b =
   Traversal a a b b
@@ -274,39 +286,44 @@ type Prism s t a b =
 
 _Left ::
   Prism (Either a x) (Either b x) a b
--- _Left h = let rh = right h in dimap (either Right (Left . Right)) (either pure (fmap Left)) rh
-_Left h = let lh = left h in dimap (either Left (Right . Right)) (either (fmap Left) pure) lh
+_Left =
+  error "todo: _Left"
 
 _Right ::
-  Prism (Either x a) (Either x b) a b
-_Right h = let rh = right h in dimap (either (Left . Left) Right) (either pure (fmap Right)) rh
+  Prism (Either x a) (Either x b) a b 
+_Right =
+  error "todo: _Right"
 
 prism ::
   (b -> t)
   -> (s -> Either t a)
   -> Prism s t a b
-prism bToT sToEta pafb = let rh = right pafb in dimap sToEta (either pure (fmap bToT)) rh
+prism =
+  error "todo: prism"
 
 _Just ::
   Prism (Maybe a) (Maybe b) a b
-_Just = prism Just (maybe (Left Nothing) Right)
+_Just =
+  error "todo: _Just"
 
 _Nothing ::
   Prism (Maybe a) (Maybe a) () ()
-_Nothing = prism (\_ -> Nothing) (maybe (Right ()) (Left . Just))
+_Nothing =
+  error "todo: _Nothing"
 
 setP ::
   Prism s t a b
   -> s
   -> Either t a
-setP p = let pl = p Left in either Right Left . pl
+setP _ _ =
+  error "todo: setP"
 
 getP ::
   Prism s t a b
   -> b
   -> t
--- Copied :(
-getP p = let pti = p . Tagged . Identity in getIdentity . getTagged . pti
+getP _ _ =
+  error "todo: getP"
 
 type Prism' a b =
   Prism a a b b
@@ -329,7 +346,8 @@ modify ::
   -> (a -> b)
   -> s
   -> t
-modify l f = getIdentity . l (Identity . f)
+modify _ _ _ =
+  error "todo: modify"
 
 -- | An alias for @modify@.
 (%~) ::
@@ -358,7 +376,8 @@ infixr 4 %~
   -> b
   -> s
   -> t
-(.~) l = let ml = modify l in ml . const
+(.~) _ _ _ =
+  error "todo: (.~)"
 
 infixl 5 .~
 
@@ -377,8 +396,9 @@ fmodify ::
   Lens s t a b
   -> (a -> f b)
   -> s
-  -> f t
-fmodify l = l
+  -> f t 
+fmodify _ _ _ =
+  error "todo: fmodify"
 
 -- |
 --
@@ -393,7 +413,8 @@ fmodify l = l
   -> f b
   -> s
   -> f t
-(|=) l = let fl = fmodify l in fl . const
+(|=) _ _ _ =
+  error "todo: (|=)"
 
 infixl 5 |=
 
@@ -403,7 +424,8 @@ infixl 5 |=
 -- (30,"abc")
 fstL ::
   Lens (a, x) (b, x) a b
-fstL f (x, y) = let fx = f x in fmap (\x' -> (x', y)) fx
+fstL =
+  error "todo: fstL"
 
 -- |
 --
@@ -411,7 +433,8 @@ fstL f (x, y) = let fx = f x in fmap (\x' -> (x', y)) fx
 -- (13,"abcdef")
 sndL ::
   Lens (x, a) (x, b) a b
-sndL f (x, y) = let fy = f y in fmap (\y' -> (x, y')) fy
+sndL =
+  error "todo: sndL"
 
 -- |
 --
@@ -486,7 +509,8 @@ compose ::
   Lens s t a b
   -> Lens q r s t
   -> Lens q r a b
-compose l1 l2 = l2 . l1
+compose _ _ =
+  error "todo: compose"
 
 -- | An alias for @compose@.
 (|.) ::
@@ -507,7 +531,8 @@ infixr 9 |.
 -- 4
 identity ::
   Lens a b a b
-identity = id
+identity =
+  error "todo: identity"
 
 -- |
 --
@@ -550,9 +575,8 @@ choice ::
   Lens s t a b
   -> Lens q r a b
   -> Lens (Either s q) (Either t r) a b
-choice l1 l2 = (\f esq -> case esq of
-                  Left s  -> Left <$> (l1 f s)
-                  Right q -> Right <$> (l2 f q))
+choice _ _ =
+  error "todo: choice"
 
 -- | An alias for @choice@.
 (|||) ::
@@ -635,7 +659,8 @@ intAndL p (IntAnd n a) =
 getSuburb ::
   Person
   -> String
-getSuburb = get $ (compose suburbL addressL)
+getSuburb =
+  error "todo: getSuburb"
 
 -- |
 --
@@ -648,7 +673,8 @@ setStreet ::
   Person
   -> String
   -> Person
-setStreet = set $ (compose streetL addressL)
+setStreet =
+  error "todo: setStreet"
 
 -- |
 --
@@ -660,8 +686,8 @@ setStreet = set $ (compose streetL addressL)
 getAgeAndCountry ::
   (Person, Locality)
   -> (Int, String)
-getAgeAndCountry (person, locality) = (get ageL person,
-                                       get countryL locality)
+getAgeAndCountry =
+  error "todo: getAgeAndCountry"
 
 -- |
 --
@@ -672,10 +698,9 @@ getAgeAndCountry (person, locality) = (get ageL person,
 -- (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 (person, address) (city, locality) =
-  (set (cityL |. localityL |. addressL) person city,
-   set localityL address locality)
-
+setCityAndLocality =
+  error "todo: setCityAndLocality"
+  
 -- |
 --
 -- >>> getSuburbOrCity (Left maryAddress)
@@ -687,7 +712,7 @@ getSuburbOrCity ::
   Either Address Locality
   -> String
 getSuburbOrCity =
-  get (suburbL ||| cityL)
+  error "todo: getSuburbOrCity"
 
 -- |
 --
@@ -701,7 +726,7 @@ setStreetOrState ::
   -> String
   -> Either Person Locality
 setStreetOrState =
-  set (streetL |. addressL ||| stateL)
+  error "todo: setStreetOrState"
 
 -- |
 --
@@ -714,20 +739,22 @@ modifyCityUppercase ::
   Person
   -> Person
 modifyCityUppercase =
-  cityL |. localityL |. addressL %~ map toUpper
+  error "todo: modifyCityUppercase"
 
 -- |
 --
--- >>> modify intAndL (even . length) (IntAnd 10 "abc")
+-- >>> modifyIntAndLengthEven (IntAnd 10 "abc")
 -- IntAnd 10 False
 --
--- >>> modify intAndL (even . length) (IntAnd 10 "abcd")
+-- >>> modifyIntAndLengthEven (IntAnd 10 "abcd")
 -- IntAnd 10 True
 modifyIntAndLengthEven ::
   IntAnd [a]
   -> IntAnd Bool
 modifyIntAndLengthEven =
-  intAndL %~ even . length
+  error "todo: modifyIntAndLengthEven"
+
+----
 
 -- |
 --
@@ -735,8 +762,8 @@ modifyIntAndLengthEven =
 -- Locality "ABC" "DEF" "GHI"
 traverseLocality ::
   Traversal' Locality String
-traverseLocality f (Locality c t y) =
-  Locality <$> f c <*> f t <*> f y
+traverseLocality =
+  error "todo: traverseLocality"
 
 -- |
 --
@@ -748,32 +775,25 @@ traverseLocality f (Locality c t y) =
 intOrIntP ::
   Prism' (IntOr a) Int
 intOrIntP =
-  prism
-    IntOrIs
-    (\i -> case i of
-            IntOrIs n -> Right n
-            IntOrIsNot a -> Left (IntOrIsNot a))
+  error "todo: intOrIntP"
 
 intOrP ::
   Prism (IntOr a) (IntOr b) a b
 intOrP =
-  prism
-    IntOrIsNot
-    (\i -> case i of
-            IntOrIs n -> Left (IntOrIs n)
-            IntOrIsNot a -> Right a)
+  error "todo: intOrP"
 
 -- |
 --
--- >> over intOrP (even . length) (IntOrIsNot "abc")
+-- >> intOrLengthEven (IntOrIsNot "abc")
 -- IntOrIsNot False
 --
--- >>> over intOrP (even . length) (IntOrIsNot "abcd")
+-- >>> intOrLengthEven (IntOrIsNot "abcd")
 -- IntOrIsNot True
 --
--- >>> over intOrP (even . length) (IntOrIs 10)
+-- >>> intOrLengthEven (IntOrIs 10)
 -- IntOrIs 10
 intOrLengthEven ::
   IntOr [a]
   -> IntOr Bool
-intOrLengthEven = over intOrP (even . length)
+intOrLengthEven =
+  error "todo: intOrLengthEven"

src/Lets/OpticPolyLens.hs

@@ -1,5 +1,4 @@
 {-# LANGUAGE RankNTypes #-}
-{-# LANGUAGE TupleSections #-}
 
 module Lets.OpticPolyLens (
   Lens(..)
@@ -44,10 +43,9 @@ module Lets.OpticPolyLens (
 , modifyIntandLengthEven
 ) where
 
-import Data.Bool(bool)
-import Data.Char(toUpper, ord)
+import Data.Char(toUpper)
 import Data.Map(Map)
-import qualified Data.Map as Map(insert, delete, lookup, fromList, alterF)
+import qualified Data.Map as Map(insert, delete, lookup)
 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))
@@ -64,30 +62,12 @@ data Lens s t a b =
   Lens
     (forall f. Functor f => (a -> f b) -> s -> f t)
 
--- Lens s t a b
-
--- Lens u w s t
---   (s -> f t) -> w -> f w
-
--- Lens u w s t . Lens s t a b
-
--- p :: (->)
--- p a b
-
--- f :: s -> a
--- fcps :: forall r . (a -> r) -> s -> r
--- f ~ fcps id
--- fcps = \c -> c . f
---              (a -> r) . s -> a
--- forall r . (a -> f r) -> s -> f r
--- forall f . Functor f => (a -> f b) -> s -> f t
-
--- Const :: forall b . a -> Const a b
 get ::
   Lens s t a b
   -> s
   -> a
-get (Lens r) s = let rc = r Const in getConst $ rc s
+get (Lens r) =
+  getConst . r Const
 
 set ::
   Lens s t a b
@@ -145,9 +125,8 @@ modify ::
   -> (a -> b)
   -> s
   -> t
-modify (Lens r) f s = let idf = Identity . f in
-                        let ridf = r idf in
-                          let sidt = ridf s in getIdentity sidt
+modify =
+  error "todo: modify"
 
 -- | An alias for @modify@.
 (%~) ::
@@ -176,10 +155,8 @@ infixr 4 %~
   -> b
   -> s
   -> t
--- 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)
+(.~) =
+  error "todo: (.~)"
 
 infixl 5 .~
 
@@ -199,7 +176,8 @@ fmodify ::
   -> (a -> f b)
   -> s
   -> f t 
-fmodify (Lens stab) aTofb s = stab aTofb s
+fmodify =
+  error "todo: fmodify"
 
 -- |
 --
@@ -214,7 +192,8 @@ fmodify (Lens stab) aTofb s = stab aTofb s
   -> f b
   -> s
   -> f t
-(|=) (Lens l) fb s = (l (\_ -> fb) s)
+(|=) =
+  error "todo: (|=)"
 
 infixl 5 |=
 
@@ -230,7 +209,8 @@ infixl 5 |=
 -- prop> let types = (x :: Int, y :: String) in setsetLaw fstL (x, y) z
 fstL ::
   Lens (a, x) (b, x) a b
-fstL = Lens (\f -> \(a, x) -> let fb = f a in (, x) <$> fb)
+fstL =
+  error "todo: fstL"
 
 -- |
 --
@@ -244,7 +224,8 @@ fstL = Lens (\f -> \(a, x) -> let fb = f a in (, x) <$> fb)
 -- prop> let types = (x :: Int, y :: String) in setsetLaw sndL (x, y) z
 sndL ::
   Lens (x, a) (x, b) a b
-sndL = Lens (\f -> \(x, a) -> let fb = f a in (x ,) <$> fb)
+sndL =
+  error "todo: sndL"
 
 -- |
 --
@@ -269,7 +250,8 @@ mapL ::
   Ord k =>
   k
   -> Lens (Map k v) (Map k v) (Maybe v) (Maybe v)
-mapL k = Lens (\f -> \mkv -> Map.alterF f k mkv)
+mapL =
+  error "todo: mapL"
 
 -- |
 --
@@ -294,8 +276,8 @@ setL ::
   Ord k =>
   k
   -> Lens (Set k) (Set k) Bool Bool
-setL k = Lens (\f -> \sk -> (\b -> bool (Set.delete k sk) (Set.insert k sk) b)
-                            <$> (f $ Set.member k sk))
+setL =
+  error "todo: setL"
 
 -- |
 --
@@ -308,7 +290,8 @@ compose ::
   Lens s t a b
   -> Lens q r s t
   -> Lens q r a b
-compose (Lens r) (Lens g) = Lens $ g . r
+compose =
+  error "todo: compose"
 
 -- | An alias for @compose@.
 (|.) ::
@@ -329,7 +312,8 @@ infixr 9 |.
 -- 4
 identity ::
   Lens a b a b
-identity = Lens (\f -> \a -> f a)
+identity =
+  error "todo: identity"
 
 -- |
 --
@@ -372,9 +356,8 @@ choice ::
   Lens s t a b
   -> Lens q r a b
   -> Lens (Either s q) (Either t r) a b
-choice (Lens l) (Lens g) = Lens (\f -> \esq -> case esq of
-                                                 Left s -> Left <$> l f s
-                                                 Right q -> Right <$> g f q)
+choice =
+  error "todo: choice"
 
 -- | An alias for @choice@.
 (|||) ::
@@ -468,7 +451,9 @@ intAndL =
 getSuburb ::
   Person
   -> String
-getSuburb = get $ (compose suburbL addressL)
+getSuburb =
+  error "todo: getSuburb"
+
 
 -- |
 --
@@ -481,7 +466,8 @@ setStreet ::
   Person
   -> String
   -> Person
-setStreet = set $ (compose streetL addressL)
+setStreet =
+  error "todo: setStreet"
 
 -- |
 --
@@ -493,8 +479,8 @@ setStreet = set $ (compose streetL addressL)
 getAgeAndCountry ::
   (Person, Locality)
   -> (Int, String)
-getAgeAndCountry (person, locality) = (get ageL person,
-                                       get countryL locality)
+getAgeAndCountry =
+  error "todo: getAgeAndCountry"
 
 -- |
 --
@@ -505,9 +491,8 @@ getAgeAndCountry (person, locality) = (get ageL person,
 -- (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 (person, address) (city, locality) =
-  (set (cityL |. localityL |. addressL) person city,
-   set localityL address locality)
+setCityAndLocality =
+  error "todo: setCityAndLocality"
   
 -- |
 --

src/Lets/StoreLens.hs

@@ -47,12 +47,12 @@ module Lets.StoreLens (
 ) where
 
 import Control.Applicative(Applicative((<*>)))
-import Data.Char(toUpper, ord)
+import Data.Char(toUpper)
 import Data.Functor((<$>))
 import Data.Map(Map)
-import qualified Data.Map as Map(insert, delete, lookup, fromList)
+import qualified Data.Map as Map(insert, delete, lookup)
 import Data.Set(Set)
-import qualified Data.Set as Set(insert, delete, member, fromList)
+import qualified Data.Set as Set(insert, delete, member)
 import Lets.Data(Store(Store), Person(Person), Locality(Locality), Address(Address))
 import Prelude hiding (product)
 
@@ -80,37 +80,30 @@ mapS ::
   (a -> b)
   -> Store s a
   -> Store s b
-mapS f (Store sToa s) = Store (\ss -> f (sToa ss)) s
+mapS =
+  error "todo: mapS"
 
 duplicateS ::
   Store s a
   -> Store s (Store s a)
-duplicateS (Store sToa a) = Store (\s -> Store sToa s) a
+duplicateS =
+  error "todo: duplicateS"
 
 extendS ::
   (Store s a -> b)
   -> Store s a
   -> Store s b
-extendS f = mapS f . duplicateS
+extendS =
+  error "todo: extendS"
 
 extractS ::
   Store s a
   -> a
-extractS = \(Store sToa s) -> sToa s
+extractS =
+  error "todo: extractS"
 
 ----
 
--- data Lens a b =
---   Lens
---     (a -> b -> a)
---     (a -> b)
--- data Store s a = Store (s -> a) s
-
--- a -> Store b a
--- a -> Store (b -> a) b
--- Drop the Store wrapper
--- a -> b -> a
--- a -> b
 data Lens a b =
   Lens
     (a -> Store b a)
@@ -200,7 +193,8 @@ modify ::
   -> (b -> b)
   -> a
   -> a
-modify (Lens f) bTob a = let Store s g = f a in s (bTob g)
+modify =
+  error "todo: modify"
 
 -- | An alias for @modify@.
 (%~) ::
@@ -229,7 +223,8 @@ infixr 4 %~
   -> b
   -> a
   -> a
-(.~) = \(Lens f) -> \v -> \a -> let Store s g = f a in s v
+(.~) =
+  error "todo: (.~)"
 
 infixl 5 .~
 
@@ -249,8 +244,9 @@ fmodify ::
   -> (b -> f b)
   -> a
   -> f a
-fmodify (Lens f) bTofb a = let Store s g = f a in s <$> bTofb g
-
+fmodify =
+  error "todo: fmodify"
+  
 -- |
 --
 -- >>> fstL |= Just 3 $ (7, "abc")
@@ -264,7 +260,8 @@ fmodify (Lens f) bTofb a = let Store s g = f a in s <$> bTofb g
   -> f b
   -> a
   -> f a
-(|=) (Lens f) fb a = let Store s g = f a in s <$> fb
+(|=) =
+  error "todo: (|=)"
 
 infixl 5 |=
 
@@ -280,7 +277,8 @@ infixl 5 |=
 -- prop> let types = (x :: Int, y :: String) in setsetLaw fstL (x, y) z
 fstL ::
   Lens (x, y) x
-fstL = Lens (\(x, y) -> Store (\x' -> (x', y)) x)
+fstL =
+  error "todo: fstL"
 
 -- |
 --
@@ -294,7 +292,8 @@ fstL = Lens (\(x, y) -> Store (\x' -> (x', y)) x)
 -- prop> let types = (x :: Int, y :: String) in setsetLaw sndL (x, y) z
 sndL ::
   Lens (x, y) y
-sndL = Lens (\(x, y) -> Store (\y' -> (x, y')) y)
+sndL =
+  error "todo: sndL"
 
 -- |
 --
@@ -319,10 +318,8 @@ mapL ::
   Ord k =>
   k
   -> Lens (Map k v) (Maybe v)
-mapL k = Lens (\mkv -> Store (\mv -> case mv of
-                                Nothing -> Map.delete k mkv
-                                Just a -> Map.insert k a mkv)
-        (Map.lookup k mkv))
+mapL =
+  error "todo: mapL"
 
 -- |
 --
@@ -347,10 +344,8 @@ setL ::
   Ord k =>
   k
   -> Lens (Set k) Bool
-setL k = Lens (\sk -> Store (\bool -> case bool of
-                True -> Set.insert k sk
-                False -> Set.delete k sk)
-              (Set.member k sk))
+setL =
+  error "todo: setL"
 
 -- |
 --
@@ -363,10 +358,8 @@ compose ::
   Lens b c
   -> Lens a b
   -> Lens a c
-compose = \(Lens f) -> \(Lens g) ->
-    Lens (\a -> let Store bToa b = g a
-                    in let Store cTob c = f b
-                        in Store (bToa . cTob) c)
+compose =
+  error "todo: compose"
 
 -- | An alias for @compose@.
 (|.) ::
@@ -387,8 +380,9 @@ infixr 9 |.
 -- 4
 identity ::
   Lens a a
-identity = Lens (\a -> Store (\a' -> a') a)
-
+identity =
+  error "todo: identity"
+    
 -- |
 --
 -- >>> get (product fstL sndL) (("abc", 3), (4, "def"))
@@ -400,10 +394,8 @@ product ::
   Lens a b
   -> Lens c d
   -> Lens (a, c) (b, d)
-product (Lens f) (Lens g) =
-    Lens (\(a, c) -> let Store h i = f a
-                         in let Store j k = g c
-                             in Store (\(b, d) -> (h b, j d)) (i, k))
+product =
+  error "todo: product"
 
 -- | An alias for @product@.
 (***) ::
@@ -432,10 +424,8 @@ choice ::
   Lens a x
   -> Lens b x
   -> Lens (Either a b) x
-choice (Lens ax) (Lens bx) =
-    Lens (\eab -> case eab of
-        Left a -> let Store f g = ax a in Store (\x -> Left $ f x) g
-        Right b -> let Store h i = bx b in Store (\x -> Right $ h x) i)
+choice =
+  error "todo: choice"
 
 -- | An alias for @choice@.
 (|||) ::
@@ -522,7 +512,8 @@ addressL =
 getSuburb ::
   Person
   -> String
-getSuburb = get $ (compose suburbL addressL)
+getSuburb =
+  error "todo: getSuburb"
 
 -- |
 --
@@ -535,7 +526,8 @@ setStreet ::
   Person
   -> String
   -> Person
-setStreet = set $ (compose streetL addressL)
+setStreet =
+  error "todo: setStreet"
 
 -- |
 --
@@ -547,9 +539,8 @@ setStreet = set $ (compose streetL addressL)
 getAgeAndCountry ::
   (Person, Locality)
   -> (Int, String)
-getAgeAndCountry (person, locality) = (get ageL person,
-                                       get countryL locality)
-
+getAgeAndCountry =
+  error "todo: getAgeAndCountry"
 
 -- |
 --
@@ -560,11 +551,9 @@ getAgeAndCountry (person, locality) = (get ageL person,
 -- (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 (person, address) (city, locality) =
-  (set (cityL |. localityL |. addressL) person city,
-   set localityL address locality)
-
-
+setCityAndLocality =
+  error "todo: setCityAndLocality"
+  
 -- |
 --
 -- >>> getSuburbOrCity (Left maryAddress)
@@ -575,10 +564,8 @@ setCityAndLocality (person, address) (city, locality) =
 getSuburbOrCity ::
   Either Address Locality
   -> String
-getSuburbOrCity = \soc -> case soc of
-                            Left address -> get suburbL address
-                            Right locality -> get cityL locality
-
+getSuburbOrCity =
+  error "todo: getSuburbOrCity"
 
 -- |
 --
@@ -591,9 +578,8 @@ setStreetOrState ::
   Either Person Locality
   -> String
   -> Either Person Locality
-setStreetOrState = \sos -> \ipsos -> case sos of
-  Left person -> Left $ set (streetL |. addressL) person ipsos
-  Right locality -> Right $ set stateL locality ipsos
+setStreetOrState =
+  error "todo: setStreetOrState"
 
 -- |
 --
@@ -605,4 +591,5 @@ setStreetOrState = \sos -> \ipsos -> case sos of
 modifyCityUppercase ::
   Person
   -> Person
-modifyCityUppercase = (cityL |. localityL |. addressL) %~ map toUpper
+modifyCityUppercase =
+  error "todo: modifyCityUppercase"

stack.yaml

@@ -1,66 +0,0 @@
-# This file was automatically generated by 'stack init'
-#
-# Some commonly used options have been documented as comments in this file.
-# For advanced use and comprehensive documentation of the format, please see:
-# https://docs.haskellstack.org/en/stable/yaml_configuration/
-
-# Resolver to choose a 'specific' stackage snapshot or a compiler version.
-# A snapshot resolver dictates the compiler version and the set of packages
-# to be used for project dependencies. For example:
-#
-# resolver: lts-3.5
-# resolver: nightly-2015-09-21
-# resolver: ghc-7.10.2
-#
-# The location of a snapshot can be provided as a file or url. Stack assumes
-# a snapshot provided as a file might change, whereas a url resource does not.
-#
-# resolver: ./custom-snapshot.yaml
-# resolver: https://example.com/snapshots/2018-01-01.yaml
-resolver: lts-14.12
-
-# User packages to be built.
-# Various formats can be used as shown in the example below.
-#
-# packages:
-# - some-directory
-# - https://example.com/foo/bar/baz-0.0.2.tar.gz
-#   subdirs:
-#   - auto-update
-#   - wai
-packages:
-- .
-# Dependency packages to be pulled from upstream that are not in the resolver.
-# These entries can reference officially published versions as well as
-# forks / in-progress versions pinned to a git hash. For example:
-#
-# extra-deps:
-# - acme-missiles-0.3
-# - git: https://github.com/commercialhaskell/stack.git
-#   commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a
-#
-# extra-deps: []
-
-# Override default flag values for local packages and extra-deps
-# flags: {}
-
-# Extra package databases containing global packages
-# extra-package-dbs: []
-
-# Control whether we use the GHC we find on the path
-# system-ghc: true
-#
-# Require a specific version of stack, using version ranges
-# require-stack-version: -any # Default
-# require-stack-version: ">=2.1"
-#
-# Override the architecture used by stack, especially useful on Windows
-# arch: i386
-# arch: x86_64
-#
-# Extra directories used by stack for building
-# extra-include-dirs: [/path/to/dir]
-# extra-lib-dirs: [/path/to/dir]
-#
-# Allow a newer minor version of GHC than the snapshot specifies
-# compiler-check: newer-minor