ffunctor 1.1.0 → 1.1.99

raw patch · 4 files changed

+341/−8 lines, 4 filesdep +exceptionsdep +generic-lensdep +transformersdep −compositionPVP ok

version bump matches the API change (PVP)

Dependencies added: exceptions, generic-lens, transformers, universum

Dependencies removed: composition

API changes (from Hackage documentation)

Files

• ffunctor.cabal +15/−3
• library/Data/FFunctor.hs +12/−1
• test/Data/FFunctor/ServantTest.hs +7/−4
• test/Data/FFunctor/TracingTest.hs +307/−0

@@ -1,6 +1,6 @@ cabal-version:       2.2 name:                ffunctor-version:             1.1.0+version:             1.1.99 synopsis:            FFunctor typeclass license:             BSD-3-Clause license-file:        LICENSE@@ -16,11 +16,17 @@   .   Useful to map over the type parameter in a record of   functions, e.g. https://www.benjamin.pizza/posts/2017-12-15-functor-functors.html+  and https://discourse.haskell.org/t/local-capabilities-with-mtl/231  source-repository head   type: git   location: https://gitlab.com/fommil/ffunctor-   ++flag transformers+  description: Compile with transformers utilities+  manual: True+  default: True+ common deps   build-depends:    , base ^>= 4.11.1.0 || ^>= 4.12.0.0   ghc-options:        -Wall@@ -31,6 +37,9 @@   import:             deps   hs-source-dirs:     library   exposed-modules:    Data.FFunctor+  if flag(transformers)+    build-depends:  , transformers+    cpp-options:      -DHAVE_TRANSFORMERS  test-suite            tests   import:             deps@@ -38,10 +47,12 @@   type:               exitcode-stdio-1.0   main-is:            Driver.hs   other-modules:      Data.FFunctor.ServantTest+                    , Data.FFunctor.TracingTest   build-depends:    , ffunctor                     , aeson            ^>= 1.4.1.0-                    , composition      ^>= 1.0.2.1+                    , exceptions       ^>= 0.10.1                     , mtl              ^>= 2.2.2+                    , generic-lens     ^>= 1.1.0.0                     , http-client      ^>= 0.5.12                     , servant          ^>= 0.14.1                     , servant-client   ^>= 0.14@@ -49,5 +60,6 @@                     , tasty-hspec      ^>= 1.1.5                     , tasty-quickcheck ^>= 0.10                     , time             ^>= 1.8.0.2+                    , universum        ^>= 1.5.0   build-tool-depends: tasty-discover:tasty-discover ^>= 4.2.1   ghc-options: -threaded

