{-# LANGUAGE ScopedTypeVariables,GeneralizedNewtypeDeriving #-}
{-
Copyright 2011 Ken Takusagawa

This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program.  If not, see <http://www.gnu.org/licenses/>.
-}
module Main (main) where{
import Data.Maybe;
import System.Environment;
import Debug.Trace;
import Data.Tree.NTree.Zipper.TypeDefs;
import Data.Tree.Class;
import Data.Tree.NTree.TypeDefs;
import Data.Tree.NavigatableTree.Class;
import Data.List;
import System.IO;
import Control.Monad;

main :: IO(());
main = (getArgs >>= (\lambda_case_var ->case lambda_case_var of {
  ([] )-> ((read_eval_print_loop mkEmpty) >>= print_tree);
  ["run"]-> run;
  ["repl"]-> ((read_eval_print_loop two_to_connect) >>= print_tree)
}));
type Node  = (Maybe(String), Mydata);
type Nnode  = NTree(Node);
type Mydata  = ();
type Edit  = NTZipper(Node);
no_data :: Mydata;
no_data = ();
make_node :: String -> Node;
make_node s = ((Just s), no_data);
placeholder :: Node;
placeholder = (Nothing, no_data);
empty_tree :: Nnode;
empty_tree = (list_make []);
leaf_make :: String -> Nnode;
leaf_make s = (mkTree (make_node s) []);
list_make :: (Tree (t)) => ([](t(Node)) -> t(Node));
list_make = (mkTree placeholder);
mkEmpty :: Edit;
mkEmpty = (fromTree empty_tree);
run :: IO(());
run = (do{
  (print((set_val (make_node "hello"))(fromJust(add_tree_left(fromJust(mvDown(make_child_here(mkEmpty))))))));
  (print_tree(sample));
  (print_tree(fromJust(mvUp(fromJust(left_promote(to_promote_sample))))));
  (print_tree(fromJust(mvUp(fromJust(right_promote(to_promote_sample))))));
});
add_tree_left :: Edit -> Maybe(Edit);
add_tree_left t = (addTreeLeft empty_tree t);
add_tree_right :: Edit -> Maybe(Edit);
add_tree_right t = (addTreeRight empty_tree t);
edit_node :: (NavigatableTreeToTree (nt)(t), NavigatableTreeModify (nt)(t)) => (t(a) -> t(a)) -> nt(a) -> nt(a);
edit_node f t = (substThisTree (f(toTree(t))) t);
type EE  = (Edit -> Edit);
make_child_here :: EE;
make_child_here = (edit_node (setChildren [empty_tree]));
set_val :: Node -> EE;
set_val x = (edit_node (setNode x));
show_tree :: (Tree (t)) => t(Node) -> String;
show_tree x = (case (fst(getNode(x))) of {
  Nothing-> (concat((intersperse " ")((map show_local_tree)(getChildren(x)))));
  _ -> (error "data node at root")
});
show_local_tree :: (Tree (t)) => t(Node) -> String;
show_local_tree x = (case (fst(getNode(x))) of {
  (Just j)-> (case (getChildren x) of {
  ([] )-> j;
  _ -> (error ("internal data node:" ++ (show j)))
});
  _ -> ("(" ++ (concat((intersperse " ")((map show_local_tree)(getChildren(x))))) ++ ")")
});
print_tree :: (Tree (t)) => (t(Node) -> IO(()));
print_tree = (putStrLn . show_tree);
push_down_node :: (Tree (t)) => t(Node) -> t(Node);
push_down_node input = (list_make [input]);
push_down :: EE;
push_down = (edit_node push_down_node);
this_down_right :: Edit -> Edit;
this_down_right z = (case (context(z)) of {
  ((:) (NTC (left ) (parent ) (right )) (rest_context ))-> (let {
new_node :: Nnode;
new_node = (list_make ((:) (ntree z) right))
}
 in (NTZ new_node ((:) (NTC left parent []) rest_context)))
});
this_down_left :: Edit -> Edit;
this_down_left z = (case (context(z)) of {
  ((:) (NTC (left ) (parent ) (right )) (rest_context ))-> (let {
new_node :: Nnode;
new_node = (list_make (endcons left (ntree z)))
}
 in (NTZ new_node ((:) (NTC [] parent right) rest_context)))
});
endcons :: [](a) -> a -> [](a);
endcons init last = ((++) init [last]);
to_promote_sample :: Edit;
to_promote_sample = (fromJust(mvRight(fromJust(mvRight(fromJust(mvDown(fromJust(mvRight(fromJust(mvRight(fromJust(mvDown(sample)))))))))))));
sample1 :: Edit;
sample1 = (fromTree (NTree (make_node "root") ((map leaf_make (words "a b")) ++ [(NTree (make_node "inner") (map leaf_make (words "c d e f")))] ++ (map leaf_make (words "g h")))));
right_promote :: (Monad (m)) => Edit -> m(Edit);
right_promote z = (case (context(z)) of {
  ((:) (NTC (myleft ) (myparent ) (myright )) ((:) (NTC (pleft ) (pparent ) (pright )) (grandparent_context )))-> (let {
new_right :: [](Nnode);
new_right = ((++) myright pright);
new_left :: Nnode;
new_left = (NTree myparent (reverse myleft))
}
 in (return (NTZ (ntree z) ((:) (NTC ((:) new_left pleft) pparent new_right) grandparent_context))));
  _ -> (fail "right-promote did not have parent")
});
left_promote :: (Monad (m)) => Edit -> m(Edit);
left_promote z = (case (context(z)) of {
  ((:) (NTC (myleft ) (myparent ) (myright )) ((:) (NTC (pleft ) (pparent ) (pright )) (grandparent_context )))-> (let {
new_left :: [](Nnode);
new_left = ((++) myleft pleft);
new_right :: Nnode;
new_right = (NTree myparent myright)
}
 in (return (NTZ (ntree z) ((:) (NTC new_left pparent ((:) new_right pright)) grandparent_context))));
  _ -> (fail "left-promote did not have parent")
});
sample :: Edit;
sample = (fromTree (list_make ((map leaf_make (words "a b")) ++ [(list_make (map leaf_make (words "c d e f")))] ++ (map leaf_make (words "g h")))));
two_to_connect :: Edit;
two_to_connect = (fromTree (list_make ((map leaf_make (words "a b")) ++ [(list_make (map leaf_make (words "c d e f"))), (list_make (map leaf_make (words "j j j j")))] ++ (map leaf_make (words "g h")))));
get_full_tree :: Edit -> Edit;
get_full_tree e = (case (mvUp e) of {
  Nothing-> e;
  (Just x)-> (get_full_tree x)
});
safe_child :: (MonadPlus (m)) => Edit -> m(Edit);
safe_child z = (do{
  (guard(isLeaf(ntree(z))));
  (guard(isNothing(fst(getNode(ntree(z))))));
  (return(make_child_here(z)));
});
safe_set :: (MonadPlus (m)) => String -> Edit -> m(Edit);
safe_set s z = (do{
  (guard(isLeaf(ntree(z))));
  (guard(isNothing(fst(getNode(ntree(z))))));
  (return((set_val (make_node s))(z)));
});
unset :: (MonadPlus (m)) => Edit -> m(Edit);
unset z = (do{
  (guard(isLeaf(ntree(z))));
  (return((set_val placeholder)(z)));
});
no_children :: Edit -> Edit;
no_children z = (z{ntree = (mkTree (getNode(ntree(z))) [])});
type Rep_type  = IO(Nnode);
read_eval_print_loop :: Edit -> Rep_type;
read_eval_print_loop z = (do{
  (putStr "$ ");
  (hFlush stdout);
  l :: String <- getLine;
  (putStrLn ("You said: " ++ (show l)));
  (case ((==) l "exit") of {
  True-> (return(ntree(get_full_tree(z))));
  _ -> (let {
go :: (Edit -> Maybe(Edit)) -> Rep_type;
go f = (case (f z) of {
  Nothing-> (do{
  (putStrLn "failed");
  (read_eval_print_loop z);
});
  (Just (j ))-> (read_eval_print_loop j)
});
no_change :: IO(()) -> Rep_type;
no_change action = (do{
  action;
  (read_eval_print_loop z);
})
}
 in (case (words l) of {
  ["child"]-> (go safe_child);
  ["down"]-> (go mvDown);
  ["up"]-> (go mvUp);
  ["left"]-> (go mvLeft);
  ["right"]-> (go mvRight);
  ["set", (val )]-> (go (safe_set val));
  ["show"]-> (no_change (print z));
  ["top"]-> (no_change(print_tree(ntree(get_full_tree(z)))));
  ["aleft"]-> (go add_tree_left);
  ["aright"]-> (go add_tree_right);
  ["dleft"]-> (go dropTreeLeft);
  ["dright"]-> (go dropTreeRight);
  ["push"]-> (go (Just . push_down));
  ["tright"]-> (go (Just . this_down_right));
  ["tleft"]-> (go (Just . this_down_left));
  ["pright"]-> (go right_promote);
  ["pleft"]-> (go left_promote);
  ["unset"]-> (go unset);
  ["noc"]-> (go (Just . no_children));
  _ -> (no_change (putStrLn "bad command"))
}))
});
})
}