-- | This module explores different ways to implement the "pairing fold".

module MonusWeightedSearch.Examples.PairingFold where

-- $setup
-- >>> :{
-- data Tree = Leaf | Tree :*: Tree
-- instance Show Tree where
--   show Leaf = "."
--   show (xs :*: ys) = "(" ++ show xs ++ "*" ++ show ys ++ ")"
-- :}

-- | The traditional definition of the pairing fold, as given in the original
-- paper.
--
-- >>> pairFold1 (:*:) (replicate 5 Leaf)
-- Just ((.*.)*((.*.)*.))
pairFold1 :: (a -> a -> a) -> [a] -> Maybe a
pairFold1 :: forall a. (a -> a -> a) -> [a] -> Maybe a
pairFold1 a -> a -> a
f []     = Maybe a
forall a. Maybe a
Nothing
pairFold1 a -> a -> a
f (a
x:[a]
xs) = a -> Maybe a
forall a. a -> Maybe a
Just (a -> [a] -> a
go a
x [a]
xs)
  where
    go :: a -> [a] -> a
go a
x []          = a
x
    go a
x1 (a
x2:[])    = a -> a -> a
f a
x1 a
x2
    go a
x1 (a
x2:a
x3:[a]
xs) = a -> a -> a
f (a -> a -> a
f a
x1 a
x2) (a -> [a] -> a
go a
x3 [a]
xs)

-- | A function that is identical to the one above, although implemented as a
-- fold.
--
-- >>> pairFold2 (:*:) (replicate 5 Leaf)
-- Just ((.*.)*((.*.)*.))
pairFold2 :: (a -> a -> a) -> [a] -> Maybe a
pairFold2 :: forall a. (a -> a -> a) -> [a] -> Maybe a
pairFold2 a -> a -> a
c [a]
xs = (a -> (Maybe a -> Maybe a) -> Maybe a -> Maybe a)
-> (Maybe a -> Maybe a) -> [a] -> Maybe a -> Maybe a
forall (t :: Type -> Type) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> (Maybe a -> Maybe a) -> Maybe a -> Maybe a
f Maybe a -> Maybe a
forall a. a -> a
id [a]
xs Maybe a
forall a. Maybe a
Nothing
  where
    f :: a -> (Maybe a -> Maybe a) -> Maybe a -> Maybe a
f a
x  Maybe a -> Maybe a
k Maybe a
Nothing   = Maybe a -> Maybe a
k (a -> Maybe a
forall a. a -> Maybe a
Just a
x)
    f a
x2 Maybe a -> Maybe a
k (Just a
x1) = a -> Maybe a
forall a. a -> Maybe a
Just (a -> (a -> a) -> Maybe a -> a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (a -> a -> a
c a
x1 a
x2) (a -> a -> a
c (a -> a -> a
c a
x1 a
x2)) (Maybe a -> Maybe a
k Maybe a
forall a. Maybe a
Nothing))

data Acc3 a
  = Acc3 (Maybe a) (Maybe a)
  deriving (forall m. Monoid m => Acc3 m -> m)
