@@ -0,0 +1,100 @@
1+--writes Relation to a String suitable for terminal output
2+module RelationTerm where
3+import RelationType
4+import Relation
5+import qualified Data.Set as S
6+import qualified Data.Map as M
7+import qualified Data.HashSet as HS
8+import qualified Data.List as L
9+
10+boxV = "│"
11+boxH = "─"
12+
13+boxTL = "┌"
14+boxTR = "┐"
15+boxBL = "└"
16+boxBR = "┘"
17+
18+boxLB = "├"
19+boxRB = "┤"
20+boxTB = "┬"
21+boxBB = "┴"
22+
23+boxC = "┼"
24+
25+dboxH = "═"
26+dboxL = "╞"
27+dboxR = "╡"
28+
29+class TermSize a where
30+ termLength :: a -> Int
31+
32+--represent a relation as a table similar to those drawn by Date
33+type Cell = String
34+type Table = ([Cell], [[Cell]]) --header, body
35+
36+addRow :: [Cell] -> Table -> Table
37+addRow cells (header,body) = (header, body ++ [cells])
38+
39+columnLocations :: Table -> [Int]
40+columnLocations (header, body) = foldl sizeFolder (head cellSizes) cellSizes
41+ where
42+ cellSizes = map (\row -> map length row) (body ++ [header]) --bar padding
43+ sizeFolder acc row = mergeMax row acc
44+ mergeMax a b = map (\(x,y) -> if x > y then x else y) (zip a b)
45+
46+relationAsTable :: Relation -> Table
47+relationAsTable rel@(Relation attributes tupleSet) = (header, body)
48+ where
49+ oAttrs = orderedAttributeNames rel
50+ header = oAttrs
51+ body :: [[Cell]]
52+ body = HS.foldl' tupleFolder [] tupleSet
53+ tupleFolder acc (RelationTuple tupMap) = acc ++ [map (\n -> showAtom (tupMap M.! n)) oAttrs]
54+
55+showAtom :: Atom -> String
56+showAtom (StringAtom s) = s
57+showAtom (IntAtom i) = show i
58+showAtom (RelationAtom rel) = renderTable $ relationAsTable rel
59+
60+renderTable :: Table -> String
61+renderTable table = renderHeader table colLocations ++ renderBody (snd table) colLocations
62+ where
63+ colLocations = columnLocations table
64+
65+renderHeader :: Table -> [Int] -> String
66+renderHeader (header, body) columnLocations = renderTopBar ++ renderHeaderNames ++ renderBottomBar ++ "\n"
67+ where
68+ renderTopBar = boxTL ++ concat (L.intersperse boxTB (map (\x -> repeatString x boxH) columnLocations)) ++ boxTR ++ "\n"
69+ renderHeaderNames = renderRow header columnLocations boxV
70+ renderBottomBar = if length body == 0 then ""
71+ else renderHBar boxLB boxC boxRB columnLocations
72+
73+renderHBar :: String -> String -> String -> [Int] -> String
74+renderHBar left middle end columnLocations = left ++ concat (L.intersperse middle (map (\x -> repeatString x boxH) columnLocations)) ++ end
75+
76+leftPaddedString :: Int -> String -> String
77+leftPaddedString size str = str ++ repeatString (size - length str) " "
78+
79+renderRow :: [Cell] -> [Int] -> String -> String
80+renderRow cells columnLocations interspersed = boxV ++ concat (L.intersperse interspersed (map (\(size, value) -> leftPaddedString size value) (zip columnLocations cells))) ++ boxV ++ "\n"
81+
82+renderBody :: [[Cell]] -> [Int] -> String
83+renderBody cellMatrix columnLocations = renderRows ++ renderBottomBar
84+ where
85+ renderRows = concat (map (\r-> renderRow r columnLocations boxV) cellMatrix)
86+ renderBottomBar = renderHBar boxBL boxBB boxBR columnLocations
87+
88+orderedAttributeNames :: Relation -> [AttributeName]
89+orderedAttributeNames = S.toAscList . attributeNames
90+
91+repeatString :: Int -> String -> String
92+repeatString c s = concat (take c (repeat s))
93+
94+showRelation :: Relation -> String
95+showRelation = renderTable . relationAsTable
96+
97+
98+
99+
100+