Skip to content

Instantly share code, notes, and snippets.

@oisdk

oisdk/brauntolist.hs

Created Jan 26, 2020
Embed
What would you like to do?
import Test.QuickCheck
import Data.Tree.Binary.Preorder (Tree(..), drawTree)
import Control.Arrow (first)
import Data.List (unfoldr)
fromList :: [a] -> Tree a
fromList xs = head (l (foldr f b xs 1 2))
where
b _ _ ys zs = (repeat Leaf, (repeat Leaf, ys))
l k = let (xs, ys) = uncurry k ys in xs
f x k 0 j ys zs = ([], (l (f x k j (j*2)), ys))
f x k i j ~(y:ys) ~(z:zs) = first (Node x y z:) (k (i-1) j ys zs)
prop :: [Int] -> Property
prop xs = toList (fromList xs) === xs
newtype B a = B { unB :: (B a -> B a) -> (B a -> B a) -> [a] }
toList :: Tree a -> [a]
toList r = unB (f r b) id id
where
f (Node x l r) fw = B (\bwl bwr -> x : unB fw (bwl . f l) (bwr . f r))
f Leaf fw = B (\bwl bwr -> [])
b = B (\qsl qsr -> unB (qsl (qsr b)) id id)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.