ffunctor 1.0.0 → 1.1.0

raw patch · 4 files changed

+180/−4 lines, 4 filesdep +aesondep +compositiondep +ffunctorPVP ok

version bump matches the API change (PVP)

Dependencies added: aeson, composition, ffunctor, http-client, mtl, servant, servant-client, tasty, tasty-hspec, tasty-quickcheck, time

API changes (from Hackage documentation)

Files

• ffunctor.cabal +22/−2
• library/Data/FFunctor.hs +2/−2
• test/Data/FFunctor/ServantTest.hs +155/−0
• test/Driver.hs +1/−0

@@ -1,13 +1,13 @@ cabal-version:       2.2 name:                ffunctor-version:             1.0.0+version:             1.1.0 synopsis:            FFunctor typeclass license:             BSD-3-Clause license-file:        LICENSE author:              Sam Halliday maintainer:          Sam Halliday copyright:           2019 Sam Halliday-bug-reports:         https://gitlab.com/fommil/fommil/merge_requests+bug-reports:         https://gitlab.com/fommil/ffunctor/merge_requests tested-with:         GHC ^>= 8.4.4 || ^>= 8.6.3 category:            Constraints description:@@ -31,3 +31,23 @@   import:             deps   hs-source-dirs:     library   exposed-modules:    Data.FFunctor++test-suite            tests+  import:             deps+  hs-source-dirs:     test+  type:               exitcode-stdio-1.0+  main-is:            Driver.hs+  other-modules:      Data.FFunctor.ServantTest+  build-depends:    , ffunctor+                    , aeson            ^>= 1.4.1.0+                    , composition      ^>= 1.0.2.1+                    , mtl              ^>= 2.2.2+                    , http-client      ^>= 0.5.12+                    , servant          ^>= 0.14.1+                    , servant-client   ^>= 0.14+                    , tasty            ^>= 1.2.1+                    , tasty-hspec      ^>= 1.1.5+                    , tasty-quickcheck ^>= 0.10+                    , time             ^>= 1.8.0.2+  build-tool-depends: tasty-discover:tasty-discover ^>= 4.2.1+  ghc-options: -threaded

@@ -1,11 +1,11 @@-{-# LANGUAGE ExplicitForAll #-} {-# LANGUAGE KindSignatures #-}+{-# LANGUAGE Rank2Types     #-}  -- | Functor of Functors module Data.FFunctor where  class FFunctor (f :: (* -> *) -> *) where --ffmap :: (Functor m, Functor n) => (m ~> n) -> f m -> f n-  ffmap :: forall m n a . (Functor m, Functor n) => (m a -> n a) -> 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?

@@ -0,0 +1,155 @@+{-# LANGUAGE DataKinds        #-}+{-# LANGUAGE DeriveAnyClass   #-}+{-# LANGUAGE DeriveGeneric    #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeOperators    #-}++module Data.FFunctor.ServantTest where++import           Control.Monad.Error.Class (liftEither)+import           Control.Monad.Except+import           Data.Aeson                hiding ((.:))+import           Data.Composition+import           Data.FFunctor+import           Data.Functor.Identity+import           Data.Proxy                (Proxy (..))+import           Data.Time                 (UTCTime)+import           GHC.Generics+import           Network.HTTP.Client       (defaultManagerSettings, newManager)+import           Servant.API+import           Servant.Client++-- From the Servant Tutorial+-- https://haskell-servant.readthedocs.io/en/stable/tutorial/index.html++-- Define a domain object+data User = User+  { name              :: String+  , age               :: Int+  , email             :: String+  , registration_date :: UTCTime+  } deriving (Generic, FromJSON, ToJSON)++-- Define the HTTP endpoints as types+type API = "users" :> Get '[JSON] [User]+      :<|> "users" :> ReqBody '[JSON] User :> Post '[JSON] User+      :<|> "users" :> Capture "userid" Integer :> ReqBody '[JSON] User :> Put '[JSON] User++-- Servant.Client derives functions that return a ClientM that can be run to+-- call those endpoints.+getUsers  :: ClientM [User]+postUsers :: User -> ClientM User+putUsers  :: Integer -> User -> ClientM User+getUsers :<|> postUsers :<|> putUsers = client (Proxy @API)++-- A record of function is just a data type that has functions as fields.+-- We can abstract over a higher kinded type parameter that will eventually+-- be our application's monad stack.+--+-- For example, we can create a record of functions for the API we just defined.+data UserApi m = UserApi+  { apiGetUsers  :: m [User]+  , apiPostUsers :: User -> m User+  , apiPutUsers  :: Integer -> User -> m User+  }++-- An advantage of records of functions is that we can write custom+-- implementations for use in unit tests, without ever talking to a real HTTP+-- server, or performing any IO.+--+-- For example, we may wish to have a trivial mock for the Identity monad, like+-- so, or to have state and error handling via Either and State. Every unit test+-- can have its own custom behaviour.+mockApi :: UserApi Identity+mockApi = UserApi (pure []) (\u -> pure u) (\_ u -> pure u)++-- For production, we want to use the Servant.Client functions that we derived+-- above. But we don't want our application's monad stack to be a ClientM, so we+-- will need to transform this...+servantApi :: UserApi ClientM+servantApi = UserApi getUsers postUsers putUsers++-- To transform a `UserApi ClientM` into a `UserApi OurMonadStack` we need to be+-- able to map over the type parameter. That is exactly what the FFunctor+-- typeclass allows us to do.+--+-- UserAPI may have an instance of an FFunctor because all occurences of the+-- higher kinded type m only appear in return (i.e. covariant) position.+--+-- Creating instances of FFunctor is procedural. Each field (which is a+-- function) has the natural transformation applied according to its number of+-- parameters:+--+--   0. If there are no parameters, the nt is applied as a regular+--      function+--   1. If there is one parameter, the nt is composed with (.)+--   2. If there are more than one parameter, the Data.Composition package may+--      be used, which provides compositions of arbitrary arity.+--      Data.Composition functions are conveniently named such that the number+--      of dots after the initial one are the number of parameters, so .:+--      handles two parameters, .:. handles three, .:: handles four, etc.+--+-- 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)++-- We need a natural transformation from ClientM into an arbitrary monad stack.+-- The bare minimum requirements to do this are:+--+--   1. we need a value of Servant.Client.ClientEnv, providing the host, port+--      and connection settings.+--   2. we need to be able to perform IO, implying MonadIO+--   3. we need to be able to report ServantError, implying MonadError+--+-- Such a natural transformation may be defined like this and may be shared by+-- all APIs.+liftClientM :: (MonadIO m, MonadError ServantError m)+  => ClientEnv+  -> ClientM a+  -> m a+liftClientM env ca = liftEither =<< (liftIO $ runClientM ca env)++-- We can now generate a UserApi for our application's monad stack, which we can+-- create during initalisation from the ClientEnv configuration.+userApi :: (MonadIO m, MonadError ServantError m) => ClientEnv -> UserApi m+userApi env = ffmap (liftClientM env) servantApi++-- But this demands that we have a `MonadError ServantError` in our stack. That+-- sucks!+--+-- The trick to overcome this limitation is to define a type alias that allows+-- us to have only local errors, provided by the ExceptT monad transformer. This+-- is a well known MTL trick (which doesn't seem to have a name) that can be+-- used to add a variety of locally scoped capabilities to a component, such as+-- a MonadState/MonadReader/MonadWriter via their associated monad transformers.+type UserApiT m = UserApi (ExceptT ServantError m)++-- For example, a downstream user may depend on UserApiT and must handle+-- ServantErrors at the point of use. They may chose to retry, recover, ignore+-- errors, or translate errors into an application specific error ADT.+--+-- Note that we only need the minimal set of constraints, so we only require a+-- Applicative to write:+doStuff :: Applicative m => UserApiT m -> String -> m Bool+doStuff http check = hasEmail <$> (runExceptT $ apiGetUsers http)+  where+    hasEmail (Left _)      = False+    hasEmail (Right users) = any (\u -> (email u) == check) 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++-- Creating an instance of UserApiT is easy+myApp :: IO Bool+myApp = do+  mgr <- newManager defaultManagerSettings+  let base = BaseUrl Http "localhost" 8080 ""+      env = mkClientEnv mgr base+      api = userApi env+  doStuff api "wibble@wobble.com"

@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF tasty-discover #-}