git.iko.soy/project-m36
on master help sign in
add wcwidth module and detection of CJK multi-column characters (does it work on windows)
8df53baAgentM
project-m36.cabal+1
compare with master
unifiedsplit
@@ -57,6 +57,7 @@ Library
57 ,time
57 ,time
58 ,hashable-time
58 ,hashable-time
59 ,old-locale
59 ,old-locale
60+ ,wcwidth
60 --used for CSV parsing
61 --used for CSV parsing
61 ,attoparsec
62 ,attoparsec
62 ,either
63 ,either
src/lib/ProjectM36/Atom.hs+1−1
@@ -15,7 +15,7 @@ atomToText :: Atom -> T.Text
15atomToText (IntegerAtom i) = (T.pack . show) i
15atomToText (IntegerAtom i) = (T.pack . show) i
16atomToText (IntAtom i) = (T.pack . show) i
16atomToText (IntAtom i) = (T.pack . show) i
17atomToText (DoubleAtom i) = (T.pack . show) i
17atomToText (DoubleAtom i) = (T.pack . show) i
18−atomToText (TextAtom i) = (T.pack . show) i --does this break quoting in CSV export?
18+atomToText (TextAtom i) = i --does this break quoting in CSV export?
19atomToText (DayAtom i) = (T.pack . show) i
19atomToText (DayAtom i) = (T.pack . show) i
20atomToText (DateTimeAtom i) = (T.pack . show) i
20atomToText (DateTimeAtom i) = (T.pack . show) i
21atomToText (ByteStringAtom i) = (T.pack . show) i
21atomToText (ByteStringAtom i) = (T.pack . show) i
src/lib/ProjectM36/Relation/Show/Term.hs+19−2
@@ -9,6 +9,10 @@ import ProjectM36.Attribute hiding (null)
9import qualified Data.List as L
9import qualified Data.List as L
10import qualified Data.Text as T
10import qualified Data.Text as T
11import Control.Arrow hiding (left)
11import Control.Arrow hiding (left)
12+import Data.Monoid
13+import Data.Char.WCWidth --guess the width that the character will appear as in the terminal
14+
15+import Debug.Trace
12
16
13boxV :: StringType
17boxV :: StringType
14boxV = "│"
18boxV = "│"
@@ -77,7 +81,7 @@ cellSizes (header, body) = map (map maxRowWidth &&& map (length . breakLines)) a
77 0
81 0
78 else
82 else
79 L.maximum (lengths row)
83 L.maximum (lengths row)
80− lengths row = map T.length (breakLines row)
84+ lengths row = map stringDisplayLength (breakLines row)
81 allRows = header : body
85 allRows = header : body
82
86
83relationAsTable :: Relation -> Table
87relationAsTable :: Relation -> Table
@@ -102,6 +106,7 @@ showParens predicate f = if predicate then
102showAtom :: Int -> Atom -> StringType
106showAtom :: Int -> Atom -> StringType
103showAtom _ (RelationAtom rel) = renderTable $ relationAsTable rel
107showAtom _ (RelationAtom rel) = renderTable $ relationAsTable rel
104showAtom level (ConstructedAtom dConsName _ atoms) = showParens (level >= 1 && not (null atoms)) $ T.concat (L.intersperse " " (dConsName : map (showAtom 1) atoms))
108showAtom level (ConstructedAtom dConsName _ atoms) = showParens (level >= 1 && not (null atoms)) $ T.concat (L.intersperse " " (dConsName : map (showAtom 1) atoms))
109+showAtom _ (TextAtom t) = "\"" <> t <> "\""
105showAtom _ atom = atomToText atom
110showAtom _ atom = atomToText atom
106
111
107renderTable :: Table -> StringType
112renderTable :: Table -> StringType
@@ -120,13 +125,14 @@ renderHeader (header, body) columnLocations = renderTopBar `T.append` renderHead
120renderHBar :: StringType -> StringType -> StringType -> [Int] -> StringType
125renderHBar :: StringType -> StringType -> StringType -> [Int] -> StringType
121renderHBar left middle end columnLocations = left `T.append` T.concat (L.intersperse middle (map (`repeatString` boxH) columnLocations)) `T.append` end
126renderHBar left middle end columnLocations = left `T.append` T.concat (L.intersperse middle (map (`repeatString` boxH) columnLocations)) `T.append` end
122
127
128+--pad a block of potentially multi-lined text
123leftPaddedString :: Int -> Int -> StringType -> StringType
129leftPaddedString :: Int -> Int -> StringType -> StringType
124leftPaddedString lineNum size str = if lineNum > length paddedLines -1 then
130leftPaddedString lineNum size str = if lineNum > length paddedLines -1 then
125 repeatString size " "
131 repeatString size " "
126 else
132 else
127 paddedLines !! lineNum
133 paddedLines !! lineNum
128 where
134 where
129− paddedLines = map (\line -> line `T.append` repeatString (size - T.length line) " ") (breakLines str)
135+ paddedLines = map (\line -> line `T.append` repeatString (size - stringDisplayLength line) " ") (breakLines str)
130
136
131renderRow :: [Cell] -> [Int] -> Int -> StringType -> StringType
137renderRow :: [Cell] -> [Int] -> Int -> StringType -> StringType
132renderRow cells columnLocations rowHeight interspersed = T.unlines $ map renderOneLine [0..rowHeight-1]
138renderRow cells columnLocations rowHeight interspersed = T.unlines $ map renderOneLine [0..rowHeight-1]
@@ -147,3 +153,14 @@ repeatString c s = T.concat (replicate c s)
147
153
148showRelation :: Relation -> StringType
154showRelation :: Relation -> StringType
149showRelation rel = renderTable (relationAsTable rel)
155showRelation rel = renderTable (relationAsTable rel)
156+
157+--use wcwidth to guess the string width in the terminal- many CJK characters can take multiple columns in a fixed width font
158+stringDisplayLength :: StringType -> Int
159+stringDisplayLength = T.foldr charSize 0
160+ where
161+ charSize char accum = let w = wcwidth char in
162+ accum + if w < 0 then
163+ 1
164+ else
165+ w
166+