{-# LANGUAGE CPP, RankNTypes, MultiParamTypeClasses, FlexibleInstances,
GeneralizedNewtypeDeriving, FlexibleContexts, ScopedTypeVariables #-}
{-# LANGUAGE DefaultSignatures, FlexibleContexts, TypeOperators,
TypeSynonymInstances, FlexibleInstances, OverlappingInstances #-}
{-# LANGUAGE Trustworthy #-}
module Test.SmallCheck.Series (
cons0, cons1, cons2, cons3, cons4, newtypeCons,
alts0, alts1, alts2, alts3, alts4, newtypeAlts,
Depth, Series, Serial(..), CoSerial(..),
genericSeries,
genericCoseries,
Positive(..), NonNegative(..), NonEmpty(..),
(\/), (><), (<~>), (>>-),
localDepth,
decDepth,
getDepth,
generate,
limit,
listSeries,
list,
listM,
fixDepth,
decDepthChecked,
constM
) where
import Control.Monad.Logic
import Control.Monad.Reader
import Control.Applicative
import Control.Monad.Identity
import Data.Int (Int, Int8, Int16, Int32, Int64)
import Data.List
import Data.Ratio
import Data.Word (Word, Word8, Word16, Word32, Word64)
import Numeric.Natural (Natural)
import Test.SmallCheck.SeriesMonad
import GHC.Generics
class Monad m => Serial m a where
series :: Series m a
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
genericSeries
:: (Monad m, Generic a, GSerial m (Rep a))
=> Series m a
genericSeries :: Series m a
genericSeries = Rep a Any -> a
forall a x. Generic a => 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 (m :: * -> *) (f :: * -> *) a. GSerial m f => Series m (f a)
gSeries
class Monad m => CoSerial m a where
coseries :: Series m b -> Series m (a->b)
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
genericCoseries
:: (Monad m, Generic a, GCoSerial m (Rep a))
=> Series m b -> Series m (a->b)
genericCoseries :: 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 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 (m :: * -> *) (f :: * -> *) b a.
GCoSerial m f =>
Series m b -> Series m (f a -> b)
gCoseries Series m b
rs
generate :: (Depth -> [a]) -> Series m a
generate :: (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 (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 :: forall m a . Monad m => Int -> Series m a -> Series m a
limit :: 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 (ml :: * -> *) b. MonadLogic ml => Depth -> ml b -> ml b
go Depth
n0 ReaderT Depth (LogicT m) a
s
where
go :: MonadLogic ml => Int -> ml b -> ml b
go :: Depth -> ml b -> ml b
go Depth
0 ml b
_ = ml b
forall (m :: * -> *) a. MonadPlus m => m a
mzero
go Depth
n ml b
mb1 = do
Maybe (b, ml b)
cons :: Maybe (b, ml b) <- ml b -> ml (Maybe (b, ml b))
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 (m :: * -> *) a. MonadPlus m => m a
mzero
Just (b
b, ml b
mb2) -> b -> ml b
forall (m :: * -> *) a. Monad m => a -> m a
return b
b ml b -> ml b -> ml b
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Depth -> ml b -> ml b
forall (ml :: * -> *) b. MonadLogic ml => Depth -> ml b -> ml b
go (Depth
nDepth -> Depth -> Depth
forall a. Num a => a -> a -> a
-Depth
1) ml b
mb2
suchThat :: Series m a -> (a -> Bool) -> Series m a
suchThat :: 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 (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 (f :: * -> *) a. Applicative f => a -> f a
pure a
x else Series m a
forall (f :: * -> *) a. Alternative f => f a
empty
listSeries :: Serial Identity a => Depth -> [a]
listSeries :: 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
list :: Depth -> Series Identity a -> [a]
list :: 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. Monad 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
listM :: Monad m => Depth -> Series m a -> m [a]
listM :: Depth -> Series m a -> m [a]
listM Depth
d Series m a
s = LogicT m a -> m [a]
forall (m :: * -> *) a. Monad 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
infixr 7 \/
(\/) :: Monad m => Series m a -> Series m a -> Series m a
\/ :: Series m a -> Series m a -> Series m a
(\/) = Series m a -> Series m a -> Series m a
forall (m :: * -> *) a. MonadLogic m => m a -> m a -> m a
interleave
infixr 8 ><
(><) :: Monad m => Series m a -> Series m b -> Series m (a,b)
Series m a
a >< :: 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
infixl 4 <~>
(<~>) :: Monad m => Series m (a -> b) -> Series m a -> Series m b
Series m (a -> b)
a <~> :: 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 (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 :: (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 :: (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
getDepth :: Series m Depth
getDepth :: 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
localDepth :: (Depth -> Depth) -> Series m a -> Series m a
localDepth :: (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 r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local Depth -> Depth
f ReaderT Depth (LogicT m) a
a
decDepth :: Series m a -> Series m a
decDepth :: 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 :: 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 :: Monad m => m b -> m (a -> b)
constM :: 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
fixDepth :: Series m a -> Series m (Series m a)
fixDepth :: 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 (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Depth
d -> Series m a -> Series m (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
decDepthChecked :: Series m a -> Series m a -> Series m a
decDepthChecked :: 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 :: m a -> m [a]
unwind m a
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 (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 (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')
cons0 :: a -> Series m a
cons0 :: 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 (f :: * -> *) a. Applicative f => a -> f a
pure a
x
cons1 :: Serial m a => (a->b) -> Series m b
cons1 :: (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
newtypeCons :: Serial m a => (a->b) -> Series m b
newtypeCons :: (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
cons2 :: (Serial m a, Serial m b) => (a->b->c) -> Series m c
cons2 :: (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
cons3 :: (Serial m a, Serial m b, Serial m c) =>
(a->b->c->d) -> Series m d
cons3 :: (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
cons4 :: (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) -> 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
alts0 :: Series m a -> Series m a
alts0 :: Series m a -> Series m a
alts0 Series m a
s = Series m a
s
alts1 :: CoSerial m a => Series m b -> Series m (a->b)
alts1 :: 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 (m :: * -> *) a b.
CoSerial m a =>
Series m b -> Series m (a -> b)
coseries Series m b
rs)
alts2
:: (CoSerial m a, CoSerial m b)
=> Series m c -> Series m (a->b->c)
alts2 :: 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 (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 (m :: * -> *) a b.
CoSerial m a =>
Series m b -> Series m (a -> b)
coseries Series m c
rs)
alts3 :: (CoSerial m a, CoSerial m b, CoSerial m c) =>
Series m d -> Series m (a->b->c->d)
alts3 :: 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 (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 (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 (m :: * -> *) a b.
CoSerial m a =>
Series m b -> Series m (a -> b)
coseries Series m d
rs)
alts4 :: (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 -> 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 (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 (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 (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 (m :: * -> *) a b.
CoSerial m a =>
Series m b -> Series m (a -> b)
coseries Series m e
rs)
newtypeAlts :: CoSerial m a => Series m b -> Series m (a->b)
newtypeAlts :: Series m b -> Series m (a -> b)
newtypeAlts = Series m b -> Series m (a -> b)
forall (m :: * -> *) a b.
CoSerial m a =>
Series m b -> Series m (a -> b)
coseries
class GSerial m f where
gSeries :: Series m (f a)
class GCoSerial m f where
gCoseries :: Series m b -> Series m (f a -> b)
instance GSerial m f => GSerial m (M1 i c f) where
gSeries :: 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 (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 :: 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 i (c :: Meta) k (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 (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 :: 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 :: 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 i c k (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 (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 :: Series m (U1 a)
gSeries = U1 a -> Series m (U1 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 :: 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 (Monad m, GSerial m a, GSerial m b) => GSerial m (a :*: b) where
gSeries :: 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 (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 (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 :: 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 (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 (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 :: 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 (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 (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 (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 :: Series m b -> Series m ((:+:) a b a -> b)
gCoseries Series m b
rs =
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 (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 (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 (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 (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 GSerial m f => GSerial m (C1 c f) where
gSeries :: Series m (C1 c f a)
gSeries = f a -> C1 c f a
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (f a -> C1 c f a) -> Series m (f a) -> Series m (C1 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 (m :: * -> *) (f :: * -> *) a. GSerial m f => Series m (f a)
gSeries
{-# INLINE gSeries #-}
instance Monad m => Serial m () where
series :: Series m ()
series = () -> Series m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
instance Monad m => CoSerial m () where
coseries :: 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 :: Series m b -> Series m (Integer -> b)
coseries = ((M Integer -> b) -> Integer -> b)
-> Series m (M Integer -> b) -> Series m (Integer -> 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 (m :: * -> *) a b.
CoSerial m a =>
Series m b -> Series m (a -> b)
coseries
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
instance Monad m => CoSerial m Natural where coseries :: Series m b -> Series m (Natural -> b)
coseries = ((N Natural -> b) -> Natural -> b)
-> Series m (N Natural -> b) -> Series m (Natural -> 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 (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 :: Series m b -> Series m (Depth -> b)
coseries = ((M Depth -> b) -> Depth -> b)
-> Series m (M Depth -> b) -> Series m (Depth -> 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 (m :: * -> *) a b.
CoSerial m a =>
Series m b -> Series m (a -> b)
coseries
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
instance Monad m => CoSerial m Word where coseries :: Series m b -> Series m (Word -> b)
coseries = ((N Word -> b) -> Word -> b)
-> Series m (N Word -> b) -> Series m (Word -> 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 (m :: * -> *) a b.
CoSerial m a =>
Series m b -> Series m (a -> b)
coseries
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
instance Monad m => CoSerial m Int8 where coseries :: Series m b -> Series m (Int8 -> b)
coseries = ((M Int8 -> b) -> Int8 -> b)
-> Series m (M Int8 -> b) -> Series m (Int8 -> 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 (m :: * -> *) a b.
CoSerial m a =>
Series m b -> Series m (a -> b)
coseries
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
instance Monad m => CoSerial m Word8 where coseries :: Series m b -> Series m (Word8 -> b)
coseries = ((N Word8 -> b) -> Word8 -> b)
-> Series m (N Word8 -> b) -> Series m (Word8 -> 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 (m :: * -> *) a b.
CoSerial m a =>
Series m b -> Series m (a -> b)
coseries
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
instance Monad m => CoSerial m Int16 where coseries :: Series m b -> Series m (Int16 -> b)
coseries = ((M Int16 -> b) -> Int16 -> b)
-> Series m (M Int16 -> b) -> Series m (Int16 -> 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 (m :: * -> *) a b.
CoSerial m a =>
Series m b -> Series m (a -> b)
coseries
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
instance Monad m => CoSerial m Word16 where coseries :: Series m b -> Series m (Word16 -> b)
coseries = ((N Word16 -> b) -> Word16 -> b)
-> Series m (N Word16 -> b) -> Series m (Word16 -> 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 (m :: * -> *) a b.
CoSerial m a =>
Series m b -> Series m (a -> b)
coseries
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
instance Monad m => CoSerial m Int32 where coseries :: Series m b -> Series m (Int32 -> b)
coseries = ((M Int32 -> b) -> Int32 -> b)
-> Series m (M Int32 -> b) -> Series m (Int32 -> 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 (m :: * -> *) a b.
CoSerial m a =>
Series m b -> Series m (a -> b)
coseries
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
instance Monad m => CoSerial m Word32 where coseries :: Series m b -> Series m (Word32 -> b)
coseries = ((N Word32 -> b) -> Word32 -> b)
-> Series m (N Word32 -> b) -> Series m (Word32 -> 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 (m :: * -> *) a b.
CoSerial m a =>
Series m b -> Series m (a -> b)
coseries
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
instance Monad m => CoSerial m Int64 where coseries :: Series m b -> Series m (Int64 -> b)
coseries = ((M Int64 -> b) -> Int64 -> b)
-> Series m (M Int64 -> b) -> Series m (Int64 -> 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 (m :: * -> *) a b.
CoSerial m a =>
Series m b -> Series m (a -> b)
coseries
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
instance Monad m => CoSerial m Word64 where coseries :: Series m b -> Series m (Word64 -> b)
coseries = ((N Word64 -> b) -> Word64 -> b)
-> Series m (N Word64 -> b) -> Series m (Word64 -> 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 (m :: * -> *) a b.
CoSerial m a =>
Series m b -> Series m (a -> b)
coseries
newtype N a = N { 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
/= :: N a -> N a -> Bool
$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
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
min :: N a -> N a -> N a
$cmin :: forall a. Ord a => N a -> N a -> N a
max :: N a -> N a -> N a
$cmax :: forall a. Ord a => N a -> N a -> N a
>= :: 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
$c< :: forall a. Ord a => N a -> N a -> Bool
compare :: N a -> N a -> Ordering
$ccompare :: forall a. Ord a => N a -> N a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (N a)
Ord, Num (N a)
Ord (N a)
Num (N a) -> Ord (N a) -> (N a -> Rational) -> Real (N a)
N a -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
forall a. Real a => Num (N a)
forall a. Real a => Ord (N a)
forall a. Real a => N a -> Rational
toRational :: N a -> Rational
$ctoRational :: forall a. Real a => N a -> Rational
$cp2Real :: forall a. Real a => Ord (N a)
$cp1Real :: forall a. Real a => Num (N a)
Real, Depth -> N a
N a -> Depth
N a -> [N a]
N a -> N a
N a -> N a -> [N a]
N a -> N a -> N a -> [N a]
(N a -> N a)
-> (N a -> N a)
-> (Depth -> N a)
-> (N a -> Depth)
-> (N a -> [N a])
-> (N a -> N a -> [N a])
-> (N a -> N a -> [N a])
-> (N a -> N a -> N a -> [N a])
-> Enum (N a)
forall a. Enum a => Depth -> N a
forall a. Enum a => N a -> Depth
forall a. Enum a => N a -> [N a]
forall a. Enum a => N a -> N a
forall a. Enum a => N a -> N a -> [N a]
forall a. Enum a => N a -> N a -> N a -> [N a]
forall a.
(a -> a)
-> (a -> a)
-> (Depth -> a)
-> (a -> Depth)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: N a -> N a -> N a -> [N a]
$cenumFromThenTo :: forall a. Enum a => N a -> N a -> N a -> [N a]
enumFromTo :: N a -> N a -> [N a]
$cenumFromTo :: forall a. Enum a => N a -> N a -> [N a]
enumFromThen :: N a -> N a -> [N a]
$cenumFromThen :: forall a. Enum a => N a -> N a -> [N a]
enumFrom :: N a -> [N a]
$cenumFrom :: forall a. Enum a => N a -> [N a]
fromEnum :: N a -> Depth
$cfromEnum :: forall a. Enum a => N a -> Depth
toEnum :: Depth -> N a
$ctoEnum :: forall a. Enum a => Depth -> N a
pred :: N a -> N a
$cpred :: forall a. Enum a => N a -> N a
succ :: N a -> N a
$csucc :: forall a. Enum a => N a -> N a
Enum, Integer -> N a
N a -> N a
N a -> N a -> N a
(N a -> N a -> N a)
-> (N a -> N a -> N a)
-> (N a -> N a -> N a)
-> (N a -> N a)
-> (N a -> N a)
-> (N a -> N a)
-> (Integer -> N a)
-> Num (N a)
forall a. Num a => Integer -> N a
forall a. Num a => N a -> N a
forall a. Num a => N a -> N a -> N a
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> N a
$cfromInteger :: forall a. Num a => Integer -> N a
signum :: N a -> N a
$csignum :: forall a. Num a => N a -> N a
abs :: N a -> N a
$cabs :: forall a. Num a => N a -> N a
negate :: N a -> N a
$cnegate :: forall a. Num a => N a -> N a
* :: N a -> N a -> N a
$c* :: forall a. Num a => N a -> N a -> N a
- :: N a -> N a -> N a
$c- :: forall a. Num a => N a -> N a -> N a
+ :: N a -> N a -> N a
$c+ :: forall a. Num a => N a -> N a -> N a
Num, Enum (N a)
Real (N a)
Real (N a)
-> Enum (N a)
-> (N a -> N a -> N a)
-> (N a -> N a -> N a)
-> (N a -> N a -> N a)
-> (N a -> N a -> N a)
-> (N a -> N a -> (N a, N a))
-> (N a -> N a -> (N a, N a))
-> (N a -> Integer)
-> Integral (N a)
N a -> Integer
N a -> N a -> (N a, N a)
N a -> N a -> N a
forall a. Integral a => Enum (N a)
forall a. Integral a => Real (N a)
forall a. Integral a => N a -> Integer
forall a. Integral a => N a -> N a -> (N a, N a)
forall a. Integral a => N a -> N a -> N a
forall a.
Real a
-> Enum a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
toInteger :: N a -> Integer
$ctoInteger :: forall a. Integral a => N a -> Integer
divMod :: N a -> N a -> (N a, N a)
$cdivMod :: forall a. Integral a => N a -> N a -> (N a, N a)
quotRem :: N a -> N a -> (N a, N a)
$cquotRem :: forall a. Integral a => N a -> N a -> (N a, N a)
mod :: N a -> N a -> N a
$cmod :: forall a. Integral a => N a -> N a -> N a
div :: N a -> N a -> N a
$cdiv :: forall a. Integral a => N a -> N a -> N a
rem :: N a -> N a -> N a
$crem :: forall a. Integral a => N a -> N a -> N a
quot :: N a -> N a -> N a
$cquot :: forall a. Integral a => N a -> N a -> N a
$cp2Integral :: forall a. Integral a => Enum (N a)
$cp1Integral :: forall a. Integral a => Real (N a)
Integral)
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 :: Series m b -> Series m (N 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 (N a -> b)) -> Series m (N a -> 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 (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 (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
newtype M a = M { 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
/= :: M a -> M a -> Bool
$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
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
min :: M a -> M a -> M a
$cmin :: forall a. Ord a => M a -> M a -> M a
max :: M a -> M a -> M a
$cmax :: forall a. Ord a => M a -> M a -> M a
>= :: 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
$c< :: forall a. Ord a => M a -> M a -> Bool
compare :: M a -> M a -> Ordering
$ccompare :: forall a. Ord a => M a -> M a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (M a)
Ord, Num (M a)
Ord (M a)
Num (M a) -> Ord (M a) -> (M a -> Rational) -> Real (M a)
M a -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
forall a. Real a => Num (M a)
forall a. Real a => Ord (M a)
forall a. Real a => M a -> Rational
toRational :: M a -> Rational
$ctoRational :: forall a. Real a => M a -> Rational
$cp2Real :: forall a. Real a => Ord (M a)
$cp1Real :: forall a. Real a => Num (M a)
Real, Depth -> M a
M a -> Depth
M a -> [M a]
M a -> M a
M a -> M a -> [M a]
M a -> M a -> M a -> [M a]
(M a -> M a)
-> (M a -> M a)
-> (Depth -> M a)
-> (M a -> Depth)
-> (M a -> [M a])
-> (M a -> M a -> [M a])
-> (M a -> M a -> [M a])
-> (M a -> M a -> M a -> [M a])
-> Enum (M a)
forall a. Enum a => Depth -> M a
forall a. Enum a => M a -> Depth
forall a. Enum a => M a -> [M a]
forall a. Enum a => M a -> M a
forall a. Enum a => M a -> M a -> [M a]
forall a. Enum a => M a -> M a -> M a -> [M a]
forall a.
(a -> a)
-> (a -> a)
-> (Depth -> a)
-> (a -> Depth)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: M a -> M a -> M a -> [M a]
$cenumFromThenTo :: forall a. Enum a => M a -> M a -> M a -> [M a]
enumFromTo :: M a -> M a -> [M a]
$cenumFromTo :: forall a. Enum a => M a -> M a -> [M a]
enumFromThen :: M a -> M a -> [M a]
$cenumFromThen :: forall a. Enum a => M a -> M a -> [M a]
enumFrom :: M a -> [M a]
$cenumFrom :: forall a. Enum a => M a -> [M a]
fromEnum :: M a -> Depth
$cfromEnum :: forall a. Enum a => M a -> Depth
toEnum :: Depth -> M a
$ctoEnum :: forall a. Enum a => Depth -> M a
pred :: M a -> M a
$cpred :: forall a. Enum a => M a -> M a
succ :: M a -> M a
$csucc :: forall a. Enum a => M a -> M a
Enum, Integer -> M a
M a -> M a
M a -> M a -> M a
(M a -> M a -> M a)
-> (M a -> M a -> M a)
-> (M a -> M a -> M a)
-> (M a -> M a)
-> (M a -> M a)
-> (M a -> M a)
-> (Integer -> M a)
-> Num (M a)
forall a. Num a => Integer -> M a
forall a. Num a => M a -> M a
forall a. Num a => M a -> M a -> M a
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> M a
$cfromInteger :: forall a. Num a => Integer -> M a
signum :: M a -> M a
$csignum :: forall a. Num a => M a -> M a
abs :: M a -> M a
$cabs :: forall a. Num a => M a -> M a
negate :: M a -> M a
$cnegate :: forall a. Num a => M a -> M a
* :: M a -> M a -> M a
$c* :: forall a. Num a => M a -> M a -> M a
- :: M a -> M a -> M a
$c- :: forall a. Num a => M a -> M a -> M a
+ :: M a -> M a -> M a
$c+ :: forall a. Num a => M a -> M a -> M a
Num, Enum (M a)
Real (M a)
Real (M a)
-> Enum (M a)
-> (M a -> M a -> M a)
-> (M a -> M a -> M a)
-> (M a -> M a -> M a)
-> (M a -> M a -> M a)
-> (M a -> M a -> (M a, M a))
-> (M a -> M a -> (M a, M a))
-> (M a -> Integer)
-> Integral (M a)
M a -> Integer
M a -> M a -> (M a, M a)
M a -> M a -> M a
forall a. Integral a => Enum (M a)
forall a. Integral a => Real (M a)
forall a. Integral a => M a -> Integer
forall a. Integral a => M a -> M a -> (M a, M a)
forall a. Integral a => M a -> M a -> M a
forall a.
Real a
-> Enum a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
toInteger :: M a -> Integer
$ctoInteger :: forall a. Integral a => M a -> Integer
divMod :: M a -> M a -> (M a, M a)
$cdivMod :: forall a. Integral a => M a -> M a -> (M a, M a)
quotRem :: M a -> M a -> (M a, M a)
$cquotRem :: forall a. Integral a => M a -> M a -> (M a, M a)
mod :: M a -> M a -> M a
$cmod :: forall a. Integral a => M a -> M a -> M a
div :: M a -> M a -> M a
$cdiv :: forall a. Integral a => M a -> M a -> M a
rem :: M a -> M a -> M a
$crem :: forall a. Integral a => M a -> M a -> M a
quot :: M a -> M a -> M a
$cquot :: forall a. Integral a => M a -> M a -> M a
$cp2Integral :: forall a. Integral a => Enum (M a)
$cp1Integral :: forall a. Integral a => Real (M a)
Integral)
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 (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 :: 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 (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 (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 (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 (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 (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 (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
Float -> Series m Float
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 :: Series m b -> Series m (Float -> b)
coseries Series m b
rs =
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 (m :: * -> *) a b. MonadLogic m => m a -> (a -> m b) -> m b
>>- \(Integer, Depth) -> b
f ->
(Float -> b) -> Series m (Float -> b)
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 :: 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 (m :: * -> *) a b.
CoSerial m a =>
Series m b -> Series m (a -> b)
coseries Series m b
rs
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
instance (Integral i, CoSerial m i) => CoSerial m (Ratio i) where
coseries :: 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 (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 -> [Char]) -> Series m Char
forall a (m :: * -> *). (Depth -> [a]) -> Series m a
generate ((Depth -> [Char]) -> Series m Char)
-> (Depth -> [Char]) -> Series m Char
forall a b. (a -> b) -> a -> b
$ \Depth
d -> Depth -> [Char] -> [Char]
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 :: Series m b -> Series m (Char -> b)
coseries Series m b
rs =
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 (m :: * -> *) a b. MonadLogic m => m a -> (a -> m b) -> m b
>>- \N Depth -> b
f ->
(Char -> b) -> Series m (Char -> b)
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 :: 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 :: 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 :: 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
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 :: 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 (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 (m :: * -> *) a b. MonadLogic m => m a -> (a -> m b) -> m b
>>- \b
r2 ->
(Bool -> b) -> Series m (Bool -> b)
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
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 :: 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 :: 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 :: 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 (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 (m :: * -> *) a b. MonadLogic m => m a -> (a -> m b) -> m b
>>- \a -> [a] -> b
f ->
([a] -> b) -> Series m ([a] -> b)
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'
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 (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
instance (Serial m a, CoSerial m a, Serial m b, CoSerial m b) => CoSerial m (a->b) where
coseries :: 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 (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 :: 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 (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 (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
instance (Serial Identity a, Show a, Show b) => Show (a->b) where
show :: (a -> b) -> [Char]
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
+ [([Char], [Char])] -> Depth
forall (t :: * -> *) a. Foldable t => t a -> Depth
length [([Char], [Char])]
ars Depth -> Depth -> Depth
forall a. Num a => a -> a -> a
* [Char] -> Depth
forall (t :: * -> *) a. Foldable t => t a -> Depth
length [Char]
"->;" Depth -> Depth -> Bool
forall a. Ord a => a -> a -> Bool
< Depth
widthLimit then
[Char]
"{"[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++(
[[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
intersperse [Char]
";" ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ [[Char]
a[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
"->"[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
r | ([Char]
a,[Char]
r) <- [([Char], [Char])]
ars]
)[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
"}"
else
[[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ [[Char]
a[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
"->\n"[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char] -> [Char]
indent [Char]
r | ([Char]
a,[Char]
r) <- [([Char], [Char])]
ars]
where
ars :: [([Char], [Char])]
ars = Depth -> [([Char], [Char])] -> [([Char], [Char])]
forall a. Depth -> [a] -> [a]
take Depth
lengthLimit [ (a -> [Char]
forall a. Show a => a -> [Char]
show a
x, b -> [Char]
forall a. Show a => a -> [Char]
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 (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [ Depth -> Depth -> Depth
forall a. Ord a => a -> a -> a
max ([Char] -> Depth
height [Char]
a) ([Char] -> Depth
height [Char]
r)
| ([Char]
a,[Char]
r) <- [([Char], [Char])]
ars ]
sumarwidth :: Depth
sumarwidth = [Depth] -> Depth
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [ [Char] -> Depth
forall (t :: * -> *) a. Foldable t => t a -> Depth
length [Char]
a Depth -> Depth -> Depth
forall a. Num a => a -> a -> a
+ [Char] -> Depth
forall (t :: * -> *) a. Foldable t => t a -> Depth
length [Char]
r
| ([Char]
a,[Char]
r) <- [([Char], [Char])]
ars]
indent :: [Char] -> [Char]
indent = [[Char]] -> [Char]
unlines ([[Char]] -> [Char]) -> ([Char] -> [[Char]]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char] -> [Char]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ([Char]
" "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++) ([[Char]] -> [[Char]])
-> ([Char] -> [[Char]]) -> [Char] -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [[Char]]
lines
height :: [Char] -> Depth
height = [[Char]] -> Depth
forall (t :: * -> *) a. Foldable t => t a -> Depth
length ([[Char]] -> Depth) -> ([Char] -> [[Char]]) -> [Char] -> Depth
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [[Char]]
lines
(Depth
widthLimit,Depth
lengthLimit,Depth
depthLimit) = (Depth
80,Depth
20,Depth
3)::(Int,Int,Depth)
newtype Positive a = Positive { 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
/= :: Positive a -> Positive a -> Bool
$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
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
min :: Positive a -> Positive a -> Positive a
$cmin :: forall a. Ord a => Positive a -> Positive a -> Positive a
max :: Positive a -> Positive a -> Positive a
$cmax :: forall a. Ord a => Positive a -> Positive a -> Positive a
>= :: 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
$c< :: forall a. Ord a => Positive a -> Positive a -> Bool
compare :: Positive a -> Positive a -> Ordering
$ccompare :: forall a. Ord a => Positive a -> Positive a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (Positive a)
Ord, Integer -> Positive a
Positive a -> Positive a
Positive a -> Positive a -> Positive a
(Positive a -> Positive a -> Positive a)
-> (Positive a -> Positive a -> Positive a)
-> (Positive a -> Positive a -> Positive a)
-> (Positive a -> Positive a)
-> (Positive a -> Positive a)
-> (Positive a -> Positive a)
-> (Integer -> Positive a)
-> Num (Positive a)
forall a. Num a => Integer -> Positive a
forall a. Num a => Positive a -> Positive a
forall a. Num a => Positive a -> Positive a -> Positive a
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Positive a
$cfromInteger :: forall a. Num a => Integer -> Positive a
signum :: Positive a -> Positive a
$csignum :: forall a. Num a => Positive a -> Positive a
abs :: Positive a -> Positive a
$cabs :: forall a. Num a => Positive a -> Positive a
negate :: Positive a -> Positive a
$cnegate :: forall a. Num a => Positive a -> Positive a
* :: Positive a -> Positive a -> Positive a
$c* :: forall a. Num a => Positive a -> Positive a -> Positive a
- :: Positive a -> Positive a -> Positive a
$c- :: forall a. Num a => Positive a -> Positive a -> Positive a
+ :: Positive a -> Positive a -> Positive a
$c+ :: forall a. Num a => Positive a -> Positive a -> Positive a
Num, Enum (Positive a)
Real (Positive a)
Real (Positive a)
-> Enum (Positive a)
-> (Positive a -> Positive a -> Positive a)
-> (Positive a -> Positive a -> Positive a)
-> (Positive a -> Positive a -> Positive a)
-> (Positive a -> Positive a -> Positive a)
-> (Positive a -> Positive a -> (Positive a, Positive a))
-> (Positive a -> Positive a -> (Positive a, Positive a))
-> (Positive a -> Integer)
-> Integral (Positive a)
Positive a -> Integer
Positive a -> Positive a -> (Positive a, Positive a)
Positive a -> Positive a -> Positive a
forall a. Integral a => Enum (Positive a)
forall a. Integral a => Real (Positive a)
forall a. Integral a => Positive a -> Integer
forall a.
Integral a =>
Positive a -> Positive a -> (Positive a, Positive a)
forall a. Integral a => Positive a -> Positive a -> Positive a
forall a.
Real a
-> Enum a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
toInteger :: Positive a -> Integer
$ctoInteger :: forall a. Integral a => Positive a -> Integer
divMod :: Positive a -> Positive a -> (Positive a, Positive a)
$cdivMod :: forall a.
Integral a =>
Positive a -> Positive a -> (Positive a, Positive a)
quotRem :: Positive a -> Positive a -> (Positive a, Positive a)
$cquotRem :: forall a.
Integral a =>
Positive a -> Positive a -> (Positive a, Positive a)
mod :: Positive a -> Positive a -> Positive a
$cmod :: forall a. Integral a => Positive a -> Positive a -> Positive a
div :: Positive a -> Positive a -> Positive a
$cdiv :: forall a. Integral a => Positive a -> Positive a -> Positive a
rem :: Positive a -> Positive a -> Positive a
$crem :: forall a. Integral a => Positive a -> Positive a -> Positive a
quot :: Positive a -> Positive a -> Positive a
$cquot :: forall a. Integral a => Positive a -> Positive a -> Positive a
$cp2Integral :: forall a. Integral a => Enum (Positive a)
$cp1Integral :: forall a. Integral a => Real (Positive a)
Integral, Num (Positive a)
Ord (Positive a)
Num (Positive a)
-> Ord (Positive a)
-> (Positive a -> Rational)
-> Real (Positive a)
Positive a -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
forall a. Real a => Num (Positive a)
forall a. Real a => Ord (Positive a)
forall a. Real a => Positive a -> Rational
toRational :: Positive a -> Rational
$ctoRational :: forall a. Real a => Positive a -> Rational
$cp2Real :: forall a. Real a => Ord (Positive a)
$cp1Real :: forall a. Real a => Num (Positive a)
Real, Depth -> Positive a
Positive a -> Depth
Positive a -> [Positive a]
Positive a -> Positive a
Positive a -> Positive a -> [Positive a]
Positive a -> Positive a -> Positive a -> [Positive a]
(Positive a -> Positive a)
-> (Positive a -> Positive a)
-> (Depth -> Positive a)
-> (Positive a -> Depth)
-> (Positive a -> [Positive a])
-> (Positive a -> Positive a -> [Positive a])
-> (Positive a -> Positive a -> [Positive a])
-> (Positive a -> Positive a -> Positive a -> [Positive a])
-> Enum (Positive a)
forall a. Enum a => Depth -> Positive a
forall a. Enum a => Positive a -> Depth
forall a. Enum a => Positive a -> [Positive a]
forall a. Enum a => Positive a -> Positive a
forall a. Enum a => Positive a -> Positive a -> [Positive a]
forall a.
Enum a =>
Positive a -> Positive a -> Positive a -> [Positive a]
forall a.
(a -> a)
-> (a -> a)
-> (Depth -> a)
-> (a -> Depth)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Positive a -> Positive a -> Positive a -> [Positive a]
$cenumFromThenTo :: forall a.
Enum a =>
Positive a -> Positive a -> Positive a -> [Positive a]
enumFromTo :: Positive a -> Positive a -> [Positive a]
$cenumFromTo :: forall a. Enum a => Positive a -> Positive a -> [Positive a]
enumFromThen :: Positive a -> Positive a -> [Positive a]
$cenumFromThen :: forall a. Enum a => Positive a -> Positive a -> [Positive a]
enumFrom :: Positive a -> [Positive a]
$cenumFrom :: forall a. Enum a => Positive a -> [Positive a]
fromEnum :: Positive a -> Depth
$cfromEnum :: forall a. Enum a => Positive a -> Depth
toEnum :: Depth -> Positive a
$ctoEnum :: forall a. Enum a => Depth -> Positive a
pred :: Positive a -> Positive a
$cpred :: forall a. Enum a => Positive a -> Positive a
succ :: Positive a -> Positive a
$csucc :: forall a. Enum a => Positive a -> Positive a
Enum)
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 -> [Char] -> [Char]
showsPrec Depth
n (Positive a
x) = Depth -> a -> [Char] -> [Char]
forall a. Show a => Depth -> a -> [Char] -> [Char]
showsPrec Depth
n a
x
newtype NonNegative a = NonNegative { 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
/= :: NonNegative a -> NonNegative a -> Bool
$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
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
min :: NonNegative a -> NonNegative a -> NonNegative a
$cmin :: forall a. Ord a => NonNegative a -> NonNegative a -> NonNegative a
max :: NonNegative a -> NonNegative a -> NonNegative a
$cmax :: forall a. Ord a => NonNegative a -> NonNegative a -> NonNegative a
>= :: 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
$c< :: forall a. Ord a => NonNegative a -> NonNegative a -> Bool
compare :: NonNegative a -> NonNegative a -> Ordering
$ccompare :: forall a. Ord a => NonNegative a -> NonNegative a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (NonNegative a)
Ord, Integer -> NonNegative a
NonNegative a -> NonNegative a
NonNegative a -> NonNegative a -> NonNegative a
(NonNegative a -> NonNegative a -> NonNegative a)
-> (NonNegative a -> NonNegative a -> NonNegative a)
-> (NonNegative a -> NonNegative a -> NonNegative a)
-> (NonNegative a -> NonNegative a)
-> (NonNegative a -> NonNegative a)
-> (NonNegative a -> NonNegative a)
-> (Integer -> NonNegative a)
-> Num (NonNegative a)
forall a. Num a => Integer -> NonNegative a
forall a. Num a => NonNegative a -> NonNegative a
forall a. Num a => NonNegative a -> NonNegative a -> NonNegative a
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> NonNegative a
$cfromInteger :: forall a. Num a => Integer -> NonNegative a
signum :: NonNegative a -> NonNegative a
$csignum :: forall a. Num a => NonNegative a -> NonNegative a
abs :: NonNegative a -> NonNegative a
$cabs :: forall a. Num a => NonNegative a -> NonNegative a
negate :: NonNegative a -> NonNegative a
$cnegate :: forall a. Num a => NonNegative a -> NonNegative a
* :: NonNegative a -> NonNegative a -> NonNegative a
$c* :: forall a. Num a => NonNegative a -> NonNegative a -> NonNegative a
- :: NonNegative a -> NonNegative a -> NonNegative a
$c- :: forall a. Num a => NonNegative a -> NonNegative a -> NonNegative a
+ :: NonNegative a -> NonNegative a -> NonNegative a
$c+ :: forall a. Num a => NonNegative a -> NonNegative a -> NonNegative a
Num, Enum (NonNegative a)
Real (NonNegative a)
Real (NonNegative a)
-> Enum (NonNegative a)
-> (NonNegative a -> NonNegative a -> NonNegative a)
-> (NonNegative a -> NonNegative a -> NonNegative a)
-> (NonNegative a -> NonNegative a -> NonNegative a)
-> (NonNegative a -> NonNegative a -> NonNegative a)
-> (NonNegative a
-> NonNegative a -> (NonNegative a, NonNegative a))
-> (NonNegative a
-> NonNegative a -> (NonNegative a, NonNegative a))
-> (NonNegative a -> Integer)
-> Integral (NonNegative a)
NonNegative a -> Integer
NonNegative a -> NonNegative a -> (NonNegative a, NonNegative a)
NonNegative a -> NonNegative a -> NonNegative a
forall a. Integral a => Enum (NonNegative a)
forall a. Integral a => Real (NonNegative a)
forall a. Integral a => NonNegative a -> Integer
forall a.
Integral a =>
NonNegative a -> NonNegative a -> (NonNegative a, NonNegative a)
forall a.
Integral a =>
NonNegative a -> NonNegative a -> NonNegative a
forall a.
Real a
-> Enum a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
toInteger :: NonNegative a -> Integer
$ctoInteger :: forall a. Integral a => NonNegative a -> Integer
divMod :: NonNegative a -> NonNegative a -> (NonNegative a, NonNegative a)
$cdivMod :: forall a.
Integral a =>
NonNegative a -> NonNegative a -> (NonNegative a, NonNegative a)
quotRem :: NonNegative a -> NonNegative a -> (NonNegative a, NonNegative a)
$cquotRem :: forall a.
Integral a =>
NonNegative a -> NonNegative a -> (NonNegative a, NonNegative a)
mod :: NonNegative a -> NonNegative a -> NonNegative a
$cmod :: forall a.
Integral a =>
NonNegative a -> NonNegative a -> NonNegative a
div :: NonNegative a -> NonNegative a -> NonNegative a
$cdiv :: forall a.
Integral a =>
NonNegative a -> NonNegative a -> NonNegative a
rem :: NonNegative a -> NonNegative a -> NonNegative a
$crem :: forall a.
Integral a =>
NonNegative a -> NonNegative a -> NonNegative a
quot :: NonNegative a -> NonNegative a -> NonNegative a
$cquot :: forall a.
Integral a =>
NonNegative a -> NonNegative a -> NonNegative a
$cp2Integral :: forall a. Integral a => Enum (NonNegative a)
$cp1Integral :: forall a. Integral a => Real (NonNegative a)
Integral, Num (NonNegative a)
Ord (NonNegative a)
Num (NonNegative a)
-> Ord (NonNegative a)
-> (NonNegative a -> Rational)
-> Real (NonNegative a)
NonNegative a -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
forall a. Real a => Num (NonNegative a)
forall a. Real a => Ord (NonNegative a)
forall a. Real a => NonNegative a -> Rational
toRational :: NonNegative a -> Rational
$ctoRational :: forall a. Real a => NonNegative a -> Rational
$cp2Real :: forall a. Real a => Ord (NonNegative a)
$cp1Real :: forall a. Real a => Num (NonNegative a)
Real, Depth -> NonNegative a
NonNegative a -> Depth
NonNegative a -> [NonNegative a]
NonNegative a -> NonNegative a
NonNegative a -> NonNegative a -> [NonNegative a]
NonNegative a -> NonNegative a -> NonNegative a -> [NonNegative a]
(NonNegative a -> NonNegative a)
-> (NonNegative a -> NonNegative a)
-> (Depth -> NonNegative a)
-> (NonNegative a -> Depth)
-> (NonNegative a -> [NonNegative a])
-> (NonNegative a -> NonNegative a -> [NonNegative a])
-> (NonNegative a -> NonNegative a -> [NonNegative a])
-> (NonNegative a
-> NonNegative a -> NonNegative a -> [NonNegative a])
-> Enum (NonNegative a)
forall a. Enum a => Depth -> NonNegative a
forall a. Enum a => NonNegative a -> Depth
forall a. Enum a => NonNegative a -> [NonNegative a]
forall a. Enum a => NonNegative a -> NonNegative a
forall a.
Enum a =>
NonNegative a -> NonNegative a -> [NonNegative a]
forall a.
Enum a =>
NonNegative a -> NonNegative a -> NonNegative a -> [NonNegative a]
forall a.
(a -> a)
-> (a -> a)
-> (Depth -> a)
-> (a -> Depth)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: NonNegative a -> NonNegative a -> NonNegative a -> [NonNegative a]
$cenumFromThenTo :: forall a.
Enum a =>
NonNegative a -> NonNegative a -> NonNegative a -> [NonNegative a]
enumFromTo :: NonNegative a -> NonNegative a -> [NonNegative a]
$cenumFromTo :: forall a.
Enum a =>
NonNegative a -> NonNegative a -> [NonNegative a]
enumFromThen :: NonNegative a -> NonNegative a -> [NonNegative a]
$cenumFromThen :: forall a.
Enum a =>
NonNegative a -> NonNegative a -> [NonNegative a]
enumFrom :: NonNegative a -> [NonNegative a]
$cenumFrom :: forall a. Enum a => NonNegative a -> [NonNegative a]
fromEnum :: NonNegative a -> Depth
$cfromEnum :: forall a. Enum a => NonNegative a -> Depth
toEnum :: Depth -> NonNegative a
$ctoEnum :: forall a. Enum a => Depth -> NonNegative a
pred :: NonNegative a -> NonNegative a
$cpred :: forall a. Enum a => NonNegative a -> NonNegative a
succ :: NonNegative a -> NonNegative a
$csucc :: forall a. Enum a => NonNegative a -> NonNegative a
Enum)
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 -> [Char] -> [Char]
showsPrec Depth
n (NonNegative a
x) = Depth -> a -> [Char] -> [Char]
forall a. Show a => Depth -> a -> [Char] -> [Char]
showsPrec Depth
n a
x
newtype NonEmpty a = NonEmpty { 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 -> [Char] -> [Char]
showsPrec Depth
n (NonEmpty [a]
x) = Depth -> [a] -> [Char] -> [Char]
forall a. Show a => Depth -> a -> [Char] -> [Char]
showsPrec Depth
n [a]
x