-- 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                   #-}
#if __GLASGOW_HASKELL__ >= 702
{-# LANGUAGE DefaultSignatures     #-}
#endif
{-# LANGUAGE DeriveFoldable        #-}
{-# LANGUAGE DeriveFunctor         #-}
{-# LANGUAGE DeriveTraversable     #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoImplicitPrelude     #-}
{-# LANGUAGE RankNTypes            #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE TypeOperators         #-}

#if MIN_VERSION_base(4,8,0)
{-# LANGUAGE Safe                  #-}
#else
{-# LANGUAGE OverlappingInstances  #-}
#if __GLASGOW_HASKELL__ >= 704
{-# LANGUAGE Trustworthy           #-}
#endif
#endif

#define HASCBOOL MIN_VERSION_base(4,10,0)

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(..),

#if __GLASGOW_HASKELL__ >= 702
  -- * Generic implementations
  genericSeries,
  genericCoseries,
#endif

  -- * 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, (<$>), (<|>))
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 Data.Ord (Ord, Ordering (LT, EQ, GT), max, (<), (>), (>=), compare, (<=))
import Data.Ratio (Ratio, numerator, denominator, (%))
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)

#if MIN_VERSION_base(4,5,0)
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))
#endif

#if __GLASGOW_HASKELL__ >= 702
import GHC.Generics (Generic, (:+:)(L1, R1), (:*:)((:*:)), C1, K1(K1), unK1, M1(M1), unM1, U1(U1), V1, Rep, to, from)
#else
import Prelude (RealFloat)
#endif
#if HASCBOOL
import Foreign.C.Types (CBool(CBool))
#endif

------------------------------
-- Main types and classes
------------------------------
--{{{

-- | @since 1.0
class Monad m => Serial m a where
  series   :: Series m a

#if __GLASGOW_HASKELL__ >= 704
  default series :: (Generic a, GSerial m (Rep a)) => Series m a
  series = Series m a
forall (m :: * -> *) a.
(Monad m, Generic a, GSerial m (Rep a)) =>
Series m a
genericSeries
#endif

#if __GLASGOW_HASKELL__ >= 702
-- | @since 1.1.5
genericSeries
  :: (Monad m, Generic a, GSerial m (Rep a))
  => Series m a
genericSeries :: forall (m :: * -> *) a.
(Monad m, Generic a, GSerial m (Rep a)) =>
Series m a
genericSeries = Rep a Any -> a
forall a x. Generic a => Rep a x -> a
forall x. Rep a x -> a
to (Rep a Any -> a) -> Series m (Rep a Any) -> Series m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Series m (Rep a Any)
forall a. Series m (Rep a a)
forall (m :: * -> *) (f :: * -> *) a. GSerial m f => Series m (f a)
gSeries
#endif

-- | @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)

#if __GLASGOW_HASKELL__ >= 704
  default coseries :: (Generic a, GCoSerial m (Rep a)) => Series m b -> Series m (a->b)
  coseries = Series m b -> Series m (a -> b)
forall (m :: * -> *) a b.
(Monad m, Generic a, GCoSerial m (Rep a)) =>
Series m b -> Series m (a -> b)
genericCoseries
#endif

#if __GLASGOW_HASKELL__ >= 702
-- | @since 1.1.5
genericCoseries
  :: (Monad m, Generic a, GCoSerial m (Rep a))
  => Series m b -> Series m (a->b)
genericCoseries :: forall (m :: * -> *) a b.
(Monad m, Generic a, GCoSerial m (Rep a)) =>
Series m b -> Series m (a -> b)
genericCoseries Series m b
rs = ((Rep a Any -> b) -> (a -> Rep a Any) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Rep a Any
forall x. a -> Rep a x
forall a x. Generic a => a -> Rep a x
from) ((Rep a Any -> b) -> a -> b)
-> Series m (Rep a Any -> b) -> Series m (a -> b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Series m b -> Series m (Rep a Any -> b)
forall b a. Series m b -> Series m (Rep a a -> b)
forall (m :: * -> *) (f :: * -> *) b a.
GCoSerial m f =>
Series m b -> Series m (f a -> b)
gCoseries Series m b
rs
#endif

-- }}}

------------------------------
-- 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 :: forall a (m :: * -> *). (Depth -> [a]) -> Series m a
generate Depth -> [a]
f = do
  Depth
d <- Series m Depth
forall (m :: * -> *). Series m Depth
getDepth
  [Series m a] -> Series m a
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum ([Series m a] -> Series m a) -> [Series m a] -> Series m a
forall a b. (a -> b) -> a -> b
$ (a -> Series m a) -> [a] -> [Series m a]
forall a b. (a -> b) -> [a] -> [b]
map a -> Series m a
forall a. a -> Series m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([a] -> [Series m a]) -> [a] -> [Series m a]
forall a b. (a -> b) -> a -> b
$ Depth -> [a]
f Depth
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 :: forall (m :: * -> *) a.
Monad m =>
Depth -> Series m a -> Series m a
limit Depth
n0 (Series ReaderT Depth (LogicT m) a
s) = ReaderT Depth (LogicT m) a -> Series m a
forall (m :: * -> *) a. ReaderT Depth (LogicT m) a -> Series m a
Series (ReaderT Depth (LogicT m) a -> Series m a)
-> ReaderT Depth (LogicT m) a -> Series m a
forall a b. (a -> b) -> a -> b
$ Depth -> ReaderT Depth (LogicT m) a -> ReaderT Depth (LogicT m) a
forall {t} {ml :: * -> *} {b}.
(Eq t, Num t, MonadLogic ml) =>
t -> ml b -> ml b
go Depth
n0 ReaderT Depth (LogicT m) a
s
  where
    go :: t -> ml b -> ml b
go t
0 ml b
_ = ml b
forall a. ml a
forall (f :: * -> *) a. Alternative f => f a
empty
    go t
n ml b
mb1 = do
      Maybe (b, ml b)
cons :: Maybe (b, ml b) <- ml b -> ml (Maybe (b, ml b))
forall a. ml a -> ml (Maybe (a, ml a))
forall (m :: * -> *) a. MonadLogic m => m a -> m (Maybe (a, m a))
msplit ml b
mb1
      case Maybe (b, ml b)
cons of
        Maybe (b, ml b)
Nothing -> ml b
forall a. ml a
forall (f :: * -> *) a. Alternative f => f a
empty
        Just (b
b, ml b
mb2) -> b -> ml b
forall a. a -> ml a
forall (m :: * -> *) a. Monad m => a -> m a
return b
b ml b -> ml b -> ml b
forall a. ml a -> ml a -> ml a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> t -> ml b -> ml b
go (t
nt -> t -> t
forall a. Num a => a -> a -> a
-t
1) ml b
mb2

suchThat :: Series m a -> (a -> Bool) -> Series m a
suchThat :: forall (m :: * -> *) a. Series m a -> (a -> Bool) -> Series m a
suchThat Series m a
s a -> Bool
p = Series m a
s Series m a -> (a -> Series m a) -> Series m a
forall a b. Series m a -> (a -> Series m b) -> Series m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
x -> if a -> Bool
p a
x then a -> Series m a
forall a. a -> Series m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x else Series m a
forall a. Series m a
forall (f :: * -> *) a. Alternative f => f a
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 :: forall a. Serial Identity a => Depth -> [a]
listSeries Depth
d = Depth -> Series Identity a -> [a]
forall a. Depth -> Series Identity a -> [a]
list Depth
d Series Identity a
forall (m :: * -> *) a. Serial m a => Series m a
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 :: forall a. Depth -> Series Identity a -> [a]
list Depth
d Series Identity a
s = Identity [a] -> [a]
forall a. Identity a -> a
runIdentity (Identity [a] -> [a]) -> Identity [a] -> [a]
forall a b. (a -> b) -> a -> b
$ LogicT Identity a -> Identity [a]
forall (m :: * -> *) a. Applicative m => LogicT m a -> m [a]
observeAllT (LogicT Identity a -> Identity [a])
-> LogicT Identity a -> Identity [a]
forall a b. (a -> b) -> a -> b
$ Depth -> Series Identity a -> LogicT Identity a
forall (m :: * -> *) a. Depth -> Series m a -> LogicT m a
runSeries Depth
d Series Identity a
s

-- | Monadic version of 'list'.
--
-- @since 1.1
listM :: Depth -> Series m a -> m [a]
listM Depth
d Series m a
s = LogicT m a -> m [a]
forall (m :: * -> *) a. Applicative m => LogicT m a -> m [a]
observeAllT (LogicT m a -> m [a]) -> LogicT m a -> m [a]
forall a b. (a -> b) -> a -> b
$ Depth -> Series m a -> LogicT m a
forall (m :: * -> *) a. Depth -> Series m a -> LogicT m a
runSeries Depth
d Series m a
s

-- | Sum (union) of series.
--
-- @since 1.0
infixr 7 \/
(\/) :: Monad m => Series m a -> Series m a -> Series m a
\/ :: forall (m :: * -> *) a.
Monad m =>
Series m a -> Series m a -> Series m a
(\/) = Series m a -> Series m a -> Series m a
forall a. Series m a -> Series m a -> Series m a
forall (m :: * -> *) a. MonadLogic m => m a -> m a -> m a
interleave

-- | Product of series
--
-- @since 1.0
infixr 8 ><
(><) :: Monad m => Series m a -> Series m b -> Series m (a,b)
Series m a
a >< :: forall (m :: * -> *) a b.
Monad m =>
Series m a -> Series m b -> Series m (a, b)
>< Series m b
b = (,) (a -> b -> (a, b)) -> Series m a -> Series m (b -> (a, b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Series m a
a Series m (b -> (a, b)) -> Series m b -> Series m (a, b)
forall (m :: * -> *) a b.
Monad m =>
Series m (a -> b) -> Series m a -> Series m b
<~> Series m b
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
Series m (a -> b)
a <~> :: forall (m :: * -> *) a b.
Monad m =>
Series m (a -> b) -> Series m a -> Series m b
<~> Series m a
b = Series m (a -> b)
a Series m (a -> b) -> ((a -> b) -> Series m b) -> Series m b
forall a b. Series m a -> (a -> Series m b) -> Series m b
forall (m :: * -> *) a b. MonadLogic m => m a -> (a -> m b) -> m b
>>- ((a -> b) -> Series m a -> Series m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Series m a
b)

uncurry3 :: (a->b->c->d) -> ((a,b,c)->d)
uncurry3 :: forall a b c d. (a -> b -> c -> d) -> (a, b, c) -> d
uncurry3 a -> b -> c -> d
f (a
x,b
y,c
z) = a -> b -> c -> d
f a
x b
y c
z

uncurry4 :: (a->b->c->d->e) -> ((a,b,c,d)->e)
uncurry4 :: forall a b c d e. (a -> b -> c -> d -> e) -> (a, b, c, d) -> e
uncurry4 a -> b -> c -> d -> e
f (a
w,b
x,c
y,d
z) = a -> b -> c -> d -> e
f a
w b
x c
y d
z

uncurry5 :: (a->b->c->d->e->f) -> ((a,b,c,d,e)->f)
uncurry5 :: forall a b c d e f.
(a -> b -> c -> d -> e -> f) -> (a, b, c, d, e) -> f
uncurry5 a -> b -> c -> d -> e -> f
f (a
v,b
w,c
x,d
y,e
z) = a -> b -> c -> d -> e -> f
f a
v b
w c
x d
y e
z

uncurry6 :: (a->b->c->d->e->f->g) -> ((a,b,c,d,e,f)->g)
uncurry6 :: forall a b c d e f g.
(a -> b -> c -> d -> e -> f -> g) -> (a, b, c, d, e, f) -> g
uncurry6 a -> b -> c -> d -> e -> f -> g
f (a
u,b
v,c
w,d
x,e
y,f
z) = a -> b -> c -> d -> e -> f -> g
f a
u b
v c
w d
x e
y f
z

-- | Query the current depth.
--
-- @since 1.0
getDepth :: Series m Depth
getDepth :: forall (m :: * -> *). Series m Depth
getDepth = ReaderT Depth (LogicT m) Depth -> Series m Depth
forall (m :: * -> *) a. ReaderT Depth (LogicT m) a -> Series m a
Series ReaderT Depth (LogicT m) Depth
forall r (m :: * -> *). MonadReader r m => m r
ask

-- | Run a series with a modified depth.
--
-- @since 1.0
localDepth :: (Depth -> Depth) -> Series m a -> Series m a
localDepth :: forall (m :: * -> *) a.
(Depth -> Depth) -> Series m a -> Series m a
localDepth Depth -> Depth
f (Series ReaderT Depth (LogicT m) a
a) = ReaderT Depth (LogicT m) a -> Series m a
forall (m :: * -> *) a. ReaderT Depth (LogicT m) a -> Series m a
Series (ReaderT Depth (LogicT m) a -> Series m a)
-> ReaderT Depth (LogicT m) a -> Series m a
forall a b. (a -> b) -> a -> b
$ (Depth -> Depth)
-> ReaderT Depth (LogicT m) a -> ReaderT Depth (LogicT m) a
forall a.
(Depth -> Depth)
-> ReaderT Depth (LogicT m) a -> ReaderT Depth (LogicT m) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local Depth -> Depth
f ReaderT Depth (LogicT m) a
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 :: forall (m :: * -> *) a. Series m a -> Series m a
decDepth Series m a
a = do
  Series m ()
forall (m :: * -> *). Series m ()
checkDepth
  (Depth -> Depth) -> Series m a -> Series m a
forall (m :: * -> *) a.
(Depth -> Depth) -> Series m a -> Series m a
localDepth (Depth -> Depth -> Depth
forall a. Num a => a -> a -> a
subtract Depth
1) Series m a
a

checkDepth :: Series m ()
checkDepth :: forall (m :: * -> *). Series m ()
checkDepth = do
  Depth
d <- Series m Depth
forall (m :: * -> *). Series m Depth
getDepth
  Bool -> Series m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Series m ()) -> Bool -> Series m ()
forall a b. (a -> b) -> a -> b
$ Depth
d Depth -> Depth -> Bool
forall a. Ord a => a -> a -> Bool
> Depth
0

-- | @'constM' = 'liftM' 'const'@
--
-- @since 1.1.1
constM :: Monad m => m b -> m (a -> b)
constM :: forall (m :: * -> *) b a. Monad m => m b -> m (a -> b)
constM = (b -> a -> b) -> m b -> m (a -> b)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM b -> a -> b
forall a b. a -> b -> a
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 :: forall (m :: * -> *) a. Series m a -> Series m (Series m a)
fixDepth Series m a
s = Series m Depth
forall (m :: * -> *). Series m Depth
getDepth Series m Depth
-> (Depth -> Series m (Series m a)) -> Series m (Series m a)
forall a b. Series m a -> (a -> Series m b) -> Series m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Depth
d -> Series m a -> Series m (Series m a)
forall a. a -> Series m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Series m a -> Series m (Series m a))
-> Series m a -> Series m (Series m a)
forall a b. (a -> b) -> a -> b
$ (Depth -> Depth) -> Series m a -> Series m a
forall (m :: * -> *) a.
(Depth -> Depth) -> Series m a -> Series m a
localDepth (Depth -> Depth -> Depth
forall a b. a -> b -> a
const Depth
d) Series m a
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 :: forall (m :: * -> *) a. Series m a -> Series m a -> Series m a
decDepthChecked Series m a
b Series m a
r = do
  Depth
d <- Series m Depth
forall (m :: * -> *). Series m Depth
getDepth
  if Depth
d Depth -> Depth -> Bool
forall a. Ord a => a -> a -> Bool
<= Depth
0
    then Series m a
b
    else Series m a -> Series m a
forall (m :: * -> *) a. Series m a -> Series m a
decDepth Series m a
r

unwind :: MonadLogic m => m a -> m [a]
unwind :: forall (m :: * -> *) a. MonadLogic m => m a -> m [a]
unwind m a
a =
  m a -> m (Maybe (a, m a))
forall a. m a -> m (Maybe (a, m a))
forall (m :: * -> *) a. MonadLogic m => m a -> m (Maybe (a, m a))
msplit m a
a m (Maybe (a, m a)) -> (Maybe (a, m a) -> m [a]) -> m [a]
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
  m [a] -> ((a, m a) -> m [a]) -> Maybe (a, m a) -> m [a]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([a] -> m [a]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return []) (\(a
x,m a
a') -> (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:) ([a] -> [a]) -> m [a] -> m [a]
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` m a -> m [a]
forall (m :: * -> *) a. MonadLogic m => m a -> m [a]
unwind m a
a')

-- }}}

------------------------------
-- cons* and alts* functions
------------------------------
-- {{{

-- | @since 1.0
cons0 :: a -> Series m a
cons0 :: forall a (m :: * -> *). a -> Series m a
cons0 a
x = Series m a -> Series m a
forall (m :: * -> *) a. Series m a -> Series m a
decDepth (Series m a -> Series m a) -> Series m a -> Series m a
forall a b. (a -> b) -> a -> b
$ a -> Series m a
forall a. a -> Series m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x

-- | @since 1.0
cons1 :: Serial m a => (a->b) -> Series m b
cons1 :: forall (m :: * -> *) a b. Serial m a => (a -> b) -> Series m b
cons1 a -> b
f = Series m b -> Series m b
forall (m :: * -> *) a. Series m a -> Series m a
decDepth (Series m b -> Series m b) -> Series m b -> Series m b
forall a b. (a -> b) -> a -> b
$ a -> b
f (a -> b) -> Series m a -> Series m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Series m a
forall (m :: * -> *) a. Serial m a => Series m a
series

-- | Same as 'cons1', but preserves the depth.
--
-- @since 1.0
newtypeCons :: Serial m a => (a->b) -> Series m b
newtypeCons :: forall (m :: * -> *) a b. Serial m a => (a -> b) -> Series m b
newtypeCons a -> b
f = a -> b
f (a -> b) -> Series m a -> Series m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Series m a
forall (m :: * -> *) a. Serial m a => Series m a
series

-- | @since 1.0
cons2 :: (Serial m a, Serial m b) => (a->b->c) -> Series m c
cons2 :: forall (m :: * -> *) a b c.
(Serial m a, Serial m b) =>
(a -> b -> c) -> Series m c
cons2 a -> b -> c
f = Series m c -> Series m c
forall (m :: * -> *) a. Series m a -> Series m a
decDepth (Series m c -> Series m c) -> Series m c -> Series m c
forall a b. (a -> b) -> a -> b
$ a -> b -> c
f (a -> b -> c) -> Series m a -> Series m (b -> c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Series m a
forall (m :: * -> *) a. Serial m a => Series m a
series Series m (b -> c) -> Series m b -> Series m c
forall (m :: * -> *) a b.
Monad m =>
Series m (a -> b) -> Series m a -> Series m b
<~> Series m b
forall (m :: * -> *) a. Serial m a => Series m a
series

-- | @since 1.0
cons3 :: (Serial m a, Serial m b, Serial m c) =>
         (a->b->c->d) -> Series m d
cons3 :: forall (m :: * -> *) a b c d.
(Serial m a, Serial m b, Serial m c) =>
(a -> b -> c -> d) -> Series m d
cons3 a -> b -> c -> d
f = Series m d -> Series m d
forall (m :: * -> *) a. Series m a -> Series m a
decDepth (Series m d -> Series m d) -> Series m d -> Series m d
forall a b. (a -> b) -> a -> b
$
  a -> b -> c -> d
f (a -> b -> c -> d) -> Series m a -> Series m (b -> c -> d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Series m a
forall (m :: * -> *) a. Serial m a => Series m a
series
    Series m (b -> c -> d) -> Series m b -> Series m (c -> d)
forall (m :: * -> *) a b.
Monad m =>
Series m (a -> b) -> Series m a -> Series m b
<~> Series m b
forall (m :: * -> *) a. Serial m a => Series m a
series
    Series m (c -> d) -> Series m c -> Series m d
forall (m :: * -> *) a b.
Monad m =>
Series m (a -> b) -> Series m a -> Series m b
<~> Series m c
forall (m :: * -> *) a. Serial m a => Series m a
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 :: forall (m :: * -> *) a b c d e.
(Serial m a, Serial m b, Serial m c, Serial m d) =>
(a -> b -> c -> d -> e) -> Series m e
cons4 a -> b -> c -> d -> e
f = Series m e -> Series m e
forall (m :: * -> *) a. Series m a -> Series m a
decDepth (Series m e -> Series m e) -> Series m e -> Series m e
forall a b. (a -> b) -> a -> b
$
  a -> b -> c -> d -> e
f (a -> b -> c -> d -> e)
-> Series m a -> Series m (b -> c -> d -> e)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Series m a
forall (m :: * -> *) a. Serial m a => Series m a
series
    Series m (b -> c -> d -> e) -> Series m b -> Series m (c -> d -> e)
forall (m :: * -> *) a b.
Monad m =>
Series m (a -> b) -> Series m a -> Series m b
<~> Series m b
forall (m :: * -> *) a. Serial m a => Series m a
series
    Series m (c -> d -> e) -> Series m c -> Series m (d -> e)
forall (m :: * -> *) a b.
Monad m =>
Series m (a -> b) -> Series m a -> Series m b
<~> Series m c
forall (m :: * -> *) a. Serial m a => Series m a
series
    Series m (d -> e) -> Series m d -> Series m e
forall (m :: * -> *) a b.
Monad m =>
Series m (a -> b) -> Series m a -> Series m b
<~> Series m d
forall (m :: * -> *) a. Serial m a => Series m a
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 :: forall (m :: * -> *) a b c d e f.
(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 a -> b -> c -> d -> e -> f
f = Series m f -> Series m f
forall (m :: * -> *) a. Series m a -> Series m a
decDepth (Series m f -> Series m f) -> Series m f -> Series m f
forall a b. (a -> b) -> a -> b
$
  a -> b -> c -> d -> e -> f
f (a -> b -> c -> d -> e -> f)
-> Series m a -> Series m (b -> c -> d -> e -> f)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Series m a
forall (m :: * -> *) a. Serial m a => Series m a
series
    Series m (b -> c -> d -> e -> f)
-> Series m b -> Series m (c -> d -> e -> f)
forall (m :: * -> *) a b.
Monad m =>
Series m (a -> b) -> Series m a -> Series m b
<~> Series m b
forall (m :: * -> *) a. Serial m a => Series m a
series
    Series m (c -> d -> e -> f) -> Series m c -> Series m (d -> e -> f)
forall (m :: * -> *) a b.
Monad m =>
Series m (a -> b) -> Series m a -> Series m b
<~> Series m c
forall (m :: * -> *) a. Serial m a => Series m a
series
    Series m (d -> e -> f) -> Series m d -> Series m (e -> f)
forall (m :: * -> *) a b.
Monad m =>
Series m (a -> b) -> Series m a -> Series m b
<~> Series m d
forall (m :: * -> *) a. Serial m a => Series m a
series
    Series m (e -> f) -> Series m e -> Series m f
forall (m :: * -> *) a b.
Monad m =>
Series m (a -> b) -> Series m a -> Series m b
<~> Series m e
forall (m :: * -> *) a. Serial m a => Series m a
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 :: forall (m :: * -> *) a b c d e f g.
(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 a -> b -> c -> d -> e -> f -> g
f = Series m g -> Series m g
forall (m :: * -> *) a. Series m a -> Series m a
decDepth (Series m g -> Series m g) -> Series m g -> Series m g
forall a b. (a -> b) -> a -> b
$
  a -> b -> c -> d -> e -> f -> g
f (a -> b -> c -> d -> e -> f -> g)
-> Series m a -> Series m (b -> c -> d -> e -> f -> g)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Series m a
forall (m :: * -> *) a. Serial m a => Series m a
series
    Series m (b -> c -> d -> e -> f -> g)
-> Series m b -> Series m (c -> d -> e -> f -> g)
forall (m :: * -> *) a b.
Monad m =>
Series m (a -> b) -> Series m a -> Series m b
<~> Series m b
forall (m :: * -> *) a. Serial m a => Series m a
series
    Series m (c -> d -> e -> f -> g)
-> Series m c -> Series m (d -> e -> f -> g)
forall (m :: * -> *) a b.
Monad m =>
Series m (a -> b) -> Series m a -> Series m b
<~> Series m c
forall (m :: * -> *) a. Serial m a => Series m a
series
    Series m (d -> e -> f -> g) -> Series m d -> Series m (e -> f -> g)
forall (m :: * -> *) a b.
Monad m =>
Series m (a -> b) -> Series m a -> Series m b
<~> Series m d
forall (m :: * -> *) a. Serial m a => Series m a
series
    Series m (e -> f -> g) -> Series m e -> Series m (f -> g)
forall (m :: * -> *) a b.
Monad m =>
Series m (a -> b) -> Series m a -> Series m b
<~> Series m e
forall (m :: * -> *) a. Serial m a => Series m a
series
    Series m (f -> g) -> Series m f -> Series m g
forall (m :: * -> *) a b.
Monad m =>
Series m (a -> b) -> Series m a -> Series m b
<~> Series m f
forall (m :: * -> *) a. Serial m a => Series m a
series

-- | @since 1.0
alts0 :: Series m a -> Series m a
alts0 :: forall (m :: * -> *) a. Series m a -> Series m a
alts0 Series m a
s = Series m a
s

-- | @since 1.0
alts1 :: CoSerial m a => Series m b -> Series m (a->b)
alts1 :: forall (m :: * -> *) a b.
CoSerial m a =>
Series m b -> Series m (a -> b)
alts1 Series m b
rs = do
  Series m b
rs <- Series m b -> Series m (Series m b)
forall (m :: * -> *) a. Series m a -> Series m (Series m a)
fixDepth Series m b
rs
  Series m (a -> b) -> Series m (a -> b) -> Series m (a -> b)
forall (m :: * -> *) a. Series m a -> Series m a -> Series m a
decDepthChecked (Series m b -> Series m (a -> b)
forall (m :: * -> *) b a. Monad m => m b -> m (a -> b)
constM Series m b
rs) (Series m b -> Series m (a -> b)
forall b. Series m b -> Series m (a -> b)
forall (m :: * -> *) a b.
CoSerial m a =>
Series m b -> Series m (a -> b)
coseries Series m b
rs)

-- | @since 1.0
alts2
  :: (CoSerial m a, CoSerial m b)
  => Series m c -> Series m (a->b->c)
alts2 :: forall (m :: * -> *) a b c.
(CoSerial m a, CoSerial m b) =>
Series m c -> Series m (a -> b -> c)
alts2 Series m c
rs = do
  Series m c
rs <- Series m c -> Series m (Series m c)
forall (m :: * -> *) a. Series m a -> Series m (Series m a)
fixDepth Series m c
rs
  Series m (a -> b -> c)
-> Series m (a -> b -> c) -> Series m (a -> b -> c)
forall (m :: * -> *) a. Series m a -> Series m a -> Series m a
decDepthChecked
    (Series m (b -> c) -> Series m (a -> b -> c)
forall (m :: * -> *) b a. Monad m => m b -> m (a -> b)
constM (Series m (b -> c) -> Series m (a -> b -> c))
-> Series m (b -> c) -> Series m (a -> b -> c)
forall a b. (a -> b) -> a -> b
$ Series m c -> Series m (b -> c)
forall (m :: * -> *) b a. Monad m => m b -> m (a -> b)
constM Series m c
rs)
    (Series m (b -> c) -> Series m (a -> b -> c)
forall b. Series m b -> Series m (a -> b)
forall (m :: * -> *) a b.
CoSerial m a =>
Series m b -> Series m (a -> b)
coseries (Series m (b -> c) -> Series m (a -> b -> c))
-> Series m (b -> c) -> Series m (a -> b -> c)
forall a b. (a -> b) -> a -> b
$ Series m c -> Series m (b -> c)
forall b. Series m b -> Series m (b -> b)
forall (m :: * -> *) a b.
CoSerial m a =>
Series m b -> Series m (a -> b)
coseries Series m c
rs)

-- | @since 1.0
alts3 ::  (CoSerial m a, CoSerial m b, CoSerial m c) =>
            Series m d -> Series m (a->b->c->d)
alts3 :: forall (m :: * -> *) a b c d.
(CoSerial m a, CoSerial m b, CoSerial m c) =>
Series m d -> Series m (a -> b -> c -> d)
alts3 Series m d
rs = do
  Series m d
rs <- Series m d -> Series m (Series m d)
forall (m :: * -> *) a. Series m a -> Series m (Series m a)
fixDepth Series m d
rs
  Series m (a -> b -> c -> d)
-> Series m (a -> b -> c -> d) -> Series m (a -> b -> c -> d)
forall (m :: * -> *) a. Series m a -> Series m a -> Series m a
decDepthChecked
    (Series m (b -> c -> d) -> Series m (a -> b -> c -> d)
forall (m :: * -> *) b a. Monad m => m b -> m (a -> b)
constM (Series m (b -> c -> d) -> Series m (a -> b -> c -> d))
-> Series m (b -> c -> d) -> Series m (a -> b -> c -> d)
forall a b. (a -> b) -> a -> b
$ Series m (c -> d) -> Series m (b -> c -> d)
forall (m :: * -> *) b a. Monad m => m b -> m (a -> b)
constM (Series m (c -> d) -> Series m (b -> c -> d))
-> Series m (c -> d) -> Series m (b -> c -> d)
forall a b. (a -> b) -> a -> b
$ Series m d -> Series m (c -> d)
forall (m :: * -> *) b a. Monad m => m b -> m (a -> b)
constM Series m d
rs)
    (Series m (b -> c -> d) -> Series m (a -> b -> c -> d)
forall b. Series m b -> Series m (a -> b)
forall (m :: * -> *) a b.
CoSerial m a =>
Series m b -> Series m (a -> b)
coseries (Series m (b -> c -> d) -> Series m (a -> b -> c -> d))
-> Series m (b -> c -> d) -> Series m (a -> b -> c -> d)
forall a b. (a -> b) -> a -> b
$ Series m (c -> d) -> Series m (b -> c -> d)
forall b. Series m b -> Series m (b -> b)
forall (m :: * -> *) a b.
CoSerial m a =>
Series m b -> Series m (a -> b)
coseries (Series m (c -> d) -> Series m (b -> c -> d))
-> Series m (c -> d) -> Series m (b -> c -> d)
forall a b. (a -> b) -> a -> b
$ Series m d -> Series m (c -> d)
forall b. Series m b -> Series m (c -> b)
forall (m :: * -> *) a b.
CoSerial m a =>
Series m b -> Series m (a -> b)
coseries Series m d
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 :: forall (m :: * -> *) a b c d e.
(CoSerial m a, CoSerial m b, CoSerial m c, CoSerial m d) =>
Series m e -> Series m (a -> b -> c -> d -> e)
alts4 Series m e
rs = do
  Series m e
rs <- Series m e -> Series m (Series m e)
forall (m :: * -> *) a. Series m a -> Series m (Series m a)
fixDepth Series m e
rs
  Series m (a -> b -> c -> d -> e)
-> Series m (a -> b -> c -> d -> e)
-> Series m (a -> b -> c -> d -> e)
forall (m :: * -> *) a. Series m a -> Series m a -> Series m a
decDepthChecked
    (Series m (b -> c -> d -> e) -> Series m (a -> b -> c -> d -> e)
forall (m :: * -> *) b a. Monad m => m b -> m (a -> b)
constM (Series m (b -> c -> d -> e) -> Series m (a -> b -> c -> d -> e))
-> Series m (b -> c -> d -> e) -> Series m (a -> b -> c -> d -> e)
forall a b. (a -> b) -> a -> b
$ Series m (c -> d -> e) -> Series m (b -> c -> d -> e)
forall (m :: * -> *) b a. Monad m => m b -> m (a -> b)
constM (Series m (c -> d -> e) -> Series m (b -> c -> d -> e))
-> Series m (c -> d -> e) -> Series m (b -> c -> d -> e)
forall a b. (a -> b) -> a -> b
$ Series m (d -> e) -> Series m (c -> d -> e)
forall (m :: * -> *) b a. Monad m => m b -> m (a -> b)
constM (Series m (d -> e) -> Series m (c -> d -> e))
-> Series m (d -> e) -> Series m (c -> d -> e)
forall a b. (a -> b) -> a -> b
$ Series m e -> Series m (d -> e)
forall (m :: * -> *) b a. Monad m => m b -> m (a -> b)
constM Series m e
rs)
    (Series m (b -> c -> d -> e) -> Series m (a -> b -> c -> d -> e)
forall b. Series m b -> Series m (a -> b)
forall (m :: * -> *) a b.
CoSerial m a =>
Series m b -> Series m (a -> b)
coseries (Series m (b -> c -> d -> e) -> Series m (a -> b -> c -> d -> e))
-> Series m (b -> c -> d -> e) -> Series m (a -> b -> c -> d -> e)
forall a b. (a -> b) -> a -> b
$ Series m (c -> d -> e) -> Series m (b -> c -> d -> e)
forall b. Series m b -> Series m (b -> b)
forall (m :: * -> *) a b.
CoSerial m a =>
Series m b -> Series m (a -> b)
coseries (Series m (c -> d -> e) -> Series m (b -> c -> d -> e))
-> Series m (c -> d -> e) -> Series m (b -> c -> d -> e)
forall a b. (a -> b) -> a -> b
$ Series m (d -> e) -> Series m (c -> d -> e)
forall b. Series m b -> Series m (c -> b)
forall (m :: * -> *) a b.
CoSerial m a =>
Series m b -> Series m (a -> b)
coseries (Series m (d -> e) -> Series m (c -> d -> e))
-> Series m (d -> e) -> Series m (c -> d -> e)
forall a b. (a -> b) -> a -> b
$ Series m e -> Series m (d -> e)
forall b. Series m b -> Series m (d -> b)
forall (m :: * -> *) a b.
CoSerial m a =>
Series m b -> Series m (a -> b)
coseries Series m e
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 :: forall (m :: * -> *) a b c d e f.
(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 Series m f
rs = do
  Series m f
rs <- Series m f -> Series m (Series m f)
forall (m :: * -> *) a. Series m a -> Series m (Series m a)
fixDepth Series m f
rs
  Series m (a -> b -> c -> d -> e -> f)
-> Series m (a -> b -> c -> d -> e -> f)
-> Series m (a -> b -> c -> d -> e -> f)
forall (m :: * -> *) a. Series m a -> Series m a -> Series m a
decDepthChecked
    (Series m (b -> c -> d -> e -> f)
-> Series m (a -> b -> c -> d -> e -> f)
forall (m :: * -> *) b a. Monad m => m b -> m (a -> b)
constM (Series m (b -> c -> d -> e -> f)
 -> Series m (a -> b -> c -> d -> e -> f))
-> Series m (b -> c -> d -> e -> f)
-> Series m (a -> b -> c -> d -> e -> f)
forall a b. (a -> b) -> a -> b
$ Series m (c -> d -> e -> f) -> Series m (b -> c -> d -> e -> f)
forall (m :: * -> *) b a. Monad m => m b -> m (a -> b)
constM (Series m (c -> d -> e -> f) -> Series m (b -> c -> d -> e -> f))
-> Series m (c -> d -> e -> f) -> Series m (b -> c -> d -> e -> f)
forall a b. (a -> b) -> a -> b
$ Series m (d -> e -> f) -> Series m (c -> d -> e -> f)
forall (m :: * -> *) b a. Monad m => m b -> m (a -> b)
constM (Series m (d -> e -> f) -> Series m (c -> d -> e -> f))
-> Series m (d -> e -> f) -> Series m (c -> d -> e -> f)
forall a b. (a -> b) -> a -> b
$ Series m (e -> f) -> Series m (d -> e -> f)
forall (m :: * -> *) b a. Monad m => m b -> m (a -> b)
constM (Series m (e -> f) -> Series m (d -> e -> f))
-> Series m (e -> f) -> Series m (d -> e -> f)
forall a b. (a -> b) -> a -> b
$ Series m f -> Series m (e -> f)
forall (m :: * -> *) b a. Monad m => m b -> m (a -> b)
constM Series m f
rs)
    (Series m (b -> c -> d -> e -> f)
-> Series m (a -> b -> c -> d -> e -> f)
forall b. Series m b -> Series m (a -> b)
forall (m :: * -> *) a b.
CoSerial m a =>
Series m b -> Series m (a -> b)
coseries (Series m (b -> c -> d -> e -> f)
 -> Series m (a -> b -> c -> d -> e -> f))
-> Series m (b -> c -> d -> e -> f)
-> Series m (a -> b -> c -> d -> e -> f)
forall a b. (a -> b) -> a -> b
$ Series m (c -> d -> e -> f) -> Series m (b -> c -> d -> e -> f)
forall b. Series m b -> Series m (b -> b)
forall (m :: * -> *) a b.
CoSerial m a =>
Series m b -> Series m (a -> b)
coseries (Series m (c -> d -> e -> f) -> Series m (b -> c -> d -> e -> f))
-> Series m (c -> d -> e -> f) -> Series m (b -> c -> d -> e -> f)
forall a b. (a -> b) -> a -> b
$ Series m (d -> e -> f) -> Series m (c -> d -> e -> f)
forall b. Series m b -> Series m (c -> b)
forall (m :: * -> *) a b.
CoSerial m a =>
Series m b -> Series m (a -> b)
coseries (Series m (d -> e -> f) -> Series m (c -> d -> e -> f))
-> Series m (d -> e -> f) -> Series m (c -> d -> e -> f)
forall a b. (a -> b) -> a -> b
$ Series m (e -> f) -> Series m (d -> e -> f)
forall b. Series m b -> Series m (d -> b)
forall (m :: * -> *) a b.
CoSerial m a =>
Series m b -> Series m (a -> b)
coseries (Series m (e -> f) -> Series m (d -> e -> f))
-> Series m (e -> f) -> Series m (d -> e -> f)
forall a b. (a -> b) -> a -> b
$ Series m f -> Series m (e -> f)
forall b. Series m b -> Series m (e -> b)
forall (m :: * -> *) a b.
CoSerial m a =>
Series m b -> Series m (a -> b)
coseries Series m f
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 :: forall (m :: * -> *) a b c d e f g.
(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 Series m g
rs = do
  Series m g
rs <- Series m g -> Series m (Series m g)
forall (m :: * -> *) a. Series m a -> Series m (Series m a)
fixDepth Series m g
rs
  Series m (a -> b -> c -> d -> e -> f -> g)
-> Series m (a -> b -> c -> d -> e -> f -> g)
-> Series m (a -> b -> c -> d -> e -> f -> g)
forall (m :: * -> *) a. Series m a -> Series m a -> Series m a
decDepthChecked
    (Series m (b -> c -> d -> e -> f -> g)
-> Series m (a -> b -> c -> d -> e -> f -> g)
forall (m :: * -> *) b a. Monad m => m b -> m (a -> b)
constM (Series m (b -> c -> d -> e -> f -> g)
 -> Series m (a -> b -> c -> d -> e -> f -> g))
-> Series m (b -> c -> d -> e -> f -> g)
-> Series m (a -> b -> c -> d -> e -> f -> g)
forall a b. (a -> b) -> a -> b
$ Series m (c -> d -> e -> f -> g)
-> Series m (b -> c -> d -> e -> f -> g)
forall (m :: * -> *) b a. Monad m => m b -> m (a -> b)
constM (Series m (c -> d -> e -> f -> g)
 -> Series m (b -> c -> d -> e -> f -> g))
-> Series m (c -> d -> e -> f -> g)
-> Series m (b -> c -> d -> e -> f -> g)
forall a b. (a -> b) -> a -> b
$ Series m (d -> e -> f -> g) -> Series m (c -> d -> e -> f -> g)
forall (m :: * -> *) b a. Monad m => m b -> m (a -> b)
constM (Series m (d -> e -> f -> g) -> Series m (c -> d -> e -> f -> g))
-> Series m (d -> e -> f -> g) -> Series m (c -> d -> e -> f -> g)
forall a b. (a -> b) -> a -> b
$ Series m (e -> f -> g) -> Series m (d -> e -> f -> g)
forall (m :: * -> *) b a. Monad m => m b -> m (a -> b)
constM (Series m (e -> f -> g) -> Series m (d -> e -> f -> g))
-> Series m (e -> f -> g) -> Series m (d -> e -> f -> g)
forall a b. (a -> b) -> a -> b
$ Series m (f -> g) -> Series m (e -> f -> g)
forall (m :: * -> *) b a. Monad m => m b -> m (a -> b)
constM (Series m (f -> g) -> Series m (e -> f -> g))
-> Series m (f -> g) -> Series m (e -> f -> g)
forall a b. (a -> b) -> a -> b
$ Series m g -> Series m (f -> g)
forall (m :: * -> *) b a. Monad m => m b -> m (a -> b)
constM Series m g
rs)
    (Series m (b -> c -> d -> e -> f -> g)
-> Series m (a -> b -> c -> d -> e -> f -> g)
forall b. Series m b -> Series m (a -> b)
forall (m :: * -> *) a b.
CoSerial m a =>
Series m b -> Series m (a -> b)
coseries (Series m (b -> c -> d -> e -> f -> g)
 -> Series m (a -> b -> c -> d -> e -> f -> g))
-> Series m (b -> c -> d -> e -> f -> g)
-> Series m (a -> b -> c -> d -> e -> f -> g)
forall a b. (a -> b) -> a -> b
$ Series m (c -> d -> e -> f -> g)
-> Series m (b -> c -> d -> e -> f -> g)
forall b. Series m b -> Series m (b -> b)
forall (m :: * -> *) a b.
CoSerial m a =>
Series m b -> Series m (a -> b)
coseries (Series m (c -> d -> e -> f -> g)
 -> Series m (b -> c -> d -> e -> f -> g))
-> Series m (c -> d -> e -> f -> g)
-> Series m (b -> c -> d -> e -> f -> g)
forall a b. (a -> b) -> a -> b
$ Series m (d -> e -> f -> g) -> Series m (c -> d -> e -> f -> g)
forall b. Series m b -> Series m (c -> b)
forall (m :: * -> *) a b.
CoSerial m a =>
Series m b -> Series m (a -> b)
coseries (Series m (d -> e -> f -> g) -> Series m (c -> d -> e -> f -> g))
-> Series m (d -> e -> f -> g) -> Series m (c -> d -> e -> f -> g)
forall a b. (a -> b) -> a -> b
$ Series m (e -> f -> g) -> Series m (d -> e -> f -> g)
forall b. Series m b -> Series m (d -> b)
forall (m :: * -> *) a b.
CoSerial m a =>
Series m b -> Series m (a -> b)
coseries (Series m (e -> f -> g) -> Series m (d -> e -> f -> g))
-> Series m (e -> f -> g) -> Series m (d -> e -> f -> g)
forall a b. (a -> b) -> a -> b
$ Series m (f -> g) -> Series m (e -> f -> g)
forall b. Series m b -> Series m (e -> b)
forall (m :: * -> *) a b.
CoSerial m a =>
Series m b -> Series m (a -> b)
coseries (Series m (f -> g) -> Series m (e -> f -> g))
-> Series m (f -> g) -> Series m (e -> f -> g)
forall a b. (a -> b) -> a -> b
$ Series m g -> Series m (f -> g)
forall b. Series m b -> Series m (f -> b)
forall (m :: * -> *) a b.
CoSerial m a =>
Series m b -> Series m (a -> b)
coseries Series m g
rs)

-- | Same as 'alts1', but preserves the depth.
--
-- @since 1.0
newtypeAlts :: CoSerial m a => Series m b -> Series m (a->b)
newtypeAlts :: forall (m :: * -> *) a b.
CoSerial m a =>
Series m b -> Series m (a -> b)
newtypeAlts = Series m b -> Series m (a -> b)
forall b. Series m b -> Series m (a -> b)
forall (m :: * -> *) a b.
CoSerial m a =>
Series m b -> Series m (a -> b)
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)

#if __GLASGOW_HASKELL__ >= 702
instance {-# OVERLAPPABLE #-} GSerial m f => GSerial m (M1 i c f) where
  gSeries :: forall a. Series m (M1 i c f a)
gSeries = f a -> M1 i c f a
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (f a -> M1 i c f a) -> Series m (f a) -> Series m (M1 i c f a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Series m (f a)
forall a. Series m (f a)
forall (m :: * -> *) (f :: * -> *) a. GSerial m f => Series m (f a)
gSeries
  {-# INLINE gSeries #-}
instance GCoSerial m f => GCoSerial m (M1 i c f) where
  gCoseries :: forall b a. Series m b -> Series m (M1 i c f a -> b)
gCoseries Series m b
rs = ((f a -> b) -> (M1 i c f a -> f a) -> M1 i c f a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. M1 i c f a -> f a
forall k i (c :: Meta) (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1) ((f a -> b) -> M1 i c f a -> b)
-> Series m (f a -> b) -> Series m (M1 i c f a -> b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Series m b -> Series m (f a -> b)
forall b a. Series m b -> Series m (f a -> b)
forall (m :: * -> *) (f :: * -> *) b a.
GCoSerial m f =>
Series m b -> Series m (f a -> b)
gCoseries Series m b
rs
  {-# INLINE gCoseries #-}

instance Serial m c => GSerial m (K1 i c) where
  gSeries :: forall a. Series m (K1 i c a)
gSeries = c -> K1 i c a
forall k i c (p :: k). c -> K1 i c p
K1 (c -> K1 i c a) -> Series m c -> Series m (K1 i c a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Series m c
forall (m :: * -> *) a. Serial m a => Series m a
series
  {-# INLINE gSeries #-}
instance CoSerial m c => GCoSerial m (K1 i c) where
  gCoseries :: forall b a. Series m b -> Series m (K1 i c a -> b)
gCoseries Series m b
rs = ((c -> b) -> (K1 i c a -> c) -> K1 i c a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. K1 i c a -> c
forall k i c (p :: k). K1 i c p -> c
unK1) ((c -> b) -> K1 i c a -> b)
-> Series m (c -> b) -> Series m (K1 i c a -> b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Series m b -> Series m (c -> b)
forall b. Series m b -> Series m (c -> b)
forall (m :: * -> *) a b.
CoSerial m a =>
Series m b -> Series m (a -> b)
coseries Series m b
rs
  {-# INLINE gCoseries #-}

instance GSerial m U1 where
  gSeries :: forall a. Series m (U1 a)
gSeries = U1 a -> Series m (U1 a)
forall a. a -> Series m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure U1 a
forall k (p :: k). U1 p
U1
  {-# INLINE gSeries #-}
instance GCoSerial m U1 where
  gCoseries :: forall b a. Series m b -> Series m (U1 a -> b)
gCoseries Series m b
rs = Series m b -> Series m (U1 a -> b)
forall (m :: * -> *) b a. Monad m => m b -> m (a -> b)
constM Series m b
rs
  {-# INLINE gCoseries #-}

instance GSerial m V1 where
  gSeries :: forall a. Series m (V1 a)
gSeries = Series m (V1 a)
forall a. Series m a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
  {-# INLINE gSeries #-}
instance GCoSerial m V1 where
  gCoseries :: forall b a. Series m b -> Series m (V1 a -> b)
gCoseries = Series m (V1 a -> b) -> Series m b -> Series m (V1 a -> b)
forall a b. a -> b -> a
const (Series m (V1 a -> b) -> Series m b -> Series m (V1 a -> b))
-> Series m (V1 a -> b) -> Series m b -> Series m (V1 a -> b)
forall a b. (a -> b) -> a -> b
$ (V1 a -> b) -> Series m (V1 a -> b)
forall a. a -> Series m a
forall (m :: * -> *) a. Monad m => a -> m a
return (\V1 a
a -> V1 a
a V1 a -> b -> b
forall a b. a -> b -> b
`seq` let x :: t
x = t
x in b
forall {t}. t
x)
  {-# INLINE gCoseries #-}

instance (Monad m, GSerial m a, GSerial m b) => GSerial m (a :*: b) where
  gSeries :: forall a. Series m ((:*:) a b a)
gSeries = a a -> b a -> (:*:) a b a
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
(:*:) (a a -> b a -> (:*:) a b a)
-> Series m (a a) -> Series m (b a -> (:*:) a b a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Series m (a a)
forall a. Series m (a a)
forall (m :: * -> *) (f :: * -> *) a. GSerial m f => Series m (f a)
gSeries Series m (b a -> (:*:) a b a)
-> Series m (b a) -> Series m ((:*:) a b a)
forall (m :: * -> *) a b.
Monad m =>
Series m (a -> b) -> Series m a -> Series m b
<~> Series m (b a)
forall a. Series m (b a)
forall (m :: * -> *) (f :: * -> *) a. GSerial m f => Series m (f a)
gSeries
  {-# INLINE gSeries #-}
instance (Monad m, GCoSerial m a, GCoSerial m b) => GCoSerial m (a :*: b) where
  gCoseries :: forall b a. Series m b -> Series m ((:*:) a b a -> b)
gCoseries Series m b
rs = (a a -> b a -> b) -> (:*:) a b a -> b
forall {f :: * -> *} {p} {g :: * -> *} {t}.
(f p -> g p -> t) -> (:*:) f g p -> t
uncur ((a a -> b a -> b) -> (:*:) a b a -> b)
-> Series m (a a -> b a -> b) -> Series m ((:*:) a b a -> b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Series m (b a -> b) -> Series m (a a -> b a -> b)
forall b a. Series m b -> Series m (a a -> b)
forall (m :: * -> *) (f :: * -> *) b a.
GCoSerial m f =>
Series m b -> Series m (f a -> b)
gCoseries (Series m b -> Series m (b a -> b)
forall b a. Series m b -> Series m (b a -> b)
forall (m :: * -> *) (f :: * -> *) b a.
GCoSerial m f =>
Series m b -> Series m (f a -> b)
gCoseries Series m b
rs)
      where
        uncur :: (f p -> g p -> t) -> (:*:) f g p -> t
uncur f p -> g p -> t
f (f p
x :*: g p
y) = f p -> g p -> t
f f p
x g p
y
  {-# INLINE gCoseries #-}

instance (Monad m, GSerial m a, GSerial m b) => GSerial m (a :+: b) where
  gSeries :: forall a. Series m ((:+:) a b a)
gSeries = (a a -> (:+:) a b a
forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 (a a -> (:+:) a b a) -> Series m (a a) -> Series m ((:+:) a b a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Series m (a a)
forall a. Series m (a a)
forall (m :: * -> *) (f :: * -> *) a. GSerial m f => Series m (f a)
gSeries) Series m ((:+:) a b a)
-> Series m ((:+:) a b a) -> Series m ((:+:) a b a)
forall a. Series m a -> Series m a -> Series m a
forall (m :: * -> *) a. MonadLogic m => m a -> m a -> m a
`interleave` (b a -> (:+:) a b a
forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 (b a -> (:+:) a b a) -> Series m (b a) -> Series m ((:+:) a b a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Series m (b a)
forall a. Series m (b a)
forall (m :: * -> *) (f :: * -> *) a. GSerial m f => Series m (f a)
gSeries)
  {-# INLINE gSeries #-}
instance (Monad m, GCoSerial m a, GCoSerial m b) => GCoSerial m (a :+: b) where
  gCoseries :: forall b a. Series m b -> Series m ((:+:) a b a -> b)
gCoseries Series m b
rs =
    Series m b -> Series m (a a -> b)
forall b a. Series m b -> Series m (a a -> b)
forall (m :: * -> *) (f :: * -> *) b a.
GCoSerial m f =>
Series m b -> Series m (f a -> b)
gCoseries Series m b
rs Series m (a a -> b)
-> ((a a -> b) -> Series m ((:+:) a b a -> b))
-> Series m ((:+:) a b a -> b)
forall a b. Series m a -> (a -> Series m b) -> Series m b
forall (m :: * -> *) a b. MonadLogic m => m a -> (a -> m b) -> m b
>>- \a a -> b
f ->
    Series m b -> Series m (b a -> b)
forall b a. Series m b -> Series m (b a -> b)
forall (m :: * -> *) (f :: * -> *) b a.
GCoSerial m f =>
Series m b -> Series m (f a -> b)
gCoseries Series m b
rs Series m (b a -> b)
-> ((b a -> b) -> Series m ((:+:) a b a -> b))
-> Series m ((:+:) a b a -> b)
forall a b. Series m a -> (a -> Series m b) -> Series m b
forall (m :: * -> *) a b. MonadLogic m => m a -> (a -> m b) -> m b
>>- \b a -> b
g ->
    ((:+:) a b a -> b) -> Series m ((:+:) a b a -> b)
forall a. a -> Series m a
forall (m :: * -> *) a. Monad m => a -> m a
return (((:+:) a b a -> b) -> Series m ((:+:) a b a -> b))
-> ((:+:) a b a -> b) -> Series m ((:+:) a b a -> b)
forall a b. (a -> b) -> a -> b
$
    \(:+:) a b a
e -> case (:+:) a b a
e of
      L1 a a
x -> a a -> b
f a a
x
      R1 b a
y -> b a -> b
g b a
y
  {-# INLINE gCoseries #-}

instance {-# OVERLAPPING #-} GSerial m f => GSerial m (C1 c f) where
  gSeries :: forall a. Series m (C1 c f a)
gSeries = f a -> M1 C c f a
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (f a -> M1 C c f a) -> Series m (f a) -> Series m (M1 C c f a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Series m (f a) -> Series m (f a)
forall (m :: * -> *) a. Series m a -> Series m a
decDepth Series m (f a)
forall a. Series m (f a)
forall (m :: * -> *) (f :: * -> *) a. GSerial m f => Series m (f a)
gSeries
  {-# INLINE gSeries #-}
#endif

-- }}}

------------------------------
-- Instances for basic types
------------------------------
-- {{{
instance Monad m => Serial m () where
  series :: Series m ()
series = () -> Series m ()
forall a. a -> Series m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
instance Monad m => CoSerial m () where
  coseries :: forall b. Series m b -> Series m (() -> b)
coseries Series m b
rs = Series m b -> Series m (() -> b)
forall (m :: * -> *) b a. Monad m => m b -> m (a -> b)
constM Series m b
rs

instance Monad m => Serial m Integer where series :: Series m Integer
series = M Integer -> Integer
forall a. M a -> a
unM (M Integer -> Integer) -> Series m (M Integer) -> Series m Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Series m (M Integer)
forall (m :: * -> *) a. Serial m a => Series m a
series
instance Monad m => CoSerial m Integer where coseries :: forall b. Series m b -> Series m (Integer -> b)
coseries = ((M Integer -> b) -> Integer -> b)
-> Series m (M Integer -> b) -> Series m (Integer -> b)
forall a b. (a -> b) -> Series m a -> Series m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((M Integer -> b) -> (Integer -> M Integer) -> Integer -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> M Integer
forall a. a -> M a
M) (Series m (M Integer -> b) -> Series m (Integer -> b))
-> (Series m b -> Series m (M Integer -> b))
-> Series m b
-> Series m (Integer -> b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Series m b -> Series m (M Integer -> b)
forall b. Series m b -> Series m (M Integer -> b)
forall (m :: * -> *) a b.
CoSerial m a =>
Series m b -> Series m (a -> b)
coseries

-- | @since 1.1.3
instance Monad m => Serial m Natural where series :: Series m Natural
series = N Natural -> Natural
forall a. N a -> a
unN (N Natural -> Natural) -> Series m (N Natural) -> Series m Natural
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Series m (N Natural)
forall (m :: * -> *) a. Serial m a => Series m a
series
-- | @since 1.1.3
instance Monad m => CoSerial m Natural where coseries :: forall b. Series m b -> Series m (Natural -> b)
coseries = ((N Natural -> b) -> Natural -> b)
-> Series m (N Natural -> b) -> Series m (Natural -> b)
forall a b. (a -> b) -> Series m a -> Series m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((N Natural -> b) -> (Natural -> N Natural) -> Natural -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Natural -> N Natural
forall a. a -> N a
N) (Series m (N Natural -> b) -> Series m (Natural -> b))
-> (Series m b -> Series m (N Natural -> b))
-> Series m b
-> Series m (Natural -> b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Series m b -> Series m (N Natural -> b)
forall b. Series m b -> Series m (N Natural -> b)
forall (m :: * -> *) a b.
CoSerial m a =>
Series m b -> Series m (a -> b)
coseries

instance Monad m => Serial m Int where series :: Series m Depth
series = M Depth -> Depth
forall a. M a -> a
unM (M Depth -> Depth) -> Series m (M Depth) -> Series m Depth
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Series m (M Depth)
forall (m :: * -> *) a. Serial m a => Series m a
series
instance Monad m => CoSerial m Int where coseries :: forall b. Series m b -> Series m (Depth -> b)
coseries = ((M Depth -> b) -> Depth -> b)
-> Series m (M Depth -> b) -> Series m (Depth -> b)
forall a b. (a -> b) -> Series m a -> Series m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((M Depth -> b) -> (Depth -> M Depth) -> Depth -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Depth -> M Depth
forall a. a -> M a
M) (Series m (M Depth -> b) -> Series m (Depth -> b))
-> (Series m b -> Series m (M Depth -> b))
-> Series m b
-> Series m (Depth -> b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Series m b -> Series m (M Depth -> b)
forall b. Series m b -> Series m (M Depth -> b)
forall (m :: * -> *) a b.
CoSerial m a =>
Series m b -> Series m (a -> b)
coseries

-- | @since 1.1.3
instance Monad m => Serial m Word where series :: Series m Word
series = N Word -> Word
forall a. N a -> a
unN (N Word -> Word) -> Series m (N Word) -> Series m Word
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Series m (N Word)
forall (m :: * -> *) a. Serial m a => Series m a
series
-- | @since 1.1.3
instance Monad m => CoSerial m Word where coseries :: forall b. Series m b -> Series m (Word -> b)
coseries = ((N Word -> b) -> Word -> b)
-> Series m (N Word -> b) -> Series m (Word -> b)
forall a b. (a -> b) -> Series m a -> Series m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((N Word -> b) -> (Word -> N Word) -> Word -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> N Word
forall a. a -> N a
N) (Series m (N Word -> b) -> Series m (Word -> b))
-> (Series m b -> Series m (N Word -> b))
-> Series m b
-> Series m (Word -> b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Series m b -> Series m (N Word -> b)
forall b. Series m b -> Series m (N Word -> b)
forall (m :: * -> *) a b.
CoSerial m a =>
Series m b -> Series m (a -> b)
coseries

-- | @since 1.1.4
instance Monad m => Serial m Int8 where series :: Series m Int8
series = M Int8 -> Int8
forall a. M a -> a
unM (M Int8 -> Int8) -> Series m (M Int8) -> Series m Int8
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Series m (M Int8)
forall (m :: * -> *) a. Serial m a => Series m a
series
-- | @since 1.1.4
instance Monad m => CoSerial m Int8 where coseries :: forall b. Series m b -> Series m (Int8 -> b)
coseries = ((M Int8 -> b) -> Int8 -> b)
-> Series m (M Int8 -> b) -> Series m (Int8 -> b)
forall a b. (a -> b) -> Series m a -> Series m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((M Int8 -> b) -> (Int8 -> M Int8) -> Int8 -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int8 -> M Int8
forall a. a -> M a
M) (Series m (M Int8 -> b) -> Series m (Int8 -> b))
-> (Series m b -> Series m (M Int8 -> b))
-> Series m b
-> Series m (Int8 -> b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Series m b -> Series m (M Int8 -> b)
forall b. Series m b -> Series m (M Int8 -> b)
forall (m :: * -> *) a b.
CoSerial m a =>
Series m b -> Series m (a -> b)
coseries

-- | @since 1.1.4
instance Monad m => Serial m Word8 where series :: Series m Word8
series = N Word8 -> Word8
forall a. N a -> a
unN (N Word8 -> Word8) -> Series m (N Word8) -> Series m Word8
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Series m (N Word8)
forall (m :: * -> *) a. Serial m a => Series m a
series
-- | @since 1.1.4
instance Monad m => CoSerial m Word8 where coseries :: forall b. Series m b -> Series m (Word8 -> b)
coseries = ((N Word8 -> b) -> Word8 -> b)
-> Series m (N Word8 -> b) -> Series m (Word8 -> b)
forall a b. (a -> b) -> Series m a -> Series m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((N Word8 -> b) -> (Word8 -> N Word8) -> Word8 -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> N Word8
forall a. a -> N a
N) (Series m (N Word8 -> b) -> Series m (Word8 -> b))
-> (Series m b -> Series m (N Word8 -> b))
-> Series m b
-> Series m (Word8 -> b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Series m b -> Series m (N Word8 -> b)
forall b. Series m b -> Series m (N Word8 -> b)
forall (m :: * -> *) a b.
CoSerial m a =>
Series m b -> Series m (a -> b)
coseries

-- | @since 1.1.4
instance Monad m => Serial m Int16 where series :: Series m Int16
series = M Int16 -> Int16
forall a. M a -> a
unM (M Int16 -> Int16) -> Series m (M Int16) -> Series m Int16
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Series m (M Int16)
forall (m :: * -> *) a. Serial m a => Series m a
series
-- | @since 1.1.4
instance Monad m => CoSerial m Int16 where coseries :: forall b. Series m b -> Series m (Int16 -> b)
coseries = ((M Int16 -> b) -> Int16 -> b)
-> Series m (M Int16 -> b) -> Series m (Int16 -> b)
forall a b. (a -> b) -> Series m a -> Series m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((M Int16 -> b) -> (Int16 -> M Int16) -> Int16 -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int16 -> M Int16
forall a. a -> M a
M) (Series m (M Int16 -> b) -> Series m (Int16 -> b))
-> (Series m b -> Series m (M Int16 -> b))
-> Series m b
-> Series m (Int16 -> b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Series m b -> Series m (M Int16 -> b)
forall b. Series m b -> Series m (M Int16 -> b)
forall (m :: * -> *) a b.
CoSerial m a =>
Series m b -> Series m (a -> b)
coseries

-- | @since 1.1.4
instance Monad m => Serial m Word16 where series :: Series m Word16
series = N Word16 -> Word16
forall a. N a -> a
unN (N Word16 -> Word16) -> Series m (N Word16) -> Series m Word16
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Series m (N Word16)
forall (m :: * -> *) a. Serial m a => Series m a
series
-- | @since 1.1.4
instance Monad m => CoSerial m Word16 where coseries :: forall b. Series m b -> Series m (Word16 -> b)
coseries = ((N Word16 -> b) -> Word16 -> b)
-> Series m (N Word16 -> b) -> Series m (Word16 -> b)
forall a b. (a -> b) -> Series m a -> Series m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((N Word16 -> b) -> (Word16 -> N Word16) -> Word16 -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> N Word16
forall a. a -> N a
N) (Series m (N Word16 -> b) -> Series m (Word16 -> b))
-> (Series m b -> Series m (N Word16 -> b))
-> Series m b
-> Series m (Word16 -> b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Series m b -> Series m (N Word16 -> b)
forall b. Series m b -> Series m (N Word16 -> b)
forall (m :: * -> *) a b.
CoSerial m a =>
Series m b -> Series m (a -> b)
coseries

-- | @since 1.1.4
instance Monad m => Serial m Int32 where series :: Series m Int32
series = M Int32 -> Int32
forall a. M a -> a
unM (M Int32 -> Int32) -> Series m (M Int32) -> Series m Int32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Series m (M Int32)
forall (m :: * -> *) a. Serial m a => Series m a
series
-- | @since 1.1.4
instance Monad m => CoSerial m Int32 where coseries :: forall b. Series m b -> Series m (Int32 -> b)
coseries = ((M Int32 -> b) -> Int32 -> b)
-> Series m (M Int32 -> b) -> Series m (Int32 -> b)
forall a b. (a -> b) -> Series m a -> Series m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((M Int32 -> b) -> (Int32 -> M Int32) -> Int32 -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> M Int32
forall a. a -> M a
M) (Series m (M Int32 -> b) -> Series m (Int32 -> b))
-> (Series m b -> Series m (M Int32 -> b))
-> Series m b
-> Series m (Int32 -> b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Series m b -> Series m (M Int32 -> b)
forall b. Series m b -> Series m (M Int32 -> b)
forall (m :: * -> *) a b.
CoSerial m a =>
Series m b -> Series m (a -> b)
coseries

-- | @since 1.1.4
instance Monad m => Serial m Word32 where series :: Series m Word32
series = N Word32 -> Word32
forall a. N a -> a
unN (N Word32 -> Word32) -> Series m (N Word32) -> Series m Word32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Series m (N Word32)
forall (m :: * -> *) a. Serial m a => Series m a
series
-- | @since 1.1.4
instance Monad m => CoSerial m Word32 where coseries :: forall b. Series m b -> Series m (Word32 -> b)
coseries = ((N Word32 -> b) -> Word32 -> b)
-> Series m (N Word32 -> b) -> Series m (Word32 -> b)
forall a b. (a -> b) -> Series m a -> Series m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((N Word32 -> b) -> (Word32 -> N Word32) -> Word32 -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> N Word32
forall a. a -> N a
N) (Series m (N Word32 -> b) -> Series m (Word32 -> b))
-> (Series m b -> Series m (N Word32 -> b))
-> Series m b
-> Series m (Word32 -> b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Series m b -> Series m (N Word32 -> b)
forall b. Series m b -> Series m (N Word32 -> b)
forall (m :: * -> *) a b.
CoSerial m a =>
Series m b -> Series m (a -> b)
coseries

-- | @since 1.1.4
instance Monad m => Serial m Int64 where series :: Series m Int64
series = M Int64 -> Int64
forall a. M a -> a
unM (M Int64 -> Int64) -> Series m (M Int64) -> Series m Int64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Series m (M Int64)
forall (m :: * -> *) a. Serial m a => Series m a
series
-- | @since 1.1.4
instance Monad m => CoSerial m Int64 where coseries :: forall b. Series m b -> Series m (Int64 -> b)
coseries = ((M Int64 -> b) -> Int64 -> b)
-> Series m (M Int64 -> b) -> Series m (Int64 -> b)
forall a b. (a -> b) -> Series m a -> Series m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((M Int64 -> b) -> (Int64 -> M Int64) -> Int64 -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> M Int64
forall a. a -> M a
M) (Series m (M Int64 -> b) -> Series m (Int64 -> b))
-> (Series m b -> Series m (M Int64 -> b))
-> Series m b
-> Series m (Int64 -> b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Series m b -> Series m (M Int64 -> b)
forall b. Series m b -> Series m (M Int64 -> b)
forall (m :: * -> *) a b.
CoSerial m a =>
Series m b -> Series m (a -> b)
coseries

-- | @since 1.1.4
instance Monad m => Serial m Word64 where series :: Series m Word64
series = N Word64 -> Word64
forall a. N a -> a
unN (N Word64 -> Word64) -> Series m (N Word64) -> Series m Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Series m (N Word64)
forall (m :: * -> *) a. Serial m a => Series m a
series
-- | @since 1.1.4
instance Monad m => CoSerial m Word64 where coseries :: forall b. Series m b -> Series m (Word64 -> b)
coseries = ((N Word64 -> b) -> Word64 -> b)
-> Series m (N Word64 -> b) -> Series m (Word64 -> b)
forall a b. (a -> b) -> Series m a -> Series m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((N Word64 -> b) -> (Word64 -> N Word64) -> Word64 -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> N Word64
forall a. a -> N a
N) (Series m (N Word64 -> b) -> Series m (Word64 -> b))
-> (Series m b -> Series m (N Word64 -> b))
-> Series m b
-> Series m (Word64 -> b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Series m b -> Series m (N Word64 -> b)
forall b. Series m b -> Series m (N Word64 -> b)
forall (m :: * -> *) a b.
CoSerial m a =>
Series m b -> Series m (a -> b)
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 { forall a. N a -> a
unN :: a } deriving (N a -> N a -> Bool
(N a -> N a -> Bool) -> (N a -> N a -> Bool) -> Eq (N a)
forall a. Eq a => N a -> N a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => N a -> N a -> Bool
== :: N a -> N a -> Bool
$c/= :: forall a. Eq a => N a -> N a -> Bool
/= :: N a -> N a -> Bool
Eq, Eq (N a)
Eq (N a)
-> (N a -> N a -> Ordering)
-> (N a -> N a -> Bool)
-> (N a -> N a -> Bool)
-> (N a -> N a -> Bool)
-> (N a -> N a -> Bool)
-> (N a -> N a -> N a)
-> (N a -> N a -> N a)
-> Ord (N a)
N a -> N a -> Bool
N a -> N a -> Ordering
N a -> N a -> N a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {a}. Ord a => Eq (N a)
forall a. Ord a => N a -> N a -> Bool
forall a. Ord a => N a -> N a -> Ordering
forall a. Ord a => N a -> N a -> N a
$ccompare :: forall a. Ord a => N a -> N a -> Ordering
compare :: N a -> N a -> Ordering
$c< :: forall a. Ord a => N a -> N a -> Bool
< :: N a -> N a -> Bool
$c<= :: forall a. Ord a => N a -> N a -> Bool
<= :: N a -> N a -> Bool
$c> :: forall a. Ord a => N a -> N a -> Bool
> :: N a -> N a -> Bool
$c>= :: forall a. Ord a => N a -> N a -> Bool
>= :: N a -> N a -> Bool
$cmax :: forall a. Ord a => N a -> N a -> N a
max :: N a -> N a -> N a
$cmin :: forall a. Ord a => N a -> N a -> N a
min :: N a -> N a -> N a
Ord, Depth -> N a -> ShowS
[N a] -> ShowS
N a -> String
(Depth -> N a -> ShowS)
-> (N a -> String) -> ([N a] -> ShowS) -> Show (N a)
forall a. Show a => Depth -> N a -> ShowS
forall a. Show a => [N a] -> ShowS
forall a. Show a => N a -> String
forall a.
(Depth -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Depth -> N a -> ShowS
showsPrec :: Depth -> N a -> ShowS
$cshow :: forall a. Show a => N a -> String
show :: N a -> String
$cshowList :: forall a. Show a => [N a] -> ShowS
showList :: [N a] -> ShowS
Show)

instance Real a => Real (N a) where
  toRational :: N a -> Rational
toRational (N a
x) = a -> Rational
forall a. Real a => a -> Rational
toRational a
x

instance Enum a => Enum (N a) where
  toEnum :: Depth -> N a
toEnum Depth
x = a -> N a
forall a. a -> N a
N (Depth -> a
forall a. Enum a => Depth -> a
toEnum Depth
x)
  fromEnum :: N a -> Depth
fromEnum (N a
x) = a -> Depth
forall a. Enum a => a -> Depth
fromEnum a
x

instance Num a => Num (N a) where
  N a
x + :: N a -> N a -> N a
+ N a
y = a -> N a
forall a. a -> N a
N (a
x a -> a -> a
forall a. Num a => a -> a -> a
+ a
y)
  N a
x * :: N a -> N a -> N a
* N a
y = a -> N a
forall a. a -> N a
N (a
x a -> a -> a
forall a. Num a => a -> a -> a
* a
y)
  negate :: N a -> N a
negate (N a
x) = a -> N a
forall a. a -> N a
N (a -> a
forall a. Num a => a -> a
negate a
x)
  abs :: N a -> N a
abs (N a
x) = a -> N a
forall a. a -> N a
N (a -> a
forall a. Num a => a -> a
abs a
x)
  signum :: N a -> N a
signum (N a
x) = a -> N a
forall a. a -> N a
N (a -> a
forall a. Num a => a -> a
signum a
x)
  fromInteger :: Integer -> N a
fromInteger Integer
x = a -> N a
forall a. a -> N a
N (Integer -> a
forall a. Num a => Integer -> a
fromInteger Integer
x)

instance Integral a => Integral (N a) where
  quotRem :: N a -> N a -> (N a, N a)
quotRem (N a
x) (N a
y) = (a -> N a
forall a. a -> N a
N a
q, a -> N a
forall a. a -> N a
N a
r)
    where
      (a
q, a
r) = a
x a -> a -> (a, a)
forall a. Integral a => a -> a -> (a, a)
`quotRem` a
y
  toInteger :: N a -> Integer
toInteger (N a
x) = a -> Integer
forall a. Integral a => a -> Integer
toInteger a
x

instance (Num a, Enum a, Serial m a) => Serial m (N a) where
  series :: Series m (N a)
series = (Depth -> [N a]) -> Series m (N a)
forall a (m :: * -> *). (Depth -> [a]) -> Series m a
generate ((Depth -> [N a]) -> Series m (N a))
-> (Depth -> [N a]) -> Series m (N a)
forall a b. (a -> b) -> a -> b
$ \Depth
d -> Depth -> [N a] -> [N a]
forall a. Depth -> [a] -> [a]
take (Depth
dDepth -> Depth -> Depth
forall a. Num a => a -> a -> a
+Depth
1) [N a
0..]

instance (Integral a, Monad m) => CoSerial m (N a) where
  coseries :: forall b. Series m b -> Series m (N a -> b)
coseries Series m b
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'.
    Series m b -> Series m b
forall (m :: * -> *) a. Series m a -> Series m a
alts0 Series m b
rs Series m b -> (b -> Series m (N a -> b)) -> Series m (N a -> b)
forall a b. Series m a -> (a -> Series m b) -> Series m b
forall (m :: * -> *) a b. MonadLogic m => m a -> (a -> m b) -> m b
>>- \b
z ->
    Series m b -> Series m (N a -> b)
forall (m :: * -> *) a b.
CoSerial m a =>
Series m b -> Series m (a -> b)
alts1 Series m b
rs Series m (N a -> b)
-> ((N a -> b) -> Series m (N a -> b)) -> Series m (N a -> b)
forall a b. Series m a -> (a -> Series m b) -> Series m b
forall (m :: * -> *) a b. MonadLogic m => m a -> (a -> m b) -> m b
>>- \N a -> b
f ->
    (N a -> b) -> Series m (N a -> b)
forall a. a -> Series m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((N a -> b) -> Series m (N a -> b))
-> (N a -> b) -> Series m (N a -> b)
forall a b. (a -> b) -> a -> b
$ \(N a
i) ->
      if a
i a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
0
        then N a -> b
f (a -> N a
forall a. a -> N a
N (a -> N a) -> a -> N a
forall a b. (a -> b) -> a -> b
$ a
ia -> a -> a
forall a. Num a => a -> a -> a
-a
1)
        else b
z

-- | 'M' is a helper type to generate values of a signed type of increasing magnitude.
newtype M a = M { forall a. M a -> a
unM :: a } deriving (M a -> M a -> Bool
(M a -> M a -> Bool) -> (M a -> M a -> Bool) -> Eq (M a)
forall a. Eq a => M a -> M a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => M a -> M a -> Bool
== :: M a -> M a -> Bool
$c/= :: forall a. Eq a => M a -> M a -> Bool
/= :: M a -> M a -> Bool
Eq, Eq (M a)
Eq (M a)
-> (M a -> M a -> Ordering)
-> (M a -> M a -> Bool)
-> (M a -> M a -> Bool)
-> (M a -> M a -> Bool)
-> (M a -> M a -> Bool)
-> (M a -> M a -> M a)
-> (M a -> M a -> M a)
-> Ord (M a)
M a -> M a -> Bool
M a -> M a -> Ordering
M a -> M a -> M a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {a}. Ord a => Eq (M a)
forall a. Ord a => M a -> M a -> Bool
forall a. Ord a => M a -> M a -> Ordering
forall a. Ord a => M a -> M a -> M a
$ccompare :: forall a. Ord a => M a -> M a -> Ordering
compare :: M a -> M a -> Ordering
$c< :: forall a. Ord a => M a -> M a -> Bool
< :: M a -> M a -> Bool
$c<= :: forall a. Ord a => M a -> M a -> Bool
<= :: M a -> M a -> Bool
$c> :: forall a. Ord a => M a -> M a -> Bool
> :: M a -> M a -> Bool
$c>= :: forall a. Ord a => M a -> M a -> Bool
>= :: M a -> M a -> Bool
$cmax :: forall a. Ord a => M a -> M a -> M a
max :: M a -> M a -> M a
$cmin :: forall a. Ord a => M a -> M a -> M a
min :: M a -> M a -> M a
Ord, Depth -> M a -> ShowS
[M a] -> ShowS
M a -> String
(Depth -> M a -> ShowS)
-> (M a -> String) -> ([M a] -> ShowS) -> Show (M a)
forall a. Show a => Depth -> M a -> ShowS
forall a. Show a => [M a] -> ShowS
forall a. Show a => M a -> String
forall a.
(Depth -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Depth -> M a -> ShowS
showsPrec :: Depth -> M a -> ShowS
$cshow :: forall a. Show a => M a -> String
show :: M a -> String
$cshowList :: forall a. Show a => [M a] -> ShowS
showList :: [M a] -> ShowS
Show)

instance Real a => Real (M a) where
  toRational :: M a -> Rational
toRational (M a
x) = a -> Rational
forall a. Real a => a -> Rational
toRational a
x

instance Enum a => Enum (M a) where
  toEnum :: Depth -> M a
toEnum Depth
x = a -> M a
forall a. a -> M a
M (Depth -> a
forall a. Enum a => Depth -> a
toEnum Depth
x)
  fromEnum :: M a -> Depth
fromEnum (M a
x) = a -> Depth
forall a. Enum a => a -> Depth
fromEnum a
x

instance Num a => Num (M a) where
  M a
x + :: M a -> M a -> M a
+ M a
y = a -> M a
forall a. a -> M a
M (a
x a -> a -> a
forall a. Num a => a -> a -> a
+ a
y)
  M a
x * :: M a -> M a -> M a
* M a
y = a -> M a
forall a. a -> M a
M (a
x a -> a -> a
forall a. Num a => a -> a -> a
* a
y)
  negate :: M a -> M a
negate (M a
x) = a -> M a
forall a. a -> M a
M (a -> a
forall a. Num a => a -> a
negate a
x)
  abs :: M a -> M a
abs (M a
x) = a -> M a
forall a. a -> M a
M (a -> a
forall a. Num a => a -> a
abs a
x)
  signum :: M a -> M a
signum (M a
x) = a -> M a
forall a. a -> M a
M (a -> a
forall a. Num a => a -> a
signum a
x)
  fromInteger :: Integer -> M a
fromInteger Integer
x = a -> M a
forall a. a -> M a
M (Integer -> a
forall a. Num a => Integer -> a
fromInteger Integer
x)

instance Integral a => Integral (M a) where
  quotRem :: M a -> M a -> (M a, M a)
quotRem (M a
x) (M a
y) = (a -> M a
forall a. a -> M a
M a
q, a -> M a
forall a. a -> M a
M a
r)
    where
      (a
q, a
r) = a
x a -> a -> (a, a)
forall a. Integral a => a -> a -> (a, a)
`quotRem` a
y
  toInteger :: M a -> Integer
toInteger (M a
x) = a -> Integer
forall a. Integral a => a -> Integer
toInteger a
x

instance (Num a, Enum a, Monad m) => Serial m (M a) where
  series :: Series m (M a)
series = Series m (M a)
forall {m :: * -> *}. Series m (M a)
others Series m (M a) -> Series m (M a) -> Series m (M a)
forall a. Series m a -> Series m a -> Series m a
forall (m :: * -> *) a. MonadLogic m => m a -> m a -> m a
`interleave` Series m (M a)
forall {m :: * -> *}. Series m (M a)
positives
    where positives :: Series m (M a)
positives = (Depth -> [M a]) -> Series m (M a)
forall a (m :: * -> *). (Depth -> [a]) -> Series m a
generate ((Depth -> [M a]) -> Series m (M a))
-> (Depth -> [M a]) -> Series m (M a)
forall a b. (a -> b) -> a -> b
$ \Depth
d -> Depth -> [M a] -> [M a]
forall a. Depth -> [a] -> [a]
take Depth
d [M a
1..]
          others :: Series m (M a)
others = (Depth -> [M a]) -> Series m (M a)
forall a (m :: * -> *). (Depth -> [a]) -> Series m a
generate ((Depth -> [M a]) -> Series m (M a))
-> (Depth -> [M a]) -> Series m (M a)
forall a b. (a -> b) -> a -> b
$ \Depth
d -> Depth -> [M a] -> [M a]
forall a. Depth -> [a] -> [a]
take (Depth
dDepth -> Depth -> Depth
forall a. Num a => a -> a -> a
+Depth
1) [M a
0,-M a
1..]

instance (Ord a, Num a, Monad m) => CoSerial m (M a) where
  coseries :: forall b. Series m b -> Series m (M a -> b)
coseries Series m b
rs =
    Series m b -> Series m b
forall (m :: * -> *) a. Series m a -> Series m a
alts0 Series m b
rs Series m b -> (b -> Series m (M a -> b)) -> Series m (M a -> b)
forall a b. Series m a -> (a -> Series m b) -> Series m b
forall (m :: * -> *) a b. MonadLogic m => m a -> (a -> m b) -> m b
>>- \b
z ->
    Series m b -> Series m (M (M a) -> b)
forall (m :: * -> *) a b.
CoSerial m a =>
Series m b -> Series m (a -> b)
alts1 Series m b
rs Series m (M (M a) -> b)
-> ((M (M a) -> b) -> Series m (M a -> b)) -> Series m (M a -> b)
forall a b. Series m a -> (a -> Series m b) -> Series m b
forall (m :: * -> *) a b. MonadLogic m => m a -> (a -> m b) -> m b
>>- \M (M a) -> b
f ->
    Series m b -> Series m (M (M a) -> b)
forall (m :: * -> *) a b.
CoSerial m a =>
Series m b -> Series m (a -> b)
alts1 Series m b
rs Series m (M (M a) -> b)
-> ((M (M a) -> b) -> Series m (M a -> b)) -> Series m (M a -> b)
forall a b. Series m a -> (a -> Series m b) -> Series m b
forall (m :: * -> *) a b. MonadLogic m => m a -> (a -> m b) -> m b
>>- \M (M a) -> b
g ->
    (M a -> b) -> Series m (M a -> b)
forall a. a -> Series m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((M a -> b) -> Series m (M a -> b))
-> (M a -> b) -> Series m (M a -> b)
forall a b. (a -> b) -> a -> b
$ \ M a
i -> case M a -> M a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare M a
i M a
0 of
        Ordering
GT -> M (M a) -> b
f (M a -> M (M a)
forall a. a -> M a
M (M a
i M a -> M a -> M a
forall a. Num a => a -> a -> a
- M a
1))
        Ordering
LT -> M (M a) -> b
g (M a -> M (M a)
forall a. a -> M a
M (M a -> M a
forall a. Num a => a -> a
abs M a
i M a -> M a -> M a
forall a. Num a => a -> a -> a
- M a
1))
        Ordering
EQ -> b
z

instance Monad m => Serial m Float where
  series :: Series m Float
series =
    Series m (Integer, Depth)
forall (m :: * -> *) a. Serial m a => Series m a
series Series m (Integer, Depth)
-> ((Integer, Depth) -> Series m Float) -> Series m Float
forall a b. Series m a -> (a -> Series m b) -> Series m b
forall (m :: * -> *) a b. MonadLogic m => m a -> (a -> m b) -> m b
>>- \(Integer
sig, Depth
exp) ->
    Bool -> Series m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Integer -> Bool
forall a. Integral a => a -> Bool
odd Integer
sig Bool -> Bool -> Bool
|| Integer
sigInteger -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
==Integer
0 Bool -> Bool -> Bool
&& Depth
expDepth -> Depth -> Bool
forall a. Eq a => a -> a -> Bool
==Depth
0) Series m () -> Series m Float -> Series m Float
forall a b. Series m a -> Series m b -> Series m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
    Float -> Series m Float
forall a. a -> Series m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> Depth -> Float
forall a. RealFloat a => Integer -> Depth -> a
encodeFloat Integer
sig Depth
exp)
instance Monad m => CoSerial m Float where
  coseries :: forall b. Series m b -> Series m (Float -> b)
coseries Series m b
rs =
    Series m b -> Series m ((Integer, Depth) -> b)
forall b. Series m b -> Series m ((Integer, Depth) -> b)
forall (m :: * -> *) a b.
CoSerial m a =>
Series m b -> Series m (a -> b)
coseries Series m b
rs Series m ((Integer, Depth) -> b)
-> (((Integer, Depth) -> b) -> Series m (Float -> b))
-> Series m (Float -> b)
forall a b. Series m a -> (a -> Series m b) -> Series m b
forall (m :: * -> *) a b. MonadLogic m => m a -> (a -> m b) -> m b
>>- \(Integer, Depth) -> b
f ->
      (Float -> b) -> Series m (Float -> b)
forall a. a -> Series m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Float -> b) -> Series m (Float -> b))
-> (Float -> b) -> Series m (Float -> b)
forall a b. (a -> b) -> a -> b
$ (Integer, Depth) -> b
f ((Integer, Depth) -> b)
-> (Float -> (Integer, Depth)) -> Float -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> (Integer, Depth)
forall a. RealFloat a => a -> (Integer, Depth)
decodeFloat

instance Monad m => Serial m Double where
  series :: Series m Double
series = (Float -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac :: Float -> Double) (Float -> Double) -> Series m Float -> Series m Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Series m Float
forall (m :: * -> *) a. Serial m a => Series m a
series
instance Monad m => CoSerial m Double where
  coseries :: forall b. Series m b -> Series m (Double -> b)
coseries Series m b
rs =
    ((Float -> b) -> (Double -> Float) -> Double -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac :: Double -> Float)) ((Float -> b) -> Double -> b)
-> Series m (Float -> b) -> Series m (Double -> b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Series m b -> Series m (Float -> b)
forall b. Series m b -> Series m (Float -> b)
forall (m :: * -> *) a b.
CoSerial m a =>
Series m b -> Series m (a -> b)
coseries Series m b
rs

-- | @since 1.1
instance (Integral i, Serial m i) => Serial m (Ratio i) where
  series :: Series m (Ratio i)
series = (i, Positive i) -> Ratio i
forall {a}. Integral a => (a, Positive a) -> Ratio a
pairToRatio ((i, Positive i) -> Ratio i)
-> Series m (i, Positive i) -> Series m (Ratio i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Series m (i, Positive i)
forall (m :: * -> *) a. Serial m a => Series m a
series
    where
      pairToRatio :: (a, Positive a) -> Ratio a
pairToRatio (a
n, Positive a
d) = a
n a -> a -> Ratio a
forall a. Integral a => a -> a -> Ratio a
% a
d
-- | @since 1.1
instance (Integral i, CoSerial m i) => CoSerial m (Ratio i) where
  coseries :: forall b. Series m b -> Series m (Ratio i -> b)
coseries Series m b
rs = (((i, i) -> b) -> (Ratio i -> (i, i)) -> Ratio i -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ratio i -> (i, i)
forall {b}. Ratio b -> (b, b)
ratioToPair) (((i, i) -> b) -> Ratio i -> b)
-> Series m ((i, i) -> b) -> Series m (Ratio i -> b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Series m b -> Series m ((i, i) -> b)
forall b. Series m b -> Series m ((i, i) -> b)
forall (m :: * -> *) a b.
CoSerial m a =>
Series m b -> Series m (a -> b)
coseries Series m b
rs
    where
      ratioToPair :: Ratio b -> (b, b)
ratioToPair Ratio b
r = (Ratio b -> b
forall a. Ratio a -> a
numerator Ratio b
r, Ratio b -> b
forall a. Ratio a -> a
denominator Ratio b
r)

instance Monad m => Serial m Char where
  series :: Series m Char
series = (Depth -> String) -> Series m Char
forall a (m :: * -> *). (Depth -> [a]) -> Series m a
generate ((Depth -> String) -> Series m Char)
-> (Depth -> String) -> Series m Char
forall a b. (a -> b) -> a -> b
$ \Depth
d -> Depth -> ShowS
forall a. Depth -> [a] -> [a]
take (Depth
dDepth -> Depth -> Depth
forall a. Num a => a -> a -> a
+Depth
1) [Char
'a'..Char
'z']
instance Monad m => CoSerial m Char where
  coseries :: forall b. Series m b -> Series m (Char -> b)
coseries Series m b
rs =
    Series m b -> Series m (N Depth -> b)
forall b. Series m b -> Series m (N Depth -> b)
forall (m :: * -> *) a b.
CoSerial m a =>
Series m b -> Series m (a -> b)
coseries Series m b
rs Series m (N Depth -> b)
-> ((N Depth -> b) -> Series m (Char -> b)) -> Series m (Char -> b)
forall a b. Series m a -> (a -> Series m b) -> Series m b
forall (m :: * -> *) a b. MonadLogic m => m a -> (a -> m b) -> m b
>>- \N Depth -> b
f ->
    (Char -> b) -> Series m (Char -> b)
forall a. a -> Series m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Char -> b) -> Series m (Char -> b))
-> (Char -> b) -> Series m (Char -> b)
forall a b. (a -> b) -> a -> b
$ \Char
c -> N Depth -> b
f (Depth -> N Depth
forall a. a -> N a
N (Char -> Depth
forall a. Enum a => a -> Depth
fromEnum Char
c Depth -> Depth -> Depth
forall a. Num a => a -> a -> a
- Char -> Depth
forall a. Enum a => a -> Depth
fromEnum Char
'a'))

instance (Serial m a, Serial m b) => Serial m (a,b) where
  series :: Series m (a, b)
series = (a -> b -> (a, b)) -> Series m (a, b)
forall (m :: * -> *) a b c.
(Serial m a, Serial m b) =>
(a -> b -> c) -> Series m c
cons2 (,)
instance (CoSerial m a, CoSerial m b) => CoSerial m (a,b) where
  coseries :: forall b. Series m b -> Series m ((a, b) -> b)
coseries Series m b
rs = (a -> b -> b) -> (a, b) -> b
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((a -> b -> b) -> (a, b) -> b)
-> Series m (a -> b -> b) -> Series m ((a, b) -> b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Series m b -> Series m (a -> b -> b)
forall (m :: * -> *) a b c.
(CoSerial m a, CoSerial m b) =>
Series m c -> Series m (a -> b -> c)
alts2 Series m b
rs

instance (Serial m a, Serial m b, Serial m c) => Serial m (a,b,c) where
  series :: Series m (a, b, c)
series = (a -> b -> c -> (a, b, c)) -> Series m (a, b, c)
forall (m :: * -> *) a b c d.
(Serial m a, Serial m b, Serial m c) =>
(a -> b -> c -> d) -> Series m d
cons3 (,,)
instance (CoSerial m a, CoSerial m b, CoSerial m c) => CoSerial m (a,b,c) where
  coseries :: forall b. Series m b -> Series m ((a, b, c) -> b)
coseries Series m b
rs = (a -> b -> c -> b) -> (a, b, c) -> b
forall a b c d. (a -> b -> c -> d) -> (a, b, c) -> d
uncurry3 ((a -> b -> c -> b) -> (a, b, c) -> b)
-> Series m (a -> b -> c -> b) -> Series m ((a, b, c) -> b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Series m b -> Series m (a -> b -> c -> b)
forall (m :: * -> *) a b c d.
(CoSerial m a, CoSerial m b, CoSerial m c) =>
Series m d -> Series m (a -> b -> c -> d)
alts3 Series m b
rs

instance (Serial m a, Serial m b, Serial m c, Serial m d) => Serial m (a,b,c,d) where
  series :: Series m (a, b, c, d)
series = (a -> b -> c -> d -> (a, b, c, d)) -> Series m (a, b, c, d)
forall (m :: * -> *) a b c d e.
(Serial m a, Serial m b, Serial m c, Serial m d) =>
(a -> b -> c -> d -> e) -> Series m e
cons4 (,,,)
instance (CoSerial m a, CoSerial m b, CoSerial m c, CoSerial m d) => CoSerial m (a,b,c,d) where
  coseries :: forall b. Series m b -> Series m ((a, b, c, d) -> b)
coseries Series m b
rs = (a -> b -> c -> d -> b) -> (a, b, c, d) -> b
forall a b c d e. (a -> b -> c -> d -> e) -> (a, b, c, d) -> e
uncurry4 ((a -> b -> c -> d -> b) -> (a, b, c, d) -> b)
-> Series m (a -> b -> c -> d -> b) -> Series m ((a, b, c, d) -> b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Series m b -> Series m (a -> b -> c -> d -> b)
forall (m :: * -> *) a b c d e.
(CoSerial m a, CoSerial m b, CoSerial m c, CoSerial m d) =>
Series m e -> Series m (a -> b -> c -> d -> e)
alts4 Series m b
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 :: Series m (a, b, c, d, e)
series = (a -> b -> c -> d -> e -> (a, b, c, d, e))
-> Series m (a, b, c, d, e)
forall (m :: * -> *) a b c d e f.
(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 (,,,,)
-- | @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 :: forall b. Series m b -> Series m ((a, b, c, d, e) -> b)
coseries Series m b
rs = (a -> b -> c -> d -> e -> b) -> (a, b, c, d, e) -> b
forall a b c d e f.
(a -> b -> c -> d -> e -> f) -> (a, b, c, d, e) -> f
uncurry5 ((a -> b -> c -> d -> e -> b) -> (a, b, c, d, e) -> b)
-> Series m (a -> b -> c -> d -> e -> b)
-> Series m ((a, b, c, d, e) -> b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Series m b -> Series m (a -> b -> c -> d -> e -> b)
forall (m :: * -> *) a b c d e f.
(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 Series m b
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 :: Series m (a, b, c, d, e, f)
series = (a -> b -> c -> d -> e -> f -> (a, b, c, d, e, f))
-> Series m (a, b, c, d, e, f)
forall (m :: * -> *) a b c d e f g.
(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 (,,,,,)
-- | @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 :: forall b. Series m b -> Series m ((a, b, c, d, e, f) -> b)
coseries Series m b
rs = (a -> b -> c -> d -> e -> f -> b) -> (a, b, c, d, e, f) -> b
forall a b c d e f g.
(a -> b -> c -> d -> e -> f -> g) -> (a, b, c, d, e, f) -> g
uncurry6 ((a -> b -> c -> d -> e -> f -> b) -> (a, b, c, d, e, f) -> b)
-> Series m (a -> b -> c -> d -> e -> f -> b)
-> Series m ((a, b, c, d, e, f) -> b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Series m b -> Series m (a -> b -> c -> d -> e -> f -> b)
forall (m :: * -> *) a b c d e f g.
(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 Series m b
rs

instance Monad m => Serial m Bool where
  series :: Series m Bool
series = Bool -> Series m Bool
forall a (m :: * -> *). a -> Series m a
cons0 Bool
True Series m Bool -> Series m Bool -> Series m Bool
forall (m :: * -> *) a.
Monad m =>
Series m a -> Series m a -> Series m a
\/ Bool -> Series m Bool
forall a (m :: * -> *). a -> Series m a
cons0 Bool
False
instance Monad m => CoSerial m Bool where
  coseries :: forall b. Series m b -> Series m (Bool -> b)
coseries Series m b
rs =
    Series m b
rs Series m b -> (b -> Series m (Bool -> b)) -> Series m (Bool -> b)
forall a b. Series m a -> (a -> Series m b) -> Series m b
forall (m :: * -> *) a b. MonadLogic m => m a -> (a -> m b) -> m b
>>- \b
r1 ->
    Series m b
rs Series m b -> (b -> Series m (Bool -> b)) -> Series m (Bool -> b)
forall a b. Series m a -> (a -> Series m b) -> Series m b
forall (m :: * -> *) a b. MonadLogic m => m a -> (a -> m b) -> m b
>>- \b
r2 ->
    (Bool -> b) -> Series m (Bool -> b)
forall a. a -> Series m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Bool -> b) -> Series m (Bool -> b))
-> (Bool -> b) -> Series m (Bool -> b)
forall a b. (a -> b) -> a -> b
$ \Bool
x -> if Bool
x then b
r1 else b
r2

-- | @since 1.2.1
instance Monad m => Serial m Ordering where
  series :: Series m Ordering
series = Ordering -> Series m Ordering
forall a (m :: * -> *). a -> Series m a
cons0 Ordering
LT Series m Ordering -> Series m Ordering -> Series m Ordering
forall (m :: * -> *) a.
Monad m =>
Series m a -> Series m a -> Series m a
\/ Ordering -> Series m Ordering
forall a (m :: * -> *). a -> Series m a
cons0 Ordering
EQ Series m Ordering -> Series m Ordering -> Series m Ordering
forall (m :: * -> *) a.
Monad m =>
Series m a -> Series m a -> Series m a
\/ Ordering -> Series m Ordering
forall a (m :: * -> *). a -> Series m a
cons0 Ordering
GT
-- | @since 1.2.1
instance Monad m => CoSerial m Ordering where
  coseries :: forall b. Series m b -> Series m (Ordering -> b)
coseries Series m b
rs =
    Series m b
rs Series m b
-> (b -> Series m (Ordering -> b)) -> Series m (Ordering -> b)
forall a b. Series m a -> (a -> Series m b) -> Series m b
forall (m :: * -> *) a b. MonadLogic m => m a -> (a -> m b) -> m b
>>- \b
r1 ->
    Series m b
rs Series m b
-> (b -> Series m (Ordering -> b)) -> Series m (Ordering -> b)
forall a b. Series m a -> (a -> Series m b) -> Series m b
forall (m :: * -> *) a b. MonadLogic m => m a -> (a -> m b) -> m b
>>- \b
r2 ->
    Series m b
rs Series m b
-> (b -> Series m (Ordering -> b)) -> Series m (Ordering -> b)
forall a b. Series m a -> (a -> Series m b) -> Series m b
forall (m :: * -> *) a b. MonadLogic m => m a -> (a -> m b) -> m b
>>- \b
r3 ->
    (Ordering -> b) -> Series m (Ordering -> b)
forall a. a -> Series m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Ordering -> b) -> Series m (Ordering -> b))
-> (Ordering -> b) -> Series m (Ordering -> b)
forall a b. (a -> b) -> a -> b
$ \Ordering
x -> case Ordering
x of
        Ordering
LT -> b
r1
        Ordering
EQ -> b
r2
        Ordering
GT -> b
r3

instance (Serial m a) => Serial m (Maybe a) where
  series :: Series m (Maybe a)
series = Maybe a -> Series m (Maybe a)
forall a (m :: * -> *). a -> Series m a
cons0 Maybe a
forall a. Maybe a
Nothing Series m (Maybe a) -> Series m (Maybe a) -> Series m (Maybe a)
forall (m :: * -> *) a.
Monad m =>
Series m a -> Series m a -> Series m a
\/ (a -> Maybe a) -> Series m (Maybe a)
forall (m :: * -> *) a b. Serial m a => (a -> b) -> Series m b
cons1 a -> Maybe a
forall a. a -> Maybe a
Just
instance (CoSerial m a) => CoSerial m (Maybe a) where
  coseries :: forall b. Series m b -> Series m (Maybe a -> b)
coseries Series m b
rs =
    b -> (a -> b) -> Maybe a -> b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (b -> (a -> b) -> Maybe a -> b)
-> Series m b -> Series m ((a -> b) -> Maybe a -> b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Series m b -> Series m b
forall (m :: * -> *) a. Series m a -> Series m a
alts0 Series m b
rs Series m ((a -> b) -> Maybe a -> b)
-> Series m (a -> b) -> Series m (Maybe a -> b)
forall (m :: * -> *) a b.
Monad m =>
Series m (a -> b) -> Series m a -> Series m b
<~> Series m b -> Series m (a -> b)
forall (m :: * -> *) a b.
CoSerial m a =>
Series m b -> Series m (a -> b)
alts1 Series m b
rs

instance (Serial m a, Serial m b) => Serial m (Either a b) where
  series :: Series m (Either a b)
series = (a -> Either a b) -> Series m (Either a b)
forall (m :: * -> *) a b. Serial m a => (a -> b) -> Series m b
cons1 a -> Either a b
forall a b. a -> Either a b
Left Series m (Either a b)
-> Series m (Either a b) -> Series m (Either a b)
forall (m :: * -> *) a.
Monad m =>
Series m a -> Series m a -> Series m a
\/ (b -> Either a b) -> Series m (Either a b)
forall (m :: * -> *) a b. Serial m a => (a -> b) -> Series m b
cons1 b -> Either a b
forall a b. b -> Either a b
Right
instance (CoSerial m a, CoSerial m b) => CoSerial m (Either a b) where
  coseries :: forall b. Series m b -> Series m (Either a b -> b)
coseries Series m b
rs =
    (a -> b) -> (b -> b) -> Either a b -> b
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ((a -> b) -> (b -> b) -> Either a b -> b)
-> Series m (a -> b) -> Series m ((b -> b) -> Either a b -> b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Series m b -> Series m (a -> b)
forall (m :: * -> *) a b.
CoSerial m a =>
Series m b -> Series m (a -> b)
alts1 Series m b
rs Series m ((b -> b) -> Either a b -> b)
-> Series m (b -> b) -> Series m (Either a b -> b)
forall (m :: * -> *) a b.
Monad m =>
Series m (a -> b) -> Series m a -> Series m b
<~> Series m b -> Series m (b -> b)
forall (m :: * -> *) a b.
CoSerial m a =>
Series m b -> Series m (a -> b)
alts1 Series m b
rs

instance Serial m a => Serial m [a] where
  series :: Series m [a]
series = [a] -> Series m [a]
forall a (m :: * -> *). a -> Series m a
cons0 [] Series m [a] -> Series m [a] -> Series m [a]
forall (m :: * -> *) a.
Monad m =>
Series m a -> Series m a -> Series m a
\/ (a -> [a] -> [a]) -> Series m [a]
forall (m :: * -> *) a b c.
(Serial m a, Serial m b) =>
(a -> b -> c) -> Series m c
cons2 (:)
instance CoSerial m a => CoSerial m [a] where
  coseries :: forall b. Series m b -> Series m ([a] -> b)
coseries Series m b
rs =
    Series m b -> Series m b
forall (m :: * -> *) a. Series m a -> Series m a
alts0 Series m b
rs Series m b -> (b -> Series m ([a] -> b)) -> Series m ([a] -> b)
forall a b. Series m a -> (a -> Series m b) -> Series m b
forall (m :: * -> *) a b. MonadLogic m => m a -> (a -> m b) -> m b
>>- \b
y ->
    Series m b -> Series m (a -> [a] -> b)
forall (m :: * -> *) a b c.
(CoSerial m a, CoSerial m b) =>
Series m c -> Series m (a -> b -> c)
alts2 Series m b
rs Series m (a -> [a] -> b)
-> ((a -> [a] -> b) -> Series m ([a] -> b)) -> Series m ([a] -> b)
forall a b. Series m a -> (a -> Series m b) -> Series m b
forall (m :: * -> *) a b. MonadLogic m => m a -> (a -> m b) -> m b
>>- \a -> [a] -> b
f ->
    ([a] -> b) -> Series m ([a] -> b)
forall a. a -> Series m a
forall (m :: * -> *) a. Monad m => a -> m a
return (([a] -> b) -> Series m ([a] -> b))
-> ([a] -> b) -> Series m ([a] -> b)
forall a b. (a -> b) -> a -> b
$ \[a]
xs -> case [a]
xs of [] -> b
y; a
x:[a]
xs' -> a -> [a] -> b
f a
x [a]
xs'

-- | @since 1.2.0
instance Serial m a => Serial m (NE.NonEmpty a) where
  series :: Series m (NonEmpty a)
series = (a -> [a] -> NonEmpty a) -> Series m (NonEmpty a)
forall (m :: * -> *) a b c.
(Serial m a, Serial m b) =>
(a -> b -> c) -> Series m c
cons2 a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
(NE.:|)

-- | @since 1.2.0
instance CoSerial m a => CoSerial m (NE.NonEmpty a) where
  coseries :: forall b. Series m b -> Series m (NonEmpty a -> b)
coseries Series m b
rs =
    Series m b -> Series m (a -> [a] -> b)
forall (m :: * -> *) a b c.
(CoSerial m a, CoSerial m b) =>
Series m c -> Series m (a -> b -> c)
alts2 Series m b
rs Series m (a -> [a] -> b)
-> ((a -> [a] -> b) -> Series m (NonEmpty a -> b))
-> Series m (NonEmpty a -> b)
forall a b. Series m a -> (a -> Series m b) -> Series m b
forall (m :: * -> *) a b. MonadLogic m => m a -> (a -> m b) -> m b
>>- \a -> [a] -> b
f ->
    (NonEmpty a -> b) -> Series m (NonEmpty a -> b)
forall a. a -> Series m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((NonEmpty a -> b) -> Series m (NonEmpty a -> b))
-> (NonEmpty a -> b) -> Series m (NonEmpty a -> b)
forall a b. (a -> b) -> a -> b
$ \(a
x NE.:| [a]
xs') -> a -> [a] -> b
f a
x [a]
xs'

#if MIN_VERSION_base(4,4,0)
-- | @since 1.2.0
instance Serial m a => Serial m (Complex a) where
#else
-- | @since 1.2.0
instance (RealFloat a, Serial m a) => Serial m (Complex a) where
#endif
  series :: Series m (Complex a)
series = (a -> a -> Complex a) -> Series m (Complex a)
forall (m :: * -> *) a b c.
(Serial m a, Serial m b) =>
(a -> b -> c) -> Series m c
cons2 a -> a -> Complex a
forall a. a -> a -> Complex a
(:+)

#if MIN_VERSION_base(4,4,0)
-- | @since 1.2.0
instance CoSerial m a => CoSerial m (Complex a) where
#else
-- | @since 1.2.0
instance (RealFloat a, CoSerial m a) => CoSerial m (Complex a) where
#endif
  coseries :: forall b. Series m b -> Series m (Complex a -> b)
coseries Series m b
rs =
    Series m b -> Series m (a -> a -> b)
forall (m :: * -> *) a b c.
(CoSerial m a, CoSerial m b) =>
Series m c -> Series m (a -> b -> c)
alts2 Series m b
rs Series m (a -> a -> b)
-> ((a -> a -> b) -> Series m (Complex a -> b))
-> Series m (Complex a -> b)
forall a b. Series m a -> (a -> Series m b) -> Series m b
forall (m :: * -> *) a b. MonadLogic m => m a -> (a -> m b) -> m b
>>- \a -> a -> b
f ->
    (Complex a -> b) -> Series m (Complex a -> b)
forall a. a -> Series m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Complex a -> b) -> Series m (Complex a -> b))
-> (Complex a -> b) -> Series m (Complex a -> b)
forall a b. (a -> b) -> a -> b
$ \(a
x :+ a
xs') -> a -> a -> b
f a
x a
xs'

-- | @since 1.2.0
instance Monad m => Serial m Void where
  series :: Series m Void
series = Series m Void
forall a. Series m a
forall (m :: * -> *) a. MonadPlus m => m a
mzero

-- | @since 1.2.0
instance Monad m => CoSerial m Void where
  coseries :: forall b. Series m b -> Series m (Void -> b)
coseries = Series m (Void -> b) -> Series m b -> Series m (Void -> b)
forall a b. a -> b -> a
const (Series m (Void -> b) -> Series m b -> Series m (Void -> b))
-> Series m (Void -> b) -> Series m b -> Series m (Void -> b)
forall a b. (a -> b) -> a -> b
$ (Void -> b) -> Series m (Void -> b)
forall a. a -> Series m a
forall (m :: * -> *) a. Monad m => a -> m a
return Void -> b
forall a. Void -> a
absurd

instance (CoSerial m a, Serial m b) => Serial m (a->b) where
  series :: Series m (a -> b)
series = Series m b -> Series m (a -> b)
forall b. Series m b -> Series m (a -> b)
forall (m :: * -> *) a b.
CoSerial m a =>
Series m b -> Series m (a -> b)
coseries Series m b
forall (m :: * -> *) a. Serial m a => Series m a
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 :: forall b. Series m b -> Series m ((a -> b) -> b)
coseries Series m b
r = do
    [a]
args <- Series m a -> Series m [a]
forall (m :: * -> *) a. MonadLogic m => m a -> m [a]
unwind Series m a
forall (m :: * -> *) a. Serial m a => Series m a
series

    [b] -> b
g <- Series m b -> [a] -> Series m ([b] -> b)
forall a b (m :: * -> *) c.
(Serial m b, CoSerial m b) =>
Series m c -> [a] -> Series m ([b] -> c)
nest Series m b
r [a]
args
    ((a -> b) -> b) -> Series m ((a -> b) -> b)
forall a. a -> Series m a
forall (m :: * -> *) a. Monad m => a -> m a
return (((a -> b) -> b) -> Series m ((a -> b) -> b))
-> ((a -> b) -> b) -> Series m ((a -> b) -> b)
forall a b. (a -> b) -> a -> b
$ \a -> b
f -> [b] -> b
g ([b] -> b) -> [b] -> b
forall a b. (a -> b) -> a -> b
$ (a -> b) -> [a] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map a -> b
f [a]
args

    where

    nest :: forall a b m c . (Serial m b, CoSerial m b) => Series m c -> [a] -> Series m ([b] -> c)
    nest :: forall a b (m :: * -> *) c.
(Serial m b, CoSerial m b) =>
Series m c -> [a] -> Series m ([b] -> c)
nest Series m c
rs [a]
args = do
      case [a]
args of
        [] -> c -> [b] -> c
forall a b. a -> b -> a
const (c -> [b] -> c) -> Series m c -> Series m ([b] -> c)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` Series m c
rs
        a
_:[a]
rest -> do
          let sf :: Series m (b -> [b] -> c)
sf = Series m ([b] -> c) -> Series m (b -> [b] -> c)
forall b. Series m b -> Series m (b -> b)
forall (m :: * -> *) a b.
CoSerial m a =>
Series m b -> Series m (a -> b)
coseries (Series m ([b] -> c) -> Series m (b -> [b] -> c))
-> Series m ([b] -> c) -> Series m (b -> [b] -> c)
forall a b. (a -> b) -> a -> b
$ Series m c -> [a] -> Series m ([b] -> c)
forall a b (m :: * -> *) c.
(Serial m b, CoSerial m b) =>
Series m c -> [a] -> Series m ([b] -> c)
nest Series m c
rs [a]
rest
          b -> [b] -> c
f <- Series m (b -> [b] -> c)
sf
          ([b] -> c) -> Series m ([b] -> c)
forall a. a -> Series m a
forall (m :: * -> *) a. Monad m => a -> m a
return (([b] -> c) -> Series m ([b] -> c))
-> ([b] -> c) -> Series m ([b] -> c)
forall a b. (a -> b) -> a -> b
$ \(b
b:[b]
bs) -> b -> [b] -> c
f b
b [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 :: (a -> b) -> String
show a -> b
f =
    if Depth
maxarheight Depth -> Depth -> Bool
forall a. Eq a => a -> a -> Bool
== Depth
1
    Bool -> Bool -> Bool
&& Depth
sumarwidth Depth -> Depth -> Depth
forall a. Num a => a -> a -> a
+ [(String, String)] -> Depth
forall a. [a] -> Depth
forall (t :: * -> *) a. Foldable t => t a -> Depth
length [(String, String)]
ars Depth -> Depth -> Depth
forall a. Num a => a -> a -> a
* String -> Depth
forall a. [a] -> Depth
forall (t :: * -> *) a. Foldable t => t a -> Depth
length String
"->;" Depth -> Depth -> Bool
forall a. Ord a => a -> a -> Bool
< Depth
widthLimit then
      String
"{"String -> ShowS
forall a. [a] -> [a] -> [a]
++
      String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
";" [String
aString -> ShowS
forall a. [a] -> [a] -> [a]
++String
"->"String -> ShowS
forall a. [a] -> [a] -> [a]
++String
r | (String
a,String
r) <- [(String, String)]
ars]
      String -> ShowS
forall a. [a] -> [a] -> [a]
++String
"}"
    else
      [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [String
aString -> ShowS
forall a. [a] -> [a] -> [a]
++String
"->\n"String -> ShowS
forall a. [a] -> [a] -> [a]
++ShowS
indent String
r | (String
a,String
r) <- [(String, String)]
ars]
    where
    ars :: [(String, String)]
ars = Depth -> [(String, String)] -> [(String, String)]
forall a. Depth -> [a] -> [a]
take Depth
lengthLimit [ (a -> String
forall a. Show a => a -> String
show a
x, b -> String
forall a. Show a => a -> String
show (a -> b
f a
x))
                           | a
x <- Depth -> Series Identity a -> [a]
forall a. Depth -> Series Identity a -> [a]
list Depth
depthLimit Series Identity a
forall (m :: * -> *) a. Serial m a => Series m a
series ]
    maxarheight :: Depth
maxarheight = [Depth] -> Depth
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum  [ Depth -> Depth -> Depth
forall a. Ord a => a -> a -> a
max (String -> Depth
height String
a) (String -> Depth
height String
r)
                           | (String
a,String
r) <- [(String, String)]
ars ]
    sumarwidth :: Depth
sumarwidth = [Depth] -> Depth
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum       [ String -> Depth
forall a. [a] -> Depth
forall (t :: * -> *) a. Foldable t => t a -> Depth
length String
a Depth -> Depth -> Depth
forall a. Num a => a -> a -> a
+ String -> Depth
forall a. [a] -> Depth
forall (t :: * -> *) a. Foldable t => t a -> Depth
length String
r
                           | (String
a,String
r) <- [(String, String)]
ars]
    indent :: ShowS
indent = [String] -> String
unlines ([String] -> String) -> (String -> [String]) -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
"  "String -> ShowS
forall a. [a] -> [a] -> [a]
++) ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines
    height :: String -> Depth
height = [String] -> Depth
forall a. [a] -> Depth
forall (t :: * -> *) a. Foldable t => t a -> Depth
length ([String] -> Depth) -> (String -> [String]) -> String -> Depth
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines
    (Depth
widthLimit,Depth
lengthLimit,Depth
depthLimit) = (Depth
80,Depth
20,Depth
3)::(Int,Int,Depth)

-- | @since 1.2.0
instance (Monad m, Serial m (f (g a))) => Serial m (Compose f g a) where
  series :: Series m (Compose f g a)
series = f (g a) -> Compose f g a
forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (f (g a) -> Compose f g a)
-> Series m (f (g a)) -> Series m (Compose f g a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Series m (f (g a))
forall (m :: * -> *) a. Serial m a => Series m a
series
-- | @since 1.2.0
instance (Monad m, CoSerial m (f (g a))) => CoSerial m (Compose f g a) where
  coseries :: forall b. Series m b -> Series m (Compose f g a -> b)
coseries = ((f (g a) -> b) -> Compose f g a -> b)
-> Series m (f (g a) -> b) -> Series m (Compose f g a -> b)
forall a b. (a -> b) -> Series m a -> Series m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((f (g a) -> b) -> (Compose f g a -> f (g a)) -> Compose f g a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Compose f g a -> f (g a)
forall {k1} {k2} (f :: k1 -> *) (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose) (Series m (f (g a) -> b) -> Series m (Compose f g a -> b))
-> (Series m b -> Series m (f (g a) -> b))
-> Series m b
-> Series m (Compose f g a -> b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Series m b -> Series m (f (g a) -> b)
forall b. Series m b -> Series m (f (g a) -> b)
forall (m :: * -> *) a b.
CoSerial m a =>
Series m b -> Series m (a -> b)
coseries

-- }}}

------------------------------
-- Convenient wrappers
------------------------------
-- {{{

--------------------------------------------------------------------------
-- | 'Positive' @x@ guarantees that \( x > 0 \).
--
-- @since 1.0
newtype Positive a = Positive { forall a. Positive a -> a
getPositive :: a }
  deriving
  ( Positive a -> Positive a -> Bool
(Positive a -> Positive a -> Bool)
-> (Positive a -> Positive a -> Bool) -> Eq (Positive a)
forall a. Eq a => Positive a -> Positive a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Positive a -> Positive a -> Bool
== :: Positive a -> Positive a -> Bool
$c/= :: forall a. Eq a => Positive a -> Positive a -> Bool
/= :: Positive a -> Positive a -> Bool
Eq
  , Eq (Positive a)
Eq (Positive a)
-> (Positive a -> Positive a -> Ordering)
-> (Positive a -> Positive a -> Bool)
-> (Positive a -> Positive a -> Bool)
-> (Positive a -> Positive a -> Bool)
-> (Positive a -> Positive a -> Bool)
-> (Positive a -> Positive a -> Positive a)
-> (Positive a -> Positive a -> Positive a)
-> Ord (Positive a)
Positive a -> Positive a -> Bool
Positive a -> Positive a -> Ordering
Positive a -> Positive a -> Positive a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {a}. Ord a => Eq (Positive a)
forall a. Ord a => Positive a -> Positive a -> Bool
forall a. Ord a => Positive a -> Positive a -> Ordering
forall a. Ord a => Positive a -> Positive a -> Positive a
$ccompare :: forall a. Ord a => Positive a -> Positive a -> Ordering
compare :: Positive a -> Positive a -> Ordering
$c< :: forall a. Ord a => Positive a -> Positive a -> Bool
< :: Positive a -> Positive a -> Bool
$c<= :: forall a. Ord a => Positive a -> Positive a -> Bool
<= :: Positive a -> Positive a -> Bool
$c> :: forall a. Ord a => Positive a -> Positive a -> Bool
> :: Positive a -> Positive a -> Bool
$c>= :: forall a. Ord a => Positive a -> Positive a -> Bool
>= :: Positive a -> Positive a -> Bool
$cmax :: forall a. Ord a => Positive a -> Positive a -> Positive a
max :: Positive a -> Positive a -> Positive a
$cmin :: forall a. Ord a => Positive a -> Positive a -> Positive a
min :: Positive a -> Positive a -> Positive a
Ord
  , (forall a b. (a -> b) -> Positive a -> Positive b)
-> (forall a b. a -> Positive b -> Positive a) -> Functor Positive
forall a b. a -> Positive b -> Positive a
forall a b. (a -> b) -> Positive a -> Positive b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Positive a -> Positive b
fmap :: forall a b. (a -> b) -> Positive a -> Positive b
$c<$ :: forall a b. a -> Positive b -> Positive a
<$ :: forall a b. a -> Positive b -> Positive a
Functor     -- ^ @since 1.2.0
  , (forall m. Monoid m => Positive m -> m)
-> (forall m a. Monoid m => (a -> m) -> Positive a -> m)
-> (forall m a. Monoid m => (a -> m) -> Positive a -> m)
-> (forall a b. (a -> b -> b) -> b -> Positive a -> b)
-> (forall a b. (a -> b -> b) -> b -> Positive a -> b)
-> (forall b a. (b -> a -> b) -> b -> Positive a -> b)
-> (forall b a. (b -> a -> b) -> b -> Positive a -> b)
-> (forall a. (a -> a -> a) -> Positive a -> a)
-> (forall a. (a -> a -> a) -> Positive a -> a)
-> (forall a. Positive a -> [a])
-> (forall a. Positive a -> Bool)
-> (forall a. Positive a -> Depth)
-> (forall a. Eq a => a -> Positive a -> Bool)
-> (forall a. Ord a => Positive a -> a)
-> (forall a. Ord a => Positive a -> a)
-> (forall a. Num a => Positive a -> a)
-> (forall a. Num a => Positive a -> a)
-> Foldable Positive
forall a. Eq a => a -> Positive a -> Bool
forall a. Num a => Positive a -> a
forall a. Ord a => Positive a -> a
forall m. Monoid m => Positive m -> m
forall a. Positive a -> Bool
forall a. Positive a -> Depth
forall a. Positive a -> [a]
forall a. (a -> a -> a) -> Positive a -> a
forall m a. Monoid m => (a -> m) -> Positive a -> m
forall b a. (b -> a -> b) -> b -> Positive a -> b
forall a b. (a -> b -> b) -> b -> Positive a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Depth)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => Positive m -> m
fold :: forall m. Monoid m => Positive m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Positive a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Positive a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Positive a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> Positive a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> Positive a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Positive a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Positive a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Positive a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Positive a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Positive a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Positive a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> Positive a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> Positive a -> a
foldr1 :: forall a. (a -> a -> a) -> Positive a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Positive a -> a
foldl1 :: forall a. (a -> a -> a) -> Positive a -> a
$ctoList :: forall a. Positive a -> [a]
toList :: forall a. Positive a -> [a]
$cnull :: forall a. Positive a -> Bool
null :: forall a. Positive a -> Bool
$clength :: forall a. Positive a -> Depth
length :: forall a. Positive a -> Depth
$celem :: forall a. Eq a => a -> Positive a -> Bool
elem :: forall a. Eq a => a -> Positive a -> Bool
$cmaximum :: forall a. Ord a => Positive a -> a
maximum :: forall a. Ord a => Positive a -> a
$cminimum :: forall a. Ord a => Positive a -> a
minimum :: forall a. Ord a => Positive a -> a
$csum :: forall a. Num a => Positive a -> a
sum :: forall a. Num a => Positive a -> a
$cproduct :: forall a. Num a => Positive a -> a
product :: forall a. Num a => Positive a -> a
Foldable    -- ^ @since 1.2.0
  , Functor Positive
Foldable Positive
Functor Positive
-> Foldable Positive
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> Positive a -> f (Positive b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    Positive (f a) -> f (Positive a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Positive a -> m (Positive b))
-> (forall (m :: * -> *) a.
    Monad m =>
    Positive (m a) -> m (Positive a))
-> Traversable Positive
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => Positive (m a) -> m (Positive a)
forall (f :: * -> *) a.
Applicative f =>
Positive (f a) -> f (Positive a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Positive a -> m (Positive b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Positive a -> f (Positive b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Positive a -> f (Positive b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Positive a -> f (Positive b)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
Positive (f a) -> f (Positive a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
Positive (f a) -> f (Positive a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Positive a -> m (Positive b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Positive a -> m (Positive b)
$csequence :: forall (m :: * -> *) a. Monad m => Positive (m a) -> m (Positive a)
sequence :: forall (m :: * -> *) a. Monad m => Positive (m a) -> m (Positive a)
Traversable -- ^ @since 1.2.0
  )

instance Real a => Real (Positive a) where
  toRational :: Positive a -> Rational
toRational (Positive a
x) = a -> Rational
forall a. Real a => a -> Rational
toRational a
x

-- | @since 1.2.0
instance (Num a, Bounded a) => Bounded (Positive a) where
  minBound :: Positive a
minBound = a -> Positive a
forall a. a -> Positive a
Positive a
1
  maxBound :: Positive a
maxBound = a -> Positive a
forall a. a -> Positive a
Positive (a
forall a. Bounded a => a
maxBound :: a)

instance Enum a => Enum (Positive a) where
  toEnum :: Depth -> Positive a
toEnum Depth
x = a -> Positive a
forall a. a -> Positive a
Positive (Depth -> a
forall a. Enum a => Depth -> a
toEnum Depth
x)
  fromEnum :: Positive a -> Depth
fromEnum (Positive a
x) = a -> Depth
forall a. Enum a => a -> Depth
fromEnum a
x

instance Num a => Num (Positive a) where
  Positive a
x + :: Positive a -> Positive a -> Positive a
+ Positive a
y = a -> Positive a
forall a. a -> Positive a
Positive (a
x a -> a -> a
forall a. Num a => a -> a -> a
+ a
y)
  Positive a
x * :: Positive a -> Positive a -> Positive a
* Positive a
y = a -> Positive a
forall a. a -> Positive a
Positive (a
x a -> a -> a
forall a. Num a => a -> a -> a
* a
y)
  negate :: Positive a -> Positive a
negate (Positive a
x) = a -> Positive a
forall a. a -> Positive a
Positive (a -> a
forall a. Num a => a -> a
negate a
x)
  abs :: Positive a -> Positive a
abs (Positive a
x) = a -> Positive a
forall a. a -> Positive a
Positive (a -> a
forall a. Num a => a -> a
abs a
x)
  signum :: Positive a -> Positive a
signum (Positive a
x) = a -> Positive a
forall a. a -> Positive a
Positive (a -> a
forall a. Num a => a -> a
signum a
x)
  fromInteger :: Integer -> Positive a
fromInteger Integer
x = a -> Positive a
forall a. a -> Positive a
Positive (Integer -> a
forall a. Num a => Integer -> a
fromInteger Integer
x)

instance Integral a => Integral (Positive a) where
  quotRem :: Positive a -> Positive a -> (Positive a, Positive a)
quotRem (Positive a
x) (Positive a
y) = (a -> Positive a
forall a. a -> Positive a
Positive a
q, a -> Positive a
forall a. a -> Positive a
Positive a
r)
    where
      (a
q, a
r) = a
x a -> a -> (a, a)
forall a. Integral a => a -> a -> (a, a)
`quotRem` a
y
  toInteger :: Positive a -> Integer
toInteger (Positive a
x) = a -> Integer
forall a. Integral a => a -> Integer
toInteger a
x

instance (Num a, Ord a, Serial m a) => Serial m (Positive a) where
  series :: Series m (Positive a)
series = a -> Positive a
forall a. a -> Positive a
Positive (a -> Positive a) -> Series m a -> Series m (Positive a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Series m a
forall (m :: * -> *) a. Serial m a => Series m a
series Series m a -> (a -> Bool) -> Series m a
forall (m :: * -> *) a. Series m a -> (a -> Bool) -> Series m a
`suchThat` (a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
0)

instance Show a => Show (Positive a) where
  showsPrec :: Depth -> Positive a -> ShowS
showsPrec Depth
n (Positive a
x) = Depth -> a -> ShowS
forall a. Show a => Depth -> a -> ShowS
showsPrec Depth
n a
x

-- | 'NonNegative' @x@ guarantees that \( x \ge 0 \).
--
-- @since 1.0
newtype NonNegative a = NonNegative { forall a. NonNegative a -> a
getNonNegative :: a }
  deriving
  ( NonNegative a -> NonNegative a -> Bool
(NonNegative a -> NonNegative a -> Bool)
-> (NonNegative a -> NonNegative a -> Bool) -> Eq (NonNegative a)
forall a. Eq a => NonNegative a -> NonNegative a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => NonNegative a -> NonNegative a -> Bool
== :: NonNegative a -> NonNegative a -> Bool
$c/= :: forall a. Eq a => NonNegative a -> NonNegative a -> Bool
/= :: NonNegative a -> NonNegative a -> Bool
Eq
  , Eq (NonNegative a)
Eq (NonNegative a)
-> (NonNegative a -> NonNegative a -> Ordering)
-> (NonNegative a -> NonNegative a -> Bool)
-> (NonNegative a -> NonNegative a -> Bool)
-> (NonNegative a -> NonNegative a -> Bool)
-> (NonNegative a -> NonNegative a -> Bool)
-> (NonNegative a -> NonNegative a -> NonNegative a)
-> (NonNegative a -> NonNegative a -> NonNegative a)
-> Ord (NonNegative a)
NonNegative a -> NonNegative a -> Bool
NonNegative a -> NonNegative a -> Ordering
NonNegative a -> NonNegative a -> NonNegative a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {a}. Ord a => Eq (NonNegative a)
forall a. Ord a => NonNegative a -> NonNegative a -> Bool
forall a. Ord a => NonNegative a -> NonNegative a -> Ordering
forall a. Ord a => NonNegative a -> NonNegative a -> NonNegative a
$ccompare :: forall a. Ord a => NonNegative a -> NonNegative a -> Ordering
compare :: NonNegative a -> NonNegative a -> Ordering
$c< :: forall a. Ord a => NonNegative a -> NonNegative a -> Bool
< :: NonNegative a -> NonNegative a -> Bool
$c<= :: forall a. Ord a => NonNegative a -> NonNegative a -> Bool
<= :: NonNegative a -> NonNegative a -> Bool
$c> :: forall a. Ord a => NonNegative a -> NonNegative a -> Bool
> :: NonNegative a -> NonNegative a -> Bool
$c>= :: forall a. Ord a => NonNegative a -> NonNegative a -> Bool
>= :: NonNegative a -> NonNegative a -> Bool
$cmax :: forall a. Ord a => NonNegative a -> NonNegative a -> NonNegative a
max :: NonNegative a -> NonNegative a -> NonNegative a
$cmin :: forall a. Ord a => NonNegative a -> NonNegative a -> NonNegative a
min :: NonNegative a -> NonNegative a -> NonNegative a
Ord
  , (forall a b. (a -> b) -> NonNegative a -> NonNegative b)
-> (forall a b. a -> NonNegative b -> NonNegative a)
-> Functor NonNegative
forall a b. a -> NonNegative b -> NonNegative a
forall a b. (a -> b) -> NonNegative a -> NonNegative b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> NonNegative a -> NonNegative b
fmap :: forall a b. (a -> b) -> NonNegative a -> NonNegative b
$c<$ :: forall a b. a -> NonNegative b -> NonNegative a
<$ :: forall a b. a -> NonNegative b -> NonNegative a
Functor     -- ^ @since 1.2.0
  , (forall m. Monoid m => NonNegative m -> m)
-> (forall m a. Monoid m => (a -> m) -> NonNegative a -> m)
-> (forall m a. Monoid m => (a -> m) -> NonNegative a -> m)
-> (forall a b. (a -> b -> b) -> b -> NonNegative a -> b)
-> (forall a b. (a -> b -> b) -> b -> NonNegative a -> b)
-> (forall b a. (b -> a -> b) -> b -> NonNegative a -> b)
-> (forall b a. (b -> a -> b) -> b -> NonNegative a -> b)
-> (forall a. (a -> a -> a) -> NonNegative a -> a)
-> (forall a. (a -> a -> a) -> NonNegative a -> a)
-> (forall a. NonNegative a -> [a])
-> (forall a. NonNegative a -> Bool)
-> (forall a. NonNegative a -> Depth)
-> (forall a. Eq a => a -> NonNegative a -> Bool)
-> (forall a. Ord a => NonNegative a -> a)
-> (forall a. Ord a => NonNegative a -> a)
-> (forall a. Num a => NonNegative a -> a)
-> (forall a. Num a => NonNegative a -> a)
-> Foldable NonNegative
forall a. Eq a => a -> NonNegative a -> Bool
forall a. Num a => NonNegative a -> a
forall a. Ord a => NonNegative a -> a
forall m. Monoid m => NonNegative m -> m
forall a. NonNegative a -> Bool
forall a. NonNegative a -> Depth
forall a. NonNegative a -> [a]
forall a. (a -> a -> a) -> NonNegative a -> a
forall m a. Monoid m => (a -> m) -> NonNegative a -> m
forall b a. (b -> a -> b) -> b -> NonNegative a -> b
forall a b. (a -> b -> b) -> b -> NonNegative a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Depth)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => NonNegative m -> m
fold :: forall m. Monoid m => NonNegative m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> NonNegative a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> NonNegative a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> NonNegative a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> NonNegative a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> NonNegative a -> b
foldr :: forall a b. (a -> b -> b) -> b -> NonNegative a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> NonNegative a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> NonNegative a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> NonNegative a -> b
foldl :: forall b a. (b -> a -> b) -> b -> NonNegative a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> NonNegative a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> NonNegative a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> NonNegative a -> a
foldr1 :: forall a. (a -> a -> a) -> NonNegative a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> NonNegative a -> a
foldl1 :: forall a. (a -> a -> a) -> NonNegative a -> a
$ctoList :: forall a. NonNegative a -> [a]
toList :: forall a. NonNegative a -> [a]
$cnull :: forall a. NonNegative a -> Bool
null :: forall a. NonNegative a -> Bool
$clength :: forall a. NonNegative a -> Depth
length :: forall a. NonNegative a -> Depth
$celem :: forall a. Eq a => a -> NonNegative a -> Bool
elem :: forall a. Eq a => a -> NonNegative a -> Bool
$cmaximum :: forall a. Ord a => NonNegative a -> a
maximum :: forall a. Ord a => NonNegative a -> a
$cminimum :: forall a. Ord a => NonNegative a -> a
minimum :: forall a. Ord a => NonNegative a -> a
$csum :: forall a. Num a => NonNegative a -> a
sum :: forall a. Num a => NonNegative a -> a
$cproduct :: forall a. Num a => NonNegative a -> a
product :: forall a. Num a => NonNegative a -> a
Foldable    -- ^ @since 1.2.0
  , Functor NonNegative
Foldable NonNegative
Functor NonNegative
-> Foldable NonNegative
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> NonNegative a -> f (NonNegative b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    NonNegative (f a) -> f (NonNegative a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> NonNegative a -> m (NonNegative b))
-> (forall (m :: * -> *) a.
    Monad m =>
    NonNegative (m a) -> m (NonNegative a))
-> Traversable NonNegative
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
NonNegative (m a) -> m (NonNegative a)
forall (f :: * -> *) a.
Applicative f =>
NonNegative (f a) -> f (NonNegative a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> NonNegative a -> m (NonNegative b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> NonNegative a -> f (NonNegative b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> NonNegative a -> f (NonNegative b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> NonNegative a -> f (NonNegative b)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
NonNegative (f a) -> f (NonNegative a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
NonNegative (f a) -> f (NonNegative a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> NonNegative a -> m (NonNegative b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> NonNegative a -> m (NonNegative b)
$csequence :: forall (m :: * -> *) a.
Monad m =>
NonNegative (m a) -> m (NonNegative a)
sequence :: forall (m :: * -> *) a.
Monad m =>
NonNegative (m a) -> m (NonNegative a)
Traversable -- ^ @since 1.2.0
  )

instance Real a => Real (NonNegative a) where
  toRational :: NonNegative a -> Rational
toRational (NonNegative a
x) = a -> Rational
forall a. Real a => a -> Rational
toRational a
x

-- | @since 1.2.0
instance (Num a, Bounded a) => Bounded (NonNegative a) where
  minBound :: NonNegative a
minBound = a -> NonNegative a
forall a. a -> NonNegative a
NonNegative a
0
  maxBound :: NonNegative a
maxBound = a -> NonNegative a
forall a. a -> NonNegative a
NonNegative (a
forall a. Bounded a => a
maxBound :: a)

instance Enum a => Enum (NonNegative a) where
  toEnum :: Depth -> NonNegative a
toEnum Depth
x = a -> NonNegative a
forall a. a -> NonNegative a
NonNegative (Depth -> a
forall a. Enum a => Depth -> a
toEnum Depth
x)
  fromEnum :: NonNegative a -> Depth
fromEnum (NonNegative a
x) = a -> Depth
forall a. Enum a => a -> Depth
fromEnum a
x

instance Num a => Num (NonNegative a) where
  NonNegative a
x + :: NonNegative a -> NonNegative a -> NonNegative a
+ NonNegative a
y = a -> NonNegative a
forall a. a -> NonNegative a
NonNegative (a
x a -> a -> a
forall a. Num a => a -> a -> a
+ a
y)
  NonNegative a
x * :: NonNegative a -> NonNegative a -> NonNegative a
* NonNegative a
y = a -> NonNegative a
forall a. a -> NonNegative a
NonNegative (a
x a -> a -> a
forall a. Num a => a -> a -> a
* a
y)
  negate :: NonNegative a -> NonNegative a
negate (NonNegative a
x) = a -> NonNegative a
forall a. a -> NonNegative a
NonNegative (a -> a
forall a. Num a => a -> a
negate a
x)
  abs :: NonNegative a -> NonNegative a
abs (NonNegative a
x) = a -> NonNegative a
forall a. a -> NonNegative a
NonNegative (a -> a
forall a. Num a => a -> a
abs a
x)
  signum :: NonNegative a -> NonNegative a
signum (NonNegative a
x) = a -> NonNegative a
forall a. a -> NonNegative a
NonNegative (a -> a
forall a. Num a => a -> a
signum a
x)
  fromInteger :: Integer -> NonNegative a
fromInteger Integer
x = a -> NonNegative a
forall a. a -> NonNegative a
NonNegative (Integer -> a
forall a. Num a => Integer -> a
fromInteger Integer
x)

instance Integral a => Integral (NonNegative a) where
  quotRem :: NonNegative a -> NonNegative a -> (NonNegative a, NonNegative a)
quotRem (NonNegative a
x) (NonNegative a
y) = (a -> NonNegative a
forall a. a -> NonNegative a
NonNegative a
q, a -> NonNegative a
forall a. a -> NonNegative a
NonNegative a
r)
    where
      (a
q, a
r) = a
x a -> a -> (a, a)
forall a. Integral a => a -> a -> (a, a)
`quotRem` a
y
  toInteger :: NonNegative a -> Integer
toInteger (NonNegative a
x) = a -> Integer
forall a. Integral a => a -> Integer
toInteger a
x

instance (Num a, Ord a, Serial m a) => Serial m (NonNegative a) where
  series :: Series m (NonNegative a)
series = a -> NonNegative a
forall a. a -> NonNegative a
NonNegative (a -> NonNegative a) -> Series m a -> Series m (NonNegative a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Series m a
forall (m :: * -> *) a. Serial m a => Series m a
series Series m a -> (a -> Bool) -> Series m a
forall (m :: * -> *) a. Series m a -> (a -> Bool) -> Series m a
`suchThat` (a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
0)

instance Show a => Show (NonNegative a) where
  showsPrec :: Depth -> NonNegative a -> ShowS
showsPrec Depth
n (NonNegative a
x) = Depth -> a -> ShowS
forall a. Show a => Depth -> a -> ShowS
showsPrec Depth
n a
x

-- | 'NonZero' @x@ guarantees that \( x \ne 0 \).
--
-- @since 1.2.0
newtype NonZero a = NonZero { forall a. NonZero a -> a
getNonZero :: a }
 deriving (NonZero a -> NonZero a -> Bool
(NonZero a -> NonZero a -> Bool)
-> (NonZero a -> NonZero a -> Bool) -> Eq (NonZero a)
forall a. Eq a => NonZero a -> NonZero a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => NonZero a -> NonZero a -> Bool
== :: NonZero a -> NonZero a -> Bool
$c/= :: forall a. Eq a => NonZero a -> NonZero a -> Bool
/= :: NonZero a -> NonZero a -> Bool
Eq, Eq (NonZero a)
Eq (NonZero a)
-> (NonZero a -> NonZero a -> Ordering)
-> (NonZero a -> NonZero a -> Bool)
-> (NonZero a -> NonZero a -> Bool)
-> (NonZero a -> NonZero a -> Bool)
-> (NonZero a -> NonZero a -> Bool)
-> (NonZero a -> NonZero a -> NonZero a)
-> (NonZero a -> NonZero a -> NonZero a)
-> Ord (NonZero a)
NonZero a -> NonZero a -> Bool
NonZero a -> NonZero a -> Ordering
NonZero a -> NonZero a -> NonZero a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {a}. Ord a => Eq (NonZero a)
forall a. Ord a => NonZero a -> NonZero a -> Bool
forall a. Ord a => NonZero a -> NonZero a -> Ordering
forall a. Ord a => NonZero a -> NonZero a -> NonZero a
$ccompare :: forall a. Ord a => NonZero a -> NonZero a -> Ordering
compare :: NonZero a -> NonZero a -> Ordering
$c< :: forall a. Ord a => NonZero a -> NonZero a -> Bool
< :: NonZero a -> NonZero a -> Bool
$c<= :: forall a. Ord a => NonZero a -> NonZero a -> Bool
<= :: NonZero a -> NonZero a -> Bool
$c> :: forall a. Ord a => NonZero a -> NonZero a -> Bool
> :: NonZero a -> NonZero a -> Bool
$c>= :: forall a. Ord a => NonZero a -> NonZero a -> Bool
>= :: NonZero a -> NonZero a -> Bool
$cmax :: forall a. Ord a => NonZero a -> NonZero a -> NonZero a
max :: NonZero a -> NonZero a -> NonZero a
$cmin :: forall a. Ord a => NonZero a -> NonZero a -> NonZero a
min :: NonZero a -> NonZero a -> NonZero a
Ord, (forall a b. (a -> b) -> NonZero a -> NonZero b)
-> (forall a b. a -> NonZero b -> NonZero a) -> Functor NonZero
forall a b. a -> NonZero b -> NonZero a
forall a b. (a -> b) -> NonZero a -> NonZero b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> NonZero a -> NonZero b
fmap :: forall a b. (a -> b) -> NonZero a -> NonZero b
$c<$ :: forall a b. a -> NonZero b -> NonZero a
<$ :: forall a b. a -> NonZero b -> NonZero a
Functor, (forall m. Monoid m => NonZero m -> m)
-> (forall m a. Monoid m => (a -> m) -> NonZero a -> m)
-> (forall m a. Monoid m => (a -> m) -> NonZero a -> m)
-> (forall a b. (a -> b -> b) -> b -> NonZero a -> b)
-> (forall a b. (a -> b -> b) -> b -> NonZero a -> b)
-> (forall b a. (b -> a -> b) -> b -> NonZero a -> b)
-> (forall b a. (b -> a -> b) -> b -> NonZero a -> b)
-> (forall a. (a -> a -> a) -> NonZero a -> a)
-> (forall a. (a -> a -> a) -> NonZero a -> a)
-> (forall a. NonZero a -> [a])
-> (forall a. NonZero a -> Bool)
-> (forall a. NonZero a -> Depth)
-> (forall a. Eq a => a -> NonZero a -> Bool)
-> (forall a. Ord a => NonZero a -> a)
-> (forall a. Ord a => NonZero a -> a)
-> (forall a. Num a => NonZero a -> a)
-> (forall a. Num a => NonZero a -> a)
-> Foldable NonZero
forall a. Eq a => a -> NonZero a -> Bool
forall a. Num a => NonZero a -> a
forall a. Ord a => NonZero a -> a
forall m. Monoid m => NonZero m -> m
forall a. NonZero a -> Bool
forall a. NonZero a -> Depth
forall a. NonZero a -> [a]
forall a. (a -> a -> a) -> NonZero a -> a
forall m a. Monoid m => (a -> m) -> NonZero a -> m
forall b a. (b -> a -> b) -> b -> NonZero a -> b
forall a b. (a -> b -> b) -> b -> NonZero a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Depth)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => NonZero m -> m
fold :: forall m. Monoid m => NonZero m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> NonZero a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> NonZero a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> NonZero a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> NonZero a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> NonZero a -> b
foldr :: forall a b. (a -> b -> b) -> b -> NonZero a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> NonZero a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> NonZero a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> NonZero a -> b
foldl :: forall b a. (b -> a -> b) -> b -> NonZero a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> NonZero a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> NonZero a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> NonZero a -> a
foldr1 :: forall a. (a -> a -> a) -> NonZero a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> NonZero a -> a
foldl1 :: forall a. (a -> a -> a) -> NonZero a -> a
$ctoList :: forall a. NonZero a -> [a]
toList :: forall a. NonZero a -> [a]
$cnull :: forall a. NonZero a -> Bool
null :: forall a. NonZero a -> Bool
$clength :: forall a. NonZero a -> Depth
length :: forall a. NonZero a -> Depth
$celem :: forall a. Eq a => a -> NonZero a -> Bool
elem :: forall a. Eq a => a -> NonZero a -> Bool
$cmaximum :: forall a. Ord a => NonZero a -> a
maximum :: forall a. Ord a => NonZero a -> a
$cminimum :: forall a. Ord a => NonZero a -> a
minimum :: forall a. Ord a => NonZero a -> a
$csum :: forall a. Num a => NonZero a -> a
sum :: forall a. Num a => NonZero a -> a
$cproduct :: forall a. Num a => NonZero a -> a
product :: forall a. Num a => NonZero a -> a
Foldable, Functor NonZero
Foldable NonZero
Functor NonZero
-> Foldable NonZero
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> NonZero a -> f (NonZero b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    NonZero (f a) -> f (NonZero a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> NonZero a -> m (NonZero b))
-> (forall (m :: * -> *) a.
    Monad m =>
    NonZero (m a) -> m (NonZero a))
-> Traversable NonZero
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => NonZero (m a) -> m (NonZero a)
forall (f :: * -> *) a.
Applicative f =>
NonZero (f a) -> f (NonZero a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> NonZero a -> m (NonZero b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> NonZero a -> f (NonZero b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> NonZero a -> f (NonZero b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> NonZero a -> f (NonZero b)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
NonZero (f a) -> f (NonZero a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
NonZero (f a) -> f (NonZero a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> NonZero a -> m (NonZero b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> NonZero a -> m (NonZero b)
$csequence :: forall (m :: * -> *) a. Monad m => NonZero (m a) -> m (NonZero a)
sequence :: forall (m :: * -> *) a. Monad m => NonZero (m a) -> m (NonZero a)
Traversable)

instance Real a => Real (NonZero a) where
  toRational :: NonZero a -> Rational
toRational (NonZero a
x) = a -> Rational
forall a. Real a => a -> Rational
toRational a
x

instance (Eq a, Num a, Bounded a) => Bounded (NonZero a) where
  minBound :: NonZero a
minBound = let x :: a
x = a
forall a. Bounded a => a
minBound in a -> NonZero a
forall a. a -> NonZero a
NonZero (if a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0 then  a
1 else a
x)
  maxBound :: NonZero a
maxBound = let x :: a
x = a
forall a. Bounded a => a
maxBound in a -> NonZero a
forall a. a -> NonZero a
NonZero (if a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0 then -a
1 else a
x)

instance Enum a => Enum (NonZero a) where
  toEnum :: Depth -> NonZero a
toEnum Depth
x = a -> NonZero a
forall a. a -> NonZero a
NonZero (Depth -> a
forall a. Enum a => Depth -> a
toEnum Depth
x)
  fromEnum :: NonZero a -> Depth
fromEnum (NonZero a
x) = a -> Depth
forall a. Enum a => a -> Depth
fromEnum a
x

instance Num a => Num (NonZero a) where
  NonZero a
x + :: NonZero a -> NonZero a -> NonZero a
+ NonZero a
y = a -> NonZero a
forall a. a -> NonZero a
NonZero (a
x a -> a -> a
forall a. Num a => a -> a -> a
+ a
y)
  NonZero a
x * :: NonZero a -> NonZero a -> NonZero a
* NonZero a
y = a -> NonZero a
forall a. a -> NonZero a
NonZero (a
x a -> a -> a
forall a. Num a => a -> a -> a
* a
y)
  negate :: NonZero a -> NonZero a
negate (NonZero a
x) = a -> NonZero a
forall a. a -> NonZero a
NonZero (a -> a
forall a. Num a => a -> a
negate a
x)
  abs :: NonZero a -> NonZero a
abs (NonZero a
x) = a -> NonZero a
forall a. a -> NonZero a
NonZero (a -> a
forall a. Num a => a -> a
abs a
x)
  signum :: NonZero a -> NonZero a
signum (NonZero a
x) = a -> NonZero a
forall a. a -> NonZero a
NonZero (a -> a
forall a. Num a => a -> a
signum a
x)
  fromInteger :: Integer -> NonZero a
fromInteger Integer
x = a -> NonZero a
forall a. a -> NonZero a
NonZero (Integer -> a
forall a. Num a => Integer -> a
fromInteger Integer
x)

instance Integral a => Integral (NonZero a) where
  quotRem :: NonZero a -> NonZero a -> (NonZero a, NonZero a)
quotRem (NonZero a
x) (NonZero a
y) = (a -> NonZero a
forall a. a -> NonZero a
NonZero a
q, a -> NonZero a
forall a. a -> NonZero a
NonZero a
r)
    where
      (a
q, a
r) = a
x a -> a -> (a, a)
forall a. Integral a => a -> a -> (a, a)
`quotRem` a
y
  toInteger :: NonZero a -> Integer
toInteger (NonZero a
x) = a -> Integer
forall a. Integral a => a -> Integer
toInteger a
x

instance (Num a, Ord a, Serial m a) => Serial m (NonZero a) where
  series :: Series m (NonZero a)
series = a -> NonZero a
forall a. a -> NonZero a
NonZero (a -> NonZero a) -> Series m a -> Series m (NonZero a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Series m a
forall (m :: * -> *) a. Serial m a => Series m a
series Series m a -> (a -> Bool) -> Series m a
forall (m :: * -> *) a. Series m a -> (a -> Bool) -> Series m a
`suchThat` (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
0)

instance Show a => Show (NonZero a) where
  showsPrec :: Depth -> NonZero a -> ShowS
showsPrec Depth
n (NonZero a
x) = Depth -> a -> ShowS
forall a. Show a => Depth -> a -> ShowS
showsPrec Depth
n a
x

-- | 'NonEmpty' @xs@ guarantees that @xs@ is not null.
--
-- @since 1.1
newtype NonEmpty a = NonEmpty { forall a. NonEmpty a -> [a]
getNonEmpty :: [a] }

instance (Serial m a) => Serial m (NonEmpty a) where
  series :: Series m (NonEmpty a)
series = [a] -> NonEmpty a
forall a. [a] -> NonEmpty a
NonEmpty ([a] -> NonEmpty a) -> Series m [a] -> Series m (NonEmpty a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> [a] -> [a]) -> Series m [a]
forall (m :: * -> *) a b c.
(Serial m a, Serial m b) =>
(a -> b -> c) -> Series m c
cons2 (:)

instance Show a => Show (NonEmpty a) where
  showsPrec :: Depth -> NonEmpty a -> ShowS
showsPrec Depth
n (NonEmpty [a]
x) = Depth -> [a] -> ShowS
forall a. Show a => Depth -> a -> ShowS
showsPrec Depth
n [a]
x

-- }}}

------------------------------
-- Foreign.C.Types
------------------------------
-- {{{

#if MIN_VERSION_base(4,5,0)
-- | @since 1.2.0
instance Monad m => Serial m CFloat where
  series :: Series m CFloat
series = (Float -> CFloat) -> Series m CFloat
forall (m :: * -> *) a b. Serial m a => (a -> b) -> Series m b
newtypeCons Float -> CFloat
CFloat
-- | @since 1.2.0
instance Monad m => CoSerial m CFloat where
  coseries :: forall b. Series m b -> Series m (CFloat -> b)
coseries Series m b
rs = Series m b -> Series m (Float -> b)
forall (m :: * -> *) a b.
CoSerial m a =>
Series m b -> Series m (a -> b)
newtypeAlts Series m b
rs Series m (Float -> b)
-> ((Float -> b) -> Series m (CFloat -> b))
-> Series m (CFloat -> b)
forall a b. Series m a -> (a -> Series m b) -> Series m b
forall (m :: * -> *) a b. MonadLogic m => m a -> (a -> m b) -> m b
>>- \Float -> b
f -> (CFloat -> b) -> Series m (CFloat -> b)
forall a. a -> Series m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((CFloat -> b) -> Series m (CFloat -> b))
-> (CFloat -> b) -> Series m (CFloat -> b)
forall a b. (a -> b) -> a -> b
$ \CFloat
l -> case CFloat
l of CFloat Float
x -> Float -> b
f Float
x

-- | @since 1.2.0
instance Monad m => Serial m CDouble where
  series :: Series m CDouble
series = (Double -> CDouble) -> Series m CDouble
forall (m :: * -> *) a b. Serial m a => (a -> b) -> Series m b
newtypeCons Double -> CDouble
CDouble
-- | @since 1.2.0
instance Monad m => CoSerial m CDouble where
  coseries :: forall b. Series m b -> Series m (CDouble -> b)
coseries Series m b
rs = Series m b -> Series m (Double -> b)
forall (m :: * -> *) a b.
CoSerial m a =>
Series m b -> Series m (a -> b)
newtypeAlts Series m b
rs Series m (Double -> b)
-> ((Double -> b) -> Series m (CDouble -> b))
-> Series m (CDouble -> b)
forall a b. Series m a -> (a -> Series m b) -> Series m b
forall (m :: * -> *) a b. MonadLogic m => m a -> (a -> m b) -> m b
>>- \Double -> b
f -> (CDouble -> b) -> Series m (CDouble -> b)
forall a. a -> Series m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((CDouble -> b) -> Series m (CDouble -> b))
-> (CDouble -> b) -> Series m (CDouble -> b)
forall a b. (a -> b) -> a -> b
$ \CDouble
l -> case CDouble
l of CDouble Double
x -> Double -> b
f Double
x

#if HASCBOOL
-- | @since 1.2.0
instance Monad m => Serial m CBool where
  series :: Series m CBool
series = (Word8 -> CBool) -> Series m CBool
forall (m :: * -> *) a b. Serial m a => (a -> b) -> Series m b
newtypeCons Word8 -> CBool
CBool
-- | @since 1.2.0
instance Monad m => CoSerial m CBool where
  coseries :: forall b. Series m b -> Series m (CBool -> b)
coseries Series m b
rs = Series m b -> Series m (Word8 -> b)
forall (m :: * -> *) a b.
CoSerial m a =>
Series m b -> Series m (a -> b)
newtypeAlts Series m b
rs Series m (Word8 -> b)
-> ((Word8 -> b) -> Series m (CBool -> b)) -> Series m (CBool -> b)
forall a b. Series m a -> (a -> Series m b) -> Series m b
forall (m :: * -> *) a b. MonadLogic m => m a -> (a -> m b) -> m b
>>- \Word8 -> b
f -> (CBool -> b) -> Series m (CBool -> b)
forall a. a -> Series m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((CBool -> b) -> Series m (CBool -> b))
-> (CBool -> b) -> Series m (CBool -> b)
forall a b. (a -> b) -> a -> b
$ \CBool
l -> case CBool
l of CBool Word8
x -> Word8 -> b
f Word8
x
#endif

-- | @since 1.2.0
instance Monad m => Serial m CChar where
  series :: Series m CChar
series = (Int8 -> CChar) -> Series m CChar
forall (m :: * -> *) a b. Serial m a => (a -> b) -> Series m b
newtypeCons Int8 -> CChar
CChar
-- | @since 1.2.0
instance Monad m => CoSerial m CChar where
  coseries :: forall b. Series m b -> Series m (CChar -> b)
coseries Series m b
rs = Series m b -> Series m (Int8 -> b)
forall (m :: * -> *) a b.
CoSerial m a =>
Series m b -> Series m (a -> b)
newtypeAlts Series m b
rs Series m (Int8 -> b)
-> ((Int8 -> b) -> Series m (CChar -> b)) -> Series m (CChar -> b)
forall a b. Series m a -> (a -> Series m b) -> Series m b
forall (m :: * -> *) a b. MonadLogic m => m a -> (a -> m b) -> m b
>>- \Int8 -> b
f -> (CChar -> b) -> Series m (CChar -> b)
forall a. a -> Series m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((CChar -> b) -> Series m (CChar -> b))
-> (CChar -> b) -> Series m (CChar -> b)
forall a b. (a -> b) -> a -> b
$ \CChar
l -> case CChar
l of CChar Int8
x -> Int8 -> b
f Int8
x

-- | @since 1.2.0
instance Monad m => Serial m CSChar where
  series :: Series m CSChar
series = (Int8 -> CSChar) -> Series m CSChar
forall (m :: * -> *) a b. Serial m a => (a -> b) -> Series m b
newtypeCons Int8 -> CSChar
CSChar
-- | @since 1.2.0
instance Monad m => CoSerial m CSChar where
  coseries :: forall b. Series m b -> Series m (CSChar -> b)
coseries Series m b
rs = Series m b -> Series m (Int8 -> b)
forall (m :: * -> *) a b.
CoSerial m a =>
Series m b -> Series m (a -> b)
newtypeAlts Series m b
rs Series m (Int8 -> b)
-> ((Int8 -> b) -> Series m (CSChar -> b))
-> Series m (CSChar -> b)
forall a b. Series m a -> (a -> Series m b) -> Series m b
forall (m :: * -> *) a b. MonadLogic m => m a -> (a -> m b) -> m b
>>- \Int8 -> b
f -> (CSChar -> b) -> Series m (CSChar -> b)
forall a. a -> Series m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((CSChar -> b) -> Series m (CSChar -> b))
-> (CSChar -> b) -> Series m (CSChar -> b)
forall a b. (a -> b) -> a -> b
$ \CSChar
l -> case CSChar
l of CSChar Int8
x -> Int8 -> b
f Int8
x

-- | @since 1.2.0
instance Monad m => Serial m CUChar where
  series :: Series m CUChar
series = (Word8 -> CUChar) -> Series m CUChar
forall (m :: * -> *) a b. Serial m a => (a -> b) -> Series m b
newtypeCons Word8 -> CUChar
CUChar
-- | @since 1.2.0
instance Monad m => CoSerial m CUChar where
  coseries :: forall b. Series m b -> Series m (CUChar -> b)
coseries Series m b
rs = Series m b -> Series m (Word8 -> b)
forall (m :: * -> *) a b.
CoSerial m a =>
Series m b -> Series m (a -> b)
newtypeAlts Series m b
rs Series m (Word8 -> b)
-> ((Word8 -> b) -> Series m (CUChar -> b))
-> Series m (CUChar -> b)
forall a b. Series m a -> (a -> Series m b) -> Series m b
forall (m :: * -> *) a b. MonadLogic m => m a -> (a -> m b) -> m b
>>- \Word8 -> b
f -> (CUChar -> b) -> Series m (CUChar -> b)
forall a. a -> Series m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((CUChar -> b) -> Series m (CUChar -> b))
-> (CUChar -> b) -> Series m (CUChar -> b)
forall a b. (a -> b) -> a -> b
$ \CUChar
l -> case CUChar
l of CUChar Word8
x -> Word8 -> b
f Word8
x

-- | @since 1.2.0
instance Monad m => Serial m CShort where
  series :: Series m CShort
series = (Int16 -> CShort) -> Series m CShort
forall (m :: * -> *) a b. Serial m a => (a -> b) -> Series m b
newtypeCons Int16 -> CShort
CShort
-- | @since 1.2.0
instance Monad m => CoSerial m CShort where
  coseries :: forall b. Series m b -> Series m (CShort -> b)
coseries Series m b
rs = Series m b -> Series m (Int16 -> b)
forall (m :: * -> *) a b.
CoSerial m a =>
Series m b -> Series m (a -> b)
newtypeAlts Series m b
rs Series m (Int16 -> b)
-> ((Int16 -> b) -> Series m (CShort -> b))
-> Series m (CShort -> b)
forall a b. Series m a -> (a -> Series m b) -> Series m b
forall (m :: * -> *) a b. MonadLogic m => m a -> (a -> m b) -> m b
>>- \Int16 -> b
f -> (CShort -> b) -> Series m (CShort -> b)
forall a. a -> Series m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((CShort -> b) -> Series m (CShort -> b))
-> (CShort -> b) -> Series m (CShort -> b)
forall a b. (a -> b) -> a -> b
$ \CShort
l -> case CShort
l of CShort Int16
x -> Int16 -> b
f Int16
x

-- | @since 1.2.0
instance Monad m => Serial m CUShort where
  series :: Series m CUShort
series = (Word16 -> CUShort) -> Series m CUShort
forall (m :: * -> *) a b. Serial m a => (a -> b) -> Series m b
newtypeCons Word16 -> CUShort
CUShort
-- | @since 1.2.0
instance Monad m => CoSerial m CUShort where
  coseries :: forall b. Series m b -> Series m (CUShort -> b)
coseries Series m b
rs = Series m b -> Series m (Word16 -> b)
forall (m :: * -> *) a b.
CoSerial m a =>
Series m b -> Series m (a -> b)
newtypeAlts Series m b
rs Series m (Word16 -> b)
-> ((Word16 -> b) -> Series m (CUShort -> b))
-> Series m (CUShort -> b)
forall a b. Series m a -> (a -> Series m b) -> Series m b
forall (m :: * -> *) a b. MonadLogic m => m a -> (a -> m b) -> m b
>>- \Word16 -> b
f -> (CUShort -> b) -> Series m (CUShort -> b)
forall a. a -> Series m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((CUShort -> b) -> Series m (CUShort -> b))
-> (CUShort -> b) -> Series m (CUShort -> b)
forall a b. (a -> b) -> a -> b
$ \CUShort
l -> case CUShort
l of CUShort Word16
x -> Word16 -> b
f Word16
x

-- | @since 1.2.0
instance Monad m => Serial m CInt where
  series :: Series m CInt
series = (Int32 -> CInt) -> Series m CInt
forall (m :: * -> *) a b. Serial m a => (a -> b) -> Series m b
newtypeCons Int32 -> CInt
CInt
-- | @since 1.2.0
instance Monad m => CoSerial m CInt where
  coseries :: forall b. Series m b -> Series m (CInt -> b)
coseries Series m b
rs = Series m b -> Series m (Int32 -> b)
forall (m :: * -> *) a b.
CoSerial m a =>
Series m b -> Series m (a -> b)
newtypeAlts Series m b
rs Series m (Int32 -> b)
-> ((Int32 -> b) -> Series m (CInt -> b)) -> Series m (CInt -> b)
forall a b. Series m a -> (a -> Series m b) -> Series m b
forall (m :: * -> *) a b. MonadLogic m => m a -> (a -> m b) -> m b
>>- \Int32 -> b
f -> (CInt -> b) -> Series m (CInt -> b)
forall a. a -> Series m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((CInt -> b) -> Series m (CInt -> b))
-> (CInt -> b) -> Series m (CInt -> b)
forall a b. (a -> b) -> a -> b
$ \CInt
l -> case CInt
l of CInt Int32
x -> Int32 -> b
f Int32
x

-- | @since 1.2.0
instance Monad m => Serial m CUInt where
  series :: Series m CUInt
series = (Word32 -> CUInt) -> Series m CUInt
forall (m :: * -> *) a b. Serial m a => (a -> b) -> Series m b
newtypeCons Word32 -> CUInt
CUInt
-- | @since 1.2.0
instance Monad m => CoSerial m CUInt where
  coseries :: forall b. Series m b -> Series m (CUInt -> b)
coseries Series m b
rs = Series m b -> Series m (Word32 -> b)
forall (m :: * -> *) a b.
CoSerial m a =>
Series m b -> Series m (a -> b)
newtypeAlts Series m b
rs Series m (Word32 -> b)
-> ((Word32 -> b) -> Series m (CUInt -> b))
-> Series m (CUInt -> b)
forall a b. Series m a -> (a -> Series m b) -> Series m b
forall (m :: * -> *) a b. MonadLogic m => m a -> (a -> m b) -> m b
>>- \Word32 -> b
f -> (CUInt -> b) -> Series m (CUInt -> b)
forall a. a -> Series m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((CUInt -> b) -> Series m (CUInt -> b))
-> (CUInt -> b) -> Series m (CUInt -> b)
forall a b. (a -> b) -> a -> b
$ \CUInt
l -> case CUInt
l of CUInt Word32
x -> Word32 -> b
f Word32
x

-- | @since 1.2.0
instance Monad m => Serial m CLong where
  series :: Series m CLong
series = (Int32 -> CLong) -> Series m CLong
forall (m :: * -> *) a b. Serial m a => (a -> b) -> Series m b
newtypeCons Int32 -> CLong
CLong
-- | @since 1.2.0
instance Monad m => CoSerial m CLong where
  coseries :: forall b. Series m b -> Series m (CLong -> b)
coseries Series m b
rs = Series m b -> Series m (Int32 -> b)
forall (m :: * -> *) a b.
CoSerial m a =>
Series m b -> Series m (a -> b)
newtypeAlts Series m b
rs Series m (Int32 -> b)
-> ((Int32 -> b) -> Series m (CLong -> b)) -> Series m (CLong -> b)
forall a b. Series m a -> (a -> Series m b) -> Series m b
forall (m :: * -> *) a b. MonadLogic m => m a -> (a -> m b) -> m b
>>- \Int32 -> b
f -> (CLong -> b) -> Series m (CLong -> b)
forall a. a -> Series m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((CLong -> b) -> Series m (CLong -> b))
-> (CLong -> b) -> Series m (CLong -> b)
forall a b. (a -> b) -> a -> b
$ \CLong
l -> case CLong
l of CLong Int32
x -> Int32 -> b
f Int32
x

-- | @since 1.2.0
instance Monad m => Serial m CULong where
  series :: Series m CULong
series = (Word32 -> CULong) -> Series m CULong
forall (m :: * -> *) a b. Serial m a => (a -> b) -> Series m b
newtypeCons Word32 -> CULong
CULong
-- | @since 1.2.0
instance Monad m => CoSerial m CULong where
  coseries :: forall b. Series m b -> Series m (CULong -> b)
coseries Series m b
rs = Series m b -> Series m (Word32 -> b)
forall (m :: * -> *) a b.
CoSerial m a =>
Series m b -> Series m (a -> b)
newtypeAlts Series m b
rs Series m (Word32 -> b)
-> ((Word32 -> b) -> Series m (CULong -> b))
-> Series m (CULong -> b)
forall a b. Series m a -> (a -> Series m b) -> Series m b
forall (m :: * -> *) a b. MonadLogic m => m a -> (a -> m b) -> m b
>>- \Word32 -> b
f -> (CULong -> b) -> Series m (CULong -> b)
forall a. a -> Series m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((CULong -> b) -> Series m (CULong -> b))
-> (CULong -> b) -> Series m (CULong -> b)
forall a b. (a -> b) -> a -> b
$ \CULong
l -> case CULong
l of CULong Word32
x -> Word32 -> b
f Word32
x

-- | @since 1.2.0
instance Monad m => Serial m CPtrdiff where
  series :: Series m CPtrdiff
series = (Int32 -> CPtrdiff) -> Series m CPtrdiff
forall (m :: * -> *) a b. Serial m a => (a -> b) -> Series m b
newtypeCons Int32 -> CPtrdiff
CPtrdiff
-- | @since 1.2.0
instance Monad m => CoSerial m CPtrdiff where
  coseries :: forall b. Series m b -> Series m (CPtrdiff -> b)
coseries Series m b
rs = Series m b -> Series m (Int32 -> b)
forall (m :: * -> *) a b.
CoSerial m a =>
Series m b -> Series m (a -> b)
newtypeAlts Series m b
rs Series m (Int32 -> b)
-> ((Int32 -> b) -> Series m (CPtrdiff -> b))
-> Series m (CPtrdiff -> b)
forall a b. Series m a -> (a -> Series m b) -> Series m b
forall (m :: * -> *) a b. MonadLogic m => m a -> (a -> m b) -> m b
>>- \Int32 -> b
f -> (CPtrdiff -> b) -> Series m (CPtrdiff -> b)
forall a. a -> Series m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((CPtrdiff -> b) -> Series m (CPtrdiff -> b))
-> (CPtrdiff -> b) -> Series m (CPtrdiff -> b)
forall a b. (a -> b) -> a -> b
$ \CPtrdiff
l -> case CPtrdiff
l of CPtrdiff Int32
x -> Int32 -> b
f Int32
x

-- | @since 1.2.0
instance Monad m => Serial m CSize where
  series :: Series m CSize
series = (Word32 -> CSize) -> Series m CSize
forall (m :: * -> *) a b. Serial m a => (a -> b) -> Series m b
newtypeCons Word32 -> CSize
CSize
-- | @since 1.2.0
instance Monad m => CoSerial m CSize where
  coseries :: forall b. Series m b -> Series m (CSize -> b)
coseries Series m b
rs = Series m b -> Series m (Word32 -> b)
forall (m :: * -> *) a b.
CoSerial m a =>
Series m b -> Series m (a -> b)
newtypeAlts Series m b
rs Series m (Word32 -> b)
-> ((Word32 -> b) -> Series m (CSize -> b))
-> Series m (CSize -> b)
forall a b. Series m a -> (a -> Series m b) -> Series m b
forall (m :: * -> *) a b. MonadLogic m => m a -> (a -> m b) -> m b
>>- \Word32 -> b
f -> (CSize -> b) -> Series m (CSize -> b)
forall a. a -> Series m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((CSize -> b) -> Series m (CSize -> b))
-> (CSize -> b) -> Series m (CSize -> b)
forall a b. (a -> b) -> a -> b
$ \CSize
l -> case CSize
l of CSize Word32
x -> Word32 -> b
f Word32
x

-- | @since 1.2.0
instance Monad m => Serial m CWchar where
  series :: Series m CWchar
series = (Int32 -> CWchar) -> Series m CWchar
forall (m :: * -> *) a b. Serial m a => (a -> b) -> Series m b
newtypeCons Int32 -> CWchar
CWchar
-- | @since 1.2.0
instance Monad m => CoSerial m CWchar where
  coseries :: forall b. Series m b -> Series m (CWchar -> b)
coseries Series m b
rs = Series m b -> Series m (Int32 -> b)
forall (m :: * -> *) a b.
CoSerial m a =>
Series m b -> Series m (a -> b)
newtypeAlts Series m b
rs Series m (Int32 -> b)
-> ((Int32 -> b) -> Series m (CWchar -> b))
-> Series m (CWchar -> b)
forall a b. Series m a -> (a -> Series m b) -> Series m b
forall (m :: * -> *) a b. MonadLogic m => m a -> (a -> m b) -> m b
>>- \Int32 -> b
f -> (CWchar -> b) -> Series m (CWchar -> b)
forall a. a -> Series m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((CWchar -> b) -> Series m (CWchar -> b))
-> (CWchar -> b) -> Series m (CWchar -> b)
forall a b. (a -> b) -> a -> b
$ \CWchar
l -> case CWchar
l of CWchar Int32
x -> Int32 -> b
f Int32
x

-- | @since 1.2.0
instance Monad m => Serial m CSigAtomic where
  series :: Series m CSigAtomic
series = (Int32 -> CSigAtomic) -> Series m CSigAtomic
forall (m :: * -> *) a b. Serial m a => (a -> b) -> Series m b
newtypeCons Int32 -> CSigAtomic
CSigAtomic
-- | @since 1.2.0
instance Monad m => CoSerial m CSigAtomic where
  coseries :: forall b. Series m b -> Series m (CSigAtomic -> b)
coseries Series m b
rs = Series m b -> Series m (Int32 -> b)
forall (m :: * -> *) a b.
CoSerial m a =>
Series m b -> Series m (a -> b)
newtypeAlts Series m b
rs Series m (Int32 -> b)
-> ((Int32 -> b) -> Series m (CSigAtomic -> b))
-> Series m (CSigAtomic -> b)
forall a b. Series m a -> (a -> Series m b) -> Series m b
forall (m :: * -> *) a b. MonadLogic m => m a -> (a -> m b) -> m b
>>- \Int32 -> b
f -> (CSigAtomic -> b) -> Series m (CSigAtomic -> b)
forall a. a -> Series m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((CSigAtomic -> b) -> Series m (CSigAtomic -> b))
-> (CSigAtomic -> b) -> Series m (CSigAtomic -> b)
forall a b. (a -> b) -> a -> b
$ \CSigAtomic
l -> case CSigAtomic
l of CSigAtomic Int32
x -> Int32 -> b
f Int32
x

-- | @since 1.2.0
instance Monad m => Serial m CLLong where
  series :: Series m CLLong
series = (Int64 -> CLLong) -> Series m CLLong
forall (m :: * -> *) a b. Serial m a => (a -> b) -> Series m b
newtypeCons Int64 -> CLLong
CLLong
-- | @since 1.2.0
instance Monad m => CoSerial m CLLong where
  coseries :: forall b. Series m b -> Series m (CLLong -> b)
coseries Series m b
rs = Series m b -> Series m (Int64 -> b)
forall (m :: * -> *) a b.
CoSerial m a =>
Series m b -> Series m (a -> b)
newtypeAlts Series m b
rs Series m (Int64 -> b)
-> ((Int64 -> b) -> Series m (CLLong -> b))
-> Series m (CLLong -> b)
forall a b. Series m a -> (a -> Series m b) -> Series m b
forall (m :: * -> *) a b. MonadLogic m => m a -> (a -> m b) -> m b
>>- \Int64 -> b
f -> (CLLong -> b) -> Series m (CLLong -> b)
forall a. a -> Series m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((CLLong -> b) -> Series m (CLLong -> b))
-> (CLLong -> b) -> Series m (CLLong -> b)
forall a b. (a -> b) -> a -> b
$ \CLLong
l -> case CLLong
l of CLLong Int64
x -> Int64 -> b
f Int64
x

-- | @since 1.2.0
instance Monad m => Serial m CULLong where
  series :: Series m CULLong
series = (Word64 -> CULLong) -> Series m CULLong
forall (m :: * -> *) a b. Serial m a => (a -> b) -> Series m b
newtypeCons Word64 -> CULLong
CULLong
-- | @since 1.2.0
instance Monad m => CoSerial m CULLong where
  coseries :: forall b. Series m b -> Series m (CULLong -> b)
coseries Series m b
rs = Series m b -> Series m (Word64 -> b)
forall (m :: * -> *) a b.
CoSerial m a =>
Series m b -> Series m (a -> b)
newtypeAlts Series m b
rs Series m (Word64 -> b)
-> ((Word64 -> b) -> Series m (CULLong -> b))
-> Series m (CULLong -> b)
forall a b. Series m a -> (a -> Series m b) -> Series m b
forall (m :: * -> *) a b. MonadLogic m => m a -> (a -> m b) -> m b
>>- \Word64 -> b
f -> (CULLong -> b) -> Series m (CULLong -> b)
forall a. a -> Series m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((CULLong -> b) -> Series m (CULLong -> b))
-> (CULLong -> b) -> Series m (CULLong -> b)
forall a b. (a -> b) -> a -> b
$ \CULLong
l -> case CULLong
l of CULLong Word64
x -> Word64 -> b
f Word64
x

-- | @since 1.2.0
instance Monad m => Serial m CIntPtr where
  series :: Series m CIntPtr
series = (Int32 -> CIntPtr) -> Series m CIntPtr
forall (m :: * -> *) a b. Serial m a => (a -> b) -> Series m b
newtypeCons Int32 -> CIntPtr
CIntPtr
-- | @since 1.2.0
instance Monad m => CoSerial m CIntPtr where
  coseries :: forall b. Series m b -> Series m (CIntPtr -> b)
coseries Series m b
rs = Series m b -> Series m (Int32 -> b)
forall (m :: * -> *) a b.
CoSerial m a =>
Series m b -> Series m (a -> b)
newtypeAlts Series m b
rs Series m (Int32 -> b)
-> ((Int32 -> b) -> Series m (CIntPtr -> b))
-> Series m (CIntPtr -> b)
forall a b. Series m a -> (a -> Series m b) -> Series m b
forall (m :: * -> *) a b. MonadLogic m => m a -> (a -> m b) -> m b
>>- \Int32 -> b
f -> (CIntPtr -> b) -> Series m (CIntPtr -> b)
forall a. a -> Series m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((CIntPtr -> b) -> Series m (CIntPtr -> b))
-> (CIntPtr -> b) -> Series m (CIntPtr -> b)
forall a b. (a -> b) -> a -> b
$ \CIntPtr
l -> case CIntPtr
l of CIntPtr Int32
x -> Int32 -> b
f Int32
x

-- | @since 1.2.0
instance Monad m => Serial m CUIntPtr where
  series :: Series m CUIntPtr
series = (Word32 -> CUIntPtr) -> Series m CUIntPtr
forall (m :: * -> *) a b. Serial m a => (a -> b) -> Series m b
newtypeCons Word32 -> CUIntPtr
CUIntPtr
-- | @since 1.2.0
instance Monad m => CoSerial m CUIntPtr where
  coseries :: forall b. Series m b -> Series m (CUIntPtr -> b)
coseries Series m b
rs = Series m b -> Series m (Word32 -> b)
forall (m :: * -> *) a b.
CoSerial m a =>
Series m b -> Series m (a -> b)
newtypeAlts Series m b
rs Series m (Word32 -> b)
-> ((Word32 -> b) -> Series m (CUIntPtr -> b))
-> Series m (CUIntPtr -> b)
forall a b. Series m a -> (a -> Series m b) -> Series m b
forall (m :: * -> *) a b. MonadLogic m => m a -> (a -> m b) -> m b
>>- \Word32 -> b
f -> (CUIntPtr -> b) -> Series m (CUIntPtr -> b)
forall a. a -> Series m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((CUIntPtr -> b) -> Series m (CUIntPtr -> b))
-> (CUIntPtr -> b) -> Series m (CUIntPtr -> b)
forall a b. (a -> b) -> a -> b
$ \CUIntPtr
l -> case CUIntPtr
l of CUIntPtr Word32
x -> Word32 -> b
f Word32
x

-- | @since 1.2.0
instance Monad m => Serial m CIntMax where
  series :: Series m CIntMax
series = (Int64 -> CIntMax) -> Series m CIntMax
forall (m :: * -> *) a b. Serial m a => (a -> b) -> Series m b
newtypeCons Int64 -> CIntMax
CIntMax
-- | @since 1.2.0
instance Monad m => CoSerial m CIntMax where
  coseries :: forall b. Series m b -> Series m (CIntMax -> b)
coseries Series m b
rs = Series m b -> Series m (Int64 -> b)
forall (m :: * -> *) a b.
CoSerial m a =>
Series m b -> Series m (a -> b)
newtypeAlts Series m b
rs Series m (Int64 -> b)
-> ((Int64 -> b) -> Series m (CIntMax -> b))
-> Series m (CIntMax -> b)
forall a b. Series m a -> (a -> Series m b) -> Series m b
forall (m :: * -> *) a b. MonadLogic m => m a -> (a -> m b) -> m b
>>- \Int64 -> b
f -> (CIntMax -> b) -> Series m (CIntMax -> b)
forall a. a -> Series m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((CIntMax -> b) -> Series m (CIntMax -> b))
-> (CIntMax -> b) -> Series m (CIntMax -> b)
forall a b. (a -> b) -> a -> b
$ \CIntMax
l -> case CIntMax
l of CIntMax Int64
x -> Int64 -> b
f Int64
x

-- | @since 1.2.0
instance Monad m => Serial m CUIntMax where
  series :: Series m CUIntMax
series = (Word64 -> CUIntMax) -> Series m CUIntMax
forall (m :: * -> *) a b. Serial m a => (a -> b) -> Series m b
newtypeCons Word64 -> CUIntMax
CUIntMax
-- | @since 1.2.0
instance Monad m => CoSerial m CUIntMax where
  coseries :: forall b. Series m b -> Series m (CUIntMax -> b)
coseries Series m b
rs = Series m b -> Series m (Word64 -> b)
forall (m :: * -> *) a b.
CoSerial m a =>
Series m b -> Series m (a -> b)
newtypeAlts Series m b
rs Series m (Word64 -> b)
-> ((Word64 -> b) -> Series m (CUIntMax -> b))
-> Series m (CUIntMax -> b)
forall a b. Series m a -> (a -> Series m b) -> Series m b
forall (m :: * -> *) a b. MonadLogic m => m a -> (a -> m b) -> m b
>>- \Word64 -> b
f -> (CUIntMax -> b) -> Series m (CUIntMax -> b)
forall a. a -> Series m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((CUIntMax -> b) -> Series m (CUIntMax -> b))
-> (CUIntMax -> b) -> Series m (CUIntMax -> b)
forall a b. (a -> b) -> a -> b
$ \CUIntMax
l -> case CUIntMax
l of CUIntMax Word64
x -> Word64 -> b
f Word64
x

-- | @since 1.2.0
instance Monad m => Serial m CClock where
  series :: Series m CClock
series = (Int32 -> CClock) -> Series m CClock
forall (m :: * -> *) a b. Serial m a => (a -> b) -> Series m b
newtypeCons Int32 -> CClock
CClock
-- | @since 1.2.0
instance Monad m => CoSerial m CClock where
  coseries :: forall b. Series m b -> Series m (CClock -> b)
coseries Series m b
rs = Series m b -> Series m (Int32 -> b)
forall (m :: * -> *) a b.
CoSerial m a =>
Series m b -> Series m (a -> b)
newtypeAlts Series m b
rs Series m (Int32 -> b)
-> ((Int32 -> b) -> Series m (CClock -> b))
-> Series m (CClock -> b)
forall a b. Series m a -> (a -> Series m b) -> Series m b
forall (m :: * -> *) a b. MonadLogic m => m a -> (a -> m b) -> m b
>>- \Int32 -> b
f -> (CClock -> b) -> Series m (CClock -> b)
forall a. a -> Series m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((CClock -> b) -> Series m (CClock -> b))
-> (CClock -> b) -> Series m (CClock -> b)
forall a b. (a -> b) -> a -> b
$ \CClock
l -> case CClock
l of CClock Int32
x -> Int32 -> b
f Int32
x

-- | @since 1.2.0
instance Monad m => Serial m CTime where
  series :: Series m CTime
series = (Int32 -> CTime) -> Series m CTime
forall (m :: * -> *) a b. Serial m a => (a -> b) -> Series m b
newtypeCons Int32 -> CTime
CTime
-- | @since 1.2.0
instance Monad m => CoSerial m CTime where
  coseries :: forall b. Series m b -> Series m (CTime -> b)
coseries Series m b
rs = Series m b -> Series m (Int32 -> b)
forall (m :: * -> *) a b.
CoSerial m a =>
Series m b -> Series m (a -> b)
newtypeAlts Series m b
rs Series m (Int32 -> b)
-> ((Int32 -> b) -> Series m (CTime -> b)) -> Series m (CTime -> b)
forall a b. Series m a -> (a -> Series m b) -> Series m b
forall (m :: * -> *) a b. MonadLogic m => m a -> (a -> m b) -> m b
>>- \Int32 -> b
f -> (CTime -> b) -> Series m (CTime -> b)
forall a. a -> Series m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((CTime -> b) -> Series m (CTime -> b))
-> (CTime -> b) -> Series m (CTime -> b)
forall a b. (a -> b) -> a -> b
$ \CTime
l -> case CTime
l of CTime Int32
x -> Int32 -> b
f Int32
x

-- | @since 1.2.0
instance Monad m => Serial m CUSeconds where
  series :: Series m CUSeconds
series = (Word32 -> CUSeconds) -> Series m CUSeconds
forall (m :: * -> *) a b. Serial m a => (a -> b) -> Series m b
newtypeCons Word32 -> CUSeconds
CUSeconds
-- | @since 1.2.0
instance Monad m => CoSerial m CUSeconds where
  coseries :: forall b. Series m b -> Series m (CUSeconds -> b)
coseries Series m b
rs = Series m b -> Series m (Word32 -> b)
forall (m :: * -> *) a b.
CoSerial m a =>
Series m b -> Series m (a -> b)
newtypeAlts Series m b
rs Series m (Word32 -> b)
-> ((Word32 -> b) -> Series m (CUSeconds -> b))
-> Series m (CUSeconds -> b)
forall a b. Series m a -> (a -> Series m b) -> Series m b
forall (m :: * -> *) a b. MonadLogic m => m a -> (a -> m b) -> m b
>>- \Word32 -> b
f -> (CUSeconds -> b) -> Series m (CUSeconds -> b)
forall a. a -> Series m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((CUSeconds -> b) -> Series m (CUSeconds -> b))
-> (CUSeconds -> b) -> Series m (CUSeconds -> b)
forall a b. (a -> b) -> a -> b
$ \CUSeconds
l -> case CUSeconds
l of CUSeconds Word32
x -> Word32 -> b
f Word32
x

-- | @since 1.2.0
instance Monad m => Serial m CSUSeconds where
  series :: Series m CSUSeconds
series = (Int32 -> CSUSeconds) -> Series m CSUSeconds
forall (m :: * -> *) a b. Serial m a => (a -> b) -> Series m b
newtypeCons Int32 -> CSUSeconds
CSUSeconds
-- | @since 1.2.0
instance Monad m => CoSerial m CSUSeconds where
  coseries :: forall b. Series m b -> Series m (CSUSeconds -> b)
coseries Series m b
rs = Series m b -> Series m (Int32 -> b)
forall (m :: * -> *) a b.
CoSerial m a =>
Series m b -> Series m (a -> b)
newtypeAlts Series m b
rs Series m (Int32 -> b)
-> ((Int32 -> b) -> Series m (CSUSeconds -> b))
-> Series m (CSUSeconds -> b)
forall a b. Series m a -> (a -> Series m b) -> Series m b
forall (m :: * -> *) a b. MonadLogic m => m a -> (a -> m b) -> m b
>>- \Int32 -> b
f -> (CSUSeconds -> b) -> Series m (CSUSeconds -> b)
forall a. a -> Series m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((CSUSeconds -> b) -> Series m (CSUSeconds -> b))
-> (CSUSeconds -> b) -> Series m (CSUSeconds -> b)
forall a b. (a -> b) -> a -> b
$ \CSUSeconds
l -> case CSUSeconds
l of CSUSeconds Int32
x -> Int32 -> b
f Int32
x
#endif

-- }}}