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