@@ -1,11 +1,22 @@+{-# LANGUAGE CPP            #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE Rank2Types     #-}  -- | Functor of Functors module Data.FFunctor where +#ifdef HAVE_TRANSFORMERS+import           Control.Monad.Trans.Class (MonadTrans, lift)+#endif+ class FFunctor (f :: (* -> *) -> *) where --ffmap :: (Functor m, Functor n) => (m ~> n) -> f m -> f n   ffmap :: (Functor m, Functor n) => (forall a . (m a -> n a)) -> f m -> f n --- TODO is there anything from stdlib that could have an instance?+#ifdef HAVE_TRANSFORMERS+-- | Lifts a record of functions (that has an FFunctor) into a monad transformer.+--+--   e.g. `luft logger` lifts a `Logger m` into a `Logger (ReaderT m Foo)`+luft :: FFunctor f => Monad m => MonadTrans t => Functor (t m) => f m -> f (t m)+luft = ffmap lift+#endif

@@ -5,12 +5,13 @@ {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeOperators    #-} +-- | Supporting code for https://discourse.haskell.org/t/local-capabilities-with-mtl/231 module Data.FFunctor.ServantTest where  import           Control.Monad.Error.Class (liftEither) import           Control.Monad.Except import           Data.Aeson                hiding ((.:))-import           Data.Composition+import           Universum.VarArg import           Data.FFunctor import           Data.Functor.Identity import           Data.Proxy                (Proxy (..))@@ -93,7 +94,9 @@ -- Note that FFunctor is not the same shape as HFunctor, MFunctor or MonadTrans, -- although they are all related from a category theory point of view. instance FFunctor UserApi where-  ffmap nt (UserApi f1 f2 f3) = UserApi (nt f1) (nt . f2) (nt .: f3)+  ffmap nt (UserApi f1 f2 f3) = UserApi (nt f1) (nt ... f2) (nt ... f3)+  -- or, with Data.Composition+--ffmap nt (UserApi f1 f2 f3) = UserApi (nt f1) (nt . f2) (nt .: f3)  -- We need a natural transformation from ClientM into an arbitrary monad stack. -- The bare minimum requirements to do this are:@@ -136,14 +139,14 @@ doStuff http check = hasEmail <$> (runExceptT $ apiGetUsers http)   where     hasEmail (Left _)      = False-    hasEmail (Right users) = any (\u -> (email u) == check) users+    hasEmail (Right users) = any ((== check) . email) users  -- Compare to the version where errors are ignored and must be handled at a -- higher layer. doStuff' :: Applicative m => UserApi m -> String -> m Bool doStuff' http check = hasEmail <$> apiGetUsers http   where-    hasEmail users = any (\u -> (email u) == check) users+    hasEmail users = any ((== check) . email) users  -- Creating an instance of UserApiT is easy myApp :: IO Bool

@@ -0,0 +1,307 @@+{-# LANGUAGE ConstraintKinds  #-}+{-# LANGUAGE ExplicitForAll   #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE NamedFieldPuns   #-}++-- | Follow on to https://discourse.haskell.org/t/local-capabilities-with-mtl/231+module Data.FFunctor.TracingTest where++import           Control.Monad.Catch+import           Control.Monad.Reader+import           Data.FFunctor+import           Data.Function               ((&))+import           Data.Generics.Product.Typed (HasType, getTyped, setTyped)+import           Data.Time                   (UTCTime)+import           Prelude                     hiding (span)+import           Universum                   ((...))++-- In https://discourse.haskell.org/t/local-capabilities-with-mtl/231 we seen+-- how to localise or delegate capabilities such as error handling. This is a+-- follow up to address some of the shortcomings of the approach when a project+-- scales, to explain why people continue to explore alternatives to MTL and why+-- many Haskell developers do not consider application design to be a solved+-- problem.+--+-- The code is available in https://gitlab.com/fommil/ffunctor/tree/master/test+--+-- Let's say we have an application that can be modularised into several+-- capabilities:+--+--   1. a Logger, for writing out text messages+--   2. an HTTP client, for talking to a webserver+--   3. a Database client, for persisting state+--   4. a Tracer, for distributed performance monitoring+--+-- We could encode these capabilities as typeclasses but to have fine control over+-- which implementation is used in a given situation we are going to use records+-- of functions.+--+-- The first 3 are fairly straightforward and may look like:++data Logger m = Logger+  { debug   :: String -> m ()+  , info    :: String -> m ()+  , warning :: String -> m ()+  }++data Http m = Http+  { getUsers :: m [String]+  , postUser :: String -> m ()+  }++data Database m = Database+  { dbHistory :: m [String]+  , dbAdd     :: String -> m ()+  }++-- The idea behind Tracing is that a server (e.g. Jaeger) receives a message+-- when opt-in computations begin and end across services in a distributed+-- system. Tracing is useful for operations monitoring and performance+-- profiling.+--+-- A "trace" is a tree of spans that each contain a start time, an end time, and+-- a name.+--+-- Spans typically have a lot of metadata associated to them but we'll keep it+-- simple for this example:++data OpenSpan = OpenSpan+  { spanStart  :: UTCTime   -- ^ when the span begins+  , spanName   :: String    -- ^ user provided+  , spanId     :: Int       -- ^ randomly generated+  , spanParent :: Maybe Int -- ^ the id of the span that caused this+  }++-- We can implement the Tracer capability with two low-level operations:+-- creating a new span, and sending the current span to the tracing server, i.e.+-- closing the span:+data Tracer m = Tracer+  { openSpan  :: (Maybe Int) -- ^ id of the parent span+              -> String      -- ^ the name of this span+              -> m OpenSpan  -- ^ the new span+  , closeSpan :: OpenSpan -> m ()+  }++-- Tracer isn't a very practical API to use directly, so we introduce a more+-- convenient function that can handle errors with MonadMask. Before we do that,+-- it is useful to introduce an alias for the ability to read the currently open+-- span, and bracket any errors:+type MonadTraced m = (MonadReader OpenSpan m, MonadMask m)++-- We can implement tracing very naturally with MonadReader.local and+-- MonadMask.finally, giving a nice API.+--+-- (tracer & span) "foo" doFoo+span :: MonadTraced m => Tracer m -> String -> m a -> m a+span tracer name ma = do+  OpenSpan{spanId} <- ask+  child <- (tracer & openSpan) (Just spanId) name+  local (const child) $ ma `finally` ((tracer & closeSpan) child)++-- Aside: we are using the operator & which just flips the order of its two+-- parameters. (tracer & openSpan) is the same as (openSpan tracer) but gives a+-- visual indication that the `openSpan` function comes from the `tracer` record+-- of functions.++-- Following the pattern from the previous letter, Local Capabilites with MTL,+-- it is useful to be able to declare a requirement with a monad transformer,+-- for situations where we can't change the constraints+type Traced = ReaderT OpenSpan++-- An immediate usecase is that we need a way to create "root spans" that don't+-- have a parent and therefore do not require a MonadReader, e.g.+--+-- (tracer & rootSpan) "foo" doFoo+rootSpan :: MonadMask m => Tracer m -> String -> (Traced m) a -> m a+rootSpan tracer name ma = do+  child <- (tracer & openSpan) Nothing name+  (runReaderT ma child) `finally` ((tracer & closeSpan) child)++-- So far, this is a great application of MTL. But this letter is about when MTL+-- starts to get in the way so let's see how that can happen... say we have some+-- business logic that grabs the users from the HTTP client and adds everything+-- to the database.+--+-- Because we are abstracting over m this will work for anything, whether it is+-- traced, untraced, or a dummy implementation for testing.+doStuff :: Monad m => Http m -> Database m -> m ()+doStuff http db = do+  users <- (http & getUsers)+  void $ traverse (db & dbAdd) users++-- But what if we only have implementations of `Http (Traced m)` and `Database+-- m`? This might be because our implementation of Http must pass a span's id+-- via a header, which is very standard. Our database doesn't have support for+-- tracing ids because the SQL standard doesn't support it.++data HttpConfig = HttpConfig -- ...+mkUsers :: MonadIO m => MonadTraced m => MonadIO n => HttpConfig -> n (Http m)+mkUsers = undefined++data DatabaseConfig = DatabaseConfig -- ...+mkDatabase :: MonadIO m => MonadIO n => DatabaseConfig -> n (Database m)+mkDatabase = undefined++-- This is where things start to get tricky. The monad types must all align or+-- there will be a compilation error.+--+-- We have three choices:+--+--   1. convert `Http (Traced m)` into a `Http m`+--   2. convert `Database m` into a `Database (Traced m)`+--   3. pass around all four versions and mix/match when we need them.+--+-- Carrying around all combinations is not scalable, although we can already use+-- mkDatabase to construct both the Databases that we need. We won't, however,+-- be able to create a `Http m`.+--+-- If we want to conjure the correct types when we need them, we'll need+-- Data.FFunctor, which allows us to map an (f m) into an (f (t m)). Let's+-- create some instances for our capabilities, using the `...` operator from+-- Universum to reduce the boilerplate++instance FFunctor Logger where+  ffmap nt (Logger p1 p2 p3) = Logger (nt ... p1) (nt ... p2) (nt ... p3)++instance FFunctor Http where+  ffmap nt (Http p1 p2) = Http (nt ... p1) (nt ... p2)++instance FFunctor Database where+  ffmap nt (Database p1 p2) = Database (nt ... p1) (nt ... p2)++instance FFunctor Tracer where+  ffmap nt (Tracer p1 p2) = Tracer (nt ... p1) (nt ... p2)++-- Now we can convert a `Database m` into a `Database (Traced m)` by calling the+-- `luft` helper method from FFunctor (it is a simple alias for `ffmap lift`).+-- Typically we'd just write this inline as `luft db`+databaseTraced' :: Monad m => Database m -> Database (Traced m)+databaseTraced' = luft++-- We might also want to opt-in to tracing inside the Database capability and+-- wrap each function call with a span. If we have written one of these we+-- probably always want to use it instead of the `luft`ed one.+--+-- It's nice that we don't need to touch the underlying implementation to add+-- tracing.+databaseTraced :: MonadMask m => Tracer (Traced m) -> Database m -> Database (Traced m)+databaseTraced tracer db =+  let db'     = luft db+      span'   = tracer & span+  in Database+   (span' "Database.history" $ (db' & dbHistory))+   (\t -> span' "Database.add" $ (db' & dbAdd) t)++-- Which is polymorphic...+class TracedCapability f where+  nachziehen :: MonadMask m => f m -> f (Traced m)++instance TracedCapability Database where+  nachziehen = databaseTraced'++-- Everything might want to provide a TracedCapability that is just `luft`, to+-- leave open the possibility of tracing in the future... or to document+-- possible cycles.+instance TracedCapability Logger where+  nachziehen = luft+instance TracedCapability Tracer where+  nachziehen = luft -- do not change this or tracing will be an infinite loop++-- We can convert a traced capability into a capability that looks like it+-- doesn't do any tracing if we provide a parent span. e.g. convert a `Http+-- (Traced m)` into a `Http m` with `skizzieren ctx http`.+skizzieren :: FFunctor f => Functor m => OpenSpan -> f (Traced m) -> f m+skizzieren ctx = ffmap (flip runReaderT ctx)++-- We need to know which Trace to use, and we might get that from a MonadReader.+-- Here's a convenience for that, but this would mean that we are in a context+-- where we can trace and we want to create capabilities that don't look like+-- they can trace, which is a bit of a strange situation to be in.+verfolgen :: FFunctor f => Functor m => MonadReader OpenSpan n => f (Traced m) -> n (f m)+verfolgen t = (\ctx -> ffmap (flip runReaderT ctx) t) <$> ask++-- It is more likely that we don't have access to a MonadReader but we have a+-- Tracer capability, and we want some other capability to run within a new root+-- span.+zeichnen :: FFunctor f => MonadMask m => Tracer m -> String -> f (Traced m) -> f m+zeichnen tracer name = ffmap $ (tracer & rootSpan) name++-- Let's pause.+--+-- The fact that luft, nachziehen, skizzieren, verfolgen and zeichnen might be+-- needed at all, should be telling us that we've wandered into the territory of+-- conceptual overhead. We're manually aligning and wiring capabilities instead+-- of writing our business logic. That's not good hackers, that's not good.+--+-- A lot of people pick one monad stack for their application and stick to that.+-- In the case of Tracer, that would mean everything gets a `(MonadReader (Maybe+-- OpenSpan))` and there is no need to luft... but we can no longer be sure that+-- we're adding a span to an existing tree vs creating a new root span. We end+-- up doing what untyped languages do: asserting behaviours with runtime tests.+--+-- If we were to use typeclass encodings for Http and Database (i.e. classic+-- MTL) we might be able to write derivation rules that do a lot of the+-- conversions automatically, but it isn't long before we need to write+-- derivations that make use of advanced ghc extensions (e.g.+-- OverlappingInstances, IncoherentInstances, UndecidableInstances, etc)... and+-- we pay for it with boilerplate in our tests with newtypes and DerivingVia. Or+-- we have orphans and lose the ability to reason about what is running in any+-- given test, which is prone to breakages during refactorings. This can also be+-- a touchy subject as some people take the principled approach that all+-- typeclasses should have laws.+--+-- Furthermore, if our application has a lot of capabilities, our business logic+-- can have long parameter lists of capabilities that we have to pass around.+-- Long parameter lists might be an indicator of a bad abstraction that needs+-- more layers, but there always seem to be a few capabilities (like logging and+-- tracing) that end up being needed everywhere.+--+-- People create encoding such as+-- [`makeClassy`](https://hackage.haskell.org/package/lens-4.17/docs/Control-Lens-Combinators.html#v:makeClassy)+-- and+-- [`makeTypeclass`](https://github.com/etorreborre/registry/blob/master/doc/boilerplate.md)+-- to reduce the boilerplate of passing capabilities, at the cost of the mental+-- overhead of the encodings, and the quality of compiler error messages.+--+-- That brings us to another problem with MTL: we can't have multiple+-- MonadReaders. So if we were to use a "classy" encoding (i.e. put capabilities+-- into a MonadReader) we would not be able to use MonadTraced. A workaround to+-- this is MORE LENSES. Here is an example replacement for MonadReader that uses+-- HasType from `generic-lens`:+type HasReader r r' m = (MonadReader r' m, HasType r r')++ask_ :: HasReader r r' m => m r+ask_ = getTyped <$> ask++local_ :: HasReader r r' m => (r -> r) -> m a -> m a+local_ f = local (\r' -> setTyped (f . getTyped $ r') r')++-- We would have to redesign the Tracer to use HasReader, which means redundant+-- type parameters (more conceptual overhead) everywhere:+type MonadTraced_ m r' = (HasReader OpenSpan r' m, MonadMask m)+span_ :: MonadTraced_ m r' => Tracer m -> String -> m a -> m a+span_ tracer name ma = do+  OpenSpan{spanId} <- ask_+  child <- (tracer & openSpan) (Just spanId) name+  local_ (const child) $ ma `finally` ((tracer & closeSpan) child)++-- In conclusion, we can use MTL with records of functions to gain a lot of type+-- safety around what our programs are capable of doing, but for non-trivial+-- projects, we will introduce boilerplate, conceptual overhead, and workarounds+-- to deal with the case when the monads don't align. We encounter similar+-- problems as ReaderT / MonadReader with error handling (ExceptT / MonadError)+-- and single-threaded statefulness (StateT / MonadState).+--+-- "Classic" MTL, with typeclasses to encode capabilities, can reduce the+-- boilerplate in the main code but ends up costing just as much when tests are+-- considered. Ultimately, typeclasses are just records of functions with magic+-- wiring that usually do the right thing and sometimes don't.+--+-- The emergence of boilerplate is good news, in a way, because when common+-- patterns emerge, it points to something fundamental... and a new solution+-- usually comes along to solve fundamental problems.+--+-- I plan to follow up this letter with an exploration of the same ideas using+-- [`fused-effects`](https://hackage.haskell.org/package/fused-effects), which+-- is the first practical Free Monad encoding that can bracket errors and is+-- therefore of great interest (although there is no sign of concurrency yet).