Skip to content

Add TraversableWithIndex instances for newtypes #18

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
garyb merged 1 commit into from
Oct 13, 2018
Merged

Add TraversableWithIndex instances for newtypes #18

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
8 changes: 7 additions & 1 deletion src/Data/Functor/App.purs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -3,18 +3,21 @@ module Data.Functor.App where
import Prelude

import Control.Alt (class Alt)
import Control.Apply (lift2)
import Control.Alternative (class Alternative)
import Control.Apply (lift2)
import Control.Comonad (class Comonad)
import Control.Extend (class Extend)
import Control.Lazy (class Lazy)
import Control.MonadPlus (class MonadZero, class MonadPlus)
import Control.Plus (class Plus)
import Data.Eq (class Eq1)
import Data.Foldable (class Foldable)
import Data.FoldableWithIndex (class FoldableWithIndex)
import Data.FunctorWithIndex (class FunctorWithIndex)
import Data.Newtype (class Newtype)
import Data.Ord (class Ord1)
import Data.Traversable (class Traversable)
import Data.TraversableWithIndex (class TraversableWithIndex)
import Unsafe.Coerce (unsafeCoerce)

newtype App f a = App (f a)
Expand Down Expand Up @@ -44,6 +47,7 @@ instance monoidApp :: (Applicative f, Monoid a) => Monoid (App f a) where
mempty = App (pure mempty)

derive newtype instance functorApp :: Functor f => Functor (App f)
derive newtype instance functorWithIndexApp :: FunctorWithIndex a f => FunctorWithIndex a (App f)
derive newtype instance applyApp :: Apply f => Apply (App f)
derive newtype instance applicativeApp :: Applicative f => Applicative (App f)
derive newtype instance bindApp :: Bind f => Bind (App f)
Expand All @@ -56,5 +60,7 @@ derive newtype instance monadPlusApp :: MonadPlus f => MonadPlus (App f)
derive newtype instance lazyApp :: Lazy (f a) => Lazy (App f a)
derive newtype instance foldableApp :: Foldable f => Foldable (App f)
derive newtype instance traversableApp :: Traversable f => Traversable (App f)
derive newtype instance foldableWithIndexApp :: FoldableWithIndex a f => FoldableWithIndex a (App f)
derive newtype instance traversableWithIndexApp :: TraversableWithIndex a f => TraversableWithIndex a (App f)
derive newtype instance extendApp :: Extend f => Extend (App f)
derive newtype instance comonadApp :: Comonad f => Comonad (App f)
16 changes: 15 additions & 1 deletion src/Data/Functor/Compose.purs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -5,13 +5,16 @@ import Prelude
import Control.Alt (class Alt, alt)
import Control.Alternative (class Alternative)
import Control.Plus (class Plus, empty)

import Data.Eq (class Eq1, eq1)
import Data.Foldable (class Foldable, foldl, foldMap, foldr)
import Data.FoldableWithIndex (class FoldableWithIndex, foldMapWithIndex, foldlWithIndex, foldrWithIndex)
import Data.Functor.App (hoistLiftApp)
import Data.FunctorWithIndex (class FunctorWithIndex, mapWithIndex)
import Data.Newtype (class Newtype)
import Data.Ord (class Ord1, compare1)
import Data.Traversable (class Traversable, traverse)
import Data.TraversableWithIndex (class TraversableWithIndex, traverseWithIndex)
import Data.Tuple (Tuple, curry)

-- | `Compose f g` is the composition of the two functors `f` and `g`.
newtype Compose f g a = Compose (f (g a))
Expand Down Expand Up @@ -45,6 +48,9 @@ instance showCompose :: Show (f (g a)) => Show (Compose f g a) where
instance functorCompose :: (Functor f, Functor g) => Functor (Compose f g) where
map f (Compose fga) = Compose $ map f <$> fga

instance functorWithIndexCompose :: (FunctorWithIndex a f, FunctorWithIndex b g) => FunctorWithIndex (Tuple a b) (Compose f g) where
mapWithIndex f (Compose fga) = Compose $ mapWithIndex (mapWithIndex <<< curry f) fga

instance applyCompose :: (Apply f, Apply g) => Apply (Compose f g) where
apply (Compose f) (Compose x) = Compose $ apply <$> f <*> x

Expand All @@ -56,10 +62,18 @@ instance foldableCompose :: (Foldable f, Foldable g) => Foldable (Compose f g) w
foldl f i (Compose fga) = foldl (foldl f) i fga
foldMap f (Compose fga) = foldMap (foldMap f) fga

instance foldableWithIndexCompose :: (FoldableWithIndex a f, FoldableWithIndex b g) => FoldableWithIndex (Tuple a b) (Compose f g) where
foldrWithIndex f i (Compose fga) = foldrWithIndex (\a -> flip (foldrWithIndex (curry f a))) i fga
foldlWithIndex f i (Compose fga) = foldlWithIndex (foldlWithIndex <<< curry f) i fga
foldMapWithIndex f (Compose fga) = foldMapWithIndex (foldMapWithIndex <<< curry f) fga

instance traversableCompose :: (Traversable f, Traversable g) => Traversable (Compose f g) where
traverse f (Compose fga) = map Compose $ traverse (traverse f) fga
sequence = traverse identity

instance traversableWithIndexCompose :: (TraversableWithIndex a f, TraversableWithIndex b g) => TraversableWithIndex (Tuple a b) (Compose f g) where
traverseWithIndex f (Compose fga) = map Compose $ traverseWithIndex (traverseWithIndex <<< curry f) fga

instance altCompose :: (Alt f, Functor g) => Alt (Compose f g) where
alt (Compose a) (Compose b) = Compose $ alt a b

Expand Down
19 changes: 17 additions & 2 deletions src/Data/Functor/Coproduct.purs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -2,16 +2,18 @@ module Data.Functor.Coproduct where

import Prelude

import Control.Extend (class Extend, extend)
import Control.Comonad (class Comonad, extract)

import Control.Extend (class Extend, extend)
import Data.Bifunctor (bimap)
import Data.Either (Either(..))
import Data.Eq (class Eq1, eq1)
import Data.Foldable (class Foldable, foldMap, foldl, foldr)
import Data.FoldableWithIndex (class FoldableWithIndex, foldMapWithIndex, foldlWithIndex, foldrWithIndex)
import Data.FunctorWithIndex (class FunctorWithIndex, mapWithIndex)
import Data.Newtype (class Newtype)
import Data.Ord (class Ord1, compare1)
import Data.Traversable (class Traversable, traverse, sequence)
import Data.TraversableWithIndex (class TraversableWithIndex, traverseWithIndex)

-- | `Coproduct f g` is the coproduct of two functors `f` and `g`
newtype Coproduct f g a = Coproduct (Either (f a) (g a))
Expand Down Expand Up @@ -69,6 +71,9 @@ instance showCoproduct :: (Show (f a), Show (g a)) => Show (Coproduct f g a) whe
instance functorCoproduct :: (Functor f, Functor g) => Functor (Coproduct f g) where
map f (Coproduct e) = Coproduct (bimap (map f) (map f) e)

instance functorWithIndexCoproduct :: (FunctorWithIndex a f, FunctorWithIndex b g) => FunctorWithIndex (Either a b) (Coproduct f g) where
mapWithIndex f (Coproduct e) = Coproduct (bimap (mapWithIndex (f <<< Left)) (mapWithIndex (f <<< Right)) e)

instance extendCoproduct :: (Extend f, Extend g) => Extend (Coproduct f g) where
extend f = Coproduct <<< coproduct
(Left <<< extend (f <<< Coproduct <<< Left))
Expand All @@ -82,10 +87,20 @@ instance foldableCoproduct :: (Foldable f, Foldable g) => Foldable (Coproduct f
foldl f z = coproduct (foldl f z) (foldl f z)
foldMap f = coproduct (foldMap f) (foldMap f)

instance foldableWithIndexCoproduct :: (FoldableWithIndex a f, FoldableWithIndex b g) => FoldableWithIndex (Either a b) (Coproduct f g) where
foldrWithIndex f z = coproduct (foldrWithIndex (f <<< Left) z) (foldrWithIndex (f <<< Right) z)
foldlWithIndex f z = coproduct (foldlWithIndex (f <<< Left) z) (foldlWithIndex (f <<< Right) z)
foldMapWithIndex f = coproduct (foldMapWithIndex (f <<< Left)) (foldMapWithIndex (f <<< Right))

instance traversableCoproduct :: (Traversable f, Traversable g) => Traversable (Coproduct f g) where
traverse f = coproduct
(map (Coproduct <<< Left) <<< traverse f)
(map (Coproduct <<< Right) <<< traverse f)
sequence = coproduct
(map (Coproduct <<< Left) <<< sequence)
(map (Coproduct <<< Right) <<< sequence)

instance traversableWithIndexCoproduct :: (TraversableWithIndex a f, TraversableWithIndex b g) => TraversableWithIndex (Either a b) (Coproduct f g) where
traverseWithIndex f = coproduct
(map (Coproduct <<< Left) <<< traverseWithIndex (f <<< Left))
(map (Coproduct <<< Right) <<< traverseWithIndex (f <<< Right))
16 changes: 15 additions & 1 deletion src/Data/Functor/Product.purs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -3,13 +3,16 @@ module Data.Functor.Product where
import Prelude

import Control.Apply (lift2)

import Data.Bifunctor (bimap)
import Data.Either (Either(..))
import Data.Eq (class Eq1, eq1)
import Data.Foldable (class Foldable, foldr, foldl, foldMap)
import Data.FoldableWithIndex (class FoldableWithIndex, foldMapWithIndex, foldlWithIndex, foldrWithIndex)
import Data.FunctorWithIndex (class FunctorWithIndex, mapWithIndex)
import Data.Newtype (class Newtype, unwrap)
import Data.Ord (class Ord1, compare1)
import Data.Traversable (class Traversable, traverse, sequence)
import Data.TraversableWithIndex (class TraversableWithIndex, traverseWithIndex)
import Data.Tuple (Tuple(..), fst, snd)

-- | `Product f g` is the product of the two functors `f` and `g`.
Expand Down Expand Up @@ -59,6 +62,17 @@ instance traversableProduct :: (Traversable f, Traversable g) => Traversable (Pr
traverse f (Product (Tuple fa ga)) = lift2 product (traverse f fa) (traverse f ga)
sequence (Product (Tuple fa ga)) = lift2 product (sequence fa) (sequence ga)

instance functorWithIndexProduct :: (FunctorWithIndex a f, FunctorWithIndex b g) => FunctorWithIndex (Either a b) (Product f g) where
mapWithIndex f (Product fga) = Product (bimap (mapWithIndex (f <<< Left)) (mapWithIndex (f <<< Right)) fga)

instance foldableWithIndexProduct :: (FoldableWithIndex a f, FoldableWithIndex b g) => FoldableWithIndex (Either a b) (Product f g) where
foldrWithIndex f z (Product (Tuple fa ga)) = foldrWithIndex (f <<< Left) (foldrWithIndex (f <<< Right) z ga) fa
foldlWithIndex f z (Product (Tuple fa ga)) = foldlWithIndex (f <<< Right) (foldlWithIndex (f <<< Left) z fa) ga
foldMapWithIndex f (Product (Tuple fa ga)) = foldMapWithIndex (f <<< Left) fa <> foldMapWithIndex (f <<< Right) ga

instance traversableWithIndexProduct :: (TraversableWithIndex a f, TraversableWithIndex b g) => TraversableWithIndex (Either a b) (Product f g) where
traverseWithIndex f (Product (Tuple fa ga)) = lift2 product (traverseWithIndex (f <<< Left) fa) (traverseWithIndex (f <<< Right) ga)

instance applyProduct :: (Apply f, Apply g) => Apply (Product f g) where
apply (Product (Tuple f g)) (Product (Tuple a b)) = product (apply f a) (apply g b)

Expand Down