{-# LANGUAGE DeriveDataTypeable #-}

module Language.Grammars.ZipperAG.Examples.BreadthFirst where

import Data.Data
import Data.Generics.Zipper
import Data.Maybe
import Debug.Trace
import Language.Grammars.ZipperAG

data Root = Root Tree
	deriving (Show, Typeable, Data)

data Tree = Fork Int Tree Tree | Empty
	deriving (Show, Typeable, Data)

constructor :: (Typeable a) => Zipper a -> String
constructor a = case ( getHole a :: Maybe Root) of
	 				Just (Root _) -> "Root"
	 				_ -> case (getHole a :: Maybe Tree) of
	 						Just (Fork _ _ _) -> "Fork"
	 						Just (Empty) -> "Empty"

-- Attributes
slist :: Zipper Root -> [Int]
slist z = case (constructor z) of
			"Fork" -> (head (ilist z) + 1) : (slist $ z.$3)
			"Empty" -> ilist z

replace :: Zipper Root -> Tree
replace z = case (constructor z) of
			"Empty" -> Empty
			"Fork"  -> Fork (head $ ilist z) (replace $ z.$2) (replace $ z.$3)
			"Root" -> replace $ z.$1

ilist :: Zipper Root -> [Int]
ilist z = case (constructor $ parent z) of
			"Root" -> [1] ++ (slist z)
			_ -> case (z.|3) of -- If it is the third child, it is the rightmost one
					True -> slist (fromJust (left z))
					False -> tail (ilist $ parent z)

tree = Fork 4 (Fork 8 Empty Empty) (Fork 2 (Fork 4 Empty Empty) Empty)

semantics = replace $ toZipper (Root tree)