Merge pull request #86 from edmundnoble/push-vltxotnpoxqt

Use setters instead of lenses in ..: and %.:

Author: edmundnoble

src/Configuration/Utils/ConfigFile.hs

@@ -126,7 +126,7 @@ fromText = id
 -- >             e → fail $ "unrecognized user " ⊕ e
 --
 setProperty
-    ∷ Lens' a b -- ^ a lens into the target that is updated by the parser
+    ∷ Setter' a b -- ^ a lens into the target that is updated by the parser
     → T.Text -- ^ the JSON property name
     → (Value → Parser b) -- ^ the JSON 'Value' parser that is used to parse the value of the property
     → Object -- ^ the parsed JSON 'Value' 'Object'
@@ -158,7 +158,7 @@ setProperty s k p o = case H.lookup (fromText k) o of
 -- >         <$< user ..: "user" % o
 -- >         <*< pwd ..: "pwd" % o
 --
-(..:) ∷ FromJSON b ⇒ Lens' a b → T.Text → Object → Parser (a → a)
+(..:) ∷ FromJSON b ⇒ Setter' a b → T.Text → Object → Parser (a → a)
 (..:) s k = setProperty s k parseJSON
 infix 6 ..:
 {-# INLINE (..:) #-}
@@ -194,7 +194,7 @@ infix 6 ..:
 -- >         <*< setProperty domain "domain" parseJSON o
 --
 updateProperty
-    ∷ Lens' a b
+    ∷ Setter' a b
     → T.Text
     → (Value → Parser (b → b))
     → Object
@@ -230,7 +230,7 @@ updateProperty s k p o = case H.lookup (fromText k) o of
 -- >         <$< auth %.: "auth" % o
 -- >         <*< domain ..: "domain" % o
 --
-(%.:) ∷ FromJSON (b → b) ⇒ Lens' a b → T.Text → Object → Parser (a → a)
+(%.:) ∷ FromJSON (b → b) ⇒ Setter' a b → T.Text → Object → Parser (a → a)
 (%.:) s k = updateProperty s k parseJSON
 infix 6 %.:
 {-# INLINE (%.:) #-}

src/Configuration/Utils/Internal.hs

@@ -21,6 +21,8 @@ module Configuration.Utils.Internal
 , view
 , Lens'
 , Lens
+, Setter'
+, Setter
 , Iso'
 , Iso
 , iso
@@ -70,15 +72,29 @@ type Lens s t a b = ∀ f . Functor f ⇒ (a → f b) → s → f t
 --
 type Lens' s a = Lens s s a a
 
+-- | This is almost the same type as the type from the lens library with the same name.
+--
+-- In case it is already import from the lens package this should be hidden
+-- from the import.
+--
+type Setter s t a b = (a -> Identity b) -> s -> Identity t
+
+-- | This is almost the same type as the type from the lens library with the same name.
+--
+-- In case it is already import from the lens package this should be hidden
+-- from the import.
+--
+type Setter' s a = Setter s s a a
+
 lens ∷ (s → a) → (s → b → t) → Lens s t a b
 lens getter setter lGetter s = setter s `fmap` lGetter (getter s)
 {-# INLINE lens #-}
 
-over ∷ ((a → Identity b) → s → Identity t) → (a → b) → s → t
+over ∷ Setter s t a b → (a → b) → s → t
 over s f = runIdentity . s (Identity . f)
 {-# INLINE over #-}
 
-set ∷ ((a → Identity b) → s → Identity t) → b → s → t
+set ∷ Setter s t a b → b → s → t
 set s a = runIdentity . s (const $ Identity a)
 {-# INLINE set #-}
 
@@ -123,4 +139,3 @@ errorT
     → m a
 errorT = exceptT (\e → error ∘ T.unpack $ "Error: " ⊕ e) return
 {-# INLINE errorT #-}
-