From b6dbc9554d5f837e02fcc145d88db98cba1bef14 Mon Sep 17 00:00:00 2001 From: Bodigrim Date: Sun, 26 Jun 2022 13:17:37 +0100 Subject: [PATCH] Share code between Show (Stream f m r) and Show1 (Stream f m) --- src/Streaming/Internal.hs | 25 ++++++++++++++----------- 1 file changed, 14 insertions(+), 11 deletions(-) diff --git a/src/Streaming/Internal.hs b/src/Streaming/Internal.hs index 64522ee..d62325c 100644 --- a/src/Streaming/Internal.hs +++ b/src/Streaming/Internal.hs @@ -194,21 +194,26 @@ instance (Monad m, Functor f, Ord1 m, Ord1 f) => Ord1 (Stream f m) where -- like producing @m String@, except that a @ShowSWrapper@ can be -- shown at any precedence. So the 'Show' instance for @m@ can show -- the contents at the correct precedence. -instance (Monad m, Show r, Show (m ShowSWrapper), Show (f (Stream f m r))) +instance (Monad m, Functor f, Show (m ShowSWrapper), Show (f ShowSWrapper), Show r) => Show (Stream f m r) where - showsPrec p xs = showParen (p > 10) $ - showString "Effect " . (showsPrec 11 $ - flip fmap (inspect xs) $ \front -> - SS $ \d -> showParen (d > 10) $ - case front of - Left r -> showString "Return " . showsPrec 11 r - Right f -> showString "Step " . showsPrec 11 f) + showsPrec = liftShowsPrec' showsPrec showList #if MIN_VERSION_base(4,9,0) instance (Monad m, Functor f, Show (m ShowSWrapper), Show (f ShowSWrapper)) => Show1 (Stream f m) where - liftShowsPrec sp sl p xs = showParen (p > 10) $ + liftShowsPrec = liftShowsPrec' + +#endif + +liftShowsPrec' + :: (Monad m, Functor f, Show (m ShowSWrapper), Show (f ShowSWrapper)) + => (Int -> a -> ShowS) + -> ([a] -> ShowS) + -> Int + -> Stream f m a + -> ShowS +liftShowsPrec' sp sl p xs = showParen (p > 10) $ showString "Effect " . (showsPrec 11 $ flip fmap (inspect xs) $ \front -> SS $ \d -> showParen (d > 10) $ @@ -217,8 +222,6 @@ instance (Monad m, Functor f, Show (m ShowSWrapper), Show (f ShowSWrapper)) Right f -> showString "Step " . showsPrec 11 (fmap (SS . (\str i -> liftShowsPrec sp sl i str)) f)) -#endif - newtype ShowSWrapper = SS (Int -> ShowS) instance Show ShowSWrapper where showsPrec p (SS s) = s p