-> (forall m a. Monoid m => (a -> m) -> Acc3 a -> m)
-> (forall m a. Monoid m => (a -> m) -> Acc3 a -> m)
-> (forall a b. (a -> b -> b) -> b -> Acc3 a -> b)
-> (forall a b. (a -> b -> b) -> b -> Acc3 a -> b)
-> (forall b a. (b -> a -> b) -> b -> Acc3 a -> b)
-> (forall b a. (b -> a -> b) -> b -> Acc3 a -> b)
-> (forall a. (a -> a -> a) -> Acc3 a -> a)
-> (forall a. (a -> a -> a) -> Acc3 a -> a)
-> (forall a. Acc3 a -> [a])
-> (forall a. Acc3 a -> Bool)
-> (forall a. Acc3 a -> Int)
-> (forall a. Eq a => a -> Acc3 a -> Bool)
-> (forall a. Ord a => Acc3 a -> a)
-> (forall a. Ord a => Acc3 a -> a)
-> (forall a. Num a => Acc3 a -> a)
-> (forall a. Num a => Acc3 a -> a)
-> Foldable Acc3
forall a. Eq a => a -> Acc3 a -> Bool
forall a. Num a => Acc3 a -> a
forall a. Ord a => Acc3 a -> a
forall m. Monoid m => Acc3 m -> m
forall a. Acc3 a -> Bool
forall a. Acc3 a -> Int
forall a. Acc3 a -> [a]
forall a. (a -> a -> a) -> Acc3 a -> a
forall m a. Monoid m => (a -> m) -> Acc3 a -> m
forall b a. (b -> a -> b) -> b -> Acc3 a -> b
forall a b. (a -> b -> b) -> b -> Acc3 a -> b
forall (t :: Type -> Type).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: forall a. Num a => Acc3 a -> a
$cproduct :: forall a. Num a => Acc3 a -> a
sum :: forall a. Num a => Acc3 a -> a
$csum :: forall a. Num a => Acc3 a -> a
minimum :: forall a. Ord a => Acc3 a -> a
$cminimum :: forall a. Ord a => Acc3 a -> a
maximum :: forall a. Ord a => Acc3 a -> a
$cmaximum :: forall a. Ord a => Acc3 a -> a
elem :: forall a. Eq a => a -> Acc3 a -> Bool
$celem :: forall a. Eq a => a -> Acc3 a -> Bool
length :: forall a. Acc3 a -> Int
$clength :: forall a. Acc3 a -> Int
null :: forall a. Acc3 a -> Bool
$cnull :: forall a. Acc3 a -> Bool
toList :: forall a. Acc3 a -> [a]
$ctoList :: forall a. Acc3 a -> [a]
foldl1 :: forall a. (a -> a -> a) -> Acc3 a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Acc3 a -> a
foldr1 :: forall a. (a -> a -> a) -> Acc3 a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> Acc3 a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> Acc3 a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Acc3 a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Acc3 a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Acc3 a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Acc3 a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Acc3 a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Acc3 a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> Acc3 a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> Acc3 a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Acc3 a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Acc3 a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Acc3 a -> m
fold :: forall m. Monoid m => Acc3 m -> m
$cfold :: forall m. Monoid m => Acc3 m -> m
Foldable

-- | This is a slightly different version to the one above: it is
-- defunctionalised, a little.
--
-- >>> pairFold3 (:*:) (replicate 5 Leaf)
-- Just (.*((.*.)*(.*.)))
pairFold3 :: (a -> a -> a) -> [a] -> Maybe a
pairFold3 :: forall a. (a -> a -> a) -> [a] -> Maybe a
pairFold3 a -> a -> a
c [a]
xs = (a -> Maybe a -> Maybe a) -> Maybe a -> Acc3 a -> Maybe a
forall (t :: Type -> Type) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> (Maybe a -> a) -> Maybe a -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((Maybe a -> a) -> Maybe a -> Maybe a)
-> (a -> Maybe a -> a) -> a -> Maybe a -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> (a -> a) -> Maybe a -> a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (a -> (a -> a) -> Maybe a -> a)
-> (a -> a -> a) -> a -> Maybe a -> a
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> a -> a -> a
c)) Maybe a
forall a. Maybe a
Nothing ((a -> Acc3 a -> Acc3 a) -> Acc3 a -> [a] -> Acc3 a
forall (t :: Type -> Type) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> Acc3 a -> Acc3 a
f (Maybe a -> Maybe a -> Acc3 a
forall a. Maybe a -> Maybe a -> Acc3 a
Acc3 Maybe a
forall a. Maybe a
Nothing Maybe a
forall a. Maybe a
Nothing) [a]
xs)
  where
    f :: a -> Acc3 a -> Acc3 a
f a
x (Acc3 Maybe a
Nothing    Maybe a
xs) = Maybe a -> Maybe a -> Acc3 a
forall a. Maybe a -> Maybe a -> Acc3 a
Acc3 (a -> Maybe a
forall a. a -> Maybe a
Just a
x) Maybe a
xs
    f a
x1 (Acc3 (Just a
x2) Maybe a
xs) = Maybe a -> Maybe a -> Acc3 a
forall a. Maybe a -> Maybe a -> Acc3 a
Acc3 Maybe a
forall a. Maybe a
Nothing (a -> Maybe a
forall a. a -> Maybe a
Just (a -> (a -> a) -> Maybe a -> a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (a -> a -> a
c a
x1 a
x2) (a -> a -> a
c (a -> a -> a
c a
x1 a
x2)) Maybe a
xs))

-- data Tree a = Leaf a | Tree a :*: Tree a deriving (Eq, Ord, Show)

-- prop :: [Word] -> Bool
-- prop xs = pairFold1 (:*:) ys == pairFold3 (:*:) ys
--   where
--     ys = map Leaf xs