{-# LANGUAGE BangPatterns #-}
import Control.Monad

data Tree a
    = Nil
    | Branch a (Tree a) (Tree a)
    deriving (Show, Eq)

notEach :: Tree Bool -> [Tree Bool]
notEach tree = go id tree [] where
    go :: (Tree Bool -> Tree Bool) -> Tree Bool -> [Tree Bool] -> [Tree Bool]
    go cont Nil rest = rest
    go cont (Branch x left right) rest =
    	-- This made a 0.2s difference because without it, ghc couldn't move the
    	-- case out of the application to the Branch constructor
    	-- (because it might not get evaluated depending on what cont does)
    	-- With the ! it is able to compile it to a direct join point
    	let !flipped = not x in
        cont (Branch flipped left right) :
        go (rebuildLeft cont x right) left (go (rebuildRight cont x left) right rest)


rebuildLeft :: (Tree Bool -> Tree Bool) -> Bool -> Tree Bool -> Tree Bool -> Tree Bool
rebuildLeft cont x right leftFlipped = cont (Branch x leftFlipped right)

rebuildRight :: (Tree Bool -> Tree Bool) -> Bool -> Tree Bool -> Tree Bool -> Tree Bool
rebuildRight cont x left rightFlipped = cont (Branch x left rightFlipped)

procreateL :: Int -> Tree Bool
procreateL 0 = Nil
procreateL n = Branch (n `rem` 2 == 0) (procreateL (n - 1)) (procreateL (n `div` 2))

procreateR :: Int -> Tree Bool
procreateR 0 = Nil
procreateR n = Branch (n `rem` 2 == 0) (procreateR (n `div` 2)) (procreateR (n - 1))

test :: IO ()
test = do
    guard $ notEach (procreateL 3) == [Branch True (Branch True (Branch False Nil Nil) (Branch False Nil Nil)) (Branch False Nil Nil),Branch False (Branch False (Branch False Nil Nil) (Branch False Nil Nil)) (Branch False Nil Nil),Branch False (Branch True (Branch True Nil Nil) (Branch False Nil Nil)) (Branch False Nil Nil),Branch False (Branch True (Branch False Nil Nil) (Branch True Nil Nil)) (Branch False Nil Nil),Branch False (Branch True (Branch False Nil Nil) (Branch False Nil Nil)) (Branch True Nil Nil)]
    guard $ notEach (procreateR 3) == [Branch True (Branch False Nil Nil) (Branch True (Branch False Nil Nil) (Branch False Nil Nil)),Branch False (Branch True Nil Nil) (Branch True (Branch False Nil Nil) (Branch False Nil Nil)),Branch False (Branch False Nil Nil) (Branch False (Branch False Nil Nil) (Branch False Nil Nil)),Branch False (Branch False Nil Nil) (Branch True (Branch True Nil Nil) (Branch False Nil Nil)),Branch False (Branch False Nil Nil) (Branch True (Branch False Nil Nil) (Branch True Nil Nil))]
    guard $ length (notEach $ procreateL 150) == 1564307
    guard $ length (notEach $ procreateR 150) == 1564307
    
main = test