newtype WrappedApplicative f a = WrapApplicative (f a)
deriving
(Functor, Show)
deriving newtype
Applicative
instance (Applicative f, Num a) => Num (WrappedApplicative f a) where
(+) = liftA2 (+)
(*) = liftA2 (*)
negate = fmap negate
fromInteger = pure . fromInteger
abs = fmap abs
signum = fmap signum
instance (Applicative f, Fractional a) => Fractional (WrappedApplicative f a) where
recip = fmap recip
fromRational = pure . fromRational
instance (Applicative f, Floating a) => Floating (WrappedApplicative f a) where
pi = pure pi
sqrt = fmap sqrt
exp = fmap exp
log = fmap log
sin = fmap sin
cos = fmap cos
asin = fmap asin
atan = fmap atan
acos = fmap acos
sinh = fmap sinh
cosh = fmap cosh
asinh = fmap asinh
atanh = fmap atanh
acosh = fmap acosh
instance (Applicative f, Semigroup s) => Semigroup (WrappedApplicative f s) where
(<>) = liftA2 (<>)
instance (Applicative f, Monoid m) => Monoid (WrappedApplicative f m) where
mempty = pure mempty
mappend = liftA2 mappend
Last active
November 26, 2017 18:19
-
-
Save Icelandjack/dab7111ba9ee2d1e25cf8728f7864e06 to your computer and use it in GitHub Desktop.
Newtype wrappers for deriving
Getting Bifunctor
, Bifoldable
from Bitraversable
newtype WrappedBif f a b = WrapBif (f a b)
instance Bitraversable t => Bifunctor (WrappedBif t) where
bimap :: (a -> a') -> (b -> b') -> (WrappedBif t a b -> WrappedBif t a' b')
bimap = bimapDefault
instance Bitraversable t => Bifoldable (WrappedBif t) where
bifoldMap :: Monoid m => (a -> m) -> (b -> m) -> (WrappedBif t a b -> m)
bifoldMap = bifoldMapDefault
instance Bitraversable t => Bitraversable (WrappedBif t) where
bitraverse :: Applicative f
=> (a -> f a')
-> (b -> f b')
-> (WrappedBif t a b -> f (WrappedBif t a' b'))
bitraverse f g (WrapBif fab) = WrapBif <$> bitraverse f g fab
Getting (>>=)
from join
and fmap
class Functor m => MonadJoin m where
return_ :: a -> m a
join_ :: m (m a) -> m a
newtype WrappedMonadJoin m a = WrapMonadJoin { unwrapMonadJoin :: m a }
deriving newtype (Functor, Applicative)
instance MonadJoin m => MonadJoin (WrappedMonadJoin m) where
return_ a = WrapMonadJoin (return_ a)
join_ (WrapMonadJoin mma) = WrapMonadJoin $ join_ (fmap unwrapMonadJoin mma)
instance (Applicative m, MonadJoin m) => Monad (WrappedMonadJoin m) where
return = return_
ma >>= k = join_ (fmap k ma)
Getting pure
, (<*>)
from unit
, (**)
class Functor f => Monoidal f where
unit :: f ()
(**) :: f a -> f b -> f (a,b)
newtype WrappedMonoidal f a = WrapMonoidal (f a)
deriving newtype
(Functor, Monoidal)
instance Monoidal f => Applicative (WrappedMonoidal f) where
pure :: a -> WrappdMonoidal f a
pure a = a <$ unit
(<*>) :: WrappedMonoidal f (a -> b) -> WrappedMonoidal f a -> WrappedMonoidal f b
mf <*> mx = fmap (uncurry id) (mf ** mx)
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
Getting
Arbitrary
,CoArbitrary
fromEnum
,Bounded
Getting
Arbitrary
,CoArbitrary
fromIntegral
,Bounded
Getting
Arbitrary
fromRandom
,Bounded