git.iko.soy/typeable/servant
on master help sign in
added Semigroup and Monoid instances for SourceT
commit8e2be01ba9f2c26d09af8c76036a91fa8b2379e1 authorScience! <cporesky@gmail.com> dateTue 26 Mar 2019, 13:27 (8 years ago) parentae94e0e
1 file changed+30
servant/src/Servant/Types/SourceT.hs+30
servant/src/Servant/Types/SourceT.hs+30
@@ -89,6 +89,20 @@ instance MFunctor SourceT where
8989 hoist f (SourceT m) = SourceT $ \k -> k $
9090 Effect $ f $ fmap (hoist f) $ m return
9191
92+-- | >>> source "xy" <> source "z" :: SourceT Identity Char
93+-- fromStepT (Effect (Identity (Yield 'x' (Yield 'y' (Yield 'z' Stop)))))
94+--
95+instance Functor m => Semigroup (SourceT m a) where
96+ SourceT withL <> SourceT withR = SourceT $ \ret ->
97+ withL $ \l ->
98+ withR $ \r ->
99+ ret $ l <> r
100+
101+-- | >>> mempty :: SourceT Maybe Int
102+-- fromStepT (Effect (Just Stop))
103+instance Functor m => Monoid (SourceT m a) where
104+ mempty = fromStepT mempty
105+
92106-- | Doesn't generate 'Error' constructors. 'SourceT' doesn't shrink.
93107instance (QC.Arbitrary a, Monad m) => QC.Arbitrary (SourceT m a) where
94108 arbitrary = fromStepT <$> QC.arbitrary
@@ -150,6 +164,22 @@ instance MFunctor StepT where
150164 go (Yield x s) = Yield x (go s)
151165 go (Effect ms) = Effect (f (fmap go ms))
152166
167+instance Functor m => Semigroup (StepT m a) where
168+ Stop <> r = r
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)
173+
174+-- | >>> mempty :: StepT [] Int
175+-- Stop
176+--
177+-- >>> mempty :: StepT Identity Int
178+-- Stop
179+--
180+instance Functor m => Monoid (StepT m a) where
181+ mempty = Stop
182+
153183-- | Doesn't generate 'Error' constructors.
154184instance (QC.Arbitrary a, Monad m) => QC.Arbitrary (StepT m a) where
155185 arbitrary = QC.sized arb where