Commit 1422b6a6 authored by Mart Lubbers's avatar Mart Lubbers

Make members of traversable and bifunctor default

Also add functor for larger tuples
parent fe5aea41
Pipeline #16895 passed with stage
in 2 minutes and 52 seconds
......@@ -4,4 +4,6 @@ class Bifunctor p
where
bifmap :: (a -> b) (c -> d) (p a c) -> p b d
first :: (a -> b) (p a c) -> p b c
first l a = bifmap l (\x->x) a
second :: (b -> c) (p a b) -> p a c
second r a = bifmap (\x->x) r a
......@@ -27,10 +27,6 @@ instance Foldable (Either a)
instance Traversable (Either a)
instance Bifunctor Either
where
bifmap :: (a -> c) (b -> d) !(Either a b) -> Either c d
first :: (a -> c) !(Either a b) -> Either c b
second :: (b -> d) !(Either a b) -> Either a d
instance Alternative (Either m) | Monoid m
......
......@@ -8,7 +8,7 @@ import Data.Functor
import Data.Maybe
import Data.Monoid
from Data.Foldable import class Foldable(foldMap,foldl,foldr)
from Data.Traversable import class Traversable(traverse,mapM)
from Data.Traversable import class Traversable(..)
import Data.Bifunctor
import Data.GenEq
......@@ -67,22 +67,12 @@ instance Traversable (Either a)
where
traverse _ (Left x) = pure (Left x)
traverse f (Right y) = Right <$> f y
sequenceA f = traverse id f
mapM f x = unwrapMonad (traverse (WrapMonad o f) x)
sequence x = mapM id x
instance Bifunctor Either
where
bifmap :: (a -> c) (b -> d) !(Either a b) -> Either c d
bifmap f _ (Left a) = Left (f a)
bifmap _ g (Right b) = Right (g b)
first :: (a -> c) !(Either a b) -> Either c b
first f d = bifmap f id d
second :: (b -> d) !(Either a b) -> Either a d
second g d = bifmap id g d
instance Alternative (Either m) | Monoid m
where
empty = Left mempty
......
......@@ -13,9 +13,9 @@ import Data.GenEq
import Data.Maybe
import Data.Monoid
from Data.Foldable import class Foldable(foldMap, foldl1, foldr1)
from Data.Traversable import class Traversable(traverse)
from Data.Traversable import class Traversable(..)
import Control.Applicative
import Control.Monad
from Control.Monad import class Monad(..)
instance Functor []
where
......@@ -79,11 +79,7 @@ where
instance Traversable []
where
traverse f x = foldr cons_f (pure []) x
where cons_f x ys = (\x xs -> [x:xs]) <$> f x <*> ys
mapM f x = mapM f x
sequenceA f = traverse id f
sequence x = mapM id x
traverse f x = foldr (\x ys->(\x xs->[x:xs]) <$> f x <*> ys) (pure []) x
(!?) infixl 9 :: ![.a] !Int -> Maybe .a
(!?) [x:_] 0 = Just x
......
......@@ -8,10 +8,11 @@ import Data.Functor
import Data.Monoid
import Data.Func
from Data.Foldable import class Foldable(..)
from Data.Traversable import class Traversable(traverse)
from Data.Traversable import class Traversable(..)
import qualified Data.Traversable
import Control.Applicative
import Control.Monad, Control.Monad.Trans
from Control.Monad import class Monad(..)
import Control.Monad.Trans
import Data.GenEq
instance Functor Maybe where fmap f m = mapMaybe f m
......@@ -88,9 +89,6 @@ instance Traversable Maybe
where
traverse _ Nothing = pure Nothing
traverse f (Just x) = Just <$> f x
sequenceA f = traverse id f
mapM f x = unwrapMonad (traverse (WrapMonad o f) x)
sequence x = 'Data.Traversable'.mapM id x
derive gEq Maybe
......@@ -150,4 +148,4 @@ instance Monad (MaybeT m) | Monad m where
instance MonadTrans MaybeT
where
liftT :: !(a b) -> MaybeT a b | Monad a
liftT m = MaybeT $ liftM Just m
liftT m = MaybeT $ Just <$> m
......@@ -92,21 +92,25 @@ from Data.Monoid import class Monoid, class Semigroup
// ('foldMapDefault').
//
class Traversable t | Functor t & Foldable t where
// Map each element of a structure to an action, evaluate
// these actions from left to right, and collect the results.
traverse :: (a -> f b) !(t a) -> f (t b) | Applicative f
// Map each element of a structure to an action, evaluate
// these actions from left to right, and collect the results.
traverse :: (a -> f b) !(t a) -> f (t b) | Applicative f
// Evaluate each action in the structure from left to right,
// and collect the results.
sequenceA :: !(t (f a)) -> f (t a) | Applicative f
// Evaluate each action in the structure from left to right,
// and collect the results.
sequenceA :: !(t (f a)) -> f (t a) | Applicative f
sequenceA a = traverse (\x.x) a
// Map each element of a structure to a monadic action, evaluate
// these actions from left to right, and collect the results.
mapM :: (a -> m b) !(t a) -> m (t b) | Monad m
// Map each element of a structure to a monadic action, evaluate
// these actions from left to right, and collect the results.
mapM :: (a -> m b) !(t a) -> m (t b) | Monad m
mapM f a = traverse f a
// Evaluate each monadic action in the structure from left to right,
// and collect the results.
sequence :: !(t (m a)) -> m (t a) | Monad m
// Evaluate each monadic action in the structure from left to right,
// and collect the results.
sequence :: !(t (m a)) -> m (t a) | Monad m
sequence a = sequenceA a
for :: !(t a) (a -> f b) -> f (t b) | Traversable t & Applicative f
forM :: !(t a) (a -> m b) -> m (t b) | Traversable t & Monad m
......
......@@ -19,6 +19,10 @@ appThd3 :: .(.c -> .d) !(.a,.b,.c) -> (.a,.b,.d)
swap :: !.(.a, .b) -> .(.b, .a)
instance Functor ((,) a)
instance Functor ((,,) a b)
instance Functor ((,,,) a b c)
instance Functor ((,,,,) a b c d)
instance Functor ((,,,,,) a b c d e)
instance Semigroup (a, b) | Semigroup a & Semigroup b
instance Semigroup (a, b, c) | Semigroup a & Semigroup b & Semigroup c
......
......@@ -38,6 +38,22 @@ instance Functor ((,) a)
where
fmap f (x, y) = (x, f y)
instance Functor ((,,) a b)
where
fmap f (x, y, z) = (x, y, f z)
instance Functor ((,,,) a b c)
where
fmap f (x, y, z, a) = (x, y, z, f a)
instance Functor ((,,,,) a b c d)
where
fmap f (x, y, z, a, b) = (x, y, z, a, f b)
instance Functor ((,,,,,) a b c d e)
where
fmap f (x, y, z, a, b, c) = (x, y, z, a, b, f c)
instance Semigroup (a, b) | Semigroup a & Semigroup b
where
mappend (a1, b1) (a2, b2) = (mappend a1 a2, mappend b1 b2)
......@@ -92,31 +108,20 @@ where
instance Traversable ((,) a)
where
traverse f (x, y) = (\x y -> (x, y)) x <$> f y
sequenceA f = traverse id f
mapM f x = unwrapMonad (traverse (WrapMonad o f) x)
sequence x = mapM id x
traverse f (x, y) = tuple x <$> f y
instance Bifunctor (,)
where
bifmap f g t = let (a, b) = t in (f a, g b)
first f d = bifmap f id d
second g d = bifmap id g d
instance Bifunctor ((,,) x)
where
bifmap f g t = let (x, a, b) = t in (x, f a, g b)
first f d = bifmap f id d
second g d = bifmap id g d
instance Bifunctor ((,,,) x y)
where
bifmap f g t = let (x, y, a, b) = t in (x, y, f a, g b)
first f d = bifmap f id d
second g d = bifmap id g d
instance Bifunctor ((,,,,) x y z)
where
bifmap f g t = let (x, y, z, a, b) = t in (x, y, z, f a, g b)
first f d = bifmap f id d
second g d = bifmap id g d
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment