implemented complexTable
This commit is contained in:
parent
d0f237e707
commit
eedeaed8fc
|
@ -19,6 +19,8 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
-}
|
-}
|
||||||
|
|
||||||
|
{-# LANGUAGE LambdaCase #-}
|
||||||
|
|
||||||
module Mtlstats.Format
|
module Mtlstats.Format
|
||||||
( padNum
|
( padNum
|
||||||
, left
|
, left
|
||||||
|
@ -29,10 +31,13 @@ module Mtlstats.Format
|
||||||
, labelTable
|
, labelTable
|
||||||
, numTable
|
, numTable
|
||||||
, tableWith
|
, tableWith
|
||||||
|
, complexTable
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Data.List (transpose)
|
import Data.List (transpose)
|
||||||
|
|
||||||
|
import Mtlstats.Types
|
||||||
|
|
||||||
-- | Pad an 'Int' with leading zeroes to fit a certain character width
|
-- | Pad an 'Int' with leading zeroes to fit a certain character width
|
||||||
padNum
|
padNum
|
||||||
:: Int
|
:: Int
|
||||||
|
@ -138,12 +143,32 @@ tableWith
|
||||||
-> [[String]]
|
-> [[String]]
|
||||||
-- ^ The cells
|
-- ^ The cells
|
||||||
-> [String]
|
-> [String]
|
||||||
tableWith func tdata = let
|
tableWith pFunc tData = complexTable
|
||||||
widths = map (map length) tdata
|
(repeat pFunc)
|
||||||
|
(map (map CellText) tData)
|
||||||
|
|
||||||
|
-- | Creates a complex table
|
||||||
|
complexTable
|
||||||
|
:: [Int -> String -> String]
|
||||||
|
-- ^ The padding function for each column
|
||||||
|
-> [[TableCell]]
|
||||||
|
-- ^ The table cells (an array of rows)
|
||||||
|
-> [String]
|
||||||
|
complexTable pFuncs tData = let
|
||||||
|
widths = map
|
||||||
|
(map $ \case
|
||||||
|
CellText str -> length str
|
||||||
|
CellFill _ -> 0)
|
||||||
|
tData
|
||||||
colWidths = map maximum $ transpose widths
|
colWidths = map maximum $ transpose widths
|
||||||
fitted = map
|
|
||||||
(\row -> map
|
bFunc = \case
|
||||||
(\(str, len) -> func len str) $
|
[] -> ""
|
||||||
zip row colWidths)
|
[(f, len, CellText str)] -> f len str
|
||||||
tdata
|
[(_, len, CellFill ch)] -> replicate len ch
|
||||||
in map unwords fitted
|
(f, len, CellText str) : cells -> f len str ++ " " ++ bFunc cells
|
||||||
|
(_, len, CellFill ch) : cells -> replicate (succ len) ch ++ bFunc cells
|
||||||
|
|
||||||
|
in map
|
||||||
|
(bFunc . zip3 pFuncs colWidths)
|
||||||
|
tData
|
||||||
|
|
|
@ -24,6 +24,7 @@ module FormatSpec (spec) where
|
||||||
import Test.Hspec (Spec, context, describe, it, shouldBe)
|
import Test.Hspec (Spec, context, describe, it, shouldBe)
|
||||||
|
|
||||||
import Mtlstats.Format
|
import Mtlstats.Format
|
||||||
|
import Mtlstats.Types
|
||||||
|
|
||||||
spec :: Spec
|
spec :: Spec
|
||||||
spec = describe "Mtlstats.Format" $ do
|
spec = describe "Mtlstats.Format" $ do
|
||||||
|
@ -36,6 +37,7 @@ spec = describe "Mtlstats.Format" $ do
|
||||||
labelTableSpec
|
labelTableSpec
|
||||||
numTableSpec
|
numTableSpec
|
||||||
tableWithSpec
|
tableWithSpec
|
||||||
|
complexTableSpec
|
||||||
|
|
||||||
padNumSpec :: Spec
|
padNumSpec :: Spec
|
||||||
padNumSpec = describe "padNum" $ do
|
padNumSpec = describe "padNum" $ do
|
||||||
|
@ -174,3 +176,28 @@ tableWithSpec = describe "tableWith" $ let
|
||||||
]
|
]
|
||||||
)
|
)
|
||||||
]
|
]
|
||||||
|
|
||||||
|
complexTableSpec :: Spec
|
||||||
|
complexTableSpec = describe "complexTable" $ mapM_
|
||||||
|
(\(label, pFuncs, cells, expected) -> context label $
|
||||||
|
it "should format correctly" $
|
||||||
|
complexTable pFuncs cells `shouldBe` expected)
|
||||||
|
[ ( "no fill"
|
||||||
|
, [left, right]
|
||||||
|
, [ [ CellText "foo", CellText "bar" ]
|
||||||
|
, [ CellText "baaz", CellText "quux" ]
|
||||||
|
]
|
||||||
|
, [ "foo bar"
|
||||||
|
, "baaz quux"
|
||||||
|
]
|
||||||
|
)
|
||||||
|
, ( "with fill"
|
||||||
|
, [left, left, left]
|
||||||
|
, [ [ CellText "foo", CellText "bar", CellText "baz" ]
|
||||||
|
, [ CellText "quux", CellFill '-', CellFill '@' ]
|
||||||
|
]
|
||||||
|
, [ "foo bar baz"
|
||||||
|
, "quux ----@@@"
|
||||||
|
]
|
||||||
|
)
|
||||||
|
]
|
||||||
|
|
Loading…
Reference in New Issue
Block a user