ascii-table 0.2.0.0 → 0.3.0.0

raw patch · 2 files changed

+160/−83 lines, 2 filesdep ~textPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: text

API changes (from Hackage documentation)

Files

• ascii-table.cabal +2/−2
• src/Data/AsciiTable.hs +158/−81

@@ -3,7 +3,7 @@ -- see: https://github.com/sol/hpack  name:           ascii-table-version:        0.2.0.0+version:        0.3.0.0 synopsis:       ASCII table description:    ASCII table category:       Data@@ -31,7 +31,7 @@     , containers     , dlist     , hashable-    , text                 >= 0.8+    , text     , unordered-containers     , vector     , wl-pprint-extras     >= 1.3 && < 3.6

@@ -1,4 +1,4 @@-{-# LANGUAGE FlexibleInstances      #-}+{-# LANGUAGE BangPatterns           #-} {-# LANGUAGE LambdaCase             #-} {-# LANGUAGE OverloadedStrings      #-} {-# LANGUAGE RecordWildCards        #-}@@ -57,6 +57,7 @@  import Control.Applicative   (pure) import Data.Aeson            (Object, Value(..))+import Data.Char             (isPrint) import Data.Foldable         (foldl', foldMap) import Data.Hashable         (Hashable) import Data.HashMap.Strict   (HashMap)@@ -64,13 +65,13 @@ import Data.Maybe            (fromMaybe) import Data.Monoid           ((<>), mempty) import Data.Set              (Set)-import Data.Text             (Text)-import Text.PrettyPrint.Free hiding ((<>))+import Data.Text             (Text, pack, unpack)+import Text.PrettyPrint.Free hiding ((<>), text) -import qualified Data.HashMap.Strict    as HashMap-import qualified Data.Set               as Set-import qualified Data.Text              as Text-import qualified Data.Vector            as Vector+import qualified Data.HashMap.Strict            as HashMap+import qualified Data.Set                       as Set+import qualified Data.Vector                    as Vector+import qualified Text.PrettyPrint.Free.Internal as PrettyPrint  {- @@ -116,9 +117,9 @@ -- Build a table with 'makeTable', and show it with the pretty-printing -- functions re-exported from this module. data Table = Table-  { tableHeaders     :: [Text]-  , tableCellHeaders :: [[Text]]-  , tableSlices      :: [[[[Text]]]]+  { tableHeaders     :: [String]+  , tableCellHeaders :: [[String]]+  , tableSlices      :: [[[[String]]]]   } deriving (Eq, Show)  instance Pretty Table where@@ -135,26 +136,26 @@         , vsep (map (ppTableSlice widths) (tableSlices table))         ]    where-    ppTableSlice :: [[Int]] -> [[[Text]]] -> Doc e+    ppTableSlice :: [[Int]] -> [[[String]]] -> Doc e     ppTableSlice ns rs =       vsep (map (ppTableRow ns) rs)       `above`       tableSliceSep '-' ns -    ppTableRow :: [[Int]] -> [[Text]] -> Doc e+    ppTableRow :: [[Int]] -> [[String]] -> Doc e     ppTableRow nss rs = hsep (zipWith ppTableElem nss rs) <+> "|"      where-      ppTableElem :: [Int] -> [Text] -> Doc e+      ppTableElem :: [Int] -> [String] -> Doc e       ppTableElem ns es = "|" <+> hsep (zipWith ppTableCell ns es)        where-        ppTableCell :: Int -> Text -> Doc e-        ppTableCell n c = fill n (text (Text.unpack (escapeTabAndNewline c)))+        ppTableCell :: Int -> String -> Doc e+        ppTableCell n c = fill n (text (escapeTabAndNewline c)) -    ppTableHeaders :: [[Int]] -> [Text] -> Doc e+    ppTableHeaders :: [[Int]] -> [String] -> Doc e     ppTableHeaders nss hs = hsep (zipWith ppTableHeader nss hs) <+> "|"      where-      ppTableHeader :: [Int] -> Text -> Doc e-      ppTableHeader ns h = "|" <+> fill (elemWidth ns) (text (Text.unpack (escapeTabAndNewline h)))+      ppTableHeader :: [Int] -> String -> Doc e+      ppTableHeader ns h = "|" <+> fill (elemWidth ns) (text (escapeTabAndNewline h))      tableSliceSep :: Char -> [[Int]] -> Doc e     tableSliceSep c = (<> "+") . hcat . map elemSep@@ -182,11 +183,11 @@                    then ms ++ [m + n - len]                    else ns       in-        zipWith adjust (map Text.length tableHeaders) ws0+        zipWith adjust (map printableLength tableHeaders) ws0      where-      unadjustedTableWidths :: [[[Text]]] -> [[Int]]+      unadjustedTableWidths :: [[[String]]] -> [[Int]]       unadjustedTableWidths =-          map (map (maximum . map Text.length) . transpose)+          map (map (maximum . map printableLength) . transpose)         . transpose        unsnoc :: [a] -> Maybe ([a], a)@@ -196,10 +197,42 @@         (ys,y) <- unsnoc xs         pure (x:ys,y) +      -- Very primitive length counter that simply ignores ASNI color escape+      -- sequences, and then ignores non-printable characters.+      --+      -- For simplicity, assume that what follows "\ESC[" is an ANSI color+      -- escape sequence, and this function is probably broken if it isn't.+      printableLength :: String -> Int+      printableLength = length . filter isPrint . filterAnsiColor+     elemWidth :: [Int] -> Int     elemWidth = foldr (\x y -> x+y+1) (-1) +    -- Escape tabs and newlines in a 'String'.+    escapeTabAndNewline :: String -> String+    escapeTabAndNewline = replace '\n' "\\n" . replace '\t' "\\t"+     where+      replace :: Char -> String -> String -> String+      replace c s = concatMap (\c' -> if c == c' then s else [c']) +    -- | Like text, but consider the length of the string after its ANSI color+    -- escape codes and unprintable characters have been filtered out.+    text :: String -> Doc e+    text s = PrettyPrint.Text (length s') s+     where+      s' = filter isPrint (filterAnsiColor s)++    filterAnsiColor :: String -> String+    filterAnsiColor "" = ""+    filterAnsiColor ('\ESC' : '[' : xs) =+      filterAnsiColor (safeTail (dropWhile (/= 'm') xs))+    filterAnsiColor (x:xs) = x : filterAnsiColor xs++    safeTail :: [a] -> [a]+    safeTail [] = []+    safeTail (_:xs) = xs++ -- | Make a 'Table' from a list of headers and a list of 'TableSlice's, each of -- which contains a list of 'TableRow's, each of which contain a list of -- 'Object's. It is assumed that all dimensions align properly (e.g. each row@@ -215,7 +248,7 @@ -- example, the table corresponding to -- -- @--- [ [{\"foo\": \"bar\"}], [{\"baz\": \"qux\"}] ] -- One 'TableSlice'+-- [ [{\"foo\": \"bar\"}], [{\"baz\": \"qux\"}] ] -- one 'TableSlice' -- @ -- -- will simply look like@@ -232,11 +265,16 @@ -- That is, each missing value is simply not displayed. -- makeTable-  :: [Text]              -- ^ Headers+  :: [String]            -- ^ Headers   -> [TableSlice Object] -- ^ Table slices   -> Table makeTable headers slices =-  makeTableWith id (\_ -> id) (\_ _ -> prettyValue) headers (flat slices)+  makeTableWith+    (\_ -> id)+    (\_ _ _ -> unpack)+    (\_ _ _ _ -> prettyValue)+    headers+    (flat slices)  where   flat :: [TableSlice Object] -> [TableSlice Object]   flat = (map . map . map . fmap) flattenObject@@ -245,81 +283,121 @@ -- adding ANSI escape codes to color output, or for rendering values depending on -- what their key is. ----- For example, you may wish to render 'String's with a @\"timestamp\"@ key--- without quotation marks.+-- For example, you may wish to render 'Data.Aeson.String's with a+-- @\"timestamp\"@ key without quotation marks.+--+-- The @Int@ argument is the header's index. The @(Int, Int)@ argument is the+-- @(absolute, relative)@ index of the key and value. Visually,+--+-- @+-- +-------------+-------------++-- | 0           | 1           |+-- |             |             |+-- | (0,0) (1,1) | (2,0) (3,1) |+-- +=============+=============++-- | (0,0) (1,1) | (2,0) (3,1) |+-- | (0,0) (1,1) | (2,0) (3,1) |+-- +-------------+-------------++-- @+--+-- This function is (unfortunately) 'String'-based as of /0.3.0.0/, because the+-- pretty printing and ANSI escape code functions are 'String'-based, too.+-- makeTableWith-  :: forall h k v.-     (Ord k, Hashable k)-  => (h -> Text)                -- ^ Header rendering function-  -> (h -> k -> Text)           -- ^ Cell header rendering function-  -> (h -> k -> v -> Text)      -- ^ Cell rendering function-  -> [h]                        -- ^ Headers-  -> [TableSlice (HashMap k v)] -- ^ Table slices+  :: forall header key value.+     (Ord key, Hashable key)+  => (Int -> header -> String)                               -- ^ Header rendering function+  -> (Int -> header -> (Int, Int) -> key -> String)          -- ^ Cell header rendering function+  -> (Int -> header -> (Int, Int) -> key -> value -> String) -- ^ Cell rendering function+  -> [header]                                                -- ^ Headers+  -> [TableSlice (HashMap key value)]                        -- ^ Table slices   -> Table makeTableWith showH showK showV headers slices =   Table headers' cell_headers' slices'  where-  cell_headers :: [[k]]+  cell_headers :: [[key]]   cell_headers =       map (Set.toAscList . foldl' step mempty)     . transpose     . concat     $ slices    where-    step :: Set k -> Maybe (HashMap k v) -> Set k+    step :: Set key -> Maybe (HashMap key value) -> Set key     step acc Nothing  = acc     step acc (Just x) = acc <> Set.fromList (HashMap.keys x) -  headers':: [Text]-  headers' = map showH headers+  headers':: [String]+  headers' = zipWith showH [0..] headers -  cell_headers' :: [[Text]]-  cell_headers' = zipWith (map . showK) headers cell_headers+  cell_headers' :: [[String]]+  cell_headers' =+    zipWith3+      (\i h -> zipWith (\r (a,k) -> showK i h (a,r) k) [0..])+      [0..]+      headers+      (tag cell_headers) -  slices' :: [[[[Text]]]]+  slices' :: [[[[String]]]]   slices' =-    (map . map) (zipWith3 go headers cell_headers) slices+    (map . map) (zipWith4 go [0..] headers (tag cell_headers)) slices    where-    go :: h -> [k] -> Maybe (HashMap k v) -> [Text]-    go h ks (fromMaybe mempty -> m) =-      map-        (\k ->+    go :: Int -> header -> [(Int, key)] -> Maybe (HashMap key value) -> [String]+    go i h ks (fromMaybe mempty -> m) =+      zipWith+        (\r (a,k) ->           case HashMap.lookup k m of             Nothing -> ""-            Just v  -> showV h k v)+            Just v  -> showV i h (a,r) k v)+        [0..]         ks +  -- Tag each element in a list of lists with its absolute index.+  --+  -- tag [[a,b,c],[d,e],[],[f]] = [[(0,a),(1,b),(2,c)],[(3,d),(4,e)],[],[(5,f)]]+  tag :: [[a]] -> [[(Int, a)]]+  tag = go 0 [] []+    where+    go _ acc0 acc1 [] = reverse (map reverse (acc1 : acc0))+    go !n acc0 acc1 (xs:xss) =+      case xs of+        []     -> go n (acc1 : acc0) [] xss+        (y:ys) -> go (n+1) acc0 ((n,y) : acc1) (ys:xss)++ -- | Pretty-print a 'Value' in one line.-prettyValue :: Value -> Text-prettyValue = \case-  Object o ->-    "{"-    <> Vector.ifoldr'-      (\i (k,v) acc ->-        "\""-        <> k-        <> "\":"-        <> prettyValue v-        <> if i == HashMap.size o - 1-            then acc-            else ", " <> acc)-      mempty-      (Vector.fromList (HashMap.toList o))-    <> "}"-  Array a ->-    "["-    <> Vector.ifoldr'-      (\i v acc ->-        if i == Vector.length a - 1-          then prettyValue v <> acc-          else prettyValue v <> ", " <> acc)-      mempty-      a-    <> "]"-  String s -> "\"" <> s <> "\""-  Number n -> Text.pack (show n)-  Bool b   -> Text.pack (show b)-  Null     -> "null"+prettyValue :: Value -> String+prettyValue = unpack . prettyValue'+ where+  prettyValue' :: Value -> Text+  prettyValue' = \case+    Object o ->+      "{"+      <> Vector.ifoldr'+        (\i (k,v) acc ->+          "\""+          <> k+          <> "\":"+          <> prettyValue' v+          <> if i == HashMap.size o - 1+              then acc+              else ", " <> acc)+        mempty+        (Vector.fromList (HashMap.toList o))+      <> "}"+    Array a ->+      "["+      <> Vector.ifoldr'+        (\i v acc ->+          if i == Vector.length a - 1+            then prettyValue' v <> acc+            else prettyValue' v <> ", " <> acc)+        mempty+        a+      <> "]"+    String s -> "\"" <> s <> "\""+    Number n -> pack (show n)+    Bool b   -> pack (show b)+    Null     -> "null"  -- | Flatten an 'Object' so that it contains no top-level 'Object' values. flattenObject :: Object -> Object@@ -334,8 +412,7 @@   prependKey :: Text -> (Text, Value) -> (Text, Value)   prependKey k0 (k1, v) = (k0 <> "." <> k1, v) --- | Escape tabs and newlines in a 'Text'.-escapeTabAndNewline :: Text -> Text-escapeTabAndNewline =-    Text.replace (Text.singleton '\n') "\\n"-  . Text.replace (Text.singleton '\t') "\\t"++zipWith4 :: (a -> b -> c -> d -> e) -> [a] -> [b] -> [c] -> [d] -> [e]+zipWith4 f (a:as) (b:bs) (c:cs) (d:ds) = f a b c d : zipWith4 f as bs cs ds+zipWith4 _ _ _ _ _ = []