can-i-haz 0.2.0.1 → 0.2.1.0

raw patch · 5 files changed

+61/−27 lines, 5 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• ChangeLog.md +5/−0
• can-i-haz.cabal +2/−2
• src/Control/Monad/Except/CoHas.hs +2/−2
• src/Control/Monad/Reader/Has.hs +31/−19
• test/Spec.hs +21/−4

@@ -1,5 +1,10 @@ # Changelog for can-i-haz +## 0.2.1.0++* Added the `update` method to `Has` (yay lenses).+* Fixed the documentation regarding the recursiveness of the search.+ ## 0.2.0.1  * Less boilerplate for `Has` tuple instances and `CoHas` `Either` instance.

@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 0394d90d99b920a658070f87d57d6cd3df94ee5b5af1d08be8b70136c4888334+-- hash: 92db1c8cf04877be4feda903d215b85919cb662aadcc285eb2f2e6e05f660886  name:           can-i-haz-version:        0.2.0.1+version:        0.2.1.0 synopsis:       Generic implementation of the Has and CoHas patterns description:    Please see the README on GitHub at <https://github.com/0xd34df00d/can-i-haz#readme> category:       Control

@@ -114,8 +114,8 @@   -- | Inject an @option@ into the @sum@ type.   --   -- The default implementation searches @sum@ for some constructor-  -- that's compatible with @option@ (potentially recursively) and creates @sum@ using that constructor.-  -- The default implementation typechecks if and only if there is a single matching constructor.+  -- that's compatible with @option@ and creates @sum@ using that constructor.+  -- The default implementation typechecks iff there is a single matching constructor.   inject :: option -> sum    default inject :: forall path. (Generic sum, SuccessfulSearch option sum path) => option -> sum

@@ -59,22 +59,6 @@  and use @ask extract@ instead of @ask@ (but this is something you'd have to do anyway). -Note that this 'Generic'-based implementation walks the types recursively,-so it's totally possible to derive 'Has' for some nested type, for example:--@-data DbConfig = DbConfig-  { connInfo :: ConnInfo-  , retriesPolicy :: RetriesPolicy-  }-data WebConfig = WebConfig { .. }--data AppEnv = AppEnv-  { dbConfig :: DbConfig-  , webConfig :: WebConfig-  } deriving (Generic, Has DbConfig, Has WebConfig, Has ConnInfo, Has RetriesPolicy)-@- = Type safety  What should happen if @record@ does not have any field of type @part@ at all?@@ -86,6 +70,18 @@ the first one in breadth-first or depth-first order, we instead decide that such a choice is inherently ambiguous, so this library will refuse to generate an instance in this case as well. += Updating the records, or poor man's lenses, and State++One we know that a value of type @part@ is contained in @record@,+we might easily update a @record@ having a function that updates the @part@.+This is done in the obvious way: we just locate the @part@ in the @record@ and 'update' it!++'Has' has a method for this, called (unsurprisingly) 'update'.++Note that this might be used for more composable functions living in 'Control.Monad.State':+now instead of @MonadState StateType m@ we write @(MonadState s m, Has StateType s)@+and use 'update' and 'extract' where necessary (likely in combination with 'modify' and 'gets').+ -}  module Control.Monad.Reader.Has@@ -107,18 +103,23 @@  class GHas (path :: Path) part grecord where   gextract :: Proxy path -> grecord p -> part+  gupdate :: Proxy path -> (part -> part) -> grecord p -> grecord p  instance GHas 'Here rec (K1 i rec) where   gextract _ (K1 x) = x+  gupdate _ f (K1 x) = K1 $ f x  instance GHas path part record => GHas path part (M1 i t record) where   gextract proxy (M1 x) = gextract proxy x+  gupdate proxy f (M1 x) = M1 (gupdate proxy f x)  instance GHas path part l => GHas ('L path) part (l :*: r) where   gextract _ (l :*: _) = gextract (Proxy :: Proxy path) l+  gupdate _ f (l :*: r) = gupdate (Proxy :: Proxy path) f l :*: r  instance GHas path part r => GHas ('R path) part (l :*: r) where   gextract _ (_ :*: r) = gextract (Proxy :: Proxy path) r+  gupdate _ f (l :*: r) = l :*: gupdate (Proxy :: Proxy path) f r  -- | Type alias representing that the search of @part@ in @record@ has been successful. --@@ -130,17 +131,28 @@ class Has part record where   -- | Extract a subvalue of type @part@ from the @record@.   ---  -- The default implementation searches for some value of the type @part@ in @record@ (potentially recursively)-  -- and returns that value. The default implementation typechecks if and only if-  -- there is a single subvalue of type @part@ in @record@.+  -- The default implementation searches for some value of the type @part@ in @record@+  -- and returns that value.+  -- The default implementation typechecks iff there is a single subvalue of type @part@ in @record@.   extract :: record -> part    default extract :: forall path. (Generic record, SuccessfulSearch part record path) => record -> part   extract = gextract (Proxy :: Proxy path) . from +  -- | Update the @record@ given an update function for the @part@.+  --+  -- The default implementation searches for some value of the type @part@ in @record@+  -- and updates that value using the supplied function.+  -- The default implementation typechecks iff there is a single subvalue of type @part@ in @record@.+  update :: (part -> part) -> record -> record++  default update :: forall path. (Generic record, SuccessfulSearch part record path) => (part -> part) -> record -> record+  update f = to . gupdate (Proxy :: Proxy path) f . from+ -- | Each type allows projecting itself (and that is an 'id' projection). instance Has record record where   extract = id+  update = id  instance SuccessfulSearch a (a0, a1) path => Has a (a0, a1) instance SuccessfulSearch a (a0, a1, a2) path => Has a (a0, a1, a2)

@@ -19,30 +19,47 @@   result <- try (evaluate $ force a)   case result of     Right _ -> assertFailure "Expected expression to not compile but it did compile"-    Left e@(TypeError msg) -> case isSuffixOf "(deferred type error)" msg of-      True -> return ()-      False -> throwIO e+    Left e@(TypeError msg) -> if "(deferred type error)" `isSuffixOf` msg+                                 then pure ()+                                 else throwIO e +fooEnvTwice :: FooEnv -> FooEnv+fooEnvTwice (FooEnv n s) = FooEnv (n * 2) (s <> s)++barEnvCons :: BarEnv -> BarEnv+barEnvCons (BarEnv d xs) = BarEnv d (0 : xs)+ main :: IO () main = hspec $ do   let baseFooEnv = FooEnv 10 "meh"+  let baseFooEnvTwice = FooEnv 20 "mehmeh"   let baseBarEnv = BarEnv 4.2 [1, 2, 3]+  let baseBarEnvCons = BarEnv 4.2 [0, 1, 2, 3]   describe "Has" $ do-    describe "Basic instance" $+    describe "Basic instance" $ do       it "any type Has itself" $ do         let exFoo = extract baseFooEnv         exFoo `shouldBe` baseFooEnv+      it "any type updates itself" $ do+        let baseFooEnv' = update fooEnvTwice baseFooEnv+        baseFooEnv' `shouldBe` baseFooEnvTwice     describe "Generic instances" $ do       it "envs have their components" $ do         let exFoo = extract $ AppEnv baseFooEnv baseBarEnv         exFoo `shouldBe` baseFooEnv         let exBar = extract $ AppEnv baseFooEnv baseBarEnv         exBar `shouldBe` baseBarEnv+      it "envs update their components" $ do+        let appEnv' = update fooEnvTwice $ update barEnvCons $ AppEnv baseFooEnv baseBarEnv+        appEnv' `shouldBe` AppEnv baseFooEnvTwice baseBarEnvCons       it "tuples have their components" $ do         let exFoo = extract (baseFooEnv, baseBarEnv)         exFoo `shouldBe` baseFooEnv         let exBar = extract (baseFooEnv, baseBarEnv)         exBar `shouldBe` baseBarEnv+      it "tuples update their components" $ do+        let pair' = update fooEnvTwice $ update barEnvCons (baseFooEnv, baseBarEnv)+        pair' `shouldBe` (baseFooEnvTwice, baseBarEnvCons)     describe "Should not typecheck" $ do       it "if there is no such type in the hierarchy" $ shouldNotTypecheck extractMissing       it "if there is more than one such type in the hierarchy" $ shouldNotTypecheck extractMultiple