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