{-# LANGUAGE
GeneralizedNewtypeDeriving
, RankNTypes
, Trustworthy
, CPP
#-}
#if !defined(MIN_VERSION_containers)
#define MIN_VERSION_containers(x,y,z) 0
#endif
module Data.Unfolder
(
Unfolder(..)
, chooseMonadDefault
, chooseMapMonadDefault
, between
, betweenD
, boundedEnum
, boundedEnumD
, Random(..)
, Arb(..)
, arbUnit
, NumConst(..)
, Nth(..)
, UnfolderTransformer(..)
, ala
, ala2
, ala3
, DualA(..)
, NT(..)
, WithRec(..)
, withRec
, limitDepth
, BFS(..)
, Split
, bfs
, bfsBySum
)
where
import Control.Applicative
import Control.Monad
import Control.Arrow (ArrowZero, ArrowPlus)
import Data.Functor.Product
import Data.Functor.Compose
import Data.Functor.Reverse
import Control.Applicative.Backwards
import Control.Applicative.Lift
import Control.Monad.Trans.Except
import Control.Monad.Trans.List
import Control.Monad.Trans.Maybe
import Control.Monad.Trans.RWS
import Control.Monad.Trans.Reader
import Control.Monad.Trans.State
import Control.Monad.Trans.Writer
import qualified System.Random as R
import Test.QuickCheck (Arbitrary(..), Gen, oneof, elements, frequency, sized, resize)
import Data.Monoid (Monoid(..))
import Data.Maybe (catMaybes)
import qualified Data.Sequence as S
class Alternative f => Unfolder f where
choose :: [f a] -> f a
choose = (f a -> f a) -> [f a] -> f a
forall (f :: * -> *) a b. Unfolder f => (a -> f b) -> [a] -> f b
chooseMap f a -> f a
forall a. a -> a
id
chooseMap :: (a -> f b) -> [a] -> f b
chooseMap a -> f b
f = (a -> f b -> f b) -> f b -> [a] -> f b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (f b -> f b -> f b
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>) (f b -> f b -> f b) -> (a -> f b) -> a -> f b -> f b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> f b
f) f b
forall (f :: * -> *) a. Alternative f => f a
empty
chooseInt :: Int -> f Int
chooseInt Int
n = (Int -> f Int) -> [Int] -> f Int
forall (f :: * -> *) a b. Unfolder f => (a -> f b) -> [a] -> f b
chooseMap Int -> f Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Int
0 .. Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
chooseMonadDefault :: (Monad m, Unfolder m) => [m a] -> m a
chooseMonadDefault :: [m a] -> m a
chooseMonadDefault [m a]
ms = Int -> m Int
forall (f :: * -> *). Unfolder f => Int -> f Int
chooseInt ([m a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [m a]
ms) m Int -> (Int -> m a) -> m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ([m a]
ms [m a] -> Int -> m a
forall a. [a] -> Int -> a
!!)
chooseMapMonadDefault :: (Monad m, Unfolder m) => (a -> m b) -> [a] -> m b
chooseMapMonadDefault :: (a -> m b) -> [a] -> m b
chooseMapMonadDefault a -> m b
f [a]
as = Int -> m Int
forall (f :: * -> *). Unfolder f => Int -> f Int
chooseInt ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
as) m Int -> (Int -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> m b
f (a -> m b) -> (Int -> a) -> Int -> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([a]
as [a] -> Int -> a
forall a. [a] -> Int -> a
!!)
between :: (Unfolder f, Enum a) => a -> a -> f a
between :: a -> a -> f a
between a
lb a
ub = (\Int
x -> Int -> a
forall a. Enum a => Int -> a
toEnum (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ a -> Int
forall a. Enum a => a -> Int
fromEnum a
lb)) (Int -> a) -> f Int -> f a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> f Int
forall (f :: * -> *). Unfolder f => Int -> f Int
chooseInt (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ a -> Int
forall a. Enum a => a -> Int
fromEnum a
ub Int -> Int -> Int
forall a. Num a => a -> a -> a
- a -> Int
forall a. Enum a => a -> Int
fromEnum a
lb)
boundedEnum :: (Unfolder f, Bounded a, Enum a) => f a
boundedEnum :: f a
boundedEnum = a -> a -> f a
forall (f :: * -> *) a. (Unfolder f, Enum a) => a -> a -> f a
between a
forall a. Bounded a => a
minBound a
forall a. Bounded a => a
maxBound
betweenD :: (Unfolder f, Enum a) => a -> a -> f a
betweenD :: a -> a -> f a
betweenD a
lb0 a
ub = a -> Int -> f a
forall t (f :: * -> *) a.
(Ord t, Num t, Unfolder f, Enum a, Enum t) =>
a -> t -> f a
betweenD' a
lb0 (a -> Int
forall a. Enum a => a -> Int
fromEnum a
ub Int -> Int -> Int
forall a. Num a => a -> a -> a
- a -> Int
forall a. Enum a => a -> Int
fromEnum a
lb0)
where
betweenD' :: a -> t -> f a
betweenD' a
lb t
n | t
n t -> t -> Bool
forall a. Ord a => a -> a -> Bool
< t
0 = f a
forall (f :: * -> *) a. Alternative f => f a
empty
| Bool
otherwise = [f a] -> f a
forall (f :: * -> *) a. Unfolder f => [f a] -> f a
choose [a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
lb, a -> t -> f a
betweenD' (a -> a
forall a. Enum a => a -> a
succ a
lb) (t -> t
forall a. Enum a => a -> a
pred t
n)]
boundedEnumD :: (Unfolder f, Bounded a, Enum a) => f a
boundedEnumD :: f a
boundedEnumD = a -> a -> f a
forall (f :: * -> *) a. (Unfolder f, Enum a) => a -> a -> f a
betweenD a
forall a. Bounded a => a
minBound a
forall a. Bounded a => a
maxBound
instance MonadPlus m => Unfolder (WrappedMonad m)
instance (ArrowZero a, ArrowPlus a) => Unfolder (WrappedArrow a b)
instance Unfolder [] where
choose :: [[a]] -> [a]
choose = [[a]] -> [a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
chooseMap :: (a -> [b]) -> [a] -> [b]
chooseMap = (a -> [b]) -> [a] -> [b]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap
chooseInt :: Int -> [Int]
chooseInt Int
n = [Int
0 .. Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
instance Unfolder Maybe where
choose :: [Maybe a] -> Maybe a
choose = (Maybe a -> Maybe a -> Maybe a) -> Maybe a -> [Maybe a] -> Maybe a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Maybe a -> Maybe a -> Maybe a
forall a b. a -> b -> a
const Maybe a
forall a. Maybe a
Nothing
chooseMap :: (a -> Maybe b) -> [a] -> Maybe b
chooseMap a -> Maybe b
f = (a -> Maybe b -> Maybe b) -> Maybe b -> [a] -> Maybe b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Maybe b -> Maybe b -> Maybe b
forall a b. a -> b -> a
const (Maybe b -> Maybe b -> Maybe b)
-> (a -> Maybe b) -> a -> Maybe b -> Maybe b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe b
f) Maybe b
forall a. Maybe a
Nothing
chooseInt :: Int -> Maybe Int
chooseInt Int
0 = Maybe Int
forall a. Maybe a
Nothing
chooseInt Int
_ = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
0
instance (Unfolder p, Unfolder q) => Unfolder (Product p q) where
chooseMap :: (a -> Product p q b) -> [a] -> Product p q b
chooseMap a -> Product p q b
f [a]
as = p b -> q b -> Product p q b
forall k (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
Pair ((a -> p b) -> [a] -> p b
forall (f :: * -> *) a b. Unfolder f => (a -> f b) -> [a] -> f b
chooseMap (Product p q b -> p b
forall (f :: * -> *) (g :: * -> *) a. Product f g a -> f a
fstP (Product p q b -> p b) -> (a -> Product p q b) -> a -> p b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Product p q b
f) [a]
as) ((a -> q b) -> [a] -> q b
forall (f :: * -> *) a b. Unfolder f => (a -> f b) -> [a] -> f b
chooseMap (Product p q b -> q b
forall (f :: * -> *) (g :: * -> *) a. Product f g a -> g a
sndP (Product p q b -> q b) -> (a -> Product p q b) -> a -> q b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Product p q b
f) [a]
as)
where
fstP :: Product f g a -> f a
fstP (Pair f a
p g a
_) = f a
p
sndP :: Product f g a -> g a
sndP (Pair f a
_ g a
q) = g a
q
chooseInt :: Int -> Product p q Int
chooseInt Int
n = p Int -> q Int -> Product p q Int
forall k (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
Pair (Int -> p Int
forall (f :: * -> *). Unfolder f => Int -> f Int
chooseInt Int
n) (Int -> q Int
forall (f :: * -> *). Unfolder f => Int -> f Int
chooseInt Int
n)
instance (Unfolder p, Applicative q) => Unfolder (Compose p q) where
chooseMap :: (a -> Compose p q b) -> [a] -> Compose p q b
chooseMap a -> Compose p q b
f = p (q b) -> Compose p q b
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (p (q b) -> Compose p q b)
-> ([a] -> p (q b)) -> [a] -> Compose p q b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> p (q b)) -> [a] -> p (q b)
forall (f :: * -> *) a b. Unfolder f => (a -> f b) -> [a] -> f b
chooseMap (Compose p q b -> p (q b)
forall k1 (f :: k1 -> *) k2 (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose (Compose p q b -> p (q b)) -> (a -> Compose p q b) -> a -> p (q b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Compose p q b
f)
chooseInt :: Int -> Compose p q Int
chooseInt Int
n = p (q Int) -> Compose p q Int
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (p (q Int) -> Compose p q Int) -> p (q Int) -> Compose p q Int
forall a b. (a -> b) -> a -> b
$ Int -> q Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> q Int) -> p Int -> p (q Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> p Int
forall (f :: * -> *). Unfolder f => Int -> f Int
chooseInt Int
n
instance Unfolder f => Unfolder (Reverse f) where
chooseMap :: (a -> Reverse f b) -> [a] -> Reverse f b
chooseMap a -> Reverse f b
f = f b -> Reverse f b
forall k (f :: k -> *) (a :: k). f a -> Reverse f a
Reverse (f b -> Reverse f b) -> ([a] -> f b) -> [a] -> Reverse f b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> f b) -> [a] -> f b
forall (f :: * -> *) a b. Unfolder f => (a -> f b) -> [a] -> f b
chooseMap (Reverse f b -> f b
forall k (f :: k -> *) (a :: k). Reverse f a -> f a
getReverse (Reverse f b -> f b) -> (a -> Reverse f b) -> a -> f b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Reverse f b
f)
chooseInt :: Int -> Reverse f Int
chooseInt Int
n = f Int -> Reverse f Int
forall k (f :: k -> *) (a :: k). f a -> Reverse f a
Reverse (f Int -> Reverse f Int) -> f Int -> Reverse f Int
forall a b. (a -> b) -> a -> b
$ Int -> f Int
forall (f :: * -> *). Unfolder f => Int -> f Int
chooseInt Int
n
instance Unfolder f => Unfolder (Backwards f) where
chooseMap :: (a -> Backwards f b) -> [a] -> Backwards f b
chooseMap a -> Backwards f b
f = f b -> Backwards f b
forall k (f :: k -> *) (a :: k). f a -> Backwards f a
Backwards (f b -> Backwards f b) -> ([a] -> f b) -> [a] -> Backwards f b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> f b) -> [a] -> f b
forall (f :: * -> *) a b. Unfolder f => (a -> f b) -> [a] -> f b
chooseMap (Backwards f b -> f b
forall k (f :: k -> *) (a :: k). Backwards f a -> f a
forwards (Backwards f b -> f b) -> (a -> Backwards f b) -> a -> f b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Backwards f b
f)
chooseInt :: Int -> Backwards f Int
chooseInt Int
n = f Int -> Backwards f Int
forall k (f :: k -> *) (a :: k). f a -> Backwards f a
Backwards (f Int -> Backwards f Int) -> f Int -> Backwards f Int
forall a b. (a -> b) -> a -> b
$ Int -> f Int
forall (f :: * -> *). Unfolder f => Int -> f Int
chooseInt Int
n
instance Unfolder f => Unfolder (Lift f)
instance (Functor m, Monad m, Monoid e) => Unfolder (ExceptT e m)
instance Applicative f => Unfolder (ListT f) where
{-# INLINABLE chooseMap #-}
chooseMap :: (a -> ListT f b) -> [a] -> ListT f b
chooseMap a -> ListT f b
f = f [b] -> ListT f b
forall (m :: * -> *) a. m [a] -> ListT m a
ListT (f [b] -> ListT f b) -> ([a] -> f [b]) -> [a] -> ListT f b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> f [b] -> f [b]) -> f [b] -> [a] -> f [b]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> f [b] -> f [b]
appRun ([b] -> f [b]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [])
where
appRun :: a -> f [b] -> f [b]
appRun a
x f [b]
ys = [b] -> [b] -> [b]
forall a. [a] -> [a] -> [a]
(++) ([b] -> [b] -> [b]) -> f [b] -> f ([b] -> [b])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ListT f b -> f [b]
forall (m :: * -> *) a. ListT m a -> m [a]
runListT (a -> ListT f b
f a
x) f ([b] -> [b]) -> f [b] -> f [b]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f [b]
ys
chooseInt :: Int -> ListT f Int
chooseInt Int
n = f [Int] -> ListT f Int
forall (m :: * -> *) a. m [a] -> ListT m a
ListT (f [Int] -> ListT f Int) -> f [Int] -> ListT f Int
forall a b. (a -> b) -> a -> b
$ [Int] -> f [Int]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Int
0 .. Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
instance (Functor m, Monad m) => Unfolder (MaybeT m) where
chooseMap :: (a -> MaybeT m b) -> [a] -> MaybeT m b
chooseMap a -> MaybeT m b
_ [] = m (Maybe b) -> MaybeT m b
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (Maybe b -> m (Maybe b)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe b
forall a. Maybe a
Nothing)
chooseMap a -> MaybeT m b
f (a
a : [a]
as) = m (Maybe b) -> MaybeT m b
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (m (Maybe b) -> MaybeT m b) -> m (Maybe b) -> MaybeT m b
forall a b. (a -> b) -> a -> b
$ do
Maybe b
res <- MaybeT m b -> m (Maybe b)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (a -> MaybeT m b
f a
a)
case Maybe b
res of
Maybe b
Nothing -> MaybeT m b -> m (Maybe b)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT m b -> m (Maybe b)) -> MaybeT m b -> m (Maybe b)
forall a b. (a -> b) -> a -> b
$ (a -> MaybeT m b) -> [a] -> MaybeT m b
forall (f :: * -> *) a b. Unfolder f => (a -> f b) -> [a] -> f b
chooseMap a -> MaybeT m b
f [a]
as
Just b
_ -> Maybe b -> m (Maybe b)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe b
res
chooseInt :: Int -> MaybeT m Int
chooseInt Int
0 = m (Maybe Int) -> MaybeT m Int
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (m (Maybe Int) -> MaybeT m Int) -> m (Maybe Int) -> MaybeT m Int
forall a b. (a -> b) -> a -> b
$ Maybe Int -> m (Maybe Int)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Int
forall a. Maybe a
Nothing
chooseInt Int
_ = m (Maybe Int) -> MaybeT m Int
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (m (Maybe Int) -> MaybeT m Int) -> m (Maybe Int) -> MaybeT m Int
forall a b. (a -> b) -> a -> b
$ Maybe Int -> m (Maybe Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
0)
instance (Monoid w, MonadPlus m, Unfolder m) => Unfolder (RWST r w s m) where
chooseMap :: (a -> RWST r w s m b) -> [a] -> RWST r w s m b
chooseMap a -> RWST r w s m b
f [a]
as = (r -> s -> m (b, s, w)) -> RWST r w s m b
forall r w s (m :: * -> *) a.
(r -> s -> m (a, s, w)) -> RWST r w s m a
RWST ((r -> s -> m (b, s, w)) -> RWST r w s m b)
-> (r -> s -> m (b, s, w)) -> RWST r w s m b
forall a b. (a -> b) -> a -> b
$ \r
r s
s -> (a -> m (b, s, w)) -> [a] -> m (b, s, w)
forall (f :: * -> *) a b. Unfolder f => (a -> f b) -> [a] -> f b
chooseMap (\a
a -> RWST r w s m b -> r -> s -> m (b, s, w)
forall r w s (m :: * -> *) a.
RWST r w s m a -> r -> s -> m (a, s, w)
runRWST (a -> RWST r w s m b
f a
a) r
r s
s) [a]
as
instance (MonadPlus m, Unfolder m) => Unfolder (StateT s m) where
chooseMap :: (a -> StateT s m b) -> [a] -> StateT s m b
chooseMap a -> StateT s m b
f [a]
as = (s -> m (b, s)) -> StateT s m b
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT ((s -> m (b, s)) -> StateT s m b)
-> (s -> m (b, s)) -> StateT s m b
forall a b. (a -> b) -> a -> b
$ \s
s -> (a -> m (b, s)) -> [a] -> m (b, s)
forall (f :: * -> *) a b. Unfolder f => (a -> f b) -> [a] -> f b
chooseMap (\a
a -> a -> StateT s m b
f a
a StateT s m b -> s -> m (b, s)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
`runStateT` s
s) [a]
as
instance Unfolder m => Unfolder (ReaderT r m) where
chooseMap :: (a -> ReaderT r m b) -> [a] -> ReaderT r m b
chooseMap a -> ReaderT r m b
f [a]
as = (r -> m b) -> ReaderT r m b
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((r -> m b) -> ReaderT r m b) -> (r -> m b) -> ReaderT r m b
forall a b. (a -> b) -> a -> b
$ \r
r -> (a -> m b) -> [a] -> m b
forall (f :: * -> *) a b. Unfolder f => (a -> f b) -> [a] -> f b
chooseMap (\a
a -> a -> ReaderT r m b
f a
a ReaderT r m b -> r -> m b
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
`runReaderT` r
r) [a]
as
instance (Monoid w, Unfolder m) => Unfolder (WriterT w m) where
chooseMap :: (a -> WriterT w m b) -> [a] -> WriterT w m b
chooseMap a -> WriterT w m b
f = m (b, w) -> WriterT w m b
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
WriterT (m (b, w) -> WriterT w m b)
-> ([a] -> m (b, w)) -> [a] -> WriterT w m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> m (b, w)) -> [a] -> m (b, w)
forall (f :: * -> *) a b. Unfolder f => (a -> f b) -> [a] -> f b
chooseMap (WriterT w m b -> m (b, w)
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT (WriterT w m b -> m (b, w))
-> (a -> WriterT w m b) -> a -> m (b, w)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> WriterT w m b
f)
instance Unfolder S.Seq where
#if MIN_VERSION_containers(0,5,6)
chooseInt :: Int -> Seq Int
chooseInt Int
n = Int -> (Int -> Int) -> Seq Int
forall a. Int -> (Int -> a) -> Seq a
S.fromFunction Int
n Int -> Int
forall a. a -> a
id
#endif
newtype Random g m a = Random { Random g m a -> StateT g m a
getRandom :: StateT g m a }
deriving (a -> Random g m b -> Random g m a
(a -> b) -> Random g m a -> Random g m b
(forall a b. (a -> b) -> Random g m a -> Random g m b)
-> (forall a b. a -> Random g m b -> Random g m a)
-> Functor (Random g m)
forall a b. a -> Random g m b -> Random g m a
forall a b. (a -> b) -> Random g m a -> Random g m b
forall g (m :: * -> *) a b.
Functor m =>
a -> Random g m b -> Random g m a
forall g (m :: * -> *) a b.
Functor m =>
(a -> b) -> Random g m a -> Random g m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Random g m b -> Random g m a
$c<$ :: forall g (m :: * -> *) a b.
Functor m =>
a -> Random g m b -> Random g m a
fmap :: (a -> b) -> Random g m a -> Random g m b
$cfmap :: forall g (m :: * -> *) a b.
Functor m =>
(a -> b) -> Random g m a -> Random g m b
Functor, Functor (Random g m)
a -> Random g m a
Functor (Random g m)
-> (forall a. a -> Random g m a)
-> (forall a b.
Random g m (a -> b) -> Random g m a -> Random g m b)
-> (forall a b c.
(a -> b -> c) -> Random g m a -> Random g m b -> Random g m c)
-> (forall a b. Random g m a -> Random g m b -> Random g m b)
-> (forall a b. Random g m a -> Random g m b -> Random g m a)
-> Applicative (Random g m)
Random g m a -> Random g m b -> Random g m b
Random g m a -> Random g m b -> Random g m a
Random g m (a -> b) -> Random g m a -> Random g m b
(a -> b -> c) -> Random g m a -> Random g m b -> Random g m c
forall a. a -> Random g m a
forall a b. Random g m a -> Random g m b -> Random g m a
forall a b. Random g m a -> Random g m b -> Random g m b
forall a b. Random g m (a -> b) -> Random g m a -> Random g m b
forall a b c.
(a -> b -> c) -> Random g m a -> Random g m b -> Random g m c
forall g (m :: * -> *). Monad m => Functor (Random g m)
forall g (m :: * -> *) a. Monad m => a -> Random g m a
forall g (m :: * -> *) a b.
Monad m =>
Random g m a -> Random g m b -> Random g m a
forall g (m :: * -> *) a b.
Monad m =>
Random g m a -> Random g m b -> Random g m b
forall g (m :: * -> *) a b.
Monad m =>
Random g m (a -> b) -> Random g m a -> Random g m b
forall g (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> Random g m a -> Random g m b -> Random g m c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: Random g m a -> Random g m b -> Random g m a
$c<* :: forall g (m :: * -> *) a b.
Monad m =>
Random g m a -> Random g m b -> Random g m a
*> :: Random g m a -> Random g m b -> Random g m b
$c*> :: forall g (m :: * -> *) a b.
Monad m =>
Random g m a -> Random g m b -> Random g m b
liftA2 :: (a -> b -> c) -> Random g m a -> Random g m b -> Random g m c
$cliftA2 :: forall g (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> Random g m a -> Random g m b -> Random g m c
<*> :: Random g m (a -> b) -> Random g m a -> Random g m b
$c<*> :: forall g (m :: * -> *) a b.
Monad m =>
Random g m (a -> b) -> Random g m a -> Random g m b
pure :: a -> Random g m a
$cpure :: forall g (m :: * -> *) a. Monad m => a -> Random g m a
$cp1Applicative :: forall g (m :: * -> *). Monad m => Functor (Random g m)
Applicative, Applicative (Random g m)
a -> Random g m a
Applicative (Random g m)
-> (forall a b.
Random g m a -> (a -> Random g m b) -> Random g m b)
-> (forall a b. Random g m a -> Random g m b -> Random g m b)
-> (forall a. a -> Random g m a)
-> Monad (Random g m)
Random g m a -> (a -> Random g m b) -> Random g m b
Random g m a -> Random g m b -> Random g m b
forall a. a -> Random g m a
forall a b. Random g m a -> Random g m b -> Random g m b
forall a b. Random g m a -> (a -> Random g m b) -> Random g m b
forall g (m :: * -> *). Monad m => Applicative (Random g m)
forall g (m :: * -> *) a. Monad m => a -> Random g m a
forall g (m :: * -> *) a b.
Monad m =>
Random g m a -> Random g m b -> Random g m b
forall g (m :: * -> *) a b.
Monad m =>
Random g m a -> (a -> Random g m b) -> Random g m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> Random g m a
$creturn :: forall g (m :: * -> *) a. Monad m => a -> Random g m a
>> :: Random g m a -> Random g m b -> Random g m b
$c>> :: forall g (m :: * -> *) a b.
Monad m =>
Random g m a -> Random g m b -> Random g m b
>>= :: Random g m a -> (a -> Random g m b) -> Random g m b
$c>>= :: forall g (m :: * -> *) a b.
Monad m =>
Random g m a -> (a -> Random g m b) -> Random g m b
$cp1Monad :: forall g (m :: * -> *). Monad m => Applicative (Random g m)
Monad)
instance (Functor m, Monad m, R.RandomGen g) => Alternative (Random g m) where
empty :: Random g m a
empty = [Random g m a] -> Random g m a
forall (f :: * -> *) a. Unfolder f => [f a] -> f a
choose []
Random g m a
a <|> :: Random g m a -> Random g m a -> Random g m a
<|> Random g m a
b = [Random g m a] -> Random g m a
forall (f :: * -> *) a. Unfolder f => [f a] -> f a
choose [Random g m a
a, Random g m a
b]
instance (Functor m, Monad m, R.RandomGen g) => MonadPlus (Random g m) where
mzero :: Random g m a
mzero = [Random g m a] -> Random g m a
forall (f :: * -> *) a. Unfolder f => [f a] -> f a
choose []
mplus :: Random g m a -> Random g m a -> Random g m a
mplus Random g m a
a Random g m a
b = [Random g m a] -> Random g m a
forall (f :: * -> *) a. Unfolder f => [f a] -> f a
choose [Random g m a
a, Random g m a
b]
instance (Functor m, Monad m, R.RandomGen g) => Unfolder (Random g m) where
choose :: [Random g m a] -> Random g m a
choose = [Random g m a] -> Random g m a
forall (m :: * -> *) a. (Monad m, Unfolder m) => [m a] -> m a
chooseMonadDefault
chooseMap :: (a -> Random g m b) -> [a] -> Random g m b
chooseMap = (a -> Random g m b) -> [a] -> Random g m b
forall (m :: * -> *) a b.
(Monad m, Unfolder m) =>
(a -> m b) -> [a] -> m b
chooseMapMonadDefault
chooseInt :: Int -> Random g m Int
chooseInt Int
n = StateT g m Int -> Random g m Int
forall g (m :: * -> *) a. StateT g m a -> Random g m a
Random (StateT g m Int -> Random g m Int)
-> ((g -> m (Int, g)) -> StateT g m Int)
-> (g -> m (Int, g))
-> Random g m Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (g -> m (Int, g)) -> StateT g m Int
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT ((g -> m (Int, g)) -> Random g m Int)
-> (g -> m (Int, g)) -> Random g m Int
forall a b. (a -> b) -> a -> b
$ (Int, g) -> m (Int, g)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Int, g) -> m (Int, g)) -> (g -> (Int, g)) -> g -> m (Int, g)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Int) -> g -> (Int, g)
forall a g. (Random a, RandomGen g) => (a, a) -> g -> (a, g)
R.randomR (Int
0, Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
data Arb a = Arb Int Int (Gen (Maybe a))
instance Functor Arb where
fmap :: (a -> b) -> Arb a -> Arb b
fmap a -> b
f (Arb Int
r Int
p Gen (Maybe a)
g) = Int -> Int -> Gen (Maybe b) -> Arb b
forall a. Int -> Int -> Gen (Maybe a) -> Arb a
Arb Int
r Int
p (Gen (Maybe b) -> Arb b) -> Gen (Maybe b) -> Arb b
forall a b. (a -> b) -> a -> b
$ (Maybe a -> Maybe b) -> Gen (Maybe a) -> Gen (Maybe b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) Gen (Maybe a)
g
instance Applicative Arb where
pure :: a -> Arb a
pure = Int -> Int -> Gen (Maybe a) -> Arb a
forall a. Int -> Int -> Gen (Maybe a) -> Arb a
Arb Int
0 Int
0 (Gen (Maybe a) -> Arb a) -> (a -> Gen (Maybe a)) -> a -> Arb a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe a -> Gen (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe a -> Gen (Maybe a)) -> (a -> Maybe a) -> a -> Gen (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
Arb Int
r1 Int
p1 Gen (Maybe (a -> b))
ff <*> :: Arb (a -> b) -> Arb a -> Arb b
<*> Arb Int
r2 Int
p2 Gen (Maybe a)
fx = Int -> Int -> Gen (Maybe b) -> Arb b
forall a. Int -> Int -> Gen (Maybe a) -> Arb a
Arb (Int
r1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
r2) (Int
p1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
p2) (Gen (Maybe b) -> Arb b) -> Gen (Maybe b) -> Arb b
forall a b. (a -> b) -> a -> b
$ (Maybe (a -> b) -> Maybe a -> Maybe b)
-> Gen (Maybe (a -> b)) -> Gen (Maybe a) -> Gen (Maybe b)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>) Gen (Maybe (a -> b))
ff Gen (Maybe a)
fx
instance Alternative Arb where
empty :: Arb a
empty = Int -> Int -> Gen (Maybe a) -> Arb a
forall a. Int -> Int -> Gen (Maybe a) -> Arb a
Arb Int
0 Int
0 (Maybe a -> Gen (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing)
Arb Int
r1 Int
p1 Gen (Maybe a)
g1 <|> :: Arb a -> Arb a -> Arb a
<|> Arb Int
r2 Int
p2 Gen (Maybe a)
g2 = Int -> Int -> Gen (Maybe a) -> Arb a
forall a. Int -> Int -> Gen (Maybe a) -> Arb a
Arb (Int
r1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
r2) (Int
p1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
p2) (Gen (Maybe a) -> Arb a) -> Gen (Maybe a) -> Arb a
forall a b. (a -> b) -> a -> b
$ Gen (Maybe a)
g1 Gen (Maybe a) -> (Maybe a -> Gen (Maybe a)) -> Gen (Maybe a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Maybe a
a -> Gen (Maybe a)
g2 Gen (Maybe a) -> (Maybe a -> Gen (Maybe a)) -> Gen (Maybe a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Maybe a
b -> a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> Gen a -> Gen (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a] -> Gen a
forall a. [a] -> Gen a
elements ([Maybe a] -> [a]
forall a. [Maybe a] -> [a]
catMaybes [Maybe a
a, Maybe a
b])
instance Unfolder Arb where
choose :: [Arb a] -> Arb a
choose [Arb a]
as = Int -> Int -> Gen (Maybe a) -> Arb a
forall a. Int -> Int -> Gen (Maybe a) -> Arb a
Arb Int
1 Int
0 (Gen (Maybe a) -> Arb a) -> Gen (Maybe a) -> Arb a
forall a b. (a -> b) -> a -> b
$ (Int -> Gen (Maybe a)) -> Gen (Maybe a)
forall a. (Int -> Gen a) -> Gen a
sized Int -> Gen (Maybe a)
g
where
g :: Int -> Gen (Maybe a)
g Int
n = [(Int, Gen (Maybe a))] -> Gen (Maybe a)
forall a. [(Int, Gen (Maybe a))] -> Gen (Maybe a)
freq ([(Int, Gen (Maybe a))] -> Gen (Maybe a))
-> [(Int, Gen (Maybe a))] -> Gen (Maybe a)
forall a b. (a -> b) -> a -> b
$ (Arb a -> [(Int, Gen (Maybe a))])
-> [Arb a] -> [(Int, Gen (Maybe a))]
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Arb a -> [(Int, Gen (Maybe a))]
forall a. Arb a -> [(Int, Gen (Maybe a))]
f [Arb a]
as
where
(Int
recPosCount, Int
parPosCount) = (Arb a -> (Int, Int) -> (Int, Int))
-> (Int, Int) -> [Arb a] -> (Int, Int)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(Arb Int
r Int
p Gen (Maybe a)
_) (Int
rc, Int
pc) -> (Int
r Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
rc, Int
p Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
pc)) (Int
0, Int
0) [Arb a]
as
recSize :: Int
recSize = (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
parPosCount) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 Int
recPosCount
f :: Arb a -> [(Int, Gen (Maybe a))]
f (Arb Int
r Int
p Gen (Maybe a)
gen) = if (Int
r Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& Int
recSize Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0) Bool -> Bool -> Bool
|| (Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
&& Int
r Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) then [] else [(Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
r Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
recSize, Int -> Gen (Maybe a) -> Gen (Maybe a)
forall a. Int -> Gen a -> Gen a
resize (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 Int
recSize) Gen (Maybe a)
gen)]
freq :: [(Int, Gen (Maybe a))] -> Gen (Maybe a)
freq [] = Maybe a -> Gen (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
freq [(Int, Gen (Maybe a))]
as = [(Int, Gen (Maybe a))] -> Gen (Maybe a)
forall a. [(Int, Gen a)] -> Gen a
frequency [(Int, Gen (Maybe a))]
as
arbUnit :: Arbitrary a => Arb a
arbUnit :: Arb a
arbUnit = Int -> Int -> Gen (Maybe a) -> Arb a
forall a. Int -> Int -> Gen (Maybe a) -> Arb a
Arb Int
0 Int
1 (a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> Gen a -> Gen (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen a
forall a. Arbitrary a => Gen a
arbitrary)
newtype NumConst a x = NumConst { NumConst a x -> a
getNumConst :: a } deriving (NumConst a x -> NumConst a x -> Bool
(NumConst a x -> NumConst a x -> Bool)
-> (NumConst a x -> NumConst a x -> Bool) -> Eq (NumConst a x)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a x. Eq a => NumConst a x -> NumConst a x -> Bool
/= :: NumConst a x -> NumConst a x -> Bool
$c/= :: forall a x. Eq a => NumConst a x -> NumConst a x -> Bool
== :: NumConst a x -> NumConst a x -> Bool
$c== :: forall a x. Eq a => NumConst a x -> NumConst a x -> Bool
Eq, Int -> NumConst a x -> ShowS
[NumConst a x] -> ShowS
NumConst a x -> String
(Int -> NumConst a x -> ShowS)
-> (NumConst a x -> String)
-> ([NumConst a x] -> ShowS)
-> Show (NumConst a x)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall a x. Show a => Int -> NumConst a x -> ShowS
forall a x. Show a => [NumConst a x] -> ShowS
forall a x. Show a => NumConst a x -> String
showList :: [NumConst a x] -> ShowS
$cshowList :: forall a x. Show a => [NumConst a x] -> ShowS
show :: NumConst a x -> String
$cshow :: forall a x. Show a => NumConst a x -> String
showsPrec :: Int -> NumConst a x -> ShowS
$cshowsPrec :: forall a x. Show a => Int -> NumConst a x -> ShowS
Show)
instance Functor (NumConst a) where
fmap :: (a -> b) -> NumConst a a -> NumConst a b
fmap a -> b
_ (NumConst a
a) = a -> NumConst a b
forall a x. a -> NumConst a x
NumConst a
a
instance Num a => Applicative (NumConst a) where
pure :: a -> NumConst a a
pure a
_ = a -> NumConst a a
forall a x. a -> NumConst a x
NumConst a
1
NumConst a
a <*> :: NumConst a (a -> b) -> NumConst a a -> NumConst a b
<*> NumConst a
b = a -> NumConst a b
forall a x. a -> NumConst a x
NumConst (a -> NumConst a b) -> a -> NumConst a b
forall a b. (a -> b) -> a -> b
$ a
a a -> a -> a
forall a. Num a => a -> a -> a
* a
b
instance Num a => Alternative (NumConst a) where
empty :: NumConst a a
empty = a -> NumConst a a
forall a x. a -> NumConst a x
NumConst a
0
NumConst a
a <|> :: NumConst a a -> NumConst a a -> NumConst a a
<|> NumConst a
b = a -> NumConst a a
forall a x. a -> NumConst a x
NumConst (a -> NumConst a a) -> a -> NumConst a a
forall a b. (a -> b) -> a -> b
$ a
a a -> a -> a
forall a. Num a => a -> a -> a
+ a
b
instance Num a => Unfolder (NumConst a)
data Nth a = Nth
{ Nth a -> Integer
size :: Integer
, Nth a -> Integer -> a
getNth :: Integer -> a
}
instance Functor Nth where
fmap :: (a -> b) -> Nth a -> Nth b
fmap a -> b
f (Nth Integer
sizeA Integer -> a
as) = Integer -> (Integer -> b) -> Nth b
forall a. Integer -> (Integer -> a) -> Nth a
Nth Integer
sizeA (a -> b
f (a -> b) -> (Integer -> a) -> Integer -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> a
as)
instance Applicative Nth where
pure :: a -> Nth a
pure a
a = Integer -> (Integer -> a) -> Nth a
forall a. Integer -> (Integer -> a) -> Nth a
Nth Integer
1 (a -> Integer -> a
forall a b. a -> b -> a
const a
a)
Nth Integer
sizeF Integer -> a -> b
fs <*> :: Nth (a -> b) -> Nth a -> Nth b
<*> Nth Integer
sizeA Integer -> a
as = Integer -> (Integer -> b) -> Nth b
forall a. Integer -> (Integer -> a) -> Nth a
Nth (Integer
sizeF Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
sizeA) ((Integer -> b) -> Nth b) -> (Integer -> b) -> Nth b
forall a b. (a -> b) -> a -> b
$ \Integer
n ->
let (Integer
l, Integer
r) = Integer
n Integer -> Integer -> (Integer, Integer)
forall a. Integral a => a -> a -> (a, a)
`divMod` Integer
sizeA in Integer -> a -> b
fs Integer
l (Integer -> a
as Integer
r)
instance Alternative Nth where
empty :: Nth a
empty = Integer -> (Integer -> a) -> Nth a
forall a. Integer -> (Integer -> a) -> Nth a
Nth Integer
0 (a -> Integer -> a
forall a b. a -> b -> a
const a
forall a. HasCallStack => a
undefined)
Nth Integer
sizeA Integer -> a
as <|> :: Nth a -> Nth a -> Nth a
<|> Nth Integer
sizeB Integer -> a
bs = Integer -> (Integer -> a) -> Nth a
forall a. Integer -> (Integer -> a) -> Nth a
Nth (Integer
sizeA Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
sizeB) ((Integer -> a) -> Nth a) -> (Integer -> a) -> Nth a
forall a b. (a -> b) -> a -> b
$ \Integer
n ->
if Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
sizeA then Integer -> a
as Integer
n else Integer -> a
bs (Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
sizeA)
instance Unfolder Nth where
chooseInt :: Int -> Nth Int
chooseInt Int
n = Integer -> (Integer -> Int) -> Nth Int
forall a. Integer -> (Integer -> a) -> Nth a
Nth (Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
n) Integer -> Int
forall a. Num a => Integer -> a
fromInteger
class UnfolderTransformer t where
lift :: Unfolder f => f a -> t f a
ala :: (UnfolderTransformer t, Unfolder f) => (t f b -> f b) -> (t f a -> t f b) -> f a -> f b
ala :: (t f b -> f b) -> (t f a -> t f b) -> f a -> f b
ala t f b -> f b
lower t f a -> t f b
f = t f b -> f b
lower (t f b -> f b) -> (f a -> t f b) -> f a -> f b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t f a -> t f b
f (t f a -> t f b) -> (f a -> t f a) -> f a -> t f b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f a -> t f a
forall (t :: (* -> *) -> * -> *) (f :: * -> *) a.
(UnfolderTransformer t, Unfolder f) =>
f a -> t f a
lift
ala2 :: (UnfolderTransformer t, Unfolder f) => (t f c -> f c) -> (t f a -> t f b -> t f c) -> f a -> f b -> f c
ala2 :: (t f c -> f c) -> (t f a -> t f b -> t f c) -> f a -> f b -> f c
ala2 t f c -> f c
lower t f a -> t f b -> t f c
f = (t f c -> f c) -> (t f b -> t f c) -> f b -> f c
forall (t :: (* -> *) -> * -> *) (f :: * -> *) b a.
(UnfolderTransformer t, Unfolder f) =>
(t f b -> f b) -> (t f a -> t f b) -> f a -> f b
ala t f c -> f c
lower ((t f b -> t f c) -> f b -> f c)
-> (f a -> t f b -> t f c) -> f a -> f b -> f c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t f a -> t f b -> t f c
f (t f a -> t f b -> t f c)
-> (f a -> t f a) -> f a -> t f b -> t f c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f a -> t f a
forall (t :: (* -> *) -> * -> *) (f :: * -> *) a.
(UnfolderTransformer t, Unfolder f) =>
f a -> t f a
lift
ala3 :: (UnfolderTransformer t, Unfolder f) => (t f d -> f d) -> (t f a -> t f b -> t f c -> t f d) -> f a -> f b -> f c -> f d
ala3 :: (t f d -> f d)
-> (t f a -> t f b -> t f c -> t f d) -> f a -> f b -> f c -> f d
ala3 t f d -> f d
lower t f a -> t f b -> t f c -> t f d
f = (t f d -> f d) -> (t f b -> t f c -> t f d) -> f b -> f c -> f d
forall (t :: (* -> *) -> * -> *) (f :: * -> *) c a b.
(UnfolderTransformer t, Unfolder f) =>
(t f c -> f c) -> (t f a -> t f b -> t f c) -> f a -> f b -> f c
ala2 t f d -> f d
lower ((t f b -> t f c -> t f d) -> f b -> f c -> f d)
-> (f a -> t f b -> t f c -> t f d) -> f a -> f b -> f c -> f d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t f a -> t f b -> t f c -> t f d
f (t f a -> t f b -> t f c -> t f d)
-> (f a -> t f a) -> f a -> t f b -> t f c -> t f d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f a -> t f a
forall (t :: (* -> *) -> * -> *) (f :: * -> *) a.
(UnfolderTransformer t, Unfolder f) =>
f a -> t f a
lift
newtype DualA f a = DualA { DualA f a -> f a
getDualA :: f a }
deriving (DualA f a -> DualA f a -> Bool
(DualA f a -> DualA f a -> Bool)
-> (DualA f a -> DualA f a -> Bool) -> Eq (DualA f a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (f :: * -> *) a. Eq (f a) => DualA f a -> DualA f a -> Bool
/= :: DualA f a -> DualA f a -> Bool
$c/= :: forall (f :: * -> *) a. Eq (f a) => DualA f a -> DualA f a -> Bool
== :: DualA f a -> DualA f a -> Bool
$c== :: forall (f :: * -> *) a. Eq (f a) => DualA f a -> DualA f a -> Bool
Eq, Int -> DualA f a -> ShowS
[DualA f a] -> ShowS
DualA f a -> String
(Int -> DualA f a -> ShowS)
-> (DualA f a -> String)
-> ([DualA f a] -> ShowS)
-> Show (DualA f a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (f :: * -> *) a. Show (f a) => Int -> DualA f a -> ShowS
forall (f :: * -> *) a. Show (f a) => [DualA f a] -> ShowS
forall (f :: * -> *) a. Show (f a) => DualA f a -> String
showList :: [DualA f a] -> ShowS
$cshowList :: forall (f :: * -> *) a. Show (f a) => [DualA f a] -> ShowS
show :: DualA f a -> String
$cshow :: forall (f :: * -> *) a. Show (f a) => DualA f a -> String
showsPrec :: Int -> DualA f a -> ShowS
$cshowsPrec :: forall (f :: * -> *) a. Show (f a) => Int -> DualA f a -> ShowS
Show, a -> DualA f b -> DualA f a
(a -> b) -> DualA f a -> DualA f b
(forall a b. (a -> b) -> DualA f a -> DualA f b)
-> (forall a b. a -> DualA f b -> DualA f a) -> Functor (DualA f)
forall a b. a -> DualA f b -> DualA f a
forall a b. (a -> b) -> DualA f a -> DualA f b
forall (f :: * -> *) a b. Functor f => a -> DualA f b -> DualA f a
forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> DualA f a -> DualA f b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> DualA f b -> DualA f a
$c<$ :: forall (f :: * -> *) a b. Functor f => a -> DualA f b -> DualA f a
fmap :: (a -> b) -> DualA f a -> DualA f b
$cfmap :: forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> DualA f a -> DualA f b
Functor, Functor (DualA f)
a -> DualA f a
Functor (DualA f)
-> (forall a. a -> DualA f a)
-> (forall a b. DualA f (a -> b) -> DualA f a -> DualA f b)
-> (forall a b c.
(a -> b -> c) -> DualA f a -> DualA f b -> DualA f c)
-> (forall a b. DualA f a -> DualA f b -> DualA f b)
-> (forall a b. DualA f a -> DualA f b -> DualA f a)
-> Applicative (DualA f)
DualA f a -> DualA f b -> DualA f b
DualA f a -> DualA f b -> DualA f a
DualA f (a -> b) -> DualA f a -> DualA f b
(a -> b -> c) -> DualA f a -> DualA f b -> DualA f c
forall a. a -> DualA f a
forall a b. DualA f a -> DualA f b -> DualA f a
forall a b. DualA f a -> DualA f b -> DualA f b
forall a b. DualA f (a -> b) -> DualA f a -> DualA f b
forall a b c. (a -> b -> c) -> DualA f a -> DualA f b -> DualA f c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
forall (f :: * -> *). Applicative f => Functor (DualA f)
forall (f :: * -> *) a. Applicative f => a -> DualA f a
forall (f :: * -> *) a b.
Applicative f =>
DualA f a -> DualA f b -> DualA f a
forall (f :: * -> *) a b.
Applicative f =>
DualA f a -> DualA f b -> DualA f b
forall (f :: * -> *) a b.
Applicative f =>
DualA f (a -> b) -> DualA f a -> DualA f b
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> DualA f a -> DualA f b -> DualA f c
<* :: DualA f a -> DualA f b -> DualA f a
$c<* :: forall (f :: * -> *) a b.
Applicative f =>
DualA f a -> DualA f b -> DualA f a
*> :: DualA f a -> DualA f b -> DualA f b
$c*> :: forall (f :: * -> *) a b.
Applicative f =>
DualA f a -> DualA f b -> DualA f b
liftA2 :: (a -> b -> c) -> DualA f a -> DualA f b -> DualA f c
$cliftA2 :: forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> DualA f a -> DualA f b -> DualA f c
<*> :: DualA f (a -> b) -> DualA f a -> DualA f b
$c<*> :: forall (f :: * -> *) a b.
Applicative f =>
DualA f (a -> b) -> DualA f a -> DualA f b
pure :: a -> DualA f a
$cpure :: forall (f :: * -> *) a. Applicative f => a -> DualA f a
$cp1Applicative :: forall (f :: * -> *). Applicative f => Functor (DualA f)
Applicative)
instance Alternative f => Alternative (DualA f) where
empty :: DualA f a
empty = f a -> DualA f a
forall (f :: * -> *) a. f a -> DualA f a
DualA f a
forall (f :: * -> *) a. Alternative f => f a
empty
DualA f a
a <|> :: DualA f a -> DualA f a -> DualA f a
<|> DualA f a
b = f a -> DualA f a
forall (f :: * -> *) a. f a -> DualA f a
DualA (f a
b f a -> f a -> f a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> f a
a)
instance Unfolder f => Unfolder (DualA f) where
chooseMap :: (a -> DualA f b) -> [a] -> DualA f b
chooseMap a -> DualA f b
f = f b -> DualA f b
forall (f :: * -> *) a. f a -> DualA f a
DualA (f b -> DualA f b) -> ([a] -> f b) -> [a] -> DualA f b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> f b) -> [a] -> f b
forall (f :: * -> *) a b. Unfolder f => (a -> f b) -> [a] -> f b
chooseMap (DualA f b -> f b
forall (f :: * -> *) a. DualA f a -> f a
getDualA (DualA f b -> f b) -> (a -> DualA f b) -> a -> f b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> DualA f b
f) ([a] -> f b) -> ([a] -> [a]) -> [a] -> f b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [a]
forall a. [a] -> [a]
reverse
chooseInt :: Int -> DualA f Int
chooseInt Int
n = f Int -> DualA f Int
forall (f :: * -> *) a. f a -> DualA f a
DualA (f Int -> DualA f Int) -> f Int -> DualA f Int
forall a b. (a -> b) -> a -> b
$ (\Int
x -> Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
x) (Int -> Int) -> f Int -> f Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> f Int
forall (f :: * -> *). Unfolder f => Int -> f Int
chooseInt Int
n
instance UnfolderTransformer DualA where
lift :: f a -> DualA f a
lift = f a -> DualA f a
forall (f :: * -> *) a. f a -> DualA f a
DualA
data NT f g = NT { NT f g -> forall a. f a -> g a
getNT :: forall a. f a -> g a }
newtype WithRec f a = WithRec { WithRec f a -> ReaderT (Int -> NT f f) f a
getWithRec :: ReaderT (Int -> NT f f) f a }
deriving (a -> WithRec f b -> WithRec f a
(a -> b) -> WithRec f a -> WithRec f b
(forall a b. (a -> b) -> WithRec f a -> WithRec f b)
-> (forall a b. a -> WithRec f b -> WithRec f a)
-> Functor (WithRec f)
forall a b. a -> WithRec f b -> WithRec f a
forall a b. (a -> b) -> WithRec f a -> WithRec f b
forall (f :: * -> *) a b.
Functor f =>
a -> WithRec f b -> WithRec f a
forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> WithRec f a -> WithRec f b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> WithRec f b -> WithRec f a
$c<$ :: forall (f :: * -> *) a b.
Functor f =>
a -> WithRec f b -> WithRec f a
fmap :: (a -> b) -> WithRec f a -> WithRec f b
$cfmap :: forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> WithRec f a -> WithRec f b
Functor, Functor (WithRec f)
a -> WithRec f a
Functor (WithRec f)
-> (forall a. a -> WithRec f a)
-> (forall a b. WithRec f (a -> b) -> WithRec f a -> WithRec f b)
-> (forall a b c.
(a -> b -> c) -> WithRec f a -> WithRec f b -> WithRec f c)
-> (forall a b. WithRec f a -> WithRec f b -> WithRec f b)
-> (forall a b. WithRec f a -> WithRec f b -> WithRec f a)
-> Applicative (WithRec f)
WithRec f a -> WithRec f b -> WithRec f b
WithRec f a -> WithRec f b -> WithRec f a
WithRec f (a -> b) -> WithRec f a -> WithRec f b
(a -> b -> c) -> WithRec f a -> WithRec f b -> WithRec f c
forall a. a -> WithRec f a
forall a b. WithRec f a -> WithRec f b -> WithRec f a
forall a b. WithRec f a -> WithRec f b -> WithRec f b
forall a b. WithRec f (a -> b) -> WithRec f a -> WithRec f b
forall a b c.
(a -> b -> c) -> WithRec f a -> WithRec f b -> WithRec f c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
forall (f :: * -> *). Applicative f => Functor (WithRec f)
forall (f :: * -> *) a. Applicative f => a -> WithRec f a
forall (f :: * -> *) a b.
Applicative f =>
WithRec f a -> WithRec f b -> WithRec f a
forall (f :: * -> *) a b.
Applicative f =>
WithRec f a -> WithRec f b -> WithRec f b
forall (f :: * -> *) a b.
Applicative f =>
WithRec f (a -> b) -> WithRec f a -> WithRec f b
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> WithRec f a -> WithRec f b -> WithRec f c
<* :: WithRec f a -> WithRec f b -> WithRec f a
$c<* :: forall (f :: * -> *) a b.
Applicative f =>
WithRec f a -> WithRec f b -> WithRec f a
*> :: WithRec f a -> WithRec f b -> WithRec f b
$c*> :: forall (f :: * -> *) a b.
Applicative f =>
WithRec f a -> WithRec f b -> WithRec f b
liftA2 :: (a -> b -> c) -> WithRec f a -> WithRec f b -> WithRec f c
$cliftA2 :: forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> WithRec f a -> WithRec f b -> WithRec f c
<*> :: WithRec f (a -> b) -> WithRec f a -> WithRec f b
$c<*> :: forall (f :: * -> *) a b.
Applicative f =>
WithRec f (a -> b) -> WithRec f a -> WithRec f b
pure :: a -> WithRec f a
$cpure :: forall (f :: * -> *) a. Applicative f => a -> WithRec f a
$cp1Applicative :: forall (f :: * -> *). Applicative f => Functor (WithRec f)
Applicative, Applicative (WithRec f)
WithRec f a
Applicative (WithRec f)
-> (forall a. WithRec f a)
-> (forall a. WithRec f a -> WithRec f a -> WithRec f a)
-> (forall a. WithRec f a -> WithRec f [a])
-> (forall a. WithRec f a -> WithRec f [a])
-> Alternative (WithRec f)
WithRec f a -> WithRec f a -> WithRec f a
WithRec f a -> WithRec f [a]
WithRec f a -> WithRec f [a]
forall a. WithRec f a
forall a. WithRec f a -> WithRec f [a]
forall a. WithRec f a -> WithRec f a -> WithRec f a
forall (f :: * -> *).
Applicative f
-> (forall a. f a)
-> (forall a. f a -> f a -> f a)
-> (forall a. f a -> f [a])
-> (forall a. f a -> f [a])
-> Alternative f
forall (f :: * -> *). Alternative f => Applicative (WithRec f)
forall (f :: * -> *) a. Alternative f => WithRec f a
forall (f :: * -> *) a.
Alternative f =>
WithRec f a -> WithRec f [a]
forall (f :: * -> *) a.
Alternative f =>
WithRec f a -> WithRec f a -> WithRec f a
many :: WithRec f a -> WithRec f [a]
$cmany :: forall (f :: * -> *) a.
Alternative f =>
WithRec f a -> WithRec f [a]
some :: WithRec f a -> WithRec f [a]
$csome :: forall (f :: * -> *) a.
Alternative f =>
WithRec f a -> WithRec f [a]
<|> :: WithRec f a -> WithRec f a -> WithRec f a
$c<|> :: forall (f :: * -> *) a.
Alternative f =>
WithRec f a -> WithRec f a -> WithRec f a
empty :: WithRec f a
$cempty :: forall (f :: * -> *) a. Alternative f => WithRec f a
$cp1Alternative :: forall (f :: * -> *). Alternative f => Applicative (WithRec f)
Alternative)
instance Unfolder f => Unfolder (WithRec f) where
chooseMap :: (a -> WithRec f b) -> [a] -> WithRec f b
chooseMap a -> WithRec f b
h [a]
as = ReaderT (Int -> NT f f) f b -> WithRec f b
forall (f :: * -> *) a. ReaderT (Int -> NT f f) f a -> WithRec f a
WithRec (ReaderT (Int -> NT f f) f b -> WithRec f b)
-> (((Int -> NT f f) -> f b) -> ReaderT (Int -> NT f f) f b)
-> ((Int -> NT f f) -> f b)
-> WithRec f b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int -> NT f f) -> f b) -> ReaderT (Int -> NT f f) f b
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT (((Int -> NT f f) -> f b) -> WithRec f b)
-> ((Int -> NT f f) -> f b) -> WithRec f b
forall a b. (a -> b) -> a -> b
$ \Int -> NT f f
f ->
NT f f -> forall a. f a -> f a
forall (f :: * -> *) (g :: * -> *). NT f g -> forall a. f a -> g a
getNT (Int -> NT f f
f Int
0) (f b -> f b) -> f b -> f b
forall a b. (a -> b) -> a -> b
$ (a -> f b) -> [a] -> f b
forall (f :: * -> *) a b. Unfolder f => (a -> f b) -> [a] -> f b
chooseMap ((Int -> NT f f) -> WithRec f b -> f b
forall (f :: * -> *) a. (Int -> NT f f) -> WithRec f a -> f a
withRec (Int -> NT f f
f (Int -> NT f f) -> (Int -> Int) -> Int -> NT f f
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int
forall a. Enum a => a -> a
succ) (WithRec f b -> f b) -> (a -> WithRec f b) -> a -> f b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> WithRec f b
h) [a]
as
instance UnfolderTransformer WithRec where
lift :: f a -> WithRec f a
lift = ReaderT (Int -> NT f f) f a -> WithRec f a
forall (f :: * -> *) a. ReaderT (Int -> NT f f) f a -> WithRec f a
WithRec (ReaderT (Int -> NT f f) f a -> WithRec f a)
-> (f a -> ReaderT (Int -> NT f f) f a) -> f a -> WithRec f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int -> NT f f) -> f a) -> ReaderT (Int -> NT f f) f a
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT (((Int -> NT f f) -> f a) -> ReaderT (Int -> NT f f) f a)
-> (f a -> (Int -> NT f f) -> f a)
-> f a
-> ReaderT (Int -> NT f f) f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f a -> (Int -> NT f f) -> f a
forall a b. a -> b -> a
const
withRec :: (Int -> NT f f) -> WithRec f a -> f a
withRec :: (Int -> NT f f) -> WithRec f a -> f a
withRec Int -> NT f f
f = (ReaderT (Int -> NT f f) f a -> (Int -> NT f f) -> f a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
`runReaderT` Int -> NT f f
f) (ReaderT (Int -> NT f f) f a -> f a)
-> (WithRec f a -> ReaderT (Int -> NT f f) f a)
-> WithRec f a
-> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WithRec f a -> ReaderT (Int -> NT f f) f a
forall (f :: * -> *) a. WithRec f a -> ReaderT (Int -> NT f f) f a
getWithRec
limitDepth :: Unfolder f => Int -> WithRec f a -> f a
limitDepth :: Int -> WithRec f a -> f a
limitDepth Int
m = (Int -> NT f f) -> WithRec f a -> f a
forall (f :: * -> *) a. (Int -> NT f f) -> WithRec f a -> f a
withRec (\Int
d -> (forall a. f a -> f a) -> NT f f
forall (f :: * -> *) (g :: * -> *).
(forall a. f a -> g a) -> NT f g
NT ((forall a. f a -> f a) -> NT f f)
-> (forall a. f a -> f a) -> NT f f
forall a b. (a -> b) -> a -> b
$ if Int
d Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
m then f a -> f a -> f a
forall a b. a -> b -> a
const f a
forall (f :: * -> *) a. Alternative f => f a
empty else f a -> f a
forall a. a -> a
id)
newtype BFS f x = BFS { BFS f x -> (Int, Split) -> Maybe [f x]
getBFS :: (Int, Split) -> Maybe [f x] }
type Split = Int -> [(Int, Int)]
instance Functor f => Functor (BFS f) where
fmap :: (a -> b) -> BFS f a -> BFS f b
fmap a -> b
f = ((Int, Split) -> Maybe [f b]) -> BFS f b
forall (f :: * -> *) x. ((Int, Split) -> Maybe [f x]) -> BFS f x
BFS (((Int, Split) -> Maybe [f b]) -> BFS f b)
-> (BFS f a -> (Int, Split) -> Maybe [f b]) -> BFS f a -> BFS f b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([f a] -> [f b]) -> Maybe [f a] -> Maybe [f b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((f a -> f b) -> [f a] -> [f b]
forall a b. (a -> b) -> [a] -> [b]
map ((a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f)) (Maybe [f a] -> Maybe [f b])
-> ((Int, Split) -> Maybe [f a]) -> (Int, Split) -> Maybe [f b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) (((Int, Split) -> Maybe [f a]) -> (Int, Split) -> Maybe [f b])
-> (BFS f a -> (Int, Split) -> Maybe [f a])
-> BFS f a
-> (Int, Split)
-> Maybe [f b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BFS f a -> (Int, Split) -> Maybe [f a]
forall (f :: * -> *) x. BFS f x -> (Int, Split) -> Maybe [f x]
getBFS
instance Applicative f => Applicative (BFS f) where
pure :: a -> BFS f a
pure = f a -> BFS f a
forall (f :: * -> *) x. f x -> BFS f x
packBFS (f a -> BFS f a) -> (a -> f a) -> a -> BFS f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
BFS (Int, Split) -> Maybe [f (a -> b)]
ff <*> :: BFS f (a -> b) -> BFS f a -> BFS f b
<*> BFS (Int, Split) -> Maybe [f a]
fx = ((Int, Split) -> Maybe [f b]) -> BFS f b
forall (f :: * -> *) x. ((Int, Split) -> Maybe [f x]) -> BFS f x
BFS (((Int, Split) -> Maybe [f b]) -> BFS f b)
-> ((Int, Split) -> Maybe [f b]) -> BFS f b
forall a b. (a -> b) -> a -> b
$ \(Int
d, Split
split) -> [Maybe [f b]] -> Maybe [f b]
forall a. [Maybe [a]] -> Maybe [a]
flattenBFS ([Maybe [f b]] -> Maybe [f b]) -> [Maybe [f b]] -> Maybe [f b]
forall a b. (a -> b) -> a -> b
$
[ ([f (a -> b)] -> [f a] -> [f b])
-> Maybe [f (a -> b)] -> Maybe [f a] -> Maybe [f b]
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 ((f (a -> b) -> f a -> f b) -> [f (a -> b)] -> [f a] -> [f b]
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>)) ((Int, Split) -> Maybe [f (a -> b)]
ff (Int
i, Split
split)) ((Int, Split) -> Maybe [f a]
fx (Int
j, Split
split)) | (Int
i, Int
j) <- Split
split Int
d ]
instance Applicative f => Alternative (BFS f) where
empty :: BFS f a
empty = ((Int, Split) -> Maybe [f a]) -> BFS f a
forall (f :: * -> *) x. ((Int, Split) -> Maybe [f x]) -> BFS f x
BFS (((Int, Split) -> Maybe [f a]) -> BFS f a)
-> ((Int, Split) -> Maybe [f a]) -> BFS f a
forall a b. (a -> b) -> a -> b
$ \(Int
d, Split
_) -> if Int
d Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then [f a] -> Maybe [f a]
forall a. a -> Maybe a
Just [] else Maybe [f a]
forall a. Maybe a
Nothing
BFS (Int, Split) -> Maybe [f a]
fa <|> :: BFS f a -> BFS f a -> BFS f a
<|> BFS (Int, Split) -> Maybe [f a]
fb = ((Int, Split) -> Maybe [f a]) -> BFS f a
forall (f :: * -> *) x. ((Int, Split) -> Maybe [f x]) -> BFS f x
BFS (((Int, Split) -> Maybe [f a]) -> BFS f a)
-> ((Int, Split) -> Maybe [f a]) -> BFS f a
forall a b. (a -> b) -> a -> b
$ \(Int, Split)
d -> [Maybe [f a]] -> Maybe [f a]
forall a. [Maybe [a]] -> Maybe [a]
flattenBFS [(Int, Split) -> Maybe [f a]
fa (Int, Split)
d, (Int, Split) -> Maybe [f a]
fb (Int, Split)
d]
instance Applicative f => Unfolder (BFS f) where
chooseMap :: (a -> BFS f b) -> [a] -> BFS f b
chooseMap a -> BFS f b
f [a]
as = ((Int, Split) -> Maybe [f b]) -> BFS f b
forall (f :: * -> *) x. ((Int, Split) -> Maybe [f x]) -> BFS f x
BFS (((Int, Split) -> Maybe [f b]) -> BFS f b)
-> ((Int, Split) -> Maybe [f b]) -> BFS f b
forall a b. (a -> b) -> a -> b
$ \(Int
d, Split
split) -> if Int
d Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then [f b] -> Maybe [f b]
forall a. a -> Maybe a
Just [] else [Maybe [f b]] -> Maybe [f b]
forall a. [Maybe [a]] -> Maybe [a]
flattenBFS ((a -> Maybe [f b]) -> [a] -> [Maybe [f b]]
forall a b. (a -> b) -> [a] -> [b]
map (\a
a -> a -> BFS f b
f a
a BFS f b -> (Int, Split) -> Maybe [f b]
forall (f :: * -> *) x. BFS f x -> (Int, Split) -> Maybe [f x]
`getBFS` (Int
d Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1, Split
split)) [a]
as)
instance UnfolderTransformer BFS where
lift :: f a -> BFS f a
lift = f a -> BFS f a
forall (f :: * -> *) x. f x -> BFS f x
packBFS
bySum :: Split
bySum :: Split
bySum Int
d = [(Int
i, Int
d Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i)| Int
i <- [Int
0 .. Int
d]]
byMax :: Split
byMax :: Split
byMax Int
d = [(Int
i, Int
d)| Int
i <- [Int
0 .. Int
d Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]] [(Int, Int)] -> [(Int, Int)] -> [(Int, Int)]
forall a. [a] -> [a] -> [a]
++ [(Int
d, Int
i)| Int
i <- [Int
0 .. Int
d]]
bfsBy :: Unfolder f => Split -> BFS f x -> f x
bfsBy :: Split -> BFS f x -> f x
bfsBy Split
split (BFS (Int, Split) -> Maybe [f x]
f) = [f x] -> f x
forall (f :: * -> *) a. Unfolder f => [f a] -> f a
choose (Int -> [f x]
loop Int
0) where loop :: Int -> [f x]
loop Int
d = [f x] -> ([f x] -> [f x]) -> Maybe [f x] -> [f x]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ([f x] -> [f x] -> [f x]
forall a. [a] -> [a] -> [a]
++ Int -> [f x]
loop (Int
d Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)) ((Int, Split) -> Maybe [f x]
f (Int
d, Split
split))
bfs :: Unfolder f => BFS f x -> f x
bfs :: BFS f x -> f x
bfs = Split -> BFS f x -> f x
forall (f :: * -> *) x. Unfolder f => Split -> BFS f x -> f x
bfsBy Split
byMax
bfsBySum :: Unfolder f => BFS f x -> f x
bfsBySum :: BFS f x -> f x
bfsBySum = Split -> BFS f x -> f x
forall (f :: * -> *) x. Unfolder f => Split -> BFS f x -> f x
bfsBy Split
bySum
packBFS :: f x -> BFS f x
packBFS :: f x -> BFS f x
packBFS f x
r = ((Int, Split) -> Maybe [f x]) -> BFS f x
forall (f :: * -> *) x. ((Int, Split) -> Maybe [f x]) -> BFS f x
BFS (((Int, Split) -> Maybe [f x]) -> BFS f x)
-> ((Int, Split) -> Maybe [f x]) -> BFS f x
forall a b. (a -> b) -> a -> b
$ \(Int
d, Split
_) -> if Int
d Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then [f x] -> Maybe [f x]
forall a. a -> Maybe a
Just [f x
r] else Maybe [f x]
forall a. Maybe a
Nothing
flattenBFS :: [Maybe [a]] -> Maybe [a]
flattenBFS :: [Maybe [a]] -> Maybe [a]
flattenBFS [Maybe [a]]
ms = case [Maybe [a]] -> [[a]]
forall a. [Maybe a] -> [a]
catMaybes [Maybe [a]]
ms of
[] -> Maybe [a]
forall a. Maybe a
Nothing
[[a]]
ms' -> [a] -> Maybe [a]
forall a. a -> Maybe a
Just ([[a]] -> [a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[a]]
ms')