composite-base 0.7.2.0 → 0.7.3.0
raw patch · 4 files changed
+22/−13 lines, 4 files
Files
- composite-base.cabal +2/−2
- src/Composite/Record.hs +9/−6
- src/Composite/TH.hs +0/−1
- src/Control/Monad/Composite/Context.hs +11/−4
composite-base.cabal view
@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 8a796b93d5ebd8ec1452a4dc2d9b7f6bf3c5e45849c264c0530564327a215993+-- hash: 9ad4c3dbcebb7a2fc26869aa4c21921b8a5c42df6ec18a74ec26bb63aba05ed5 name: composite-base-version: 0.7.2.0+version: 0.7.3.0 synopsis: Shared utilities for composite-* packages. description: Shared helpers for the various composite packages. category: Records
src/Composite/Record.hs view
@@ -17,7 +17,6 @@ import Data.Kind (Constraint) import Data.List.NonEmpty (NonEmpty((:|))) import Data.Proxy (Proxy(Proxy))-import Data.Semigroup (Semigroup) import Data.String (IsString) import Data.Text (Text, pack) import Data.Vinyl (Rec((:&), RNil), RecApplicative, rcast, recordToList, rpure)@@ -245,16 +244,20 @@ -- |Given a list of constraints @cs@, apply some function for each @r@ in the target record type @rs@ with proof that those constraints hold for @r@, -- generating a record with the result of each application. reifyDicts- :: forall (cs :: [u -> Constraint]) (f :: u -> *) (rs :: [u]) (proxy :: [u -> Constraint] -> *).+ :: forall u. forall (cs :: [u -> Constraint]) (f :: u -> *) (rs :: [u]) (proxy :: [u -> Constraint] -> *). (AllHave cs rs, RecApplicative rs) => proxy cs -> (forall proxy' (a :: u). HasInstances a cs => proxy' a -> f a) -> Rec f rs-reifyDicts _ f = go (rpure (Const ()))+reifyDicts x f = go x (rpure (Const ())) f where- go :: forall (rs' :: [u]). AllHave cs rs' => Rec (Const ()) rs' -> Rec f rs'- go RNil = RNil- go ((_ :: Const () a) :& xs) = f (Proxy @a) :& go xs+ go :: forall (f :: u -> *) (cs :: [u -> Constraint]) (rs' :: [u]) (proxy :: [u -> Constraint] -> *). AllHave cs rs'+ => proxy cs+ -> Rec (Const ()) rs'+ -> (forall proxy' (a :: u). HasInstances a cs => proxy' a -> f a)+ -> Rec f rs'+ go _ RNil _ = RNil+ go y ((_ :: Const () a) :& ys) g = g (Proxy @a) :& go y ys g {-# INLINE reifyDicts #-} -- |Class which reifies the symbols of a record composed of ':->' fields as 'Text'.
src/Composite/TH.hs view
@@ -11,7 +11,6 @@ import Data.Char (toLower) import Data.List (foldl') import Data.Maybe (catMaybes)-import Data.Monoid ((<>)) import Data.Proxy (Proxy(Proxy)) import Data.Vinyl (RecApplicative) import Data.Vinyl.Lens (type (∈))
src/Control/Monad/Composite/Context.hs view
@@ -25,7 +25,9 @@ import Control.Monad.Cont.Class (MonadCont(callCC)) import Control.Monad.Error.Class (MonadError(throwError, catchError)) import Control.Monad.Except (ExceptT(ExceptT), runExceptT)+#if !MIN_VERSION_base(4,13,0) import Control.Monad.Fail (MonadFail)+#endif import qualified Control.Monad.Fail as MonadFail import Control.Monad.Fix (MonadFix(mfix)) import Control.Monad.IO.Class (MonadIO(liftIO))@@ -44,13 +46,16 @@ import qualified Control.Monad.Writer.Lazy as Lazy import qualified Control.Monad.Writer.Strict as Strict import Control.Monad.Writer.Class (MonadWriter(writer, tell, listen, pass))-import Data.Monoid (Monoid) +import Control.Monad.IO.Unlift+ ( MonadUnliftIO+#if !MIN_VERSION_unliftio_core(0,2,0)+ , UnliftIO(UnliftIO), askUnliftIO, unliftIO, withUnliftIO+#endif #if MIN_VERSION_unliftio_core(0,1,1)-import Control.Monad.IO.Unlift (askUnliftIO, MonadUnliftIO, UnliftIO(UnliftIO), unliftIO, withUnliftIO, withRunInIO)-#else-import Control.Monad.IO.Unlift (askUnliftIO, MonadUnliftIO, UnliftIO(UnliftIO), unliftIO, withUnliftIO)+ , withRunInIO #endif+ ) -- |Class of monad (stacks) which have context reading functionality baked in. Similar to 'Control.Monad.Reader.MonadReader' but can coexist with a -- another monad that provides 'Control.Monad.Reader.MonadReader' and requires the context to be a record.@@ -179,10 +184,12 @@ f (runInBase . ($ c) . runContextT) instance MonadUnliftIO m => MonadUnliftIO (ContextT c m) where+#if !MIN_VERSION_unliftio_core(0,2,0) {-# INLINE askUnliftIO #-} askUnliftIO = ContextT $ \c -> withUnliftIO $ \u -> return (UnliftIO (unliftIO u . flip runContextT c))+#endif #if MIN_VERSION_unliftio_core(0,1,1) {-# INLINE withRunInIO #-} withRunInIO inner =