module Language.Grammars.ZipperAG.Examples.HTMLTableFormatter where
import Data.Data
import Data.Generics.Zipper
import Data.Maybe
data R = RootR Table
deriving (Typeable, Show, Data)
data Table = RootTable Rows
deriving (Typeable, Show, Data)
data Rows = NoRow
| ConsRow Row Rows
deriving (Typeable, Show, Data)
data Row = OneRow Elems
deriving (Typeable, Show, Data)
data Elems = NoElem
| ConsElem Elem Elems
deriving (Typeable, Show, Data)
data Elem = TableText String
| NestedTable Table
deriving (Typeable, Show, Data)
constructor :: Zipper R -> String
constructor a = case ( getHole a :: Maybe R ) of
Just (RootR _) -> "RootR"
otherwise -> case ( getHole a :: Maybe Table ) of
Just (RootTable _) -> "RootTable"
otherwise -> case ( getHole a :: Maybe Rows ) of
Just (NoRow) -> "NoRow"
Just (ConsRow _ _) -> "ConsRow"
otherwise -> case ( getHole a :: Maybe Row ) of
Just (OneRow _) -> "OneRow"
otherwise -> case ( getHole a :: Maybe Elems ) of
Just (NoElem) -> "NoElem"
Just (ConsElem _ _) -> "ConsElem"
otherwise -> case ( getHole a :: Maybe Elem ) of
Just (TableText _) -> "TableText"
Just (NestedTable _) -> "NestedTable"
otherwise -> error "Naha, that production does not exist!"
(.$) :: 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.$(n1))
in case r of
Just x -> x
Nothing -> error "You are going to a child that does not exist (2)!"
(.|) :: Zipper a -> Int -> Bool
z .| 1 = case (left z) of
Nothing -> False
_ -> True
z .| n = case (left z) of
Nothing -> False
Just x -> z .| (n1)
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!"
value t = case ( getHole t :: Maybe Elem ) of
Just (TableText x) -> x
_ -> error "You should not be asking for that value!"
(.#.) :: Data a => (t -> a) -> t -> Zipper a
highorder_attr .#. zipper = toZipper (highorder_attr zipper)
n_Syn z = case (constructor z) of
"RootR" -> n_Syn $ z.$1
"RootTable" -> maxList ( ns_Syn $ z.$1 )
"OneRow" -> n_Syn $ z.$1
"NoElem" -> 0
"ConsElem" -> 1 + (n_Syn $ z.$2)
ns_Syn z = case (constructor z) of
"NoRow" -> []
"ConsRow" -> (n_Syn $ z.$1) : (ns_Syn $ z.$2)
ane_Inh z = case (constructor z) of
"RootTable" -> n_Syn z
"NoRow" -> case (constructor $ parent z) of
"RootTable" -> n_Syn $ parent z
"NoRow" -> ane_Inh $ parent z
"ConsRow" -> ane_Inh $ parent z
"ConsRow" -> case (constructor $ parent z) of
"RootTable" -> n_Syn $ parent z
"OneRow" -> ane_Inh $ parent z
"ConsRow" -> ane_Inh $ parent z
"OneRow" -> ane_Inh $ parent z
"NoElem" -> case (constructor $ parent z) of
"OneRow" -> ane_Inh $ parent z
"ConsElem" -> (ane_Inh $ parent z) 1
"NoElem" -> (ane_Inh $ parent z) 1
"ConsElem" -> case (constructor $ parent z) of
"OneRow" -> ane_Inh $ parent z
"ConsElem" -> (ane_Inh $ parent z) 1
"NoElem" -> (ane_Inh $ parent z) 1
r2 z = RootR (r2_table $ z.$1)
r2_table z = RootTable (r2_rows $ z.$1)
r2_rows z = case (constructor z) of
"NoRow" -> NoRow
"ConsRow" -> ConsRow (r2_row $ z.$1) (r2_rows $ z.$2)
r2_row z = OneRow (r2_elems $ z.$1)
r2_elems z = case (constructor z) of
"NoElem" -> add_elems (ane_Inh z)
"ConsElem" -> ConsElem (r2_elem $ z.$1) (r2_elems $ z.$2)
r2_elem z = case (constructor z) of
"TableText" -> TableText (value z)
"NestedTable" -> NestedTable (r2_table $ z.$1)
mh_Syn z = case (constructor z) of
"RootR" -> mh_Syn $ z.$1
"RootTable" -> mh_Syn $ z.$1
"NoRow" -> 0
"ConsRow" -> (mh_Syn $ z.$1) + 1 + (mh_Syn $ z.$2)
"OneRow" -> mh_Syn $ z.$1
"ConsElem" -> max (mh_Syn $ z.$1) (mh_Syn $ z.$2)
"NoElem" -> 0
"TableText" -> 1
"NestedTable" -> (mh_Syn $ z.$1 ) + 1
mw_Syn z = case (constructor z) of
"RootR" -> mw_Syn $ z.$1
"RootTable" -> lmw_Local z
"TableText" -> length (value z)
"NestedTable" -> (mw_Syn $ z.$1) + 2
mws_Syn z = case (constructor z) of
"NoRow" -> []
"ConsRow" -> eq_zipwith_max (mws_Syn $ z.$1) (mws_Syn $ z.$2)
"OneRow" -> mws_Syn $ z.$1
"ConsElem" -> (mw_Syn $ z.$1) : (mws_Syn $ z.$2)
"NoElem" -> []
lmw_Local z = case (constructor z) of
"RootTable" -> (sumList (mws_Syn $ z.$1)) + (lengthList (mws_Syn $ z.$1)) 1
"ConsRow" -> (sumList (aws_Inh z)) + (lengthList (aws_Inh z)) 1
ah_Inh z = case (constructor z) of
"RootR" -> mh_Syn $ z
"RootTable" -> case (constructor $ parent z) of
"RootR" -> ah_Inh $ parent z
"OneElem" -> ah_Inh $ parent z
"ConsElem" -> ah_Inh $ parent z
"ConsElem" ->case (constructor $ parent z) of
"OneRow" -> mh_Syn z
"ConsElem" -> ah_Inh $ parent z
"NoElem" -> case (constructor $ parent z) of
"OneRow" -> mh_Syn z
"ConsElem" -> ah_Inh $ parent z
"TableText" -> ah_Inh $ parent z
"NestedTable" -> ah_Inh $ parent z
aws_Inh z = case (constructor z) of
"ConsRow" ->case (constructor $ parent z) of
"RootTable" -> mws_Syn z
"ConsRow" -> aws_Inh $ parent z
"NoRow" -> case (constructor $ parent z) of
"RootTable" -> mws_Syn z
"ConsRow" -> aws_Inh $ parent z
"OneRow" -> aws_Inh $ parent z
"ConsElem" -> case (constructor $ parent z) of
"OneRow" -> aws_Inh $ parent z
"ConsElem" -> tailList (aws_Inh $ parent z)
"NoElem" -> case (constructor $ parent z) of
"OneRow" -> aws_Inh $ parent z
"ConsElem" -> tailList (aws_Inh $ parent z)
aw_Inh z = case (constructor z) of
"RootR" -> mw_Syn z
"RootTable" -> case (constructor $ parent z) of
"RootR" -> ah_Inh $ parent z
"NestedTable" -> aw_Inh $ parent z
"TableText" -> headList (aws_Inh $ parent z)
"NestedTable" -> headList (aws_Inh $ parent z)
lines_Syn t = let z = t
in case (constructor z) of
"RootR" -> lines_Syn $ z.$1
"RootTable" -> (add_sepline (lmw_Local z)) ++ (lines_Syn $ z.$1) ++ (add_sepline (lmw_Local z))
"NoRow" -> []
"ConsRow" -> add_sep_line (lmw_Local z) (lines_Syn $ z.$1) (lines_Syn $ z.$2)
"OneRow" -> add_border_line (lines_Syn $ z.$1)
"NoElem" -> []
"ConsElem" -> let ag = addglue (aw_Inh $ z.$1) (mw_Syn $ z.$1) (ah_Inh $ z.$1) (mh_Syn $ z.$1) (lines_Syn $ z.$1) ("align")
in eq_zipwith_cat ag (lines_Syn $ z.$2)
"TableText" -> value z : []
"NestedTable" -> lines_Syn $ z.$1
sumList = sum
lengthList = length
eq_zeros = []
eq_zipwith_max :: [Int] -> [Int] -> [Int]
eq_zipwith_max [] l2 = l2
eq_zipwith_max l1 [] = l1
eq_zipwith_max (l1:l1s) (l2:l2s) = (max l1 l2) : (eq_zipwith_max l1s l2s)
maxList :: [Int] -> Int
maxList [] = 0
maxList (x:xs) = max x (maxList xs)
headList :: [Int] -> Int
headList [] = 0
headList (x:xs) = x
tailList :: [a] -> [a]
tailList [] = []
tailList (x:xs) = xs
eq_zipwith_cat :: [String] -> [String] -> [String]
eq_zipwith_cat l1 [] = l1
eq_zipwith_cat [] l2 = l2
eq_zipwith_cat (l11:l11s) (l22:l22s) = (l11 ++ "|" ++ l22) : (eq_zipwith_cat l11s l22s)
add_border_line :: [String] -> [String]
add_border_line [] = []
add_border_line (x:xs) = ("|" ++ x ++ "|") : (add_border_line xs)
addglue :: Int -> Int -> Int -> Int -> [String] -> String -> [String]
addglue aw mw ah mh lineS a = (glue_horizontal aw mw lineS a) ++ (glue_vertical_new (ahmh) (add_vertical aw))
glue_horizontal :: Int -> Int -> [String] -> String -> [String]
glue_horizontal _ _ [] _ = []
glue_horizontal aw mw (l:ls) a = (add_hor l (awmw) a) : (glue_horizontal aw mw ls a)
add_hor :: String -> Int -> String -> String
add_hor l aw "left" = l ++ (hor_spaces aw)
add_hor l aw "right" = (hor_spaces aw) ++ l
add_hor l aw "center" = let y = (div aw 2)
in (hor_spaces y) ++ l ++ (hor_spaces y)
add_hor l aw _ = l ++ (hor_spaces aw)
hor_spaces :: Int -> String
hor_spaces i = if (i <= 0) then "" else (repeatChar ' ' i)
glue_vertical_new :: Int -> [String] -> [String]
glue_vertical_new n l = if (n <= 0) then [] else l ++ (glue_vertical_new (n1) l)
add_vertical :: Int -> [String]
add_vertical aw = if (aw <= 0) then [] else (repeatChar ' ' aw) : []
add_sepline :: Int -> [String]
add_sepline aw = if (aw <= 0)
then []
else ["|" ++ (repeatChar '-' aw) ++ "|"]
add_sep_line :: Int -> [String] -> [String] -> [String]
add_sep_line mw l [] = l
add_sep_line mw l rest = l ++ (add_sepline mw) ++ rest
add_elems :: Int -> Elems
add_elems 0 = NoElem
add_elems n = ConsElem (TableText " ") (add_elems (n1))
repeatChar :: Char -> Int -> String
repeatChar _ 0 = []
repeatChar c i = c : (repeatChar c (i1))
nestedtable = RootTable (ConsRow (OneRow (ConsElem (TableText "Some more random text!") (NoElem))) (NoRow))
elem1 = TableText "This is some text on a table!"
elem2 = TableText "And even more random text!"
row1 = ConsRow (OneRow (ConsElem (TableText "This is a big phrase etc etc.") NoElem)) (NoRow)
elem3 = ConsElem (TableText "This is a big phrase just to make sure this HTML AG etc etc.") (NoElem)
table = RootR (RootTable (ConsRow (OneRow (ConsElem (elem1) (ConsElem (NestedTable nestedtable) (NoElem)))) (ConsRow (OneRow (ConsElem (elem2) (elem3))) (row1))))
printTable :: [String] -> String
printTable [] = ""
printTable (x:xs) = x ++ "\n" ++ (printTable xs)
ata z = toZipper (r2 z)
semantics t = putStrLn $ printTable $ lines_Syn $ ata $ (toZipper t)