1{-# OPTIONS -fglasgow-exts #-}
2
3module Tree (tests) where
4
5{-
6
7This example illustrates serialisation and de-serialisation,
8but we replace *series* by *trees* so to say.
9
10-}
11
12import Test.HUnit
13
14import Control.Monad.Reader
15import Data.Generics
16import Data.Maybe
17import Data.Tree
18import CompanyDatatypes
19
20
21-- Trealise Data to Tree
22data2tree :: Data a => a -> Tree String
23data2tree = gdefault `extQ` atString
24  where
25    atString (x::String) = Node x []
26    gdefault x = Node (showConstr (toConstr x)) (gmapQ data2tree x)
27
28
29-- De-trealise Tree to Data
30tree2data :: Data a => Tree String -> Maybe a
31tree2data = gdefault `extR` atString
32  where
33    atString (Node x []) = Just x
34    gdefault (Node x ts) = res
35      where
36
37	-- a helper for type capture
38        res  = maybe Nothing (kids . fromConstr) con
39
40	-- the type to constructed
41        ta   = fromJust res
42
43	-- construct constructor
44        con  = readConstr (dataTypeOf ta) x
45
46        -- recursion per kid with accumulation
47        perkid ts = const (tail ts, tree2data (head ts))
48
49        -- recurse into kids
50        kids x =
51          do guard (glength x == length ts)
52             snd (gmapAccumM perkid ts x)
53
54
55-- Main function for testing
56tests = (   genCom
57        , ( data2tree genCom
58        , ( (tree2data (data2tree genCom)) :: Maybe Company
59        , ( Just genCom == tree2data (data2tree genCom)
60        )))) ~=? output
61
62output = (C [D "Research" (E (P "Laemmel" "Amsterdam") (S 8000.0)) [PU (E (P "Joost" "Amsterdam") (S 1000.0)),PU (E (P "Marlow" "Cambridge") (S 2000.0))],D "Strategy" (E (P "Blair" "London") (S 100000.0)) []],(Node {rootLabel = "C", subForest = [Node {rootLabel = "(:)", subForest = [Node {rootLabel = "D", subForest = [Node {rootLabel = "Research", subForest = []},Node {rootLabel = "E", subForest = [Node {rootLabel = "P", subForest = [Node {rootLabel = "Laemmel", subForest = []},Node {rootLabel = "Amsterdam", subForest = []}]},Node {rootLabel = "S", subForest = [Node {rootLabel = "8000.0", subForest = []}]}]},Node {rootLabel = "(:)", subForest = [Node {rootLabel = "PU", subForest = [Node {rootLabel = "E", subForest = [Node {rootLabel = "P", subForest = [Node {rootLabel = "Joost", subForest = []},Node {rootLabel = "Amsterdam", subForest = []}]},Node {rootLabel = "S", subForest = [Node {rootLabel = "1000.0", subForest = []}]}]}]},Node {rootLabel = "(:)", subForest = [Node {rootLabel = "PU", subForest = [Node {rootLabel = "E", subForest = [Node {rootLabel = "P", subForest = [Node {rootLabel = "Marlow", subForest = []},Node {rootLabel = "Cambridge", subForest = []}]},Node {rootLabel = "S", subForest = [Node {rootLabel = "2000.0", subForest = []}]}]}]},Node {rootLabel = "[]", subForest = []}]}]}]},Node {rootLabel = "(:)", subForest = [Node {rootLabel = "D", subForest = [Node {rootLabel = "Strategy", subForest = []},Node {rootLabel = "E", subForest = [Node {rootLabel = "P", subForest = [Node {rootLabel = "Blair", subForest = []},Node {rootLabel = "London", subForest = []}]},Node {rootLabel = "S", subForest = [Node {rootLabel = "100000.0", subForest = []}]}]},Node {rootLabel = "[]", subForest = []}]},Node {rootLabel = "[]", subForest = []}]}]}]},(Just (C [D "Research" (E (P "Laemmel" "Amsterdam") (S 8000.0)) [PU (E (P "Joost" "Amsterdam") (S 1000.0)),PU (E (P "Marlow" "Cambridge") (S 2000.0))],D "Strategy" (E (P "Blair" "London") (S 100000.0)) []]),True)))
63