@@ -89,6 +89,20 @@ instance MFunctor SourceT where
89 hoist f (SourceT m) = SourceT $ \k -> k $
89 hoist f (SourceT m) = SourceT $ \k -> k $
90 Effect $ f $ fmap (hoist f) $ m return
90 Effect $ f $ fmap (hoist f) $ m return
92+-- | >>> source "xy" <> source "z" :: SourceT Identity Char
93+-- fromStepT (Effect (Identity (Yield 'x' (Yield 'y' (Yield 'z' Stop)))))
95+instance Functor m => Semigroup (SourceT m a) where
96+ SourceT withL <> SourceT withR = SourceT $ \ret ->
101+-- | >>> mempty :: SourceT Maybe Int
102+-- fromStepT (Effect (Just Stop))
103+instance Functor m => Monoid (SourceT m a) where
104+ mempty = fromStepT mempty
92-- | Doesn't generate 'Error' constructors. 'SourceT' doesn't shrink.
106-- | Doesn't generate 'Error' constructors. 'SourceT' doesn't shrink.
93instance (QC.Arbitrary a, Monad m) => QC.Arbitrary (SourceT m a) where
107instance (QC.Arbitrary a, Monad m) => QC.Arbitrary (SourceT m a) where
94 arbitrary = fromStepT <$> QC.arbitrary
108 arbitrary = fromStepT <$> QC.arbitrary
@@ -150,6 +164,22 @@ instance MFunctor StepT where
150 go (Yield x s) = Yield x (go s)
164 go (Yield x s) = Yield x (go s)
151 go (Effect ms) = Effect (f (fmap go ms))
165 go (Effect ms) = Effect (f (fmap go ms))
167+instance Functor m => Semigroup (StepT m a) where
169+ Error err <> _ = Error err
170+ Skip s <> r = Skip (s <> r)
171+ Yield x s <> r = Yield x (s <> r)
172+ Effect ms <> r = Effect ((<> r) <$> ms)
174+-- | >>> mempty :: StepT [] Int
177+-- >>> mempty :: StepT Identity Int
180+instance Functor m => Monoid (StepT m a) where
153-- | Doesn't generate 'Error' constructors.
183-- | Doesn't generate 'Error' constructors.
154instance (QC.Arbitrary a, Monad m) => QC.Arbitrary (StepT m a) where
184instance (QC.Arbitrary a, Monad m) => QC.Arbitrary (StepT m a) where
155 arbitrary = QC.sized arb where
185 arbitrary = QC.sized arb where