smallcheck-1.2.2: Test/SmallCheck/Series.hs
-- vim:fdm=marker:foldtext=foldtext()
--------------------------------------------------------------------
-- |
-- Module : Test.SmallCheck.Series
-- Copyright : (c) Colin Runciman et al.
-- License : BSD3
-- Maintainer: Roman Cheplyaka <roma@ro-che.info>
--
-- You need this module if you want to generate test values of your own
-- types.
--
-- You'll typically need the following extensions:
--
-- >{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
--
-- SmallCheck itself defines data generators for all the data types used
-- by the "Prelude".
--
-- In order to generate values and functions of your own types, you need
-- to make them instances of 'Serial' (for values) and 'CoSerial' (for
-- functions). There are two main ways to do so: using Generics or writing
-- the instances by hand.
--------------------------------------------------------------------
{-# LANGUAGE CPP #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeOperators #-}
module Test.SmallCheck.Series (
-- {{{
-- * Generic instances
-- | The easiest way to create the necessary instances is to use GHC
-- generics (available starting with GHC 7.2.1).
--
-- Here's a complete example:
--
-- >{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
-- >{-# LANGUAGE DeriveGeneric #-}
-- >
-- >import Test.SmallCheck.Series
-- >import GHC.Generics
-- >
-- >data Tree a = Null | Fork (Tree a) a (Tree a)
-- > deriving Generic
-- >
-- >instance Serial m a => Serial m (Tree a)
--
-- Here we enable the @DeriveGeneric@ extension which allows to derive 'Generic'
-- instance for our data type. Then we declare that @Tree@ @a@ is an instance of
-- 'Serial', but do not provide any definitions. This causes GHC to use the
-- default definitions that use the 'Generic' instance.
--
-- One minor limitation of generic instances is that there's currently no
-- way to distinguish newtypes and datatypes. Thus, newtype constructors
-- will also count as one level of depth.
-- * Data Generators
-- | Writing 'Serial' instances for application-specific types is
-- straightforward. You need to define a 'series' generator, typically using
-- @consN@ family of generic combinators where N is constructor arity.
--
-- For example:
--
-- >data Tree a = Null | Fork (Tree a) a (Tree a)
-- >
-- >instance Serial m a => Serial m (Tree a) where
-- > series = cons0 Null \/ cons3 Fork
--
-- For newtypes use 'newtypeCons' instead of 'cons1'.
-- The difference is that 'cons1' is counts as one level of depth, while
-- 'newtypeCons' doesn't affect the depth.
--
-- >newtype Light a = Light a
-- >
-- >instance Serial m a => Serial m (Light a) where
-- > series = newtypeCons Light
--
-- For data types with more than 6 fields define @consN@ as
--
-- >consN f = decDepth $
-- > f <$> series
-- > <~> series
-- > <~> series
-- > <~> ... {- series repeated N times in total -}
-- ** What does @consN@ do, exactly?
-- | @consN@ has type
-- @(Serial t₁, ..., Serial tₙ) => (t₁ -> ... -> tₙ -> t) -> Series t@.
--
-- @consN@ @f@ is a series which, for a given depth \(d > 0\), produces values of the
-- form
--
-- >f x₁ ... xₙ
--
-- where @xₖ@ ranges over all values of type @tₖ@ of depth up to \(d-1\)
-- (as defined by the 'series' functions for @tₖ@).
--
-- @consN@ functions also ensure that xₖ are enumerated in the
-- breadth-first order. Thus, combinations of smaller depth come first
-- (assuming the same is true for @tₖ@).
--
-- If \(d \le 0\), no values are produced.
cons0, cons1, cons2, cons3, cons4, cons5, cons6, newtypeCons,
-- * Function Generators
-- | To generate functions of an application-specific argument type,
-- make the type an instance of 'CoSerial'.
--
-- Again there is a standard pattern, this time using the @altsN@
-- combinators where again N is constructor arity. Here are @Tree@ and
-- @Light@ instances:
--
--
-- >instance CoSerial m a => CoSerial m (Tree a) where
-- > coseries rs =
-- > alts0 rs >>- \z ->
-- > alts3 rs >>- \f ->
-- > return $ \t ->
-- > case t of
-- > Null -> z
-- > Fork t1 x t2 -> f t1 x t2
--
-- >instance CoSerial m a => CoSerial m (Light a) where
-- > coseries rs =
-- > newtypeAlts rs >>- \f ->
-- > return $ \l ->
-- > case l of
-- > Light x -> f x
--
-- For data types with more than 6 fields define @altsN@ as
--
-- >altsN rs = do
-- > rs <- fixDepth rs
-- > decDepthChecked
-- > (constM $ constM $ ... $ constM rs)
-- > (coseries $ coseries $ ... $ coseries rs)
-- > {- constM and coseries are repeated N times each -}
-- ** What does altsN do, exactly?
-- | @altsN@ has type
-- @(Serial t₁, ..., Serial tₙ) => Series t -> Series (t₁ -> ... -> tₙ -> t)@.
--
-- @altsN@ @s@ is a series which, for a given depth \( d \), produces functions of
-- type
--
-- >t₁ -> ... -> tₙ -> t
--
-- If \( d \le 0 \), these are constant functions, one for each value produced
-- by @s@.
--
-- If \( d > 0 \), these functions inspect each of their arguments up to the depth
-- \( d-1 \) (as defined by the 'coseries' functions for the corresponding
-- types) and return values produced by @s@. The depth to which the
-- values are enumerated does not depend on the depth of inspection.
alts0, alts1, alts2, alts3, alts4, alts5, alts6, newtypeAlts,
-- * Basic definitions
Depth, Series, Serial(..), CoSerial(..),
-- * Generic implementations
genericSeries,
genericCoseries,
-- * Convenient wrappers
Positive(..), NonNegative(..), NonZero(..), NonEmpty(..),
-- * Other useful definitions
(\/), (><), (<~>), (>>-),
localDepth,
decDepth,
getDepth,
generate,
limit,
listSeries,
list,
listM,
fixDepth,
decDepthChecked,
constM
-- }}}
) where
import Control.Applicative (empty, pure, (<$>), (<|>), ZipList(ZipList))
import Control.Monad (Monad, liftM, guard, mzero, mplus, msum, return, (>>), (>>=))
import Control.Monad.Identity (Identity(Identity), runIdentity)
import Control.Monad.Logic (MonadLogic, (>>-), interleave, msplit, observeAllT)
import Control.Monad.Reader (ask, local)
import Data.Bool (Bool (True, False), (&&), (||))
import Data.Char (Char)
import Data.Complex (Complex((:+)))
import Data.Either (Either (Left, Right), either)
import Data.Eq (Eq, (==), (/=))
import Data.Foldable (Foldable)
import Data.Function (($), (.), const)
import Data.Functor (Functor, fmap)
import Data.Functor.Compose (Compose(Compose), getCompose)
import Data.Int (Int, Int8, Int16, Int32, Int64)
import Data.List (intercalate, take, map, length, (++), maximum, sum, unlines, lines, concat)
import qualified Data.List.NonEmpty as NE
import Data.Maybe (Maybe (Just, Nothing), maybe)
import qualified Data.Monoid as Monoid
import Data.Ord (Ord, Ordering (LT, EQ, GT), max, (<), (>), (>=), compare, (<=), Down(Down))
import Data.Ratio (Ratio, numerator, denominator, (%))
import qualified Data.Semigroup as Semigroup
import Data.Traversable (Traversable)
import Data.Tuple (uncurry)
import Data.Void (Void, absurd)
import Data.Word (Word, Word8, Word16, Word32, Word64)
import Numeric.Natural (Natural)
import Prelude (Integer, Real, toRational, Enum, toEnum, fromEnum, Num, (+), (*), Integral, quotRem, toInteger, negate, abs, signum, fromInteger, Bounded, minBound, maxBound, Float, Double, (-), odd, encodeFloat, decodeFloat, realToFrac, seq, subtract)
import Test.SmallCheck.SeriesMonad
import Text.Show (Show, showsPrec, show)
import Foreign.C.Types (CFloat(CFloat), CDouble(CDouble), CChar(CChar), CSChar(CSChar), CUChar(CUChar), CShort(CShort), CUShort(CUShort), CInt(CInt), CUInt(CUInt), CLong(CLong), CULong(CULong), CPtrdiff(CPtrdiff), CSize(CSize), CWchar(CWchar), CSigAtomic(CSigAtomic), CLLong(CLLong), CULLong(CULLong), CIntPtr(CIntPtr), CUIntPtr(CUIntPtr), CIntMax(CIntMax), CUIntMax(CUIntMax), CClock(CClock), CTime(CTime), CUSeconds(CUSeconds), CSUSeconds(CSUSeconds), CBool(CBool))
import GHC.Generics (Generic, (:+:)(L1, R1), (:*:)((:*:)), C1, K1(K1), unK1, M1(M1), unM1, U1(U1), V1, Rep, to, from)
#if MIN_VERSION_base(4,18,0)
import Data.Tuple (Solo(MkSolo))
#endif
------------------------------
-- Main types and classes
------------------------------
--{{{
-- | @since 1.0
class Monad m => Serial m a where
series :: Series m a
default series :: (Generic a, GSerial m (Rep a)) => Series m a
series = genericSeries
-- | @since 1.1.5
genericSeries
:: (Monad m, Generic a, GSerial m (Rep a))
=> Series m a
genericSeries = to <$> gSeries
-- | @since 1.0
class Monad m => CoSerial m a where
-- | A proper 'coseries' implementation should pass the depth unchanged to
-- its first argument. Doing otherwise will make enumeration of curried
-- functions non-uniform in their arguments.
coseries :: Series m b -> Series m (a->b)
default coseries :: (Generic a, GCoSerial m (Rep a)) => Series m b -> Series m (a->b)
coseries = genericCoseries
-- | @since 1.1.5
genericCoseries
:: (Monad m, Generic a, GCoSerial m (Rep a))
=> Series m b -> Series m (a->b)
genericCoseries rs = (. from) <$> gCoseries rs
-- }}}
------------------------------
-- Helper functions
------------------------------
-- {{{
-- | A simple series specified by a function from depth to the list of
-- values up to that depth.
--
-- @since 1.0
generate :: (Depth -> [a]) -> Series m a
generate f = do
d <- getDepth
msum $ map return $ f d
-- | Limit a 'Series' to its first @n@ elements.
--
-- @since 1.1.5
limit :: forall m a . Monad m => Int -> Series m a -> Series m a
limit n0 (Series s) = Series $ go n0 s
where
go 0 _ = empty
go n mb1 = do
cons :: Maybe (b, ml b) <- msplit mb1
case cons of
Nothing -> empty
Just (b, mb2) -> return b <|> go (n-1) mb2
suchThat :: Series m a -> (a -> Bool) -> Series m a
suchThat s p = s >>= \x -> if p x then pure x else empty
-- | Given a depth, return the list of values generated by a 'Serial' instance.
--
-- For example, list all integers up to depth 1:
--
-- * @listSeries 1 :: [Int] -- returns [0,1,-1]@
--
-- @since 1.1.2
listSeries :: Serial Identity a => Depth -> [a]
listSeries d = list d series
-- | Return the list of values generated by a 'Series'. Useful for
-- debugging 'Serial' instances.
--
-- Examples:
--
-- * @'list' 3 'series' :: ['Int'] -- returns [0,1,-1,2,-2,3,-3]@
--
-- * @'list' 3 ('series' :: 'Series' 'Data.Functor.Identity' 'Int') -- returns [0,1,-1,2,-2,3,-3]@
--
-- * @'list' 2 'series' :: [['Bool']] -- returns [[],['True'],['False']]@
--
-- The first two are equivalent. The second has a more explicit type binding.
--
-- @since 1.0
list :: Depth -> Series Identity a -> [a]
list d s = runIdentity $ observeAllT $ runSeries d s
-- | Monadic version of 'list'.
--
-- @since 1.1
listM d s = observeAllT $ runSeries d s
-- | Sum (union) of series.
--
-- @since 1.0
infixr 7 \/
(\/) :: Monad m => Series m a -> Series m a -> Series m a
(\/) = interleave
-- | Product of series
--
-- @since 1.0
infixr 8 ><
(><) :: Monad m => Series m a -> Series m b -> Series m (a,b)
a >< b = (,) <$> a <~> b
-- | Fair version of 'Control.Applicative.ap' and 'Control.Applicative.<*>'.
--
-- @since 1.0
infixl 4 <~>
(<~>) :: Monad m => Series m (a -> b) -> Series m a -> Series m b
a <~> b = a >>- (<$> b)
uncurry3 :: (a->b->c->d) -> ((a,b,c)->d)
uncurry3 f (x,y,z) = f x y z
uncurry4 :: (a->b->c->d->e) -> ((a,b,c,d)->e)
uncurry4 f (w,x,y,z) = f w x y z
uncurry5 :: (a->b->c->d->e->f) -> ((a,b,c,d,e)->f)
uncurry5 f (v,w,x,y,z) = f v w x y z
uncurry6 :: (a->b->c->d->e->f->g) -> ((a,b,c,d,e,f)->g)
uncurry6 f (u,v,w,x,y,z) = f u v w x y z
-- | Query the current depth.
--
-- @since 1.0
getDepth :: Series m Depth
getDepth = Series ask
-- | Run a series with a modified depth.
--
-- @since 1.0
localDepth :: (Depth -> Depth) -> Series m a -> Series m a
localDepth f (Series a) = Series $ local f a
-- | Run a 'Series' with the depth decreased by 1.
--
-- If the current depth is less or equal to 0, the result is 'empty'.
--
-- @since 1.0
decDepth :: Series m a -> Series m a
decDepth a = do
checkDepth
localDepth (subtract 1) a
checkDepth :: Series m ()
checkDepth = do
d <- getDepth
guard $ d > 0
-- | @'constM' = 'liftM' 'const'@
--
-- @since 1.1.1
constM :: Monad m => m b -> m (a -> b)
constM = fmap const
-- | Fix the depth of a series at the current level. The resulting series
-- will no longer depend on the \"ambient\" depth.
--
-- @since 1.1.1
fixDepth :: Series m a -> Series m (Series m a)
fixDepth s = getDepth >>= \d -> return $ localDepth (const d) s
-- | If the current depth is 0, evaluate the first argument. Otherwise,
-- evaluate the second argument with decremented depth.
--
-- @since 1.1.1
decDepthChecked :: Series m a -> Series m a -> Series m a
decDepthChecked b r = do
d <- getDepth
if d <= 0
then b
else decDepth r
unwind :: MonadLogic m => m a -> m [a]
unwind a =
msplit a >>=
maybe (return []) (\(x,a') -> (x:) <$> unwind a')
-- }}}
------------------------------
-- cons* and alts* functions
------------------------------
-- {{{
-- | @since 1.0
cons0 :: a -> Series m a
cons0 x = decDepth $ pure x
-- | @since 1.0
cons1 :: Serial m a => (a->b) -> Series m b
cons1 f = decDepth $ f <$> series
-- | Same as 'cons1', but preserves the depth.
--
-- @since 1.0
newtypeCons :: Serial m a => (a->b) -> Series m b
newtypeCons f = f <$> series
-- | @since 1.0
cons2 :: (Serial m a, Serial m b) => (a->b->c) -> Series m c
cons2 f = decDepth $ f <$> series <~> series
-- | @since 1.0
cons3 :: (Serial m a, Serial m b, Serial m c) =>
(a->b->c->d) -> Series m d
cons3 f = decDepth $
f <$> series
<~> series
<~> series
-- | @since 1.0
cons4 :: (Serial m a, Serial m b, Serial m c, Serial m d) =>
(a->b->c->d->e) -> Series m e
cons4 f = decDepth $
f <$> series
<~> series
<~> series
<~> series
-- | @since 1.2.0
cons5 :: (Serial m a, Serial m b, Serial m c, Serial m d, Serial m e) =>
(a->b->c->d->e->f) -> Series m f
cons5 f = decDepth $
f <$> series
<~> series
<~> series
<~> series
<~> series
-- | @since 1.2.0
cons6 :: (Serial m a, Serial m b, Serial m c, Serial m d, Serial m e, Serial m f) =>
(a->b->c->d->e->f->g) -> Series m g
cons6 f = decDepth $
f <$> series
<~> series
<~> series
<~> series
<~> series
<~> series
-- | @since 1.0
alts0 :: Series m a -> Series m a
alts0 s = s
-- | @since 1.0
alts1 :: CoSerial m a => Series m b -> Series m (a->b)
alts1 rs = do
rs <- fixDepth rs
decDepthChecked (constM rs) (coseries rs)
-- | @since 1.0
alts2
:: (CoSerial m a, CoSerial m b)
=> Series m c -> Series m (a->b->c)
alts2 rs = do
rs <- fixDepth rs
decDepthChecked
(constM $ constM rs)
(coseries $ coseries rs)
-- | @since 1.0
alts3 :: (CoSerial m a, CoSerial m b, CoSerial m c) =>
Series m d -> Series m (a->b->c->d)
alts3 rs = do
rs <- fixDepth rs
decDepthChecked
(constM $ constM $ constM rs)
(coseries $ coseries $ coseries rs)
-- | @since 1.0
alts4 :: (CoSerial m a, CoSerial m b, CoSerial m c, CoSerial m d) =>
Series m e -> Series m (a->b->c->d->e)
alts4 rs = do
rs <- fixDepth rs
decDepthChecked
(constM $ constM $ constM $ constM rs)
(coseries $ coseries $ coseries $ coseries rs)
-- | @since 1.2.0
alts5 :: (CoSerial m a, CoSerial m b, CoSerial m c, CoSerial m d, CoSerial m e) =>
Series m f -> Series m (a->b->c->d->e->f)
alts5 rs = do
rs <- fixDepth rs
decDepthChecked
(constM $ constM $ constM $ constM $ constM rs)
(coseries $ coseries $ coseries $ coseries $ coseries rs)
-- | @since 1.2.0
alts6 :: (CoSerial m a, CoSerial m b, CoSerial m c, CoSerial m d, CoSerial m e, CoSerial m f) =>
Series m g -> Series m (a->b->c->d->e->f->g)
alts6 rs = do
rs <- fixDepth rs
decDepthChecked
(constM $ constM $ constM $ constM $ constM $ constM rs)
(coseries $ coseries $ coseries $ coseries $ coseries $ coseries rs)
-- | Same as 'alts1', but preserves the depth.
--
-- @since 1.0
newtypeAlts :: CoSerial m a => Series m b -> Series m (a->b)
newtypeAlts = coseries
-- }}}
------------------------------
-- Generic instances
------------------------------
-- {{{
class GSerial m f where
gSeries :: Series m (f a)
class GCoSerial m f where
gCoseries :: Series m b -> Series m (f a -> b)
instance {-# OVERLAPPABLE #-} GSerial m f => GSerial m (M1 i c f) where
gSeries = M1 <$> gSeries
{-# INLINE gSeries #-}
instance GCoSerial m f => GCoSerial m (M1 i c f) where
gCoseries rs = (. unM1) <$> gCoseries rs
{-# INLINE gCoseries #-}
instance Serial m c => GSerial m (K1 i c) where
gSeries = K1 <$> series
{-# INLINE gSeries #-}
instance CoSerial m c => GCoSerial m (K1 i c) where
gCoseries rs = (. unK1) <$> coseries rs
{-# INLINE gCoseries #-}
instance GSerial m U1 where
gSeries = pure U1
{-# INLINE gSeries #-}
instance GCoSerial m U1 where
gCoseries = constM
{-# INLINE gCoseries #-}
instance GSerial m V1 where
gSeries = mzero
{-# INLINE gSeries #-}
instance GCoSerial m V1 where
gCoseries = const $ return (\a -> a `seq` let x = x in x)
{-# INLINE gCoseries #-}
instance (Monad m, GSerial m a, GSerial m b) => GSerial m (a :*: b) where
gSeries = (:*:) <$> gSeries <~> gSeries
{-# INLINE gSeries #-}
instance (Monad m, GCoSerial m a, GCoSerial m b) => GCoSerial m (a :*: b) where
gCoseries rs = uncur <$> gCoseries (gCoseries rs)
where
uncur f (x :*: y) = f x y
{-# INLINE gCoseries #-}
instance (Monad m, GSerial m a, GSerial m b) => GSerial m (a :+: b) where
gSeries = (L1 <$> gSeries) `interleave` (R1 <$> gSeries)
{-# INLINE gSeries #-}
instance (Monad m, GCoSerial m a, GCoSerial m b) => GCoSerial m (a :+: b) where
gCoseries rs =
gCoseries rs >>- \f ->
gCoseries rs >>- \g ->
return $
\case
L1 x -> f x
R1 y -> g y
{-# INLINE gCoseries #-}
instance {-# OVERLAPPING #-} GSerial m f => GSerial m (C1 c f) where
gSeries = M1 <$> decDepth gSeries
{-# INLINE gSeries #-}
-- }}}
------------------------------
-- Instances for basic types
------------------------------
-- {{{
instance Monad m => Serial m () where
series = return ()
instance Monad m => CoSerial m () where
coseries = constM
instance Monad m => Serial m Integer where series = unM <$> series
instance Monad m => CoSerial m Integer where coseries = fmap (. M) . coseries
-- | @since 1.1.3
instance Monad m => Serial m Natural where series = unN <$> series
-- | @since 1.1.3
instance Monad m => CoSerial m Natural where coseries = fmap (. N) . coseries
instance Monad m => Serial m Int where series = unM <$> series
instance Monad m => CoSerial m Int where coseries = fmap (. M) . coseries
-- | @since 1.1.3
instance Monad m => Serial m Word where series = unN <$> series
-- | @since 1.1.3
instance Monad m => CoSerial m Word where coseries = fmap (. N) . coseries
-- | @since 1.1.4
instance Monad m => Serial m Int8 where series = unM <$> series
-- | @since 1.1.4
instance Monad m => CoSerial m Int8 where coseries = fmap (. M) . coseries
-- | @since 1.1.4
instance Monad m => Serial m Word8 where series = unN <$> series
-- | @since 1.1.4
instance Monad m => CoSerial m Word8 where coseries = fmap (. N) . coseries
-- | @since 1.1.4
instance Monad m => Serial m Int16 where series = unM <$> series
-- | @since 1.1.4
instance Monad m => CoSerial m Int16 where coseries = fmap (. M) . coseries
-- | @since 1.1.4
instance Monad m => Serial m Word16 where series = unN <$> series
-- | @since 1.1.4
instance Monad m => CoSerial m Word16 where coseries = fmap (. N) . coseries
-- | @since 1.1.4
instance Monad m => Serial m Int32 where series = unM <$> series
-- | @since 1.1.4
instance Monad m => CoSerial m Int32 where coseries = fmap (. M) . coseries
-- | @since 1.1.4
instance Monad m => Serial m Word32 where series = unN <$> series
-- | @since 1.1.4
instance Monad m => CoSerial m Word32 where coseries = fmap (. N) . coseries
-- | @since 1.1.4
instance Monad m => Serial m Int64 where series = unM <$> series
-- | @since 1.1.4
instance Monad m => CoSerial m Int64 where coseries = fmap (. M) . coseries
-- | @since 1.1.4
instance Monad m => Serial m Word64 where series = unN <$> series
-- | @since 1.1.4
instance Monad m => CoSerial m Word64 where coseries = fmap (. N) . coseries
-- | 'N' is a wrapper for 'Integral' types that causes only non-negative values
-- to be generated. Generated functions of type @N a -> b@ do not distinguish
-- different negative values of @a@.
newtype N a = N { unN :: a } deriving (Eq, Ord, Show)
instance Real a => Real (N a) where
toRational (N x) = toRational x
instance Enum a => Enum (N a) where
toEnum x = N (toEnum x)
fromEnum (N x) = fromEnum x
instance Num a => Num (N a) where
N x + N y = N (x + y)
N x * N y = N (x * y)
negate (N x) = N (negate x)
abs (N x) = N (abs x)
signum (N x) = N (signum x)
fromInteger x = N (fromInteger x)
instance Integral a => Integral (N a) where
quotRem (N x) (N y) = (N q, N r)
where
(q, r) = x `quotRem` y
toInteger (N x) = toInteger x
instance (Num a, Enum a, Serial m a) => Serial m (N a) where
series = generate $ \d -> take (d+1) [0..]
instance (Integral a, Monad m) => CoSerial m (N a) where
coseries rs =
-- This is a recursive function, because @alts1 rs@ typically calls
-- back to 'coseries' (but with lower depth).
--
-- The recursion stops when depth == 0. Then alts1 produces a constant
-- function, and doesn't call back to 'coseries'.
alts0 rs >>- \z ->
alts1 rs >>- \f ->
return $ \(N i) ->
if i > 0
then f (N $ i-1)
else z
-- | 'M' is a helper type to generate values of a signed type of increasing magnitude.
newtype M a = M { unM :: a } deriving (Eq, Ord, Show)
instance Real a => Real (M a) where
toRational (M x) = toRational x
instance Enum a => Enum (M a) where
toEnum x = M (toEnum x)
fromEnum (M x) = fromEnum x
instance Num a => Num (M a) where
M x + M y = M (x + y)
M x * M y = M (x * y)
negate (M x) = M (negate x)
abs (M x) = M (abs x)
signum (M x) = M (signum x)
fromInteger x = M (fromInteger x)
instance Integral a => Integral (M a) where
quotRem (M x) (M y) = (M q, M r)
where
(q, r) = x `quotRem` y
toInteger (M x) = toInteger x
instance (Num a, Enum a, Monad m) => Serial m (M a) where
series = others `interleave` positives
where positives = generate $ \d -> take d [1..]
others = generate $ \d -> take (d+1) [0,-1..]
instance (Ord a, Num a, Monad m) => CoSerial m (M a) where
coseries rs =
alts0 rs >>- \z ->
alts1 rs >>- \f ->
alts1 rs >>- \g ->
pure $ \ i -> case compare i 0 of
GT -> f (M (i - 1))
LT -> g (M (abs i - 1))
EQ -> z
instance Monad m => Serial m Float where
series =
series >>- \(sig, exp) ->
guard (odd sig || sig==0 && exp==0) >>
return (encodeFloat sig exp)
instance Monad m => CoSerial m Float where
coseries rs =
coseries rs >>- \f ->
return $ f . decodeFloat
instance Monad m => Serial m Double where
series = (realToFrac :: Float -> Double) <$> series
instance Monad m => CoSerial m Double where
coseries rs =
(. (realToFrac :: Double -> Float)) <$> coseries rs
-- | @since 1.1
instance (Integral i, Serial m i) => Serial m (Ratio i) where
series = pairToRatio <$> series
where
pairToRatio (n, Positive d) = n % d
-- | @since 1.1
instance (Integral i, CoSerial m i) => CoSerial m (Ratio i) where
coseries rs = (. ratioToPair) <$> coseries rs
where
ratioToPair r = (numerator r, denominator r)
instance Monad m => Serial m Char where
series = generate $ \d -> take (d+1) ['a'..'z']
instance Monad m => CoSerial m Char where
coseries rs =
coseries rs >>- \f ->
return $ \c -> f (N (fromEnum c - fromEnum 'a'))
instance (Serial m a, Serial m b) => Serial m (a,b) where
series = cons2 (,)
instance (CoSerial m a, CoSerial m b) => CoSerial m (a,b) where
coseries rs = uncurry <$> alts2 rs
instance (Serial m a, Serial m b, Serial m c) => Serial m (a,b,c) where
series = cons3 (,,)
instance (CoSerial m a, CoSerial m b, CoSerial m c) => CoSerial m (a,b,c) where
coseries rs = uncurry3 <$> alts3 rs
instance (Serial m a, Serial m b, Serial m c, Serial m d) => Serial m (a,b,c,d) where
series = cons4 (,,,)
instance (CoSerial m a, CoSerial m b, CoSerial m c, CoSerial m d) => CoSerial m (a,b,c,d) where
coseries rs = uncurry4 <$> alts4 rs
-- | @since 1.2.0
instance (Serial m a, Serial m b, Serial m c, Serial m d, Serial m e) => Serial m (a,b,c,d,e) where
series = cons5 (,,,,)
-- | @since 1.2.0
instance (CoSerial m a, CoSerial m b, CoSerial m c, CoSerial m d, CoSerial m e) => CoSerial m (a,b,c,d,e) where
coseries rs = uncurry5 <$> alts5 rs
-- | @since 1.2.0
instance (Serial m a, Serial m b, Serial m c, Serial m d, Serial m e, Serial m f) => Serial m (a,b,c,d,e,f) where
series = cons6 (,,,,,)
-- | @since 1.2.0
instance (CoSerial m a, CoSerial m b, CoSerial m c, CoSerial m d, CoSerial m e, CoSerial m f) => CoSerial m (a,b,c,d,e,f) where
coseries rs = uncurry6 <$> alts6 rs
instance Monad m => Serial m Bool where
series = cons0 True \/ cons0 False
instance Monad m => CoSerial m Bool where
coseries rs =
rs >>- \r1 ->
rs >>- \r2 ->
return $ \x -> if x then r1 else r2
-- | @since 1.2.1
instance Monad m => Serial m Ordering where
series = cons0 LT \/ cons0 EQ \/ cons0 GT
-- | @since 1.2.1
instance Monad m => CoSerial m Ordering where
coseries rs =
rs >>- \r1 ->
rs >>- \r2 ->
rs >>- \r3 ->
pure $ \case
LT -> r1
EQ -> r2
GT -> r3
instance (Serial m a) => Serial m (Maybe a) where
series = cons0 Nothing \/ cons1 Just
instance (CoSerial m a) => CoSerial m (Maybe a) where
coseries rs =
maybe <$> alts0 rs <~> alts1 rs
instance (Serial m a, Serial m b) => Serial m (Either a b) where
series = cons1 Left \/ cons1 Right
instance (CoSerial m a, CoSerial m b) => CoSerial m (Either a b) where
coseries rs =
either <$> alts1 rs <~> alts1 rs
instance Serial m a => Serial m [a] where
series = cons0 [] \/ cons2 (:)
instance CoSerial m a => CoSerial m [a] where
coseries rs =
alts0 rs >>- \y ->
alts2 rs >>- \f ->
return $ \case [] -> y; x:xs' -> f x xs'
-- | @since 1.2.0
instance Serial m a => Serial m (NE.NonEmpty a) where
series = cons2 (NE.:|)
-- | @since 1.2.0
instance CoSerial m a => CoSerial m (NE.NonEmpty a) where
coseries rs =
alts2 rs >>- \f ->
return $ \(x NE.:| xs') -> f x xs'
-- | @since 1.2.0
instance Serial m a => Serial m (Complex a) where
series = cons2 (:+)
-- | @since 1.2.0
instance CoSerial m a => CoSerial m (Complex a) where
coseries rs =
alts2 rs >>- \f ->
return $ \(x :+ xs') -> f x xs'
-- | @since 1.2.0
instance Monad m => Serial m Void where
series = mzero
-- | @since 1.2.0
instance Monad m => CoSerial m Void where
coseries = const $ return absurd
instance (CoSerial m a, Serial m b) => Serial m (a->b) where
series = coseries series
-- Thanks to Ralf Hinze for the definition of coseries
-- using the nest auxiliary.
instance (Serial m a, CoSerial m a, Serial m b, CoSerial m b) => CoSerial m (a->b) where
coseries r = do
args <- unwind series
g <- nest r args
return $ \f -> g $ map f args
where
nest :: forall a b m c . (Serial m b, CoSerial m b) => Series m c -> [a] -> Series m ([b] -> c)
nest rs args = case args of
[] -> const <$> rs
_:rest -> do
let sf = coseries $ nest rs rest
f <- sf
return $ \(b:bs) -> f b bs
-- show the extension of a function (in part, bounded both by
-- the number and depth of arguments)
instance (Serial Identity a, Show a, Show b) => Show (a -> b) where
show f =
if maxarheight == 1
&& sumarwidth + length ars * length "->;" < widthLimit then
"{"++
intercalate ";" [a++"->"++r | (a,r) <- ars]
++"}"
else
concat $ [a++"->\n"++indent r | (a,r) <- ars]
where
ars = take lengthLimit [ (show x, show (f x))
| x <- list depthLimit series ]
maxarheight = maximum [ max (height a) (height r)
| (a,r) <- ars ]
sumarwidth = sum [ length a + length r
| (a,r) <- ars]
indent = unlines . map (" "++) . lines
height = length . lines
(widthLimit,lengthLimit,depthLimit) = (80,20,3)::(Int,Int,Depth)
-- | @since 1.2.0
instance (Monad m, Serial m (f (g a))) => Serial m (Compose f g a) where
series = Compose <$> series
-- | @since 1.2.0
instance (Monad m, CoSerial m (f (g a))) => CoSerial m (Compose f g a) where
coseries = fmap (. getCompose) . coseries
-- }}}
------------------------------
-- Convenient wrappers
------------------------------
-- {{{
--------------------------------------------------------------------------
-- | 'Positive' @x@ guarantees that \( x > 0 \).
--
-- @since 1.0
newtype Positive a = Positive { getPositive :: a }
deriving
( Eq
, Ord
, Functor -- ^ @since 1.2.0
, Foldable -- ^ @since 1.2.0
, Traversable -- ^ @since 1.2.0
)
instance Real a => Real (Positive a) where
toRational (Positive x) = toRational x
-- | @since 1.2.0
instance (Num a, Bounded a) => Bounded (Positive a) where
minBound = Positive 1
maxBound = Positive (maxBound :: a)
instance Enum a => Enum (Positive a) where
toEnum x = Positive (toEnum x)
fromEnum (Positive x) = fromEnum x
instance Num a => Num (Positive a) where
Positive x + Positive y = Positive (x + y)
Positive x * Positive y = Positive (x * y)
negate (Positive x) = Positive (negate x)
abs (Positive x) = Positive (abs x)
signum (Positive x) = Positive (signum x)
fromInteger x = Positive (fromInteger x)
instance Integral a => Integral (Positive a) where
quotRem (Positive x) (Positive y) = (Positive q, Positive r)
where
(q, r) = x `quotRem` y
toInteger (Positive x) = toInteger x
instance (Num a, Ord a, Serial m a) => Serial m (Positive a) where
series = Positive <$> series `suchThat` (> 0)
instance Show a => Show (Positive a) where
showsPrec n (Positive x) = showsPrec n x
-- | 'NonNegative' @x@ guarantees that \( x \ge 0 \).
--
-- @since 1.0
newtype NonNegative a = NonNegative { getNonNegative :: a }
deriving
( Eq
, Ord
, Functor -- ^ @since 1.2.0
, Foldable -- ^ @since 1.2.0
, Traversable -- ^ @since 1.2.0
)
instance Real a => Real (NonNegative a) where
toRational (NonNegative x) = toRational x
-- | @since 1.2.0
instance (Num a, Bounded a) => Bounded (NonNegative a) where
minBound = NonNegative 0
maxBound = NonNegative (maxBound :: a)
instance Enum a => Enum (NonNegative a) where
toEnum x = NonNegative (toEnum x)
fromEnum (NonNegative x) = fromEnum x
instance Num a => Num (NonNegative a) where
NonNegative x + NonNegative y = NonNegative (x + y)
NonNegative x * NonNegative y = NonNegative (x * y)
negate (NonNegative x) = NonNegative (negate x)
abs (NonNegative x) = NonNegative (abs x)
signum (NonNegative x) = NonNegative (signum x)
fromInteger x = NonNegative (fromInteger x)
instance Integral a => Integral (NonNegative a) where
quotRem (NonNegative x) (NonNegative y) = (NonNegative q, NonNegative r)
where
(q, r) = x `quotRem` y
toInteger (NonNegative x) = toInteger x
instance (Num a, Ord a, Serial m a) => Serial m (NonNegative a) where
series = NonNegative <$> series `suchThat` (>= 0)
instance Show a => Show (NonNegative a) where
showsPrec n (NonNegative x) = showsPrec n x
-- | 'NonZero' @x@ guarantees that \( x \ne 0 \).
--
-- @since 1.2.0
newtype NonZero a = NonZero { getNonZero :: a }
deriving (Eq, Ord, Functor, Foldable, Traversable)
instance Real a => Real (NonZero a) where
toRational (NonZero x) = toRational x
instance (Eq a, Num a, Bounded a) => Bounded (NonZero a) where
minBound = let x = minBound in NonZero (if x == 0 then 1 else x)
maxBound = let x = maxBound in NonZero (if x == 0 then -1 else x)
instance Enum a => Enum (NonZero a) where
toEnum x = NonZero (toEnum x)
fromEnum (NonZero x) = fromEnum x
instance Num a => Num (NonZero a) where
NonZero x + NonZero y = NonZero (x + y)
NonZero x * NonZero y = NonZero (x * y)
negate (NonZero x) = NonZero (negate x)
abs (NonZero x) = NonZero (abs x)
signum (NonZero x) = NonZero (signum x)
fromInteger x = NonZero (fromInteger x)
instance Integral a => Integral (NonZero a) where
quotRem (NonZero x) (NonZero y) = (NonZero q, NonZero r)
where
(q, r) = x `quotRem` y
toInteger (NonZero x) = toInteger x
instance (Num a, Ord a, Serial m a) => Serial m (NonZero a) where
series = NonZero <$> series `suchThat` (/= 0)
instance Show a => Show (NonZero a) where
showsPrec n (NonZero x) = showsPrec n x
-- | 'NonEmpty' @xs@ guarantees that @xs@ is not null.
--
-- @since 1.1
newtype NonEmpty a = NonEmpty { getNonEmpty :: [a] }
instance (Serial m a) => Serial m (NonEmpty a) where
series = NonEmpty <$> cons2 (:)
instance Show a => Show (NonEmpty a) where
showsPrec n (NonEmpty x) = showsPrec n x
-- }}}
------------------------------
-- Foreign.C.Types
------------------------------
-- {{{
-- | @since 1.2.0
instance Monad m => Serial m CFloat where
series = newtypeCons CFloat
-- | @since 1.2.0
instance Monad m => CoSerial m CFloat where
coseries rs = newtypeAlts rs >>- \f -> return $ \(CFloat x) -> f x
-- | @since 1.2.0
instance Monad m => Serial m CDouble where
series = newtypeCons CDouble
-- | @since 1.2.0
instance Monad m => CoSerial m CDouble where
coseries rs = newtypeAlts rs >>- \f -> return $ \(CDouble x) -> f x
-- | @since 1.2.0
instance Monad m => Serial m CBool where
series = newtypeCons CBool
-- | @since 1.2.0
instance Monad m => CoSerial m CBool where
coseries rs = newtypeAlts rs >>- \f -> return $ \(CBool x) -> f x
-- | @since 1.2.0
instance Monad m => Serial m CChar where
series = newtypeCons CChar
-- | @since 1.2.0
instance Monad m => CoSerial m CChar where
coseries rs = newtypeAlts rs >>- \f -> return $ \(CChar x) -> f x
-- | @since 1.2.0
instance Monad m => Serial m CSChar where
series = newtypeCons CSChar
-- | @since 1.2.0
instance Monad m => CoSerial m CSChar where
coseries rs = newtypeAlts rs >>- \f -> return $ \(CSChar x) -> f x
-- | @since 1.2.0
instance Monad m => Serial m CUChar where
series = newtypeCons CUChar
-- | @since 1.2.0
instance Monad m => CoSerial m CUChar where
coseries rs = newtypeAlts rs >>- \f -> return $ \(CUChar x) -> f x
-- | @since 1.2.0
instance Monad m => Serial m CShort where
series = newtypeCons CShort
-- | @since 1.2.0
instance Monad m => CoSerial m CShort where
coseries rs = newtypeAlts rs >>- \f -> return $ \(CShort x) -> f x
-- | @since 1.2.0
instance Monad m => Serial m CUShort where
series = newtypeCons CUShort
-- | @since 1.2.0
instance Monad m => CoSerial m CUShort where
coseries rs = newtypeAlts rs >>- \f -> return $ \(CUShort x) -> f x
-- | @since 1.2.0
instance Monad m => Serial m CInt where
series = newtypeCons CInt
-- | @since 1.2.0
instance Monad m => CoSerial m CInt where
coseries rs = newtypeAlts rs >>- \f -> return $ \(CInt x) -> f x
-- | @since 1.2.0
instance Monad m => Serial m CUInt where
series = newtypeCons CUInt
-- | @since 1.2.0
instance Monad m => CoSerial m CUInt where
coseries rs = newtypeAlts rs >>- \f -> return $ \(CUInt x) -> f x
-- | @since 1.2.0
instance Monad m => Serial m CLong where
series = newtypeCons CLong
-- | @since 1.2.0
instance Monad m => CoSerial m CLong where
coseries rs = newtypeAlts rs >>- \f -> return $ \(CLong x) -> f x
-- | @since 1.2.0
instance Monad m => Serial m CULong where
series = newtypeCons CULong
-- | @since 1.2.0
instance Monad m => CoSerial m CULong where
coseries rs = newtypeAlts rs >>- \f -> return $ \(CULong x) -> f x
-- | @since 1.2.0
instance Monad m => Serial m CPtrdiff where
series = newtypeCons CPtrdiff
-- | @since 1.2.0
instance Monad m => CoSerial m CPtrdiff where
coseries rs = newtypeAlts rs >>- \f -> return $ \(CPtrdiff x) -> f x
-- | @since 1.2.0
instance Monad m => Serial m CSize where
series = newtypeCons CSize
-- | @since 1.2.0
instance Monad m => CoSerial m CSize where
coseries rs = newtypeAlts rs >>- \f -> return $ \(CSize x) -> f x
-- | @since 1.2.0
instance Monad m => Serial m CWchar where
series = newtypeCons CWchar
-- | @since 1.2.0
instance Monad m => CoSerial m CWchar where
coseries rs = newtypeAlts rs >>- \f -> return $ \(CWchar x) -> f x
-- | @since 1.2.0
instance Monad m => Serial m CSigAtomic where
series = newtypeCons CSigAtomic
-- | @since 1.2.0
instance Monad m => CoSerial m CSigAtomic where
coseries rs = newtypeAlts rs >>- \f -> return $ \(CSigAtomic x) -> f x
-- | @since 1.2.0
instance Monad m => Serial m CLLong where
series = newtypeCons CLLong
-- | @since 1.2.0
instance Monad m => CoSerial m CLLong where
coseries rs = newtypeAlts rs >>- \f -> return $ \(CLLong x) -> f x
-- | @since 1.2.0
instance Monad m => Serial m CULLong where
series = newtypeCons CULLong
-- | @since 1.2.0
instance Monad m => CoSerial m CULLong where
coseries rs = newtypeAlts rs >>- \f -> return $ \(CULLong x) -> f x
-- | @since 1.2.0
instance Monad m => Serial m CIntPtr where
series = newtypeCons CIntPtr
-- | @since 1.2.0
instance Monad m => CoSerial m CIntPtr where
coseries rs = newtypeAlts rs >>- \f -> return $ \(CIntPtr x) -> f x
-- | @since 1.2.0
instance Monad m => Serial m CUIntPtr where
series = newtypeCons CUIntPtr
-- | @since 1.2.0
instance Monad m => CoSerial m CUIntPtr where
coseries rs = newtypeAlts rs >>- \f -> return $ \(CUIntPtr x) -> f x
-- | @since 1.2.0
instance Monad m => Serial m CIntMax where
series = newtypeCons CIntMax
-- | @since 1.2.0
instance Monad m => CoSerial m CIntMax where
coseries rs = newtypeAlts rs >>- \f -> return $ \(CIntMax x) -> f x
-- | @since 1.2.0
instance Monad m => Serial m CUIntMax where
series = newtypeCons CUIntMax
-- | @since 1.2.0
instance Monad m => CoSerial m CUIntMax where
coseries rs = newtypeAlts rs >>- \f -> return $ \(CUIntMax x) -> f x
-- | @since 1.2.0
instance Monad m => Serial m CClock where
series = newtypeCons CClock
-- | @since 1.2.0
instance Monad m => CoSerial m CClock where
coseries rs = newtypeAlts rs >>- \f -> return $ \(CClock x) -> f x
-- | @since 1.2.0
instance Monad m => Serial m CTime where
series = newtypeCons CTime
-- | @since 1.2.0
instance Monad m => CoSerial m CTime where
coseries rs = newtypeAlts rs >>- \f -> return $ \(CTime x) -> f x
-- | @since 1.2.0
instance Monad m => Serial m CUSeconds where
series = newtypeCons CUSeconds
-- | @since 1.2.0
instance Monad m => CoSerial m CUSeconds where
coseries rs = newtypeAlts rs >>- \f -> return $ \(CUSeconds x) -> f x
-- | @since 1.2.0
instance Monad m => Serial m CSUSeconds where
series = newtypeCons CSUSeconds
-- | @since 1.2.0
instance Monad m => CoSerial m CSUSeconds where
coseries rs = newtypeAlts rs >>- \f -> return $ \(CSUSeconds x) -> f x
-- }}}
------------------------------
-- Newtypes from base
------------------------------
-- {{{
-- | @since 1.2.2
instance (Monad m, Serial m a) => Serial m (Identity a) where
series = newtypeCons Identity
-- | @since 1.2.2
instance (Monad m, CoSerial m a) => CoSerial m (Identity a) where
coseries rs = newtypeAlts rs >>- \f -> return $ \(Identity x) -> f x
#if MIN_VERSION_base(4,18,0)
-- | @since 1.2.2
instance (Monad m, Serial m a) => Serial m (Solo a) where
series = newtypeCons MkSolo
-- | @since 1.2.2
instance (Monad m, CoSerial m a) => CoSerial m (Solo a) where
coseries rs = newtypeAlts rs >>- \f -> return $ \(MkSolo x) -> f x
#endif
-- | @since 1.2.2
instance (Monad m, Serial m a) => Serial m (ZipList a) where
series = newtypeCons ZipList
-- | @since 1.2.2
instance (Monad m, CoSerial m a) => CoSerial m (ZipList a) where
coseries rs = newtypeAlts rs >>- \f -> return $ \(ZipList x) -> f x
-- | @since 1.2.2
instance (Monad m, Serial m a) => Serial m (Down a) where
series = newtypeCons Down
-- | @since 1.2.2
instance (Monad m, CoSerial m a) => CoSerial m (Down a) where
coseries rs = newtypeAlts rs >>- \f -> return $ \(Down x) -> f x
-- | @since 1.2.2
instance (Monad m, Serial m a) => Serial m (Monoid.First a) where
series = newtypeCons Monoid.First
-- | @since 1.2.2
instance (Monad m, CoSerial m a) => CoSerial m (Monoid.First a) where
coseries rs = newtypeAlts rs >>- \f -> return $ \(Monoid.First x) -> f x
-- | @since 1.2.2
instance (Monad m, Serial m a) => Serial m (Monoid.Last a) where
series = newtypeCons Monoid.Last
-- | @since 1.2.2
instance (Monad m, CoSerial m a) => CoSerial m (Monoid.Last a) where
coseries rs = newtypeAlts rs >>- \f -> return $ \(Monoid.Last x) -> f x
-- | @since 1.2.2
instance (Monad m, Serial m a) => Serial m (Semigroup.First a) where
series = newtypeCons Semigroup.First
-- | @since 1.2.2
instance (Monad m, CoSerial m a) => CoSerial m (Semigroup.First a) where
coseries rs = newtypeAlts rs >>- \f -> return $ \(Semigroup.First x) -> f x
-- | @since 1.2.2
instance (Monad m, Serial m a) => Serial m (Semigroup.Last a) where
series = newtypeCons Semigroup.Last
-- | @since 1.2.2
instance (Monad m, CoSerial m a) => CoSerial m (Semigroup.Last a) where
coseries rs = newtypeAlts rs >>- \f -> return $ \(Semigroup.Last x) -> f x
-- | @since 1.2.2
instance Monad m => Serial m Semigroup.All where
series = newtypeCons Semigroup.All
-- | @since 1.2.2
instance Monad m => CoSerial m Semigroup.All where
coseries rs = newtypeAlts rs >>- \f -> return $ \(Semigroup.All x) -> f x
-- | @since 1.2.2
instance Monad m => Serial m Semigroup.Any where
series = newtypeCons Semigroup.Any
-- | @since 1.2.2
instance Monad m => CoSerial m Semigroup.Any where
coseries rs = newtypeAlts rs >>- \f -> return $ \(Semigroup.Any x) -> f x
-- | @since 1.2.2
instance (Monad m, Serial m a) => Serial m (Semigroup.Max a) where
series = newtypeCons Semigroup.Max
-- | @since 1.2.2
instance (Monad m, CoSerial m a) => CoSerial m (Semigroup.Max a) where
coseries rs = newtypeAlts rs >>- \f -> return $ \(Semigroup.Max x) -> f x
-- | @since 1.2.2
instance (Monad m, Serial m a) => Serial m (Semigroup.Min a) where
series = newtypeCons Semigroup.Min
-- | @since 1.2.2
instance (Monad m, CoSerial m a) => CoSerial m (Semigroup.Min a) where
coseries rs = newtypeAlts rs >>- \f -> return $ \(Semigroup.Min x) -> f x
-- | @since 1.2.2
instance (Monad m, Serial m a) => Serial m (Semigroup.Dual a) where
series = newtypeCons Semigroup.Dual
-- | @since 1.2.2
instance (Monad m, CoSerial m a) => CoSerial m (Semigroup.Dual a) where
coseries rs = newtypeAlts rs >>- \f -> return $ \(Semigroup.Dual x) -> f x
-- | @since 1.2.2
instance (Monad m, Serial m a) => Serial m (Semigroup.Product a) where
series = newtypeCons Semigroup.Product
-- | @since 1.2.2
instance (Monad m, CoSerial m a) => CoSerial m (Semigroup.Product a) where
coseries rs = newtypeAlts rs >>- \f -> return $ \(Semigroup.Product x) -> f x
-- | @since 1.2.2
instance (Monad m, Serial m a) => Serial m (Semigroup.Sum a) where
series = newtypeCons Semigroup.Sum
-- | @since 1.2.2
instance (Monad m, CoSerial m a) => CoSerial m (Semigroup.Sum a) where
coseries rs = newtypeAlts rs >>- \f -> return $ \(Semigroup.Sum x) -> f x
-- | @since 1.2.2
instance (Monad m, Serial m a) => Serial m (Semigroup.WrappedMonoid a) where
series = newtypeCons Semigroup.WrapMonoid
-- | @since 1.2.2
instance (Monad m, CoSerial m a) => CoSerial m (Semigroup.WrappedMonoid a) where
coseries rs = newtypeAlts rs >>- \f -> return $ \(Semigroup.WrapMonoid x) -> f x
-- }}}