{-# LANGUAGE NoMonomorphismRestriction #-}
module BalancedFold where

-- import Test.QuickCheck
-- import Test.QuickCheck.Property
import Control.Exception

-- | Conceptually,this turns the second arg into a balanced binary tree (with data at the leafs) and then folds this tree with the first arg. 
--
--
-- Example:
--
-- > balancedFold (-) [1,2,4,8] = (1-2)-(4-8) (= 3)
--
-- For nodes which cover an odd number of elements, the leftover element goes to the right subtree.
balancedFold :: (a -> a -> a) 
 -> [a] -- ^ PARTIALITY WARNING: List must be nonempty
 -> a
balancedFold f = go
    where
      go [] = error "balancedFold of an empty list is undefined"
      go [x] = x
      go xs = 
          let
              (l,r) = splitAt (length xs `div` 2) xs
          in
            f (go l) (go r) 


-- | @AscendFromLeaf l r leaf m i@ 
-- \"descends\" to the /i/-th leaf -- counted from left to right, zero-based -- 
-- of a tree with the same structure as 
--
-- > @balancedFold Node (repeat m (Leaf ()))@
--
-- would produce. It then starts with the value /leaf/, and ascends back up, 
-- applying /l/ to the value whenever ascending up a left-child edge 
-- and /r/ when ascending up a right-child edge.
ascendFromLeaf :: (Integral int) => (t -> t) -> (t -> t) -> t -> int -> int -> t
ascendFromLeaf l r leaf = go
    where
      go 1 i = assert (i==0) $ leaf
      go m i = 
          let
              nl = m     `div` 2
              nr = (m+1) `div` 2
          in if i < nl 
             then l (go nl i)
             else r (go nr (i-nl))


-- * Testing

-- data Tree a = Node (Tree a) (Tree a) | Leaf a
--             deriving (Eq)
                     
-- leftChild (Node x _) = x
-- leftChild x = error ("leftChild "++show x)
-- rightChild (Node _ x) = x
-- rightChild x = error ("leftChild "++show x)
                     
-- instance Show a => Show (Tree a) where
--     show = go 0
--         where
--           go 0 x = case x of
--                      Leaf y -> show y
--                      Node x1 x2 -> "+\n"++go 1 x1++"\n"++go 1 x2
--           go n x = concat (replicate (n-1) "| ") ++ "+-" ++
--                    case x of
--                      Leaf y -> show y
--                      Node x1 x2 -> "+\n" ++ go (n+1) x1 ++ "\n" ++ go (n+1) x2

-- prop1 = do
--   n <- choose (1,100)
--   i <- choose (0,n-1)
--   let
--       tree :: Tree Int
--       tree = balancedFold Node [ Leaf i | i <- [0..n-1] ]
             
--       getter :: Tree Int -> Tree Int
--       getter = ascendFromLeaf 
--                (\f -> f . leftChild) 
--                (\f -> f . rightChild)
--                id
--                n
--                i
               
             
--   return (whenFail (print (n,tree,i,getter tree)) $
--           getter tree == Leaf i)
      
---- END TESTING