{-# LANGUAGE DeriveDataTypeable #-}

module Language.Grammars.ZipperAG.Examples.BreadthFirst where

import Data.Data
import Data.Generics.Zipper
import Data.Maybe
import Debug.Trace

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"

(.$) :: Zipper a -> Int -> Zipper a
z .$ 1 = let d = down' z
		 in case d of
			Just x -> x
			Nothing -> error "You are going to a child that does not exist (1)!"
z .$ n = let r = right (z.$(n-1))
		 in case r of
			Just x -> x
			Nothing -> error "You are going to a child that does not exist (2)!"

-- Tests if z is the n'th sibling
(.|) :: Zipper a -> Int -> Bool
z .| n = n == (aux z)
	where aux z = case (left z) of
					Nothing -> 1
					Just _  -> 1 + aux (fromJust $ left z)

parent z = let a = up z
		   in case a of
		   		Just x -> x
		   		Nothing -> error "You are asking for the parent of the TopMost Tree!"

-- 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)