Move Foldable, Traversable of Either to Data.Either

parent 95767a57
......@@ -8,6 +8,8 @@ definition module Data.Either
from Control.Applicative import class Applicative, class *>, class <*
from Control.Monad import class Monad
from Data.Functor import class Functor
from Data.Foldable import class Foldable
from Data.Traversable import class Traversable
:: Either a b = Left a | Right b
......@@ -22,4 +24,7 @@ instance <* (Either e)
instance Monad (Either e)
instance Foldable (Either a)
instance Traversable (Either a)
either :: (.a -> .c) (.b -> .c) !(Either .a .b) -> .c
implementation module Data.Either
from StdEnv import flip, id, o
from StdMisc import abort
import Control.Applicative
import Control.Monad
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)
import qualified Data.Traversable as T
instance Functor (Either a) where
fmap f (Left l) = Left l
......@@ -24,9 +31,40 @@ where
<* _ (Left l) = Left l
<* x _ = x
instance Monad (Either e) where
bind (Left l) _ = Left l
bind (Right r) k = k r
instance Monad (Either e)
where
bind (Left l) _ = Left l
bind (Right r) k = k r
instance Foldable (Either a)
where
foldMap _ (Left _) = mempty
foldMap f (Right y) = f y
fold x = foldMap id x
foldr _ z (Left _) = z
foldr f z (Right 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 (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 = 'T'.mapM id x
either :: (.a -> .c) (.b -> .c) !(Either .a .b) -> .c
either f _ (Left x) = f x
......
......@@ -2,7 +2,6 @@ definition module Data.Foldable
from Control.Applicative import class Applicative (..), :: Const, class Alternative (..), class *>
from Control.Monad import class Monad (..), >>=, class MonadPlus (..)
from Data.Either import :: Either
from Data.Functor import class Functor (..)
from Data.Monoid import class Monoid (..), class Semigroup (..)
from Data.Maybe import :: Maybe
......@@ -85,8 +84,6 @@ class Foldable t where
*/
foldl1 :: (a a -> a) !(t a) -> a
instance Foldable (Either a)
// TODO Cleanify
//instance Ix i => Foldable (Array i)
......
......@@ -5,7 +5,6 @@ from StdMisc import abort
import Control.Applicative
from Control.Monad import class Monad(..), >>=
from Data.List import instance Semigroup [a], instance Monoid [a], instance Foldable []
import Data.Either
import Data.Monoid
import Data.Maybe
import qualified StdList as SL
......@@ -13,29 +12,6 @@ import StdClass
from StdOverloaded import class < (..)
from StdBool import not
instance Foldable (Either a) where
foldMap _ (Left _) = mempty
foldMap f (Right y) = f y
fold x = foldMap id x
foldr _ z (Left _) = z
foldr f z (Right 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
......
......@@ -5,7 +5,6 @@ from Control.Monad import class Monad
from Data.Functor import class Functor
from Data.Foldable import class Foldable
from Data.Monoid import class Monoid, class Semigroup
from Data.Either import :: Either
// Functors representing data structures that can be traversed from left to
// right.
......@@ -109,8 +108,6 @@ class Traversable t | Functor t & Foldable t where
// and collect the results.
sequence :: !(t (m a)) -> m (t a) | Monad m
instance Traversable (Either 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
......
......@@ -4,27 +4,16 @@ implementation module Data.Traversable
* Ported from Haskell's Data.Traversable by Jurriën Stutterheim 15-08-2014
*/
import Control.Applicative
import Data.Either
//from Data.Foldable import class Foldable
import Data.Foldable
import Data.Functor
from Data.List import instance Functor []
from Data.Either import instance Functor (Either a)
from Control.Monad import class Monad
import qualified Control.Monad as CM
from Data.Monoid import class Monoid
import Data.Tuple
from StdFunc import o, id, flip
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
// TODO Cleanify
//instance Ix i => Traversable (Array i) where
//traverse f arr = listArray (bounds arr) `fmap` traverse f (elems arr)
......
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