{-# LANGUAGE StandaloneDeriving, UndecidableInstances #-}
module Witherable.Lens.Withering (Withering(..), empty) where
import Control.Applicative (liftA2)
newtype Withering f a = Withering { forall (f :: * -> *) a. Withering f a -> f (Maybe a)
runWithering :: f (Maybe a) }
deriving instance Eq (f (Maybe a)) => Eq (Withering f a)
deriving instance Ord (f (Maybe a)) => Ord (Withering f a)
deriving instance Show (f (Maybe a)) => Show (Withering f a)
instance Functor f => Functor (Withering f) where
fmap :: forall a b. (a -> b) -> Withering f a -> Withering f b
fmap a -> b
f (Withering f (Maybe a)
x) = f (Maybe b) -> Withering f b
forall (f :: * -> *) a. f (Maybe a) -> Withering f a
Withering ((Maybe a -> Maybe b) -> f (Maybe a) -> f (Maybe b)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> Maybe a -> Maybe b
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) f (Maybe a)
x)
instance Applicative f => Applicative (Withering f) where
pure :: forall a. a -> Withering f a
pure a
x = f (Maybe a) -> Withering f a
forall (f :: * -> *) a. f (Maybe a) -> Withering f a
Withering (Maybe a -> f (Maybe a)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Maybe a
forall a. a -> Maybe a
Just a
x))
Withering f (Maybe (a -> b))
f <*> :: forall a b. Withering f (a -> b) -> Withering f a -> Withering f b
<*> Withering f (Maybe a)
x = f (Maybe b) -> Withering f b
forall (f :: * -> *) a. f (Maybe a) -> Withering f a
Withering ((Maybe (a -> b) -> Maybe a -> Maybe b)
-> f (Maybe (a -> b)) -> f (Maybe a) -> f (Maybe b)
forall a b c. (a -> b -> c) -> f a -> f b -> f c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Maybe (a -> b) -> Maybe a -> Maybe b
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>) f (Maybe (a -> b))
f f (Maybe a)
x)
empty :: Applicative f => Withering f a
empty :: forall (f :: * -> *) a. Applicative f => Withering f a
empty = f (Maybe a) -> Withering f a
forall (f :: * -> *) a. f (Maybe a) -> Withering f a
Withering (Maybe a -> f (Maybe a)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing)