diff --git a/docs/README.md b/docs/README.md index ecf1296..dc423a2 100644 --- a/docs/README.md +++ b/docs/README.md @@ -9,6 +9,13 @@ data ListT f a ``` +#### `ZipListT` + +``` purescript +newtype ZipListT f a +``` + + #### `nil` ``` purescript @@ -205,6 +212,13 @@ zipWith :: forall f a b c. (Monad f) => (a -> b -> c) -> ListT f a -> ListT f b ``` +#### `zipList` + +``` purescript +zipList :: forall f a. ListT f a -> ZipListT f a +``` + + #### `semigroupListT` ``` purescript @@ -212,6 +226,13 @@ instance semigroupListT :: (Applicative f) => Semigroup (ListT f a) ``` +#### `semigroupZipListT` + +``` purescript +instance semigroupZipListT :: (Applicative f) => Semigroup (ZipListT f a) +``` + + #### `monoidListT` ``` purescript @@ -219,6 +240,13 @@ instance monoidListT :: (Applicative f) => Monoid (ListT f a) ``` +#### `monoidZipListT` + +``` purescript +instance monoidZipListT :: (Applicative f) => Monoid (ZipListT f a) +``` + + #### `functorListT` ``` purescript @@ -226,6 +254,13 @@ instance functorListT :: (Functor f) => Functor (ListT f) ``` +#### `functorZipListT` + +``` purescript +instance functorZipListT :: (Functor f) => Functor (ZipListT f) +``` + + #### `unfoldableListT` ``` purescript @@ -240,6 +275,13 @@ instance applyListT :: (Monad f) => Apply (ListT f) ``` +#### `applyZipListT` + +``` purescript +instance applyZipListT :: (Monad f) => Apply (ZipListT f) +``` + + #### `applicativeListT` ``` purescript @@ -247,6 +289,13 @@ instance applicativeListT :: (Monad f) => Applicative (ListT f) ``` +#### `applicativeZipListT` + +``` purescript +instance applicativeZipListT :: (Monad f) => Applicative (ZipListT f) +``` + + #### `bindListT` ``` purescript @@ -275,6 +324,13 @@ instance altListT :: (Applicative f) => Alt (ListT f) ``` +#### `altZipListT` + +``` purescript +instance altZipListT :: (Applicative f) => Alt (ZipListT f) +``` + + #### `plusListT` ``` purescript @@ -282,6 +338,13 @@ instance plusListT :: (Monad f) => Plus (ListT f) ``` +#### `plusZipListT` + +``` purescript +instance plusZipListT :: (Monad f) => Plus (ZipListT f) +``` + + #### `alternativeListT` ``` purescript @@ -289,6 +352,13 @@ instance alternativeListT :: (Monad f) => Alternative (ListT f) ``` +#### `alternativeZipListT` + +``` purescript +instance alternativeZipListT :: (Monad f) => Alternative (ZipListT f) +``` + + #### `monadPlusListT` ``` purescript diff --git a/src/Control/Monad/ListT.purs b/src/Control/Monad/ListT.purs index 919c421..abe66aa 100644 --- a/src/Control/Monad/ListT.purs +++ b/src/Control/Monad/ListT.purs @@ -1,5 +1,6 @@ module Control.Monad.ListT ( ListT() + , ZipListT() , catMaybes , cons' , drop @@ -28,6 +29,7 @@ module Control.Monad.ListT , wrapLazy , zipWith , zipWith' + , zipList ) where import Data.Lazy @@ -45,7 +47,9 @@ module Control.Monad.ListT import Control.Monad.Trans data ListT f a = ListT (f (Step a (ListT f a))) - + + newtype ZipListT f a = ZipListT (ListT f a) + data Step a s = Yield a (Lazy s) | Skip (Lazy s) | @@ -195,33 +199,51 @@ module Control.Monad.ListT zipWith f = zipWith' g where g a b = pure $ f a b + zipList :: forall f a. ListT f a -> ZipListT f a + zipList = ZipListT + instance semigroupListT :: (Applicative f) => Semigroup (ListT f a) where (<>) = concat + instance semigroupZipListT :: (Applicative f) => Semigroup (ZipListT f a) where + (<>) (ZipListT a) (ZipListT b) = ZipListT $ a <> b + instance monoidListT :: (Applicative f) => Monoid (ListT f a) where mempty = nil + instance monoidZipListT :: (Applicative f) => Monoid (ZipListT f a) where + mempty = ZipListT mempty + instance functorListT :: (Functor f) => Functor (ListT f) where (<$>) f = stepMap g where g (Yield a s) = Yield (f a) ((<$>) f <$> s) g (Skip s) = Skip ((<$>) f <$> s) g Done = Done + instance functorZipListT :: (Functor f) => Functor (ZipListT f) where + (<$>) f (ZipListT a) = ZipListT $ f <$> a + instance unfoldableListT :: (Monad f) => Unfoldable (ListT f) where -- unfoldr :: forall a b. (b -> Maybe (Tuple a b)) -> b -> ListT f a unfoldr f b = go (f b) where go Nothing = nil go (Just (Tuple a b)) = cons' (pure a) (defer \_ -> (go (f b))) - instance applyListT :: (Monad f) => Apply (ListT f) where + instance applyListT :: (Monad f) => Apply (ListT f) where (<*>) f x = do f' <- f x' <- x - return (f x) + return (f' x') + + instance applyZipListT :: (Monad f) => Apply (ZipListT f) where + (<*>) (ZipListT a) (ZipListT b) = ZipListT $ zipWith g a b where g f x = f x instance applicativeListT :: (Monad f) => Applicative (ListT f) where pure = singleton + instance applicativeZipListT :: (Monad f) => Applicative (ZipListT f) where + pure = ZipListT <<< pure + instance bindListT :: (Monad f) => Bind (ListT f) where (>>=) fa f = stepMap g fa where g (Yield a s) = Skip (h <$> s) where h s = f a `concat` (s >>= f) -- FIXME compiler bug with overlapping instances? @@ -236,9 +258,17 @@ module Control.Monad.ListT instance altListT :: (Applicative f) => Alt (ListT f) where (<|>) = concat + instance altZipListT :: (Applicative f) => Alt (ZipListT f) where + (<|>) (ZipListT a) (ZipListT b) = ZipListT $ a <|> b + instance plusListT :: (Monad f) => Plus (ListT f) where empty = nil + instance plusZipListT :: (Monad f) => Plus (ZipListT f) where + empty = ZipListT empty + instance alternativeListT :: (Monad f) => Alternative (ListT f) + instance alternativeZipListT :: (Monad f) => Alternative (ZipListT f) + instance monadPlusListT :: (Monad f) => MonadPlus (ListT f)