{-# OPTIONS_GHC -Wall #-}
module TreeTraversal
where

import Zipper
import Data.Monoid
import Data.Tree
import Control.Applicative

data TreeTraversal conditional = Id
                               | Up 
                               | Down 
                               | TurnRight 
                               | TurnLeft 
                               | Compose (TreeTraversal conditional) (TreeTraversal conditional) 
                               | Cond conditional (TreeTraversal conditional) (TreeTraversal conditional)

class Conditional c where
    evalPosition :: c -> Tree a -> Bool

instance Monoid (TreeTraversal c) where
    mempty = Id
    mappend = Compose

traverse :: (Conditional c) => TreeTraversal c -> Tree a -> a
traverse tt tr = getNode $ (interpret tt) (addZipper tr)

interpret :: (Conditional c) => TreeTraversal c -> (TreeLoc a -> TreeLoc a)
interpret Up                = up
interpret Down              = down
interpret TurnRight         = turnRight
interpret TurnLeft          = turnLeft
interpret (t1 `Compose` t2) = interpret t1 . interpret t2
interpret Id                = id
interpret (Cond c t1 t2)    = cond (evalPosition c . tree) (interpret t1) (interpret t2)

cond :: (Applicative f) => f Bool -> f a -> f a -> f a
cond c t f = liftA3 if' c t f

if' :: Bool -> a -> a -> a
if' c t f = if c then t else f

applyWhile :: (b -> Bool) -> b -> [b -> b] -> b
applyWhile = \p x -> last . takeWhile p . scanl (flip ($)) x

interleave :: [a] -> [a] -> [a]
interleave [] ys = ys
interleave xs [] = xs
interleave (x:xs) (y:ys) = x:y:(xs`interleave`ys)