Verified Commit 95767a57 authored by Camil Staps's avatar Camil Staps 🙂

Move Semigroup,Monoid,Foldable,Traversable of tuples to Data.Tuple

parent 203fb604
......@@ -86,7 +86,6 @@ class Foldable t where
foldl1 :: (a a -> a) !(t a) -> a
instance Foldable (Either a)
instance Foldable ((,) a)
// TODO Cleanify
//instance Ix i => Foldable (Array i)
......
......@@ -36,27 +36,6 @@ instance Foldable (Either a) where
mf Nothing y = Just y
mf (Just x) y = Just (f x y)
instance Foldable ((,) a) where
foldMap f (_, y) = f y
fold x = foldMap id x
foldr f z (_, y) = f y z
foldr` f z0 xs = foldl f` id xs z0
where f` k x z = k (f x z)
foldl f z t = appEndo (getDual (foldMap (Dual o Endo o flip f) t)) z
foldl` f z0 xs = foldr f` id xs z0
where f` x k z = k (f z x)
foldr1 f xs = fromMaybe (abort "foldr1: empty structure")
(foldr mf Nothing xs)
where
mf x Nothing = Just x
mf x (Just y) = Just (f x y)
foldl1 f xs = fromMaybe (abort "foldl1: empty structure")
(foldl mf Nothing xs)
where
mf Nothing y = Just y
mf (Just x) y = Just (f x y)
// TODO Cleanify
//instance Ix i => Foldable (Array i) where
//foldr f z = Prelude.foldr f z o elems
......
......@@ -20,6 +20,7 @@ import StdClass
from StdBool import &&
from StdMisc import abort
import Data.Maybe
import Data.Tuple
from StdList import repeatn
import qualified StdList as SL
......
......@@ -19,16 +19,7 @@ where
mconcat xs :== 'StdList'.foldr mappend mempty xs
instance Semigroup ()
instance Semigroup (a, b) | Semigroup a & Semigroup b
instance Semigroup (a, b, c) | Semigroup a & Semigroup b & Semigroup c
instance Semigroup (a, b, c, d) | Semigroup a & Semigroup b & Semigroup c & Semigroup d
instance Semigroup (a, b, c, d, e) | Semigroup a & Semigroup b & Semigroup c & Semigroup d & Semigroup e
instance Monoid ()
instance Monoid (a, b) | Monoid a & Monoid b
instance Monoid (a, b, c) | Monoid a & Monoid b & Monoid c
instance Monoid (a, b, c, d) | Monoid a & Monoid b & Monoid c & Monoid d
instance Monoid (a, b, c, d, e) | Monoid a & Monoid b & Monoid c & Monoid d & Monoid e
:: Dual a = Dual a
......
......@@ -12,30 +12,6 @@ instance Semigroup () where
instance Monoid () where
mempty = ()
instance Semigroup (a, b) | Semigroup a & Semigroup b where
mappend (a1, b1) (a2, b2) = (mappend a1 a2, mappend b1 b2)
instance Monoid (a, b) | Monoid a & Monoid b where
mempty = (mempty, mempty)
instance Semigroup (a, b, c) | Semigroup a & Semigroup b & Semigroup c where
mappend (a1, b1, c1) (a2, b2, c2) = (mappend a1 a2, mappend b1 b2, mappend c1 c2)
instance Monoid (a, b, c) | Monoid a & Monoid b & Monoid c where
mempty = (mempty, mempty, mempty)
instance Semigroup (a, b, c, d) | Semigroup a & Semigroup b & Semigroup c & Semigroup d where
mappend (a1, b1, c1, d1) (a2, b2, c2, d2) = (mappend a1 a2, mappend b1 b2, mappend c1 c2, mappend d1 d2)
instance Monoid (a, b, c, d) | Monoid a & Monoid b & Monoid c & Monoid d where
mempty = (mempty, mempty, mempty, mempty)
instance Semigroup (a, b, c, d, e) | Semigroup a & Semigroup b & Semigroup c & Semigroup d & Semigroup e where
mappend (a1, b1, c1, d1, e1) (a2, b2, c2, d2, e2) = (mappend a1 a2, mappend b1 b2, mappend c1 c2, mappend d1 d2, mappend e1 e2)
instance Monoid (a, b, c, d, e) | Monoid a & Monoid b & Monoid c & Monoid d & Monoid e where
mempty = (mempty, mempty, mempty, mempty, mempty)
instance Semigroup (Dual a) | Semigroup a where
mappend (Dual x) (Dual y) = Dual (mappend y x)
......
......@@ -111,8 +111,6 @@ class Traversable t | Functor t & Foldable t where
instance Traversable (Either a)
instance Traversable ((,) 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
mapAccumL :: (b -> (*s -> *(c, *s))) (t b) *s -> *(t c, *s) | Traversable t
......
......@@ -25,12 +25,6 @@ instance Traversable (Either a) where
mapM f x = unwrapMonad (traverse (WrapMonad o f) x)
sequence x = mapM id x
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
// TODO Cleanify
//instance Ix i => Traversable (Array i) where
//traverse f arr = listArray (bounds arr) `fmap` traverse f (elems arr)
......
definition module Data.Tuple
from Data.Functor import class Functor
from Data.Monoid import class Semigroup, class Monoid
from Data.Foldable import class Foldable
from Data.Traversable import class Traversable
tuple :: a b -> (a,b)
tuple3 :: a b c -> (a,b,c)
......@@ -15,3 +18,16 @@ appThd3 :: (.c -> .d) !(.a,.b,.c) -> (.a,.b,.d)
swap :: !(a, b) -> (b, a)
instance Functor ((,) a)
instance Semigroup (a, b) | Semigroup a & Semigroup b
instance Semigroup (a, b, c) | Semigroup a & Semigroup b & Semigroup c
instance Semigroup (a, b, c, d) | Semigroup a & Semigroup b & Semigroup c & Semigroup d
instance Semigroup (a, b, c, d, e) | Semigroup a & Semigroup b & Semigroup c & Semigroup d & Semigroup e
instance Monoid (a, b) | Monoid a & Monoid b
instance Monoid (a, b, c) | Monoid a & Monoid b & Monoid c
instance Monoid (a, b, c, d) | Monoid a & Monoid b & Monoid c & Monoid d
instance Monoid (a, b, c, d, e) | Monoid a & Monoid b & Monoid c & Monoid d & Monoid e
instance Foldable ((,) a)
instance Traversable ((,) a)
implementation module Data.Tuple
from StdFunc import id, o
from StdMisc import abort
import Data.Functor
import Data.Maybe
import Data.Monoid
import Data.Foldable
import Data.Traversable
import Control.Applicative
tuple :: a b -> (a,b)
tuple a b = (a,b)
......@@ -29,3 +36,62 @@ swap (a,b) = (b,a)
instance Functor ((,) a)
where
fmap f (x, y) = (x, f y)
instance Semigroup (a, b) | Semigroup a & Semigroup b
where
mappend (a1, b1) (a2, b2) = (mappend a1 a2, mappend b1 b2)
instance Monoid (a, b) | Monoid a & Monoid b
where
mempty = (mempty, mempty)
instance Semigroup (a, b, c) | Semigroup a & Semigroup b & Semigroup c
where
mappend (a1, b1, c1) (a2, b2, c2) = (mappend a1 a2, mappend b1 b2, mappend c1 c2)
instance Monoid (a, b, c) | Monoid a & Monoid b & Monoid c
where
mempty = (mempty, mempty, mempty)
instance Semigroup (a, b, c, d) | Semigroup a & Semigroup b & Semigroup c & Semigroup d
where
mappend (a1, b1, c1, d1) (a2, b2, c2, d2) = (mappend a1 a2, mappend b1 b2, mappend c1 c2, mappend d1 d2)
instance Monoid (a, b, c, d) | Monoid a & Monoid b & Monoid c & Monoid d
where
mempty = (mempty, mempty, mempty, mempty)
instance Semigroup (a, b, c, d, e) | Semigroup a & Semigroup b & Semigroup c & Semigroup d & Semigroup e
where
mappend (a1, b1, c1, d1, e1) (a2, b2, c2, d2, e2) = (mappend a1 a2, mappend b1 b2, mappend c1 c2, mappend d1 d2, mappend e1 e2)
instance Monoid (a, b, c, d, e) | Monoid a & Monoid b & Monoid c & Monoid d & Monoid e
where
mempty = (mempty, mempty, mempty, mempty, mempty)
instance Foldable ((,) a)
where
foldMap f (_, y) = f y
fold x = foldMap id x
foldr f z (_, y) = f y z
foldr` f z0 xs = foldl f` id xs z0
where f` k x z = k (f x z)
foldl f z t = appEndo (getDual (foldMap (Dual o Endo o flip f) t)) z
foldl` f z0 xs = foldr f` id xs z0
where f` x k z = k (f z x)
foldr1 f xs = fromMaybe (abort "foldr1: empty structure") (foldr mf Nothing xs)
where
mf x Nothing = Just x
mf x (Just y) = Just (f x y)
foldl1 f xs = fromMaybe (abort "foldl1: empty structure") (foldl mf Nothing xs)
where
mf Nothing y = Just y
mf (Just x) y = Just (f x y)
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
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