kvitable 1.0.2.1 → 1.0.3.0

raw patch · 4 files changed

+77/−48 lines, 4 filesdep ~basePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• CHANGELOG.md +5/−0
• kvitable.cabal +2/−2
• src/Data/KVITable/Render/ASCII.hs +24/−17
• src/Data/KVITable/Render/HTML.hs +46/−29

@@ -1,5 +1,10 @@ # Revision history for KVITable +## 1.0 3.0 -- 2024-02-22++* Support GHC 9.8.+* Internal updates to confirm safety and avoid partial functions.+ ## 1.0.2.0 -- 2023-01-09  * Support GHC 9.4.

@@ -1,6 +1,6 @@ cabal-version:       >=1.10 name:                kvitable-version:             1.0.2.1+version:             1.0.3.0 synopsis:            Key/Value Indexed Table container and formatting library description:    .@@ -53,7 +53,7 @@                      , Data.KVITable.Render.ASCII                      , Data.KVITable.Render.HTML   -- other-modules:-  build-depends:       base >=4.12 && <4.19+  build-depends:       base >=4.12 && <4.20                      , containers                      , lucid  >= 2.9 && < 2.12                      , microlens >= 0.4 && < 0.5

@@ -1,3 +1,4 @@+{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-}@@ -74,14 +75,14 @@ data FmtVal = Separator | TxtVal Text | CenterVal Text  fmtRender :: FmtLine -> [FmtVal] -> Text-fmtRender (FmtLine [] _sigils _sepsigils) [] = ""-fmtRender (FmtLine cols sigils sepsigils) vals =+fmtRender (FmtLine _cols _sigils _sepsigils) [] = ""+fmtRender (FmtLine cols sigils sepsigils) vals@(val:_) =   if length cols == length vals   then let sig f o = case o of                        Separator   -> f sepsigils                        TxtVal _    -> f sigils                        CenterVal _ -> f sigils-           l = sig sep $ head vals+           l = sig sep val        in l <>           T.concat           [ sig pad fld <>@@ -123,7 +124,9 @@     [ fmtRender lastFmt (replicate (fmtColCnt lastFmt) Separator) ])   where     hrows = hdrstep cfg t keys-    lastFmt = if null hrows then fmtLine [] else hdrFmt $ head $ reverse hrows+    lastFmt = case reverse hrows of+                [] -> fmtLine []+                (hrow:_) -> hdrFmt hrow  hdrstep :: PP.Pretty v => RenderConfig -> KVITable v -> [Key] -> [HeaderLine] hdrstep _cfg t [] =@@ -167,13 +170,16 @@       subhdrsV v = hdrvalstep cfg t (steppath <> [(key,v)]) keys       subTtlHdrs = let subAtVal v = (T.length v, subhdrsV v)                    in fmap subAtVal vals-      szexts = let subVW = fmtWidth . hdrFmt . head-                   subW (hl,sh) = let sv = subVW sh-                                  in if and [ hideBlankCols cfg,-                                              fmtEmptyCols $ hdrFmt $ head sh-                                            ]-                                     then (0, 0)-                                     else (hl, sv)+      szexts = let subW (hl,sh) =+                     case sh of+                       [] -> (0, 0)  -- should never be the case+                       (sh0:_) ->+                         let sv = fmtWidth $ hdrFmt sh0+                         in if and [ hideBlankCols cfg,+                                     fmtEmptyCols $ hdrFmt sh0+                                   ]+                            then (0, 0)+                            else (hl, sv)                in fmap (uncurry max . subW) subTtlHdrs       rsz_extsubhdrs = fmap hdrJoin $                        L.transpose $@@ -220,12 +226,13 @@         in filterOrDefaultBlankRows $ [ (False, multivalRows (key:kseq) path) ]       | otherwise =         let subrows keyval = asciiRows kseq $ path <> [ (key, keyval) ]-            grprow subs = if key `elem` rowGroup cfg && not (null subs)-                          then let subl = [ (True, replicate (length $ snd $ head subs) Separator) ]-                               in if fst (last subs)-                                  then init subs <> subl-                                  else subs <> subl-                          else subs+            grprow = \case+              subs@(sub0:_) | key `elem` rowGroup cfg ->+                  let subl = [ (True, replicate (length $ snd sub0) Separator) ]+                  in if fst (last subs)+                     then init subs <> subl+                     else subs <> subl+              subs -> subs             addSubrows ret keyval = ret <> (grprow $ fst $                                             foldl leftAdd ([],keyval) $ subrows keyval)             leftAdd (acc,kv) (b,subrow) = (acc <> [ (b, TxtVal kv : subrow) ],

@@ -18,6 +18,8 @@  import qualified Data.Foldable as F import qualified Data.List as L+import           Data.List.NonEmpty ( NonEmpty( (:|) ) )+import qualified Data.List.NonEmpty as NEL import           Data.Maybe ( fromMaybe, isNothing ) import           Data.Text ( Text ) import qualified Data.Text as T@@ -117,34 +119,34 @@ renderHdrs :: PP.Pretty v            => RenderConfig -> KVITable v -> [Key]            -> ( FmtLine, Html () )-renderHdrs cfg t keys =-  ( rowfmt, sequence_ [ fmtRender fmt hdrvals trailer-                      | (HdrLine fmt hdrvals trailer) <- hrows-                      ])+renderHdrs cfg t keys = ( rowfmt, sequence_ hdrs )   where+    hdrs = fmap renderHdr hrows     (hrows, rowfmt) = hdrstep cfg t keys+    renderHdr (HdrLine fmt hdrvals trailer) = fmtRender fmt hdrvals trailer  hdrstep :: PP.Pretty v-        => RenderConfig -> KVITable v -> [Key] -> ([HeaderLine], FmtLine)+        => RenderConfig -> KVITable v -> [Key]+        -> (NEL.NonEmpty HeaderLine, FmtLine) hdrstep _cfg t [] =-  ( [ HdrLine (FmtLine [1]) [Hdr 1 False $ t ^. valueColName] Nothing ]+  ( HdrLine (FmtLine [1]) [Hdr 1 False $ t ^. valueColName] Nothing :| []   , FmtLine [1]   ) hdrstep cfg t (key:keys) =   if colStackAt cfg == Just key   then hdrvalstep cfg t [] (key:keys) -- switch to column stacking mode   else-    let (nexthdrs, lowestfmt) = hdrstep cfg t keys-        (HdrLine fmt vals tr) = head nexthdrs -- safe: there were keys+    let (nexthdr0 :| nexthdrs, lowestfmt) = hdrstep cfg t keys+        (HdrLine fmt vals tr) = nexthdr0         fmt' = fmtAddColLeft 1 fmt-        val = Hdr (length nexthdrs) False key-    in ( (HdrLine fmt' (val : vals) tr) : tail nexthdrs+        val = Hdr (length nexthdrs + 1) False key+    in ( (HdrLine fmt' (val : vals) tr) :| nexthdrs        , fmtAddColLeft 1 lowestfmt        )  hdrvalstep :: PP.Pretty v            => RenderConfig -> KVITable v -> KeySpec -> [Key]-           -> ([HeaderLine], FmtLine)+           -> (NEL.NonEmpty HeaderLine, FmtLine) hdrvalstep _ _ _ [] = error "HTML hdrvalstep with empty keys after matching colStackAt -- impossible" hdrvalstep cfg t steppath (key:[]) =   let titles = ordering $ fromMaybe [] $ L.lookup key $ t ^. keyVals@@ -157,25 +159,40 @@                  then 0                  else 1       fmt = FmtLine $ fmap cwidth titles-  in ( [ HdrLine fmt (Hdr 1 False <$> titles) (Just key) ], fmt)+  in ( HdrLine fmt (Hdr 1 False <$> titles) (Just key) :| [], fmt) hdrvalstep cfg t steppath (key:keys) =-  let titles = ordering $ fromMaybe [] $ L.lookup key $ t ^. keyVals-      ordering = if sortKeyVals cfg then sortWithNums else id-      subhdrsV v = hdrvalstep cfg t (steppath <> [(key,v)]) keys-      subTtlHdrs :: [ ([HeaderLine], FmtLine) ]-      subTtlHdrs = subhdrsV <$> titles-      subhdrs = if hideBlankCols cfg-                then subTtlHdrs-                else L.replicate (length titles) $ head subTtlHdrs-      subhdr_rollup = joinHdrs <$> L.transpose (fst <$> subhdrs)-      joinHdrs hl = foldl (<>) (head hl) (tail hl)-      superFmt sub = let FmtLine subcols = hdrFmt $ last $ fst sub-                     in if sum subcols == 0-                        then 0-                        else length $ L.filter (/= 0) subcols-      topfmt = FmtLine (superFmt <$> subhdrs)-      tophdr = HdrLine topfmt (Hdr 1 False <$> titles) $ Just key-  in ( tophdr : subhdr_rollup, F.fold (snd <$> subTtlHdrs))+  let ordering = if sortKeyVals cfg then sortWithNums else id+  in case ordering $ fromMaybe [] $ L.lookup key $ t ^. keyVals of+       [] -> error "cannot happen"+       (ttl:ttls) ->+         let+           titles = ttl :| ttls+           subhdrsV v = hdrvalstep cfg t (steppath <> [(key,v)]) keys+           subTtlHdrs :: NEL.NonEmpty (NEL.NonEmpty HeaderLine, FmtLine)+           subTtlHdrs = subhdrsV <$> titles+           subhdrs :: NEL.NonEmpty (NEL.NonEmpty HeaderLine, FmtLine)+           subhdrs = if hideBlankCols cfg+                     then subTtlHdrs+                     else+                       -- Want to repeat the first element of subTtlHdrs to get a+                       -- NonEmpty the same length as titles.  Both titles and+                       -- subTtlHdrs are NonEmpty, but NonEmpty has no replicate+                       -- function.+                       let n = length titles -- >= 1 because titles is NonEmpty+                           e = NEL.head subTtlHdrs+                           tail' = NEL.take (n-1) $ NEL.repeat e+                       in e :| tail'+           subhdr_rollup = joinHdrs <$> NEL.transpose (fst <$> subhdrs)+           joinHdrs :: NEL.NonEmpty HeaderLine -> HeaderLine+           joinHdrs (hl0 :| hls) = foldl (<>) hl0 hls+           superFmt :: (NEL.NonEmpty HeaderLine, FmtLine) -> Int+           superFmt sub = let FmtLine subcols = hdrFmt $ NEL.last $ fst sub+                          in if sum subcols == 0+                             then 0+                             else length $ L.filter (/= 0) subcols+           topfmt = FmtLine $ NEL.toList (superFmt <$> subhdrs)+           tophdr = HdrLine topfmt (NEL.toList (Hdr 1 False <$> titles)) $ Just key+         in ( NEL.cons tophdr subhdr_rollup, F.fold (snd <$> subTtlHdrs))  ----------------------------------------------------------------------