packages feed

objective 1.2 → 1.3

raw patch · 5 files changed

+47/−78 lines, 5 filesdep −bifunctorsdep −containersdep −hashabledep ~basedep ~witherable

Dependencies removed: bifunctors, containers, hashable, mtl, profunctors, template-haskell, transformers-compat, unordered-containers, void

Dependency ranges changed: base, witherable

Files

CHANGELOG.md view
@@ -1,3 +1,11 @@+1.3+----+* Supported GHC 9.0+* Removed `unfoldOM`+* Removed `apprisesOf`+* Removed `withBuilder`+* Trimmed unnecessary dependencies+ 1.2 ----
objective.cabal view
@@ -1,20 +1,20 @@+cabal-version:       2.4 name:                objective-version:             1.2+version:             1.3 synopsis:            Composable objects description:         Composable objects homepage:            https://github.com/fumieval/objective bug-reports:         http://github.com/fumieval/objective/issues-license:             BSD3+license:             BSD-3-Clause license-file:        LICENSE author:              Fumiaki Kinoshita maintainer:          Fumiaki Kinoshita <fumiexcel@gmail.com>-copyright:           Copyright (c) 2014 Fumiaki Kinoshita+copyright:           Copyright (c) 2014-2021 Fumiaki Kinoshita category:            Control build-type:          Simple extra-source-files:   CHANGELOG.md   README.md-cabal-version:       >=1.10  source-repository head   type: git@@ -27,20 +27,11 @@       , Control.Object.Instance       , Control.Object.Mortal   other-extensions:    MultiParamTypeClasses, KindSignatures, TypeFamilies-  build-depends:       base >=4.6 && <5-    , bifunctors+  build-depends:       base >=4.9 && <5     , exceptions >= 0.8-    , containers >= 0.5.0.0 && <0.6-    , unordered-containers >= 0.2.0.0 && <0.3     , transformers >= 0.3 && <0.6-    , transformers-compat-    , hashable-    , mtl-    , profunctors-    , void-    , witherable >= 0.1.3+    , witherable ^>= 0.4     , monad-skeleton >= 0.1.1 && <0.3-    , template-haskell-  ghc-options: -Wall+  ghc-options: -Wall -Wcompat   hs-source-dirs:      src   default-language:    Haskell2010
src/Control/Object/Instance.hs view
@@ -44,7 +44,7 @@ -- In case of exception, the original object will be set. invokeOn :: (MonadIO m, MonadMask m)          => (forall x. g x -> m x) -> Instance f g -> f a -> m a-invokeOn = invokeOnUsing runObject+invokeOn = invokeOnUsing (\o f -> runObject o f) {-# INLINE invokeOn #-}  -- | Invoke a method.
src/Control/Object/Mortal.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE Safe #-} {-# LANGUAGE Rank2Types #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE BangPatterns #-}@@ -19,7 +19,6 @@     mortal_,     runMortal,     immortal,-    apprisesOf,     apprises,     apprise     ) where@@ -32,10 +31,8 @@ import Control.Monad.Trans.Writer.Strict import Data.Bifunctor import Data.Monoid-import Data.Witherable+import Witherable import Data.Tuple (swap)-import Control.Arrow ((***))-import Unsafe.Coerce  -- | A 'Mortal' is an object that may die. -- A mortal yields a final result upon death.@@ -46,67 +43,55 @@ -- newtype Mortal f g a = Mortal { unMortal :: Object f (ExceptT a g) } -instance (Functor m, Monad m) => Functor (Mortal f m) where+instance Monad m => Functor (Mortal f m) where   fmap f (Mortal obj) = Mortal (obj @>>^ mapExceptT (fmap (first f)))   {-# INLINE fmap #-} -instance (Functor m, Monad m) => Applicative (Mortal f m) where-  pure = return+instance Monad m => Applicative (Mortal f m) where+  pure a = mortal $ const $ throwE a   {-# INLINE pure #-}   (<*>) = ap   {-# INLINE (<*>) #-}  instance Monad m => Monad (Mortal f m) where-  return a = mortal $ const $ throwE a-  {-# INLINE return #-}-  m >>= k = mortal $ \f -> lift (runExceptT $ runMortal m f) >>= \r -> case r of+  m >>= k = mortal $ \f -> lift (runExceptT $ runMortal m f) >>= \case     Left a -> runMortal (k a) f     Right (x, m') -> return (x, m' >>= k)  instance MonadTrans (Mortal f) where-  lift m = mortal $ const $ ExceptT $ liftM Left m+  lift m = mortal $ const $ ExceptT $ fmap Left m   {-# INLINE lift #-}  -- | Construct a mortal in a 'Object' construction manner. mortal :: Monad m => (forall x. f x -> ExceptT a m (x, Mortal f m a)) -> Mortal f m a-mortal f = unsafeCoerce f `asTypeOf` Mortal (Object (liftM (fmap unMortal) . f))+mortal f = Mortal (Object (fmap (fmap unMortal) . f)) {-# INLINE mortal #-}  -- | Send a message to a mortal. runMortal :: Monad m => Mortal f m a -> f x -> ExceptT a m (x, Mortal f m a)-runMortal = unsafeCoerce `asTypeOf` ((liftM (fmap Mortal) . ) . runObject . unMortal)+runMortal m f = fmap Mortal <$> runObject (unMortal m) f {-# INLINE runMortal #-} --- | Restricted 'Mortal' constuctor which can be applied to 'transit', 'fromFoldable' without ambiguousness.+-- | A smart constructor of 'Mortal' where the result type is restricted to () mortal_ :: Object f (ExceptT () g) -> Mortal f g () mortal_ = Mortal {-# INLINE mortal_ #-}  -- | Turn an object into a mortal without death.-immortal :: (Functor m, Monad m) => Object f m -> Mortal f m x+immortal :: Monad m => Object f m -> Mortal f m x immortal obj = Mortal (obj @>>^ lift) {-# INLINE immortal #-} --- | Send a message to mortals through a filter.-apprisesOf :: Monad m-  => WitherLike' (WriterT r m) s (Mortal f m b)-  -> f a -> (a -> r) -> (b -> r) -> StateT s m r-apprisesOf l f p q = StateT $ \t -> liftM swap $ runWriterT $ flip l t-    $ \obj -> WriterT $ runExceptT (runMortal obj f) >>= \case-      Left r -> return (Nothing, q r)-      Right (x, obj') -> return (Just obj', p x)-{-# INLINABLE apprisesOf #-}- -- | Send a message to mortals in a 'Witherable' container.------ @apprises = apprisesOf wither@----apprises :: (Witherable t, Monad m, Applicative m, Monoid r) => f a -> (a -> r) -> (b -> r) -> StateT (t (Mortal f m b)) m r-apprises = apprisesOf wither+apprises :: (Witherable t, Monad m, Monoid r) => f a -> (a -> r) -> (b -> r) -> StateT (t (Mortal f m b)) m r+apprises f p q = StateT $ \t -> fmap swap $ runWriterT $ flip wither t+  $ \obj -> WriterT $ runExceptT (runMortal obj f) >>= \case+    Left r -> return (Nothing, q r)+    Right (x, obj') -> return (Just obj', p x) {-# INLINE apprises #-}  -- | Send a message to mortals in a container.-apprise :: (Witherable t, Monad m, Applicative m) => f a -> StateT (t (Mortal f m r)) m ([a], [r])-apprise f = fmap (flip appEndo [] *** flip appEndo [])-  $ apprises f (\a -> (Endo (a:), mempty)) (\b -> (mempty, Endo (b:)))+apprise :: (Witherable t, Monad m) => f a -> StateT (t (Mortal f m r)) m ([a], [r])+apprise f = bimap (`appEndo` []) (`appEndo` [])+  <$> apprises f (\a -> (Endo (a:), mempty)) (\b -> (mempty, Endo (b:))) {-# INLINE apprise #-}
src/Control/Object/Object.hs view
@@ -1,5 +1,6 @@ {-# LANGUAGE RankNTypes, TupleSections, TypeOperators #-} {-# LANGUAGE GADTs #-}+{-# LANGUAGE LambdaCase #-} {-# LANGUAGE Safe #-} ----------------------------------------------------------------------------- -- |@@ -22,7 +23,6 @@   , (@||@)   -- * Stateful construction   , unfoldO-  , unfoldOM   , stateful   , (@~)   , variable@@ -39,12 +39,9 @@   , invokes   , (@!=)   , announce-  , withBuilder   ) where import Control.Monad.Trans.State.Strict-import Control.Monad import Control.Monad.Skeleton-import Data.Traversable as T import Control.Monad.Trans.Writer.Strict import Data.Monoid import Data.Tuple (swap)@@ -62,7 +59,7 @@  -- | An infix alias for 'runObject' (@-) :: Object f g -> f x -> g (x, Object f g)-(@-) = runObject+a @- b = runObject a b {-# INLINE (@-) #-} infixr 3 @- @@ -99,7 +96,7 @@  -- | Combine objects so as to handle a 'Functor.Sum' of interfaces. (@||@) :: Functor h => Object f h -> Object g h -> Object (f `Functor.Sum` g) h-a @||@ b = Object $ \r -> case r of+a @||@ b = Object $ \case   Functor.InL f -> fmap (fmap (@||@b)) (runObject a f)   Functor.InR g -> fmap (fmap (a@||@)) (runObject b g) @@ -111,11 +108,6 @@ unfoldO h = go where go r = Object $ fmap (fmap go) . h r {-# INLINE unfoldO #-} --- | Same as 'unfoldO' but requires 'Monad' instead-unfoldOM :: Monad m => (forall a. r -> f a -> m (a, r)) -> r -> Object f m-unfoldOM h = go where go r = Object $ liftM (fmap go) . h r-{-# INLINE unfoldOM #-}- -- | Build a stateful object. -- -- @stateful t s = t ^>>\@ variable s@@@ -148,28 +140,25 @@  -- | Add capability to handle multiple messages at once. cascading :: Monad m => Object t m -> Object (Skeleton t) m-cascading = unfoldOM cascadeObject+cascading = unfoldO cascadeObject {-# INLINE cascading #-}  -- | Send a message to an object through a lens. invokesOf :: Monad m   => ((Object t m -> WriterT r m (Object t m)) -> s -> WriterT r m s)   -> t a -> (a -> r) -> StateT s m r-invokesOf t f c = StateT $ liftM swap . runWriterT+invokesOf t f c = StateT $ fmap swap . runWriterT   . t (\obj -> WriterT $ runObject obj f >>= \(x, obj') -> return (obj', c x)) {-# INLINABLE invokesOf #-} -invokes :: (T.Traversable t, Monad m, Monoid r)+invokes :: (Traversable t, Monad m, Monoid r)   => f a -> (a -> r) -> StateT (t (Object f m)) m r-invokes = invokesOf T.mapM+invokes = invokesOf traverse {-# INLINE invokes #-}  -- | Send a message to objects in a traversable container.------ @announce = withBuilder . invokesOf traverse@----announce :: (T.Traversable t, Monad m) => f a -> StateT (t (Object f m)) m [a]-announce f = withBuilderM (invokes f)+announce :: (Traversable t, Monad m) => f a -> StateT (t (Object f m)) m [a]+announce f = withListBuilder (invokes f) {-# INLINABLE announce #-}  -- | A method invocation operator on 'StateT'.@@ -179,13 +168,9 @@ l @!= f = invokesOf l f id {-# INLINE (@!=) #-} -withBuilder :: Functor f => ((a -> Endo [a]) -> f (Endo [a])) -> f [a]-withBuilder f = fmap (flip appEndo []) (f (Endo . (:)))-{-# INLINABLE withBuilder #-}--withBuilderM :: Monad f => ((a -> Endo [a]) -> f (Endo [a])) -> f [a]-withBuilderM f = liftM (flip appEndo []) (f (Endo . (:)))-{-# INLINABLE withBuilderM #-}+withListBuilder :: Functor f => ((a -> Endo [a]) -> f (Endo [a])) -> f [a]+withListBuilder f = fmap (flip appEndo []) (f (Endo . (:)))+{-# INLINABLE withListBuilder #-}  data Fallible t a where   Fallible :: t a -> Fallible t (Maybe a)