diff --git a/README.md b/README.md index 748566a..d3ba714 100644 --- a/README.md +++ b/README.md @@ -1,5 +1,85 @@ # Module Documentation +## Module Control.Monad.ListT + +### Types + + data ListT f a where + ListT :: f (Step a (ListT f a)) -> ListT f a + + data Step a s + + +### Type Class Instances + + instance applicativeListT :: (Monad f) => Applicative (ListT f) + + instance applyListT :: (Monad f) => Apply (ListT f) + + instance bindListT :: (Monad f) => Bind (ListT f) + + instance functorListT :: (Functor f) => Functor (ListT f) + + instance monadListT :: (Monad f) => Monad (ListT f) + + instance monadTransListT :: MonadTrans ListT + + instance monoidListT :: (Applicative f) => Monoid (ListT f a) + + instance semigroupListT :: (Applicative f) => Semigroup (ListT f a) + + +### Values + + catMaybes :: forall f a. (Functor f) => ListT f (Maybe a) -> ListT f a + + cons' :: forall f a. (Applicative f) => Lazy a -> Lazy (ListT f a) -> ListT f a + + drop :: forall f a. (Applicative f) => Number -> ListT f a -> ListT f a + + dropWhile :: forall f a. (Applicative f) => (a -> Boolean) -> ListT f a -> ListT f a + + filter :: forall f a. (Functor f) => (a -> Boolean) -> ListT f a -> ListT f a + + foldl :: forall f a b. (Monad f) => (b -> a -> b) -> b -> ListT f a -> f b + + fromArray :: forall f a. (Monad f) => [a] -> ListT f a + + fromEffect :: forall f a. (Applicative f) => f a -> ListT f a + + head :: forall f a. (Monad f) => ListT f a -> f (Maybe a) + + mapMaybe :: forall f a b. (Functor f) => (a -> Maybe b) -> ListT f a -> ListT f b + + nil :: forall f a. (Applicative f) => ListT f a + + prepend :: forall f a. (Applicative f) => a -> ListT f a -> ListT f a + + prepend' :: forall f a. (Applicative f) => a -> Lazy (ListT f a) -> ListT f a + + scanl :: forall f a b. (Monad f) => (b -> a -> b) -> b -> ListT f a -> ListT f b + + singleton :: forall f a. (Applicative f) => a -> ListT f a + + tail :: forall f a. (Monad f) => ListT f a -> f (Maybe (ListT f a)) + + take :: forall f a. (Applicative f) => Number -> ListT f a -> ListT f a + + takeWhile :: forall f a. (Applicative f) => (a -> Boolean) -> ListT f a -> ListT f a + + uncons :: forall f a. (Monad f) => ListT f a -> f (Maybe (Tuple a (ListT f a))) + + unfold :: forall f a z. (Monad f) => (z -> f (Maybe (Tuple z a))) -> z -> ListT f a + + wrapEffect :: forall f a. (Monad f) => f (ListT f a) -> ListT f a + + wrapLazy :: forall f a. (Monad f) => Lazy (ListT f a) -> ListT f a + + zipWith :: forall f a b c. (Monad f) => (a -> b -> c) -> ListT f a -> ListT f b -> ListT f c + + zipWith' :: forall f a b c. (Monad f) => (a -> b -> f c) -> ListT f a -> ListT f b -> ListT f c + + ## Module Data.List ### Types diff --git a/bower.json b/bower.json index 369dd2f..5c34331 100644 --- a/bower.json +++ b/bower.json @@ -18,7 +18,11 @@ "purescript-arrays" : "*", "purescript-maybe" : "*", "purescript-foldable-traversable" : "*", - "purescript-unfoldable" : "*" + "purescript-unfoldable" : "*", + "purescript-transformers" : "*", + "purescript-lazy" : "*", + "purescript-monoid" : "*", + "purescript-tuples" : "*" }, "devDependencies": { "purescript-quickcheck" : "*" diff --git a/src/Control/Monad/ListT.purs b/src/Control/Monad/ListT.purs new file mode 100644 index 0000000..d169fa3 --- /dev/null +++ b/src/Control/Monad/ListT.purs @@ -0,0 +1,200 @@ +module Control.Monad.ListT + ( ListT(..) -- FIXME: compiler bug: error in exports (wrong kind) unless constructor is exported + , Step() -- FIXME: have to export this for the preceding export + , nil + , cons' + , prepend' + , prepend + , singleton + , fromEffect + , wrapEffect + , wrapLazy + , unfold + , fromArray + , take + , takeWhile + , drop + , dropWhile + , filter + , mapMaybe + , catMaybes + , uncons + , head + , tail + , foldl + , scanl + , zipWith' + , zipWith + ) where + + import Control.Monad + import Control.Monad.Trans + import Data.Lazy + import Data.Monoid + import Data.Maybe + import Data.Tuple + import qualified Data.Array as A + + data ListT f a = ListT (f (Step a (ListT f a))) + + data Step a s = + Yield a (Lazy s) | + Skip (Lazy s) | + Done + + runListT :: forall f a. ListT f a -> f (Step a (ListT f a)) + runListT (ListT fa) = fa + + nil :: forall f a. (Applicative f) => ListT f a + nil = ListT $ pure Done + + cons' :: forall f a. (Applicative f) => Lazy a -> Lazy (ListT f a) -> ListT f a + cons' lh t = ListT $ f <$> (pure unit) where + f _ = Yield (force lh) t + + prepend' :: forall f a. (Applicative f) => a -> Lazy (ListT f a) -> ListT f a + prepend' h t = ListT $ pure (Yield h t) + + prepend :: forall f a. (Applicative f) => a -> ListT f a -> ListT f a + prepend h t = prepend' h (defer $ const t) + + stepMap :: forall f a b. (Functor f) => (Step a (ListT f a) -> Step b (ListT f b)) -> ListT f a -> ListT f b + stepMap f l = ListT $ f <$> (runListT l) + + concat :: forall f a. (Applicative f) => ListT f a -> ListT f a -> ListT f a + concat x y = stepMap f x where + f (Yield a s) = Yield a (flip (<>) y <$> s) + f (Skip s) = Skip (flip (<>) y <$> s) + f Done = Skip (defer $ const y) + + instance semigroupListT :: (Applicative f) => Semigroup (ListT f a) where + (<>) = concat + + instance monoidListT :: (Applicative f) => Monoid (ListT f a) where + mempty = nil + + 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 applyListT :: (Monad f) => Apply (ListT f) where + (<*>) = zipWith g where g f x = f x + + instance applicativeListT :: (Monad f) => Applicative (ListT f) where + pure = singleton + + 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? + g (Skip s) = Skip (h <$> s) where h s = s >>= f + g Done = Done + + instance monadListT :: (Monad f) => Monad (ListT f) + + instance monadTransListT :: MonadTrans ListT where + lift = fromEffect + + singleton :: forall f a. (Applicative f) => a -> ListT f a + singleton a = prepend a nil + + fromEffect :: forall f a. (Applicative f) => f a -> ListT f a + fromEffect fa = ListT $ (flip Yield) (defer $ \_ -> nil) <$> fa + + wrapEffect :: forall f a. (Monad f) => f (ListT f a) -> ListT f a + wrapEffect v = ListT $ Skip <<< defer <<< const <$> v + + wrapLazy :: forall f a. (Monad f) => Lazy (ListT f a) -> ListT f a + wrapLazy v = ListT $ pure (Skip v) + + unfold :: forall f a z. (Monad f) => (z -> f (Maybe (Tuple z a))) -> z -> ListT f a + unfold f z = ListT $ g <$> f z where + g (Just (Tuple z a)) = Yield a (defer \_ -> (unfold f z)) + g Nothing = Done + + fromArray :: forall f a. (Monad f) => [a] -> ListT f a + fromArray xs = unfold f 0 where + f n = pure $ Tuple (n + 1) <$> (xs A.!! n) + + take :: forall f a. (Applicative f) => Number -> ListT f a -> ListT f a + take 0 fa = nil + take n fa = stepMap f fa where + f (Yield a s) = Yield a s' where s' = take (n - 1) <$> s + f (Skip s) = Skip s' where s' = take n <$> s + f Done = Done + + takeWhile :: forall f a. (Applicative f) => (a -> Boolean) -> ListT f a -> ListT f a + takeWhile f = stepMap g where + -- FIXME: type inferencer bug with if/then/else + g (Yield a s) = ifThenElse (f a) (Yield a (takeWhile f <$> s)) Done where ifThenElse p a b = if p then a else b + g (Skip s) = Skip $ takeWhile f <$> s + g Done = Done + + drop :: forall f a. (Applicative f) => Number -> ListT f a -> ListT f a + drop 0 fa = fa + drop n fa = stepMap f fa where + f (Yield a s) = Skip s' where s' = drop (n - 1) <$> s + f (Skip s) = Skip s' where s' = drop n <$> s + f Done = Done + + dropWhile :: forall f a. (Applicative f) => (a -> Boolean) -> ListT f a -> ListT f a + dropWhile f = stepMap g where + g (Yield a s) = if f a then Skip (dropWhile f <$> s) else Yield a s + g (Skip s) = Skip $ dropWhile f <$> s + g Done = Done + + filter :: forall f a. (Functor f) => (a -> Boolean) -> ListT f a -> ListT f a + filter f = stepMap g where + g (Yield a s) = if f a then Yield a s' else Skip s' where s' = filter f <$> s + g (Skip s) = Skip s' where s' = filter f <$> s + g Done = Done + + mapMaybe :: forall f a b. (Functor f) => (a -> Maybe b) -> ListT f a -> ListT f b + mapMaybe f = stepMap g where + g (Yield a s) = (fromMaybe Skip (Yield <$> (f a))) (mapMaybe f <$> s) + g (Skip s) = Skip $ mapMaybe f <$> s + g Done = Done + + catMaybes :: forall f a. (Functor f) => ListT f (Maybe a) -> ListT f a + catMaybes = mapMaybe id + + uncons :: forall f a. (Monad f) => ListT f a -> f (Maybe (Tuple a (ListT f a))) + uncons l = runListT l >>= g where + g (Yield a s) = pure $ Just $ Tuple a (force s) + g (Skip s) = uncons (force s) + g Done = pure Nothing + + head :: forall f a. (Monad f) => ListT f a -> f (Maybe a) + head l = ((<$>) fst) <$> uncons l + + tail :: forall f a. (Monad f) => ListT f a -> f (Maybe (ListT f a)) + tail l = ((<$>) snd) <$> uncons l + + foldl :: forall f a b. (Monad f) => (b -> a -> b) -> b -> ListT f a -> f b + foldl f = loop where + loop b l = uncons l >>= g where + g Nothing = pure b + g (Just (Tuple a as)) = loop (f b a) as + + scanl :: forall f a b. (Monad f) => (b -> a -> b) -> b -> ListT f a -> ListT f b + scanl f b l = unfold g (Tuple b l) where + g (Tuple b l) = h <$> runListT l where + h (Yield a s) = Just $ Tuple (Tuple b' (force s)) b' where b' = f b a + h (Skip s) = Just $ Tuple (Tuple b (force s)) b + h Done = Nothing + + zipWith' :: forall f a b c. (Monad f) => (a -> b -> f c) -> ListT f a -> ListT f b -> ListT f c + zipWith' f = loop where + loop fa fb = + wrapEffect $ do + ua <- uncons fa + ub <- uncons fb + g ua ub + where g _ Nothing = pure nil + g Nothing _ = pure nil + g (Just (Tuple ha ta)) (Just (Tuple hb tb)) = (flip prepend') (defer \_ -> zipWith' f ta tb) <$> (f ha hb) + + zipWith :: forall f a b c. (Monad f) => (a -> b -> c) -> ListT f a -> ListT f b -> ListT f c + zipWith f = zipWith' g where + g a b = pure $ f a b \ No newline at end of file