kvitable-1.0.3.0/0000755000000000000000000000000007346545000011643 5ustar0000000000000000kvitable-1.0.3.0/CHANGELOG.md0000644000000000000000000000046007346545000013454 0ustar0000000000000000# 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.0.1.0 -- 2022-05-26 * Support GHC 9.2 [thanks to Ryan Scott]. ## 1.0.0.0 -- 2021-01-30 * Initial version kvitable-1.0.3.0/LICENSE0000644000000000000000000000133107346545000012646 0ustar0000000000000000Copyright (c) 2021 Kevin Quick Permission to use, copy, modify, and/or distribute this software for any purpose with or without fee is hereby granted, provided that the above copyright notice and this permission notice appear in all copies. THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. kvitable-1.0.3.0/README.md0000644000000000000000000005010107346545000013117 0ustar0000000000000000The `KVITable` is similar to a `Map`, but the keys to the map are a list of `Key=Val` data. Although the `KVITable` is perfectly useable as a container in this fashion, the main use of the `KVITable` is in rendering this data in various configurations; because of this focus, there is no particular attention to other container aspects such as: performance, space usage, etc. An example table can be created via: ```haskell {-# LANGUAGE OverloadedStrings #-} import qualified Data.Text as T import Data.KVITable nestedTable = foldl foldlInsert (mempty & keyVals .~ [ ("millions", ["0"]) , ("thousands", ["0"]) , ("hundreds", ["0"]) , ("tens", ["0"]) , ("ones", ["0"]) ] ) [ ([("millions", T.pack $ show m) ,("thousands", T.pack $ show t) ,("hundreds", T.pack $ show h) ,("tens", T.pack $ show d) ,("ones", T.pack $ show o)], if (o `rem` 2) == 1 then "odd" else "even") | m <- [0..2 :: Int] , t <- [0..2 :: Int] , h <- [1..2 :: Int] , d <- [2..2 :: Int] , o <- [0..1 :: Int] ] ``` This Haskell code generates a table where the keys are the various scale indicators along with a corresponding key value. The table entries themselves are the words `odd` or `even`. Rendering this table in ASCII mode, with blank rows and columns hidden, and enabling column stacking at the "hundreds" key column can be done with the following code: ```haskell import Data.KVITable.Render.ASCII render (defaultRenderConfig { sortKeyVals = True , rowRepeat = False , hideBlankCols = True , hideBlankRows = True , equisizedCols = False , colStackAt = Just "hundreds" }) nestedTable ``` The output from this rendering will look like: ``` ____ snip vv ____ | millions | thousands | ___ 1 ____ | ___ 2 ____ | <- hundreds | | | ___ 2 ____ | ___ 2 ____ | <- tens | | | 0 | 1 | 0 | 1 | <- ones +----------+-----------+------+-----+------+-----+ | 0 | 0 | even | odd | even | odd | | | 1 | even | odd | even | odd | | | 2 | even | odd | even | odd | | 1 | 0 | even | odd | even | odd | | | 1 | even | odd | even | odd | | | 2 | even | odd | even | odd | | 2 | 0 | even | odd | even | odd | | | 1 | even | odd | even | odd | | | 2 | even | odd | even | odd | ____ snip ^^ ____ ``` When rendered to HTML instead by using the same code but importing `Data.KVITable.Render.HTML` (and please use a little CSS to make things prettier), the following is obtained: ****
millions thousands 1 2  ←hundreds
2 2  ←tens
0 1 0 1  ←ones
0 0 even odd even odd
1 even odd even odd
2 even odd even odd
1 0 even odd even odd
1 even odd even odd
2 even odd even odd
2 0 even odd even odd
1 even odd even odd
2 even odd even odd
**** ## Different ColStack specification By changing the `colStackAt` specification in the rendering configuration from the "hundreds" column to the "thousands" column, the column at which `Key Val`'s are shown as column headers instead of rows is changed and the following ASCII results are obtained: ``` ____ snip vv ____ | millions | __________ 0 __________ | __________ 1 __________ | __________ 2 __________ | <- thousands | | ___ 1 ____ | ___ 2 ____ | ___ 1 ____ | ___ 2 ____ | ___ 1 ____ | ___ 2 ____ | <- hundreds | | ___ 2 ____ | ___ 2 ____ | ___ 2 ____ | ___ 2 ____ | ___ 2 ____ | ___ 2 ____ | <- tens | | 0 | 1 | 0 | 1 | 0 | 1 | 0 | 1 | 0 | 1 | 0 | 1 | <- ones +----------+------+-----+------+-----+------+-----+------+-----+------+-----+------+-----+ | 0 | even | odd | even | odd | even | odd | even | odd | even | odd | even | odd | | 1 | even | odd | even | odd | even | odd | even | odd | even | odd | even | odd | | 2 | even | odd | even | odd | even | odd | even | odd | even | odd | even | odd | ____ snip ^^ ____ ``` or as HTML: ****
millions 0 1 2  ←thousands
1 2 1 2 1 2  ←hundreds
2 2 2 2 2 2  ←tens
0 1 0 1 0 1 0 1 0 1 0 1  ←ones
0 even odd even odd even odd even odd even odd even odd
1 even odd even odd even odd even odd even odd even odd
2 even odd even odd even odd even odd even odd even odd
**** ## No column stacking Alternatively, the `colStackAt` rendering configuration parameter may be specified as `Nothing`, indicating that all `Key Val` values are to be specified on separate rows, with no stacked columns. The ASCII form of this is: ``` ____ snip vv ____ | millions | thousands | hundreds | tens | ones | Value | +----------+-----------+----------+------+------+-------+ | 0 | 0 | 1 | 2 | 0 | even | | | | | | 1 | odd | | | | 2 | 2 | 0 | even | | | | | | 1 | odd | | | 1 | 1 | 2 | 0 | even | | | | | | 1 | odd | | | | 2 | 2 | 0 | even | | | | | | 1 | odd | | | 2 | 1 | 2 | 0 | even | | | | | | 1 | odd | | | | 2 | 2 | 0 | even | | | | | | 1 | odd | | 1 | 0 | 1 | 2 | 0 | even | | | | | | 1 | odd | | | | 2 | 2 | 0 | even | | | | | | 1 | odd | | | 1 | 1 | 2 | 0 | even | | | | | | 1 | odd | | | | 2 | 2 | 0 | even | | | | | | 1 | odd | | | 2 | 1 | 2 | 0 | even | | | | | | 1 | odd | | | | 2 | 2 | 0 | even | | | | | | 1 | odd | | 2 | 0 | 1 | 2 | 0 | even | | | | | | 1 | odd | | | | 2 | 2 | 0 | even | | | | | | 1 | odd | | | 1 | 1 | 2 | 0 | even | | | | | | 1 | odd | | | | 2 | 2 | 0 | even | | | | | | 1 | odd | | | 2 | 1 | 2 | 0 | even | | | | | | 1 | odd | | | | 2 | 2 | 0 | even | | | | | | 1 | odd | ____ snip ^^ ____ ``` and the HTML form is ****
millions thousands hundreds tens ones Value
0 0 1 2 0 even
1 odd
2 2 0 even
1 odd
1 1 2 0 even
1 odd
2 2 0 even
1 odd
2 1 2 0 even
1 odd
2 2 0 even
1 odd
1 0 1 2 0 even
1 odd
2 2 0 even
1 odd
1 1 2 0 even
1 odd
2 2 0 even
1 odd
2 1 2 0 even
1 odd
2 2 0 even
1 odd
2 0 1 2 0 even
1 odd
2 2 0 even
1 odd
1 1 2 0 even
1 odd
2 2 0 even
1 odd
2 1 2 0 even
1 odd
2 2 0 even
1 odd
**** More examples can be found in the examples subdirectory, including: * [Zoo Inventory](examples/zoo.md) kvitable-1.0.3.0/Setup.hs0000644000000000000000000000005607346545000013300 0ustar0000000000000000import Distribution.Simple main = defaultMain kvitable-1.0.3.0/examples/0000755000000000000000000000000007346545000013461 5ustar0000000000000000kvitable-1.0.3.0/examples/hundreds_all.md0000644000000000000000000002326407346545000016456 0ustar0000000000000000This example uses the same generated `KVITable` data that was described in the README, but formats the output differently. ```haskell render (defaultRenderConfig { KTR.sortKeyVals = True , KTR.rowRepeat = False , KTR.hideBlankCols = False , KTR.hideBlankRows = False , KTR.equisizedCols = False , KTR.colStackAt = Just "hundreds" } ) nestedTable ``` Here, the hiding of blank rows and columns is disabled, which makes the table significantly larger: ``` ____ snip vv ____ | millions | thousands | _____ 0 _____ | _______ 1 ________ | _______ 2 ________ | <- hundreds | | | _ 0 _ | _ 2 _ | _ 0 _ | ___ 2 ____ | _ 0 _ | ___ 2 ____ | <- tens | | | 0 | 1 | 0 | 1 | 0 | 1 | 0 | 1 | 0 | 1 | 0 | 1 | <- ones +----------+-----------+---+---+---+---+---+---+------+-----+---+---+------+-----+ | 0 | 0 | | | | | | | even | odd | | | even | odd | | | 1 | | | | | | | even | odd | | | even | odd | | | 2 | | | | | | | even | odd | | | even | odd | | 1 | 0 | | | | | | | even | odd | | | even | odd | | | 1 | | | | | | | even | odd | | | even | odd | | | 2 | | | | | | | even | odd | | | even | odd | | 2 | 0 | | | | | | | even | odd | | | even | odd | | | 1 | | | | | | | even | odd | | | even | odd | | | 2 | | | | | | | even | odd | | | even | odd | ____ snip ^^ ____ ``` *****
millions thousands 0 1 2  ←hundreds
0 2 0 2 0 2  ←tens
0 1 0 1 0 1 0 1 0 1 0 1  ←ones
0 0 even odd even odd
1 even odd even odd
2 even odd even odd
1 0 even odd even odd
1 even odd even odd
2 even odd even odd
2 0 even odd even odd
1 even odd even odd
2 even odd even odd
***** ## Equisized columns For the ASCII layout, the rendering configuration can set `equisizedCols` to `True` to keep each column the same size. ``` ____ snip vv ____ | millions | thousands | ___________ 0 ___________ | ___________ 1 ___________ | ___________ 2 ___________ | <- hundreds | | | ____ 0 ____ | ____ 2 ____ | ____ 0 ____ | ____ 2 ____ | ____ 0 ____ | ____ 2 ____ | <- tens | | | 0 | 1 | 0 | 1 | 0 | 1 | 0 | 1 | 0 | 1 | 0 | 1 | <- ones +----------+-----------+------+------+------+------+------+------+------+------+------+------+------+------+ | 0 | 0 | | | | | | | even | odd | | | even | odd | | | 1 | | | | | | | even | odd | | | even | odd | | | 2 | | | | | | | even | odd | | | even | odd | | 1 | 0 | | | | | | | even | odd | | | even | odd | | | 1 | | | | | | | even | odd | | | even | odd | | | 2 | | | | | | | even | odd | | | even | odd | | 2 | 0 | | | | | | | even | odd | | | even | odd | | | 1 | | | | | | | even | odd | | | even | odd | | | 2 | | | | | | | even | odd | | | even | odd | ____ snip ^^ ____ ``` This setting has no effect on the HTML layout; to achieve the same effect for HTML, CSS settings should be used.kvitable-1.0.3.0/examples/zoo.md0000644000000000000000000004272507346545000014624 0ustar0000000000000000In this example, the inventory of various Zoo animals from different City Zoos is maintained in a `KVITable`, where each animal is additionally classified by parameters such as Biome and Diet. The `KVITable` creation is somewhat lengthy due to the size of the inventory; the [SampleTables.hs](../test/SampleTables.hs) file should be consulted for the definition of the `KVITable` `zooTable` and `zooTable2`. Rendering the data without any column stacking, but with multiple row groupings: ``` import Data.KVITable.Render.ASCII render (defaultRenderConfig { sortKeyVals = True , rowRepeat = False , rowGroup = [ "Location", "Biome", "Category" ] }) zooTable2 ``` results in the following: ``` ____ snip vv ____ | Location | Biome | Category | Diet | Name | Subtype | Count | +-----------+----------+----------+-----------+---------+-------------+-------+ | LA | Jungle | Animal | Herbivore | Hippo | | 1 | | |----------+----------+-----------+---------+-------------+-------+ | | Savannah | Animal | Carnivore | Lion | | 4 | | | | | Herbivore | Giraffe | | 2 | | | | | | Rhino | | 3 | +-----------+----------+----------+-----------+---------+-------------+-------+ | Miami | Polar | Bird | Carnivore | Penguin | Gentoo | 20 | | |----------+----------+-----------+---------+-------------+-------+ | | Savannah | Animal | Carnivore | Lion | | 2 | | | | | Herbivore | Giraffe | Reticulated | 3 | +-----------+----------+----------+-----------+---------+-------------+-------+ | New York | Savannah | Animal | Carnivore | Lion | | 3 | +-----------+----------+----------+-----------+---------+-------------+-------+ | San Diego | Jungle | Animal | Omnivore | Bear | Sun | 1 | | |----------+----------+-----------+---------+-------------+-------+ | | Plains | Animal | Omnivore | Bear | Black | 1 | | | | | | | Brown | 1 | | |----------+----------+-----------+---------+-------------+-------+ | | Polar | Animal | Omnivore | Bear | Polar | 1 | | | |----------+-----------+---------+-------------+-------+ | | | Bird | Carnivore | Penguin | Emperor | 8 | | | | | | | Gentoo | 2 | | |----------+----------+-----------+---------+-------------+-------+ | | Savannah | Animal | Carnivore | Lion | | 9 | +-----------+----------+----------+-----------+---------+-------------+-------+ ____ snip ^^ ____ ``` or in HTML (with CSS inherited from the Markdown configuration... imagine how much nicer this could be with your own CSS styling!): ******
Location Biome Category Diet Name Subtype Count
LA Jungle Animal Herbivore Hippo 1
Savannah Animal Carnivore Lion 4
Herbivore Giraffe 2
Rhino 3
Miami Polar Bird Carnivore Penguin Gentoo 20
Savannah Animal Carnivore Lion 2
Herbivore Giraffe Reticulated 3
New York Savannah Animal Carnivore Lion 3
San Diego Jungle Animal Omnivore Bear Sun 1
Plains Animal Omnivore Bear Black 1
Brown 1
Polar Animal Omnivore Bear Polar 1
Bird Carnivore Penguin Emperor 8
Gentoo 2
Savannah Animal Carnivore Lion 9
****** ## With Column Stacking Removing the "Subtype" field from the zoo table and then modifying the rendering configuration to add column stacking on the `"Name"` key `Val`s results in: ``` ____ snip vv ____ | Location | Biome | Category | Diet | Bear | Giraffe | Hippo | Lion | Penguin | Rhino | <- Name +-----------+----------+----------+-----------+------+---------+-------+------+---------+-------+ | LA | Jungle | Animal | Herbivore | | | 1 | | | | | |----------+----------+-----------+------+---------+-------+------+---------+-------+ | | Savannah | Animal | Carnivore | | | | 4 | | | | | | | Herbivore | | 2 | | | | 3 | +-----------+----------+----------+-----------+------+---------+-------+------+---------+-------+ | Miami | Polar | Bird | Carnivore | | | | | 20 | | | |----------+----------+-----------+------+---------+-------+------+---------+-------+ | | Savannah | Animal | Carnivore | | | | 2 | | | | | | | Herbivore | | 3 | | | | | +-----------+----------+----------+-----------+------+---------+-------+------+---------+-------+ | New York | Savannah | Animal | Carnivore | | | | 3 | | | +-----------+----------+----------+-----------+------+---------+-------+------+---------+-------+ | San Diego | Jungle | Animal | Omnivore | 1 | | | | | | | |----------+----------+-----------+------+---------+-------+------+---------+-------+ | | Plains | Animal | Omnivore | 2 | | | | | | | |----------+----------+-----------+------+---------+-------+------+---------+-------+ | | Polar | Animal | Omnivore | 1 | | | | | | | | |----------+-----------+------+---------+-------+------+---------+-------+ | | | Bird | Carnivore | | | | | 10 | | | |----------+----------+-----------+------+---------+-------+------+---------+-------+ | | Savannah | Animal | Carnivore | | | | 9 | | | +-----------+----------+----------+-----------+------+---------+-------+------+---------+-------+ ____ snip ^^ ____ ``` And as HTML: ******
Location Biome Category Diet Bear Giraffe Hippo Lion Penguin Rhino  ←Name
LA Jungle Animal Herbivore 1
Savannah Animal Carnivore 4
Herbivore 2 3
Miami Polar Bird Carnivore 20
Savannah Animal Carnivore 2
Herbivore 3
New York Savannah Animal Carnivore 3
San Diego Jungle Animal Omnivore 1
Plains Animal Omnivore 2
Polar Animal Omnivore 1
Bird Carnivore 10
Savannah Animal Carnivore 9
******kvitable-1.0.3.0/kvitable.cabal0000644000000000000000000000570007346545000014432 0ustar0000000000000000cabal-version: >=1.10 name: kvitable version: 1.0.3.0 synopsis: Key/Value Indexed Table container and formatting library description: . Allows creation of a table from a set of of Key+Value Indices. This differs from the standard 'Map' structure in that the 'Map' simply indexes by value but the KVI table indexes by a heterogeneous list of keys along with their associated values. This effectively creates an N-dimensional table, where @N=Product(Count(Values[key]))@. The table contents can be sparse. . This library also provides the ability to format multi-dimensional data in a table presentation. The table is automatically formatted and can be output in a number of different styles (ascii, html, etc.) . Multi-dimensional data is more difficult to represent than simple two-dimensional data; this package provides the ability to select which dimensions should be represented as sub-rows and which dimensions should be represented as sub-columns. See the README for examples -- bug-reports: license: ISC license-file: LICENSE author: Kevin Quick maintainer: kquick@galois.com copyright: Kevin Quick, 2021-2022 category: Text homepage: https://github.com/kquick/kvitable build-type: Simple tested-with: GHC ==8.6.5 GHC ==8.8.4 GHC ==8.10.7 GHC ==9.0.1 GHC ==9.2.7 GHC ==9.4.4 GHC ==8.6.1 extra-source-files: CHANGELOG.md , examples/hundreds_all.md , examples/zoo.md , README.md library hs-source-dirs: src default-language: Haskell2010 GHC-options: -Wall -Wcompat -Wincomplete-uni-patterns -Wpartial-fields -fhide-source-paths -- other-extensions: exposed-modules: Data.KVITable , Data.KVITable.Render , Data.KVITable.Render.ASCII , Data.KVITable.Render.HTML -- other-modules: build-depends: base >=4.12 && <4.20 , containers , lucid >= 2.9 && < 2.12 , microlens >= 0.4 && < 0.5 , prettyprinter >= 1.7 && < 1.8 , text test-suite test-kvitable type: exitcode-stdio-1.0 hs-source-dirs: test default-language: Haskell2010 GHC-options: -fhide-source-paths main-is: TestMain.hs other-modules: AsciiRenderTests , HTMLRenderTests , SampleTables , TestQQDefs build-depends: base , html-parse , kvitable , microlens , pretty-show , tasty , tasty-hunit , template-haskell , text kvitable-1.0.3.0/src/Data/0000755000000000000000000000000007346545000013303 5ustar0000000000000000kvitable-1.0.3.0/src/Data/KVITable.hs0000644000000000000000000003163207346545000015245 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeFamilies #-} -- | The 'KVITable' is similar to a 'Data.Map', but the keys for a -- 'KVITable' are made up of sequences of @Key=Val@ values. The -- primary use of a 'KVITable' is for rendering the information in -- various configurations and formats, although it may be used like -- any other container. module Data.KVITable ( KVITable(KVITable) , Key , KeyVal , KeyVals , KeySpec , fromList , toList , Data.KVITable.lookup , keyVals , keyValGen , valueColName , insert , foldlInsert , Data.KVITable.filter , adjust , adjustWithKey , delete , update , updateWithKey , rows ) where import Data.Function ( on ) import qualified Data.List as L import qualified Data.Map as Map import Data.Text ( Text ) import qualified GHC.Exts import Lens.Micro ( Lens' ) -- | The core KeyValue Indexed Table. This table is similar to a Map, -- but the values are indexed by a list of Key+Value combinations, and -- the table contents can be sparse. -- KWQ: make fields strict? check with tasty-bench data KVITable v = KVITable { keyvals :: KeyVals -- ^ allowed value for keys (in order) , keyvalGen :: Key -> KeyVal -- ^ Function to generate the keyval if the keyval is not -- explicitly provided. Provided with the Key and returns the -- KeyVal that should be used. , contents :: Map.Map KeySpec v -- ^ Internal contents of the KVITable -- The invariant for the KVITable contents is that each KeySpec -- contains all keys listed in keyvals (in the same order) with -- the defaultKeyVal for any keys not explicitly provided for that -- value. , valuecolName :: Text -- ^ name of the value cells } instance Eq v => Eq (KVITable v) where -- n.b. keyvals (i.e. metadata) are _not_ used for equality, only contents (==) = (==) `on` contents instance Show v => Show (KVITable v) where show t = "KVITable {" <> " keyvals = " <> show (keyvals t) <> " contents = " <> show (contents t) <> ", valuecolName = " <> show (valuecolName t) <> "}" -- | The 'Key' is the first half of a tuple that makes up the list of -- keys (the 'KeySpec'). The second half is the 'KeyVal'. type Key = Text -- | The 'KeyVal' is the first half of a tuple that makes up the list of -- keys (the 'KeySpec'). The first half is the 'Key'. type KeyVal = Text -- | The 'KeySpec' is the list of tuples and defines the unique key -- for a value in the 'KVITable'. type KeySpec = [ (Key, KeyVal ) ] -- | The 'KeyVals' specifies all valid values for a particular 'Key' -- in the 'KVITable'. The set of 'KeyVals' can be provided at the -- initialization of the 'KVITable' to ensure specific values are -- considered (especially if rendering includes blank rows or -- columns); if entries are added to the table with a 'KeyVal' -- previously unknown for the 'Key', the 'KeyVals' for the table is -- automatically updated to include the new 'KeyVal'. type KeyVals = [ (Key, [KeyVal]) ] -- | The KVITable semigroup is left biased (same as Data.Map). Note -- that joining tables can result in a table that has a different -- keyVals sequence than either input table. instance Semigroup (KVITable v) where a <> b = foldl foldlInsert (mempty { valuecolName = valuecolName a , keyvals = keyvals a }) (toList b <> toList a) instance Monoid (KVITable v) where mempty = KVITable { keyvals = mempty , keyvalGen = const "" , contents = mempty , valuecolName = "Value" } instance Functor KVITable where fmap f t = KVITable { contents = fmap f (contents t) , keyvalGen = keyvalGen t , keyvals = keyvals t , valuecolName = valuecolName t } instance Foldable KVITable where foldMap f = foldMap f . contents instance Traversable KVITable where traverse f t = (\c -> KVITable { contents = c , valuecolName = valuecolName t , keyvals = keyvals t , keyvalGen = keyvalGen t } ) <$> traverse f (contents t) instance GHC.Exts.IsList (KVITable v) where type Item (KVITable v) = (KeySpec, v) fromList = foldl foldlInsert mempty toList = GHC.Exts.toList . contents -- | Converts a list of @([(Key,Val)], Value)@ tuples to a KVI table. fromList :: [ GHC.Exts.Item (KVITable v) ] -> KVITable v fromList = GHC.Exts.fromList -- | Converts a KVI table to a list of @([(Key,Val)], Value)@ tuples. toList :: KVITable v -> [ GHC.Exts.Item (KVITable v) ] toList = GHC.Exts.toList -- | Fetch or set the keyvals list via lenses. Note that setting the -- keyval list will drop any current contents in the table that do not -- have entries in the keyvals list. keyVals :: Lens' (KVITable v) KeyVals keyVals f t = (\kvs -> t { keyvals = kvs , contents = let inKVS spec _ = inkv spec kvs inkv [] [] = True inkv ((sk,sv):srs) ((k,vs):kv) | sk == k && sv `elem` vs = inkv srs kv inkv _ _ = False in Map.filterWithKey inKVS (contents t) } ) <$> f (keyvals t) -- | Fetch or set the default 'KeyVal' generator for this 'KVITable' keyValGen :: Lens' (KVITable v) (Key -> KeyVal) keyValGen f t = (\n -> t { keyvalGen = n } ) <$> f (keyvalGen t) -- | Fetch or set the column name for the actual value cell in the -- 'KVITable'. valueColName :: Lens' (KVITable v) Text valueColName f t = (\n -> t { valuecolName = n } ) <$> f (valuecolName t) -- | Retrieve an entry from the KVITable given a keyspec. The keyspec -- may be minimally specified (i.e. it does not need to contain keys -- whose value is the default key value) and it may present the keys -- out of order and the lookup will still succeed (if there is a value -- for the normalized keyspec), but it will be faster to use the -- normalized key directly. lookup :: KeySpec -> KVITable v -> Maybe v lookup keyspec t = case Map.lookup keyspec $ contents t of Just v -> Just v Nothing -> -- keyspec might be under-specified or in a different order let ks = normalizeKeySpec t keyspec in Map.lookup ks $ contents t normalizeKeySpec :: KVITable v -> KeySpec -> KeySpec normalizeKeySpec t keyspec = let keyandval s (k,vs) = case L.lookup k keyspec of Just v -> if v `elem` vs then s <> [(k,v)] else s -- no level added, so this should never match in the Map Nothing -> s <> [(k, keyvalGen t k)] in foldl keyandval [] (keyvals t) -- | Inserts a new cell value into the table at the specified keyspec -- location. The keyspec may be minimally specified and out-of-order. -- -- This may be an expensive operation if it has to extend the keyvals -- for the table. In general, insertion is expected to be less -- frequent than lookups so computation costs are biased towards the -- insertion operation. insert :: KeySpec -> v -> KVITable v -> KVITable v insert keyspec val t = endset t val (keyvals t) keyspec [] [] remainingKeyValDefaults :: KVITable v -> [(Key,a)] -> KeySpec remainingKeyValDefaults t = fmap (\(k,_) -> (k, keyvalGen t k)) addDefVal :: KVITable v -> (Key, [KeyVal]) -> (Key, [KeyVal]) addDefVal t e@(k,vs) = if (keyvalGen t k) `elem` vs then e else (k, keyvalGen t k : vs) endset :: KVITable v -> v -> KeyVals -> KeySpec -> KeySpec -> KeyVals -> KVITable v endset t val rkv [] tspec kvbld = -- Reached the end of the user's keyspec but there are more -- known keyvals in this KVITable, so add the entry with the -- default KeyVal for the remaining keyspec (and ensure the -- default KeyVal is listed in the table's keyvals). let spec = tspec <> remainingKeyValDefaults t rkv in t { contents = Map.insert spec val (contents t) , keyvals = kvbld <> (addDefVal t <$> rkv) } endset t val [] spec tspec kvbld = -- Reached the end of the known keyvals for this table but the -- user's keyspec has additional elements. This should extend -- the tables keyvals with the remaining keyspec; also all -- existing table values should be pushed out to use the -- default values for the new keys in their keyspec. let spec' = tspec <> spec keySpecElemToKeyVals (k,v) = (k, if null curTblList then [v] else [v, keyvalGen t k]) keyvals' = kvbld <> (keySpecElemToKeyVals <$> spec) curTblList = Map.toList $ contents t defaultsExtension = remainingKeyValDefaults t spec updTblList = fmap (\(ks,v) -> (ks <> defaultsExtension, v)) curTblList in t { contents = Map.insert spec' val $ Map.fromList updTblList , keyvals = keyvals' } endset t val kvs@((k,vs):rkvs) ((sk,sv):srs) tspec kvbld = if k == sk then let kv' = if sv `elem` vs then kvbld <> [(k, vs)] else kvbld <> [(k, sv : vs)] in endset t val rkvs srs (tspec <> [(k,sv)]) kv' else -- re-arrange user spec crudely by throwing invalid -- candidates to the end and retrying. This isn't -- necessarily efficient, but keyspecs aren't expected to be -- longer than about a dozen entries. if sk `elem` (fst <$> rkvs) && k `elem` (fst <$> srs) then endset t val kvs (srs <> [(sk,sv)]) tspec kvbld else if any (`elem` (fst <$> kvs)) (fst <$> srs) then endset t val kvs (srs <> [(sk,sv)]) tspec kvbld else let defVal = keyvalGen t k vs' = if defVal `elem` vs then vs else (defVal : vs) in endset t val rkvs ((sk,sv):srs) (tspec <> [(k,defVal)]) (kvbld <> [(k,vs')]) -- | The foldlInsert is a convenience function that can be specified -- as the function argument of a foldl operation over the list form of -- a KVITable to generate the associated KVITable. foldlInsert :: KVITable v -> (KeySpec, v) -> KVITable v foldlInsert t (k,v) = insert k v t -- | Filter 'KVITable' to retain only the elements that satisfy some predicate. filter :: ((KeySpec, v) -> Bool) -> KVITable v -> KVITable v filter f t = foldl chkInsert (emptyClone t) $ toList t where emptyClone o = o { contents = mempty } chkInsert o (k,v) = if f (k,v) then insert k v o else o -- | Delete the value at the specified keyspec location in the -- 'KVITable'. If the keyspec does not exist, the original table is -- returned. delete :: KeySpec -> KVITable v -> KVITable v delete k t = t { contents = Map.delete (normalizeKeySpec t k) $ contents t } -- | Adjust a value at the specified keyspec; return the original -- 'KVITable' if that keyspec is not found in the table. adjustWithKey :: (KeySpec -> v -> v) -> KeySpec -> KVITable v -> KVITable v adjustWithKey f k t = t { contents = Map.adjustWithKey f (normalizeKeySpec t k) $ contents t } -- | Adjust a value at the specified keyspec; return the original -- 'KVITable' if that keyspec is not found in the table. adjust :: (v -> v) -> KeySpec -> KVITable v -> KVITable v adjust f k t = t { contents = Map.adjust f (normalizeKeySpec t k) $ contents t } -- | Update the 'KVITable' to remove or set a new value for the -- specified entry if the updating function returns @Nothing@ or @Just -- v@, respectively. The update function is passed both the keyspec -- and the current value at that key. If the value does not exist in -- the table, the original table is returned. updateWithKey :: (KeySpec -> v -> Maybe v) -> KeySpec -> KVITable v -> KVITable v updateWithKey f k t = t { contents = Map.updateWithKey f (normalizeKeySpec t k) $ contents t } -- | Update the 'KVITable' to remove or set a new value for the -- specified entry if the updating function returns @Nothing@ or @Just -- v@, respectively. The update function is passed the value for the -- keyspec to be updated. If the value does not exist in the table, -- the original table is returned. update :: (v -> Maybe v) -> KeySpec -> KVITable v -> KVITable v update f k t = t { contents = Map.update f (normalizeKeySpec t k) $ contents t } -- | The 'rows' function returns a set of rows for the 'KVITable' as a -- list structure, where each list entry is a different row. A row -- consists of the /values/ of the keys for that row followed by the -- value of the entry (to get the names of the keys, use 'keyVals'). rows :: KVITable v -> [ ([KeyVal], v) ] rows t = go (keyvals t) [] where go [] spec = let spec' = reverse spec in case Map.lookup spec' (contents t) of Nothing -> [] Just v -> [ (snd <$> spec', v) ] go ((key, vals):kvs) spec = concatMap (\v -> let spec' = (key,v):spec in go kvs spec') vals kvitable-1.0.3.0/src/Data/KVITable/0000755000000000000000000000000007346545000014704 5ustar0000000000000000kvitable-1.0.3.0/src/Data/KVITable/Render.hs0000644000000000000000000000603207346545000016460 0ustar0000000000000000-- | Common definitions (and support functions) for rendering a -- 'KVITable'. module Data.KVITable.Render ( RenderConfig(..) , defaultRenderConfig , sortWithNums ) where import Data.KVITable import qualified Data.List as L import Data.Text ( Text ) import qualified Data.Text as T -- | Returns the default rendering configuration, to be used with a -- format-specific @render@ call. defaultRenderConfig :: RenderConfig defaultRenderConfig = RenderConfig { hideBlankRows = True , hideBlankCols = True , equisizedCols = True , sortKeyVals = False , colStackAt = Nothing , rowRepeat = True , rowGroup = [] , caption = Nothing } -- | The 'RenderConfig' specifies the various controls and -- configurations used when rendering a 'KVITable' in various formats. -- The 'RenderConfig' is global t oall formats, although some of the -- fields in the 'RenderConfig' will be ignored as not-applicable by -- some formats. data RenderConfig = RenderConfig { hideBlankRows :: Bool -- ^ 'True' (default) removes rows for which there are no values , hideBlankCols :: Bool -- ^ 'True' (default) removes columns for which there are no values , equisizedCols :: Bool -- ^ 'True' (default) to maintain a consistent column width, -- otherwise the columns are shunk to the minimum size needed to -- display the title and values. Not applicable for some backends -- (e.g. HTML) where the backend provides table rendering -- functionality. , sortKeyVals :: Bool -- ^ 'True' (default is False) to sort the KeyVal entries when -- rendering a table. , colStackAt :: Maybe Key -- ^ Column key to begin stacking keys in columns and sub-columns -- rather than creating additional sub-rows. , rowRepeat :: Bool -- ^ 'True' (default) if an identical 'KeyVal' is to be repeated -- in subsequent applicable rows. , rowGroup :: [Key] -- ^ List of Key names that should by grouped by inserting -- horizontal row lines between KeyVals , caption :: Maybe Text -- ^ Caption to render for table for backends which support -- captions; otherwise ignored. } -- | Sorting for KeyVals. If the value starts or ends with a digit, -- then this should do a rough numeric sort on the expectation that -- the digits represent a version or some other numeric value. As an -- approximation of a numeric sort, sort by word size and then string -- value. This will result in [ "1", "2", "10", "50", "400" ], but -- would fail with [ "v1.0", "v2.0", "v3.0", "v2.0.5", "v1.0.0.3" ], -- but it's a reasonably fast heuristic and probably better than a -- straight ascii sort. -- -- This function is used by the 'KVITable' rendering functions. sortWithNums :: [KeyVal] -> [KeyVal] sortWithNums kvs = let skvs = zip (rank <$> kvs) kvs rank e = if (not $ T.null e) && or [ T.head e `elem` ['0'..'9'] , T.last e `elem` ['0'..'9'] ] then T.length e else 0 in snd <$> L.sort skvs kvitable-1.0.3.0/src/Data/KVITable/Render/0000755000000000000000000000000007346545000016123 5ustar0000000000000000kvitable-1.0.3.0/src/Data/KVITable/Render/ASCII.hs0000644000000000000000000002507007346545000017313 0ustar0000000000000000{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeOperators #-} -- | This module provides the 'KVITable' 'render' function for -- rendering the table in a plain ASCII format. module Data.KVITable.Render.ASCII ( render -- re-export Render definitions to save the caller an additional import , RenderConfig(..) , defaultRenderConfig ) where import qualified Data.List as L import Data.Maybe ( fromMaybe, isNothing ) import Data.Text ( Text ) import qualified Data.Text as T import Lens.Micro ( (^.) ) import qualified Prettyprinter as PP import Data.KVITable import Data.KVITable.Render import Prelude hiding ( lookup ) -- | Renders the specified table in ASCII format, using the specified -- 'RenderConfig' controls. render :: PP.Pretty v => RenderConfig -> KVITable v -> Text render cfg t = let kseq = fst <$> t ^. keyVals (fmt, hdr) = renderHdrs cfg t kseq bdy = renderSeq cfg fmt kseq t in T.unlines $ hdr <> bdy ---------------------------------------------------------------------- data FmtLine = FmtLine [Int] Sigils Sigils -- last is for sepline data Sigils = Sigils { sep :: Text, pad :: Text, cap :: Text } fmtLine :: [Int] -> FmtLine fmtLine cols = FmtLine cols Sigils { sep = "|", pad = " ", cap = "_" } Sigils { sep = "+", pad = "-", cap = "_" } fmtColCnt :: FmtLine -> Int fmtColCnt (FmtLine cols _ _) = length cols perColOvhd :: Int perColOvhd = 2 -- pad chars on either side of each column's entry -- | Formatted width of output, including pad on either side of each -- column's value (but not the outer set), and a separator between columns. -- -- Note that a column size of 0 indicates that hideBlankCols is active -- and the column was found to be empty of values, so it should not be -- counted. fmtWidth :: FmtLine -> Int fmtWidth (FmtLine cols _ _) = let cols' = L.filter (/= 0) cols in sum cols' + ((perColOvhd + 1) * (length cols' - 1)) fmtEmptyCols :: FmtLine -> Bool fmtEmptyCols (FmtLine cols _ _) = sum cols == 0 fmtAddColLeft :: Int -> FmtLine -> FmtLine fmtAddColLeft leftCol (FmtLine cols s s') = FmtLine (leftCol : cols) s s' data FmtVal = Separator | TxtVal Text | CenterVal Text fmtRender :: FmtLine -> [FmtVal] -> Text 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 val in l <> T.concat [ sig pad fld <> (case fld of Separator -> T.pack (replicate sz '-') TxtVal v -> T.pack (replicate (sz - T.length v) ' ') <> v CenterVal t -> let (w,e) = (sz - T.length t - 2) `divMod` 2 m = cap sigils ls = T.replicate (w + 0) m rs = T.replicate (w + e) m in if T.length t + 2 >= sz then (T.replicate (sz - T.length t) " ") <> t else ls <> " " <> t <> " " <> rs ) <> sig pad fld <> sig sep fld -- KWQ or if next fld is Nothing | (sz,fld) <- zip cols vals, sz /= 0 ] else error ("Insufficient arguments (" <> show (length vals) <> ")" <> " for FmtLine " <> show (length cols)) ---------------------------------------------------------------------- data HeaderLine = HdrLine FmtLine HdrVals Trailer type HdrVals = [FmtVal] type Trailer = Text hdrFmt :: HeaderLine -> FmtLine hdrFmt (HdrLine fmt _ _) = fmt renderHdrs :: PP.Pretty v => RenderConfig -> KVITable v -> [Key] -> (FmtLine, [Text]) renderHdrs cfg t keys = ( lastFmt , [ fmtRender fmt hdrvals <> (if T.null trailer then "" else (" <- " <> trailer)) | (HdrLine fmt hdrvals trailer) <- hrows ] <> [ fmtRender lastFmt (replicate (fmtColCnt lastFmt) Separator) ]) where hrows = hdrstep cfg t keys lastFmt = case reverse hrows of [] -> fmtLine [] (hrow:_) -> hdrFmt hrow hdrstep :: PP.Pretty v => RenderConfig -> KVITable v -> [Key] -> [HeaderLine] hdrstep _cfg t [] = -- colStackAt wasn't recognized, so devolve into a non-colstack table let valcoltxt = t ^. valueColName valcoltsz = T.length valcoltxt valsizes = length . show . PP.pretty . snd <$> toList t valwidth = maximum $ valcoltsz : valsizes in [ HdrLine (fmtLine [valwidth]) [TxtVal valcoltxt] "" ] hdrstep cfg t (key:keys) = if colStackAt cfg == Just key then hdrvalstep cfg t [] (key:keys) -- switch to column-stacking mode else let keyw = maximum ( T.length key : fmap T.length (fromMaybe [] $ L.lookup key $ t ^. keyVals) ) mkhdr (hs, v) (HdrLine fmt hdrvals trailer) = ( HdrLine (fmtAddColLeft keyw fmt) (TxtVal v : hdrvals) trailer : hs , "") in reverse $ fst $ foldl mkhdr ([], key) $ hdrstep cfg t keys -- first line shows hdrval for non-colstack'd columns, others are blank hdrvalstep :: PP.Pretty v => RenderConfig -> KVITable v -> KeySpec -> [Key] -> [HeaderLine] hdrvalstep _ _ _ [] = error "ASCII hdrvalstep with empty keys after matching colStackAt -- impossible" hdrvalstep cfg t steppath (key:[]) = let titles = ordering $ fromMaybe [] $ L.lookup key $ t ^. keyVals ordering = if sortKeyVals cfg then sortWithNums else id cvalWidths kv = fmap (length . show . PP.pretty . snd) $ L.filter ((L.isSuffixOf (steppath <> [(key, kv)])) . fst) $ toList t colWidth kv = let cvw = cvalWidths kv in if and [ hideBlankCols cfg, sum cvw == 0 ] then 0 else maximum $ T.length kv : cvw cwidths = fmap colWidth titles fmtcols = if equisizedCols cfg then (replicate (length cwidths) (maximum cwidths)) else cwidths in [ HdrLine (fmtLine $ fmtcols) (TxtVal <$> titles) key ] hdrvalstep cfg t steppath (key:keys) = let vals = 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 = let subAtVal v = (T.length v, subhdrsV v) in fmap subAtVal vals 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 $ fmap (uncurry rsz_hdrstack) $ zip szhdrs $ fmap snd subTtlHdrs largest = maximum szexts szhdrs = if equisizedCols cfg && not (hideBlankCols cfg) then replicate (length vals) largest else szexts rsz_hdrstack s vhs = fmap (rsz_hdrs s) vhs rsz_hdrs hw (HdrLine (FmtLine c s j) v r) = let nzCols = L.filter (/= 0) c pcw = sum nzCols + ((perColOvhd + 1) * (length nzCols - 1)) (ew,w0) = let l = length nzCols in if l == 0 then (0,0) else max 0 (hw - pcw) `divMod` length nzCols c' = fst $ foldl (\(c'',n) w -> (c''<>[n+w],ew)) ([],ew+w0) c in HdrLine (FmtLine c' s j) v r hdrJoin hl = foldl hlJoin (HdrLine (fmtLine []) [] "") hl hlJoin (HdrLine (FmtLine c s j) v _) (HdrLine (FmtLine c' _ _) v' r) = HdrLine (FmtLine (c<>c') s j) (v<>v') r tvals = fmap CenterVal vals in HdrLine (fmtLine szhdrs) tvals key : rsz_extsubhdrs renderSeq :: PP.Pretty v => RenderConfig -> FmtLine -> [Key] -> KVITable v -> [Text] renderSeq cfg fmt keys kvitbl = fmtRender fmt . snd <$> asciiRows keys [] where asciiRows :: [Key] -> KeySpec -> [ (Bool, [FmtVal]) ] asciiRows [] path = let v = lookup path kvitbl skip = case v of Nothing -> hideBlankRows cfg Just _ -> False in if skip then [] else [ (False, [ maybe (TxtVal "") TxtVal (T.pack . show . PP.pretty <$> v) ]) ] asciiRows (key:kseq) path | colStackAt cfg == Just key = let filterOrDefaultBlankRows = fmap (fmap defaultBlanks) . if hideBlankRows cfg then L.filter (not . all isNothing . snd) else id defaultBlanks = fmap (\v -> maybe (TxtVal "") TxtVal v) in filterOrDefaultBlankRows $ [ (False, multivalRows (key:kseq) path) ] | otherwise = let subrows keyval = asciiRows kseq $ path <> [ (key, keyval) ] 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) ], if rowRepeat cfg then kv else "") ordering = if sortKeyVals cfg then sortWithNums else id in foldl addSubrows [] $ ordering $ fromMaybe [] $ L.lookup key $ kvitbl ^. keyVals multivalRows :: [Key] -> KeySpec -> [ Maybe Text ] multivalRows (key:[]) path = let ordering = if sortKeyVals cfg then sortWithNums else id keyvals = ordering $ fromMaybe [] $ L.lookup key $ kvitbl ^. keyVals showEnt = T.pack . show . PP.pretty in (\v -> (showEnt <$> (lookup (path <> [(key,v)]) kvitbl))) <$> keyvals multivalRows (key:kseq) path = let ordering = if sortKeyVals cfg then sortWithNums else id keyvals = ordering $ fromMaybe [] $ L.lookup key $ kvitbl ^. keyVals in concatMap (\v -> multivalRows kseq (path <> [(key,v)])) keyvals multivalRows [] _ = error "multivalRows cannot be called with no keys!" kvitable-1.0.3.0/src/Data/KVITable/Render/HTML.hs0000644000000000000000000002444607346545000017235 0ustar0000000000000000{-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-} -- | This module provides the 'KVITable' 'render' function for -- rendering the table in a HTML table format. The various HTML table -- entries have class designators that allow the user to provide CSS -- to adjust the appearance of the table. module Data.KVITable.Render.HTML ( render -- re-export Render definitions to save the caller an additional import , RenderConfig(..) , defaultRenderConfig ) where 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 import qualified Data.Text.Lazy as TL import Lens.Micro ( (^.) ) import Lucid import qualified Prettyprinter as PP import Data.KVITable import Data.KVITable.Render import Prelude hiding ( lookup ) -- | Renders the specified table in HTML format, using the specified -- 'RenderConfig' controls. The output is only the @@ -- definition; it is intended to be embedded in a larger HTML -- document. render :: PP.Pretty v => RenderConfig -> KVITable v -> Text render cfg t = let kseq = fst <$> t ^. keyVals (fmt, hdr) = renderHdrs cfg t kseq bdy = renderSeq cfg fmt kseq t in TL.toStrict $ renderText $ table_ [ class_ "kvitable" ] $ do maybe mempty (caption_ . toHtml) $ Data.KVITable.Render.caption cfg thead_ [ class_ "kvitable_head" ] hdr tbody_ [ class_ "kvitable_body" ] bdy ---------------------------------------------------------------------- data FmtLine = FmtLine [Int] -- colspans, length is # columns instance Semigroup FmtLine where (FmtLine c1) <> (FmtLine c2) = FmtLine $ c1 <> c2 instance Monoid FmtLine where mempty = FmtLine mempty fmtAddColLeft :: Int -> FmtLine -> FmtLine fmtAddColLeft lspan (FmtLine col) = FmtLine $ lspan : col data FmtVal = Val Height LastInGroup Text | Hdr Height LastInGroup Text deriving Show type Height = Int type LastInGroup = Bool type RightLabel = Text fmtRender :: FmtLine -> [FmtVal] -> Maybe RightLabel -> Html () fmtRender (FmtLine cols) vals mbRLabel = do tr_ [ class_ "kvitable_tr" ] $ let excessColCnt = length cols - length vals cell (w,Hdr h l v) = let a = [ [ class_ "kvitable_th" ] , if h == 1 then [] else [ rowspan_ $ T.pack $ show h ] , if w == 1 then [] else [ colspan_ $ T.pack $ show w , class_ " multicol" ] , if l then [ class_ " last_in_group" ] else [] ] in th_ (concat $ reverse a) (toHtml v) cell (w,Val h l v) = let a = [ [ class_ "kvitable_td" ] , if h == 1 then [] else [ rowspan_ $ T.pack $ show h ] , if w == 1 then [] else [ colspan_ $ T.pack $ show w , class_ " multicol" ] , if l then [ class_ " last_in_group" ] else [] ] in td_ (concat $ reverse a) (toHtml v) labelMark = toHtmlRaw (" ←" :: Text) labelHtml = th_ [ class_ "rightlabel kvitable_th" ] . (labelMark <>) . toHtml in do mapM_ cell $ L.filter ((/= 0) . fst) $ zip (drop excessColCnt cols) vals maybe mempty labelHtml mbRLabel ---------------------------------------------------------------------- data HeaderLine = HdrLine FmtLine HdrVals Trailer type HdrVals = [FmtVal] type Trailer = Maybe Text instance Semigroup HeaderLine where (HdrLine fmt1 hv1 t1) <> (HdrLine fmt2 hv2 _) = HdrLine (fmt1 <> fmt2) (hv1 <> hv2) t1 hdrFmt :: HeaderLine -> FmtLine hdrFmt (HdrLine fmt _ _) = fmt renderHdrs :: PP.Pretty v => RenderConfig -> KVITable v -> [Key] -> ( FmtLine, Html () ) 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] -> (NEL.NonEmpty HeaderLine, FmtLine) hdrstep _cfg t [] = ( 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 (nexthdr0 :| nexthdrs, lowestfmt) = hdrstep cfg t keys (HdrLine fmt vals tr) = nexthdr0 fmt' = fmtAddColLeft 1 fmt 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] -> (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 ordering = if sortKeyVals cfg then sortWithNums else id cvalWidths kv = fmap (length . show . PP.pretty . snd) $ L.filter ((L.isSuffixOf (steppath <> [(key, kv)])) . fst) $ toList t cwidth c = if and [ hideBlankCols cfg , 0 == (sum $ cvalWidths c) ] then 0 else 1 fmt = FmtLine $ fmap cwidth titles in ( HdrLine fmt (Hdr 1 False <$> titles) (Just key) :| [], fmt) hdrvalstep cfg t steppath (key:keys) = 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)) ---------------------------------------------------------------------- renderSeq :: PP.Pretty v => RenderConfig -> FmtLine -> [Key] -> KVITable v -> Html () renderSeq cfg fmt keys t = mapM_ (flip (fmtRender fmt) Nothing) $ htmlRows keys [] where mkVal = Val 1 False . T.pack . show . PP.pretty htmlRows :: [Key] -> KeySpec -> [ [FmtVal] ] htmlRows [] path = let v = lookup path t skip = case v of Nothing -> hideBlankRows cfg Just _ -> False row = maybe (Val 1 False "") mkVal v in if skip then [] else [ [row] ] htmlRows (key:kseq) path | colStackAt cfg == Just key = let filterOrDefaultBlankRows = fmap (fmap (maybe (Val 1 False "") id)) . if hideBlankRows cfg then L.filter (not . all isNothing) else id in filterOrDefaultBlankRows $ [ multivalRows (key:kseq) path ] | otherwise = let keyvals = ordering $ fromMaybe [] $ L.lookup key $ t ^. keyVals ordering = if sortKeyVals cfg then sortWithNums else id subrows keyval = htmlRows kseq $ path <> [(key,keyval)] endOfGroup = key `elem` rowGroup cfg addSubrows ret keyval = let sr = subrows keyval in ret <> (fst $ foldl (leftAdd (length sr)) ([],Just keyval) $ reverse $ zip (endOfGroup: L.repeat False) $ reverse sr) leftAdd nrows (acc,mb'kv) (endGrp, subrow) = let sr = setValGrouping endGrp <$> subrow setValGrouping g (Val h g' v) = Val h (g || g') v setValGrouping g (Hdr h g' v) = Hdr h (g || g') v in ( acc <> [ (case mb'kv of Nothing -> sr Just kv -> let w = if rowRepeat cfg then 1 else nrows in Hdr w endOfGroup kv : sr ) ] , if rowRepeat cfg then mb'kv else Nothing) in foldl addSubrows [] keyvals multivalRows [] _ = error "HTML multivalRows cannot be called with no keys!" multivalRows (key:[]) path = let keyvals = ordering $ fromMaybe [] $ L.lookup key $ t ^. keyVals ordering = if sortKeyVals cfg then sortWithNums else id in (\v -> mkVal <$> lookup (path <> [(key,v)]) t) <$> keyvals multivalRows (key:kseq) path = let keyvals = ordering $ fromMaybe [] $ L.lookup key $ t ^. keyVals ordering = if sortKeyVals cfg then sortWithNums else id in concatMap (\v -> multivalRows kseq (path <> [(key,v)])) keyvals kvitable-1.0.3.0/test/0000755000000000000000000000000007346545000012622 5ustar0000000000000000kvitable-1.0.3.0/test/AsciiRenderTests.hs0000644000000000000000000011545107346545000016400 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE TypeApplications #-} module AsciiRenderTests where import Control.Monad ( unless ) import Data.Text ( Text ) import qualified Data.Text as T import Lens.Micro ( (^.), (.~), (%~), (&) ) import Test.Tasty import Test.Tasty.HUnit import SampleTables import TestQQDefs import qualified Data.KVITable as KVI import qualified Data.KVITable.Render as KTR import qualified Data.KVITable.Render.ASCII as KTRA cmpTables :: Text -> Text -> Text -> IO () cmpTables nm actual expected = unless (expected == actual) $ do let dl (e,a) = if e == a then db e else de " ↱" e <> "\n " <> da " ↳" a db b = "| > " <> b de m e = "|" <> m <> "expect> " <> e da m a = "|" <> m <> "actual> " <> a el = T.lines expected al = T.lines actual addnum n l = let nt = T.pack (show n) nl = T.length nt in T.take (4 - nl) " " <> nt <> l let details = ("MISMATCH between " <> T.pack (show $ length el) <> " expected and " <> T.pack (show $ length al) <> " actual for " <> nm) : (fmap (uncurry addnum) $ zip [1..] $ concat $ -- Highly simplistic "diff" output assumes -- correlated lines: added or removed lines just -- cause everything to shown as different from that -- point forward. [ fmap dl $ zip el al , fmap (de "∌ ") $ drop (length al) el , fmap (da "∹ ") $ drop (length el) al ]) assertFailure $ T.unpack $ T.unlines details testAsciiRendering = testGroup "ASCII rendering" $ let kvi0 = mempty :: KVI.KVITable Text cfg0 = KTR.defaultRenderConfig cfgWBlankRows = cfg0 { KTR.hideBlankRows = False } in [ testCase "empty table" $ cmpTables "empty table" (KTRA.render cfg0 kvi0) [sq| **** | Value | +-------+ **** |] , testCase "empty table with blanks" $ cmpTables "empty table" (KTRA.render cfgWBlankRows kvi0) [sq| **** | Value | +-------+ | | **** |] , testCase "empty table with labels" $ let kvi = mempty & KVI.keyVals @Float .~ [ ("foo", []), ("dog", []) ] in cmpTables "empty table with labels" (KTRA.render cfg0 kvi) [sq| **** | foo | dog | Value | +-----+-----+-------+ ****|] , testCase "add key" $ let t0 = mempty & KVI.keyVals .~ [ ("foo", ["bar", "baz"]) ] :: KVI.KVITable Text t1 = KVI.insert [ ("foo", "baz"), ("dog", "woof") ] "yo" $ KVI.insert [ ("foo", "bar") ] "hi" t0 in do KVI.rows t1 @?= [ ([ "bar", "" ], "hi") , ([ "baz", "woof"], "yo") ] cmpTables "add key" (KTRA.render cfg0 t1) [sq| **** | foo | dog | Value | +-----+------+-------+ | bar | | hi | | baz | woof | yo | ****|] , testCase "deep add" $ let t0 = mempty & KVI.keyVals .~ [ ("foo", ["bar", "baz"]) , ("moon", ["beam", "pie"]) ] & KVI.valueColName .~ "says" & KVI.keyValGen .~ const "?" :: KVI.KVITable Text t1 = KVI.insert [ ("foo", "Bill"), ("moon", "Ted"), ("dog", "arf arf") ] "Excellent!" $ KVI.insert [ ("foo", "baz"), ("moon", "beam"), ("dog", "woof") ] "yo" $ KVI.insert [ ("foo", "bar"), ("moon", "pie") ] "hi" t0 in cmpTables "add key" (KTRA.render cfg0 t1) [sq| **** | foo | moon | dog | says | +------+------+---------+------------+ | Bill | Ted | arf arf | Excellent! | | bar | pie | ? | hi | | baz | beam | woof | yo | ****|] , testCase "medium sized table render, sorted" $ cmpTables "medium table" (KTRA.render (cfg0 { KTR.sortKeyVals = True }) mediumKVI) [sq| **** | compiler | debug | optimization | Value | +----------+-------+--------------+-------+ | gcc7 | no | 0 | bad | | gcc7 | no | 1 | good | | gcc7 | yes | 0 | good | | gcc7 | yes | 3 | ugly | | gcc8 | yes | 0 | good | | gcc8 | yes | 1 | bad | | gcc8 | yes | 3 | true | | clang6 | yes | 0 | ok | | clang7 | no | 0 | good | | clang7 | no | 1 | good | | clang7 | no | 3 | good | | clang7 | yes | 3 | good | | clang10 | no | 3 | good | | clang10 | yes | 3 | good | ****|] , testCase "medium sized table render, unsorted" $ cmpTables "medium table" (KTRA.render (cfg0 { KTR.sortKeyVals = False }) mediumKVI) [sq| **** | compiler | debug | optimization | Value | +----------+-------+--------------+-------+ | gcc7 | yes | 0 | good | | gcc7 | yes | 3 | ugly | | gcc7 | no | 0 | bad | | gcc7 | no | 1 | good | | gcc8 | yes | 0 | good | | gcc8 | yes | 1 | bad | | gcc8 | yes | 3 | true | | clang6 | yes | 0 | ok | | clang10 | yes | 3 | good | | clang10 | no | 3 | good | | clang7 | yes | 3 | good | | clang7 | no | 0 | good | | clang7 | no | 1 | good | | clang7 | no | 3 | good | ****|] , testCase "medium table, sorted, blank, row skip, no repeats" $ cmpTables "medium table" (KTRA.render (cfg0 { KTR.sortKeyVals = True , KTR.rowRepeat = False }) mediumKVI) [sq| **** | compiler | debug | optimization | Value | +----------+-------+--------------+-------+ | gcc7 | no | 0 | bad | | | | 1 | good | | | yes | 0 | good | | | | 3 | ugly | | gcc8 | yes | 0 | good | | | | 1 | bad | | | | 3 | true | | clang6 | yes | 0 | ok | | clang7 | no | 0 | good | | | | 1 | good | | | | 3 | good | | | yes | 3 | good | | clang10 | no | 3 | good | | | yes | 3 | good | ****|] , testCase "medium table, sorted, blank row skip, no repeats, group unknown" $ cmpTables "medium table s 0brow 0rep [unknown]" (KTRA.render (cfg0 { KTR.sortKeyVals = True , KTR.rowRepeat = False , KTR.rowGroup = ["unknown"] }) mediumKVI) [sq| **** | compiler | debug | optimization | Value | +----------+-------+--------------+-------+ | gcc7 | no | 0 | bad | | | | 1 | good | | | yes | 0 | good | | | | 3 | ugly | | gcc8 | yes | 0 | good | | | | 1 | bad | | | | 3 | true | | clang6 | yes | 0 | ok | | clang7 | no | 0 | good | | | | 1 | good | | | | 3 | good | | | yes | 3 | good | | clang10 | no | 3 | good | | | yes | 3 | good | ****|] , testCase "medium table, sorted, blank row skip, no repeats, group compiler" $ cmpTables "medium table s 0brow 0rep [unknown]" (KTRA.render (cfg0 { KTR.sortKeyVals = True , KTR.rowRepeat = False , KTR.rowGroup = ["compiler"] }) mediumKVI) [sq| **** | compiler | debug | optimization | Value | +----------+-------+--------------+-------+ | gcc7 | no | 0 | bad | | | | 1 | good | | | yes | 0 | good | | | | 3 | ugly | +----------+-------+--------------+-------+ | gcc8 | yes | 0 | good | | | | 1 | bad | | | | 3 | true | +----------+-------+--------------+-------+ | clang6 | yes | 0 | ok | +----------+-------+--------------+-------+ | clang7 | no | 0 | good | | | | 1 | good | | | | 3 | good | | | yes | 3 | good | +----------+-------+--------------+-------+ | clang10 | no | 3 | good | | | yes | 3 | good | +----------+-------+--------------+-------+ ****|] , testCase "medium table, sorted, blank row skip, no repeats, multi-group" $ cmpTables "medium table s 0brow 0rep [compiler,debug]" (KTRA.render (cfg0 { KTR.sortKeyVals = True , KTR.rowRepeat = False , KTR.rowGroup = ["unknown", "compiler", "unk", "debug", "huh"] }) mediumKVI) [sq| **** | compiler | debug | optimization | Value | +----------+-------+--------------+-------+ | gcc7 | no | 0 | bad | | | | 1 | good | | |-------+--------------+-------+ | | yes | 0 | good | | | | 3 | ugly | +----------+-------+--------------+-------+ | gcc8 | yes | 0 | good | | | | 1 | bad | | | | 3 | true | +----------+-------+--------------+-------+ | clang6 | yes | 0 | ok | +----------+-------+--------------+-------+ | clang7 | no | 0 | good | | | | 1 | good | | | | 3 | good | | |-------+--------------+-------+ | | yes | 3 | good | +----------+-------+--------------+-------+ | clang10 | no | 3 | good | | |-------+--------------+-------+ | | yes | 3 | good | +----------+-------+--------------+-------+ ****|] , testCase "medium table, sorted, blank" $ cmpTables "medium table" (KTRA.render (cfg0 { KTR.sortKeyVals = True , KTR.hideBlankRows = False }) mediumKVI) [sq| **** | compiler | debug | optimization | Value | +----------+-------+--------------+-------+ | gcc7 | no | 0 | bad | | gcc7 | no | 1 | good | | gcc7 | no | 3 | | | gcc7 | yes | 0 | good | | gcc7 | yes | 1 | | | gcc7 | yes | 3 | ugly | | gcc8 | no | 0 | | | gcc8 | no | 1 | | | gcc8 | no | 3 | | | gcc8 | yes | 0 | good | | gcc8 | yes | 1 | bad | | gcc8 | yes | 3 | true | | clang6 | no | 0 | | | clang6 | no | 1 | | | clang6 | no | 3 | | | clang6 | yes | 0 | ok | | clang6 | yes | 1 | | | clang6 | yes | 3 | | | clang7 | no | 0 | good | | clang7 | no | 1 | good | | clang7 | no | 3 | good | | clang7 | yes | 0 | | | clang7 | yes | 1 | | | clang7 | yes | 3 | good | | clang10 | no | 0 | | | clang10 | no | 1 | | | clang10 | no | 3 | good | | clang10 | yes | 0 | | | clang10 | yes | 1 | | | clang10 | yes | 3 | good | ****|] , testCase "medium sized table render, sorted, no blank, colstack unknown" $ cmpTables "medium table s 0blnk colstk=unknown" (KTRA.render (cfg0 { KTR.sortKeyVals = True , KTR.colStackAt = Just "unknown" }) mediumKVI) [sq| **** | compiler | debug | optimization | Value | +----------+-------+--------------+-------+ | gcc7 | no | 0 | bad | | gcc7 | no | 1 | good | | gcc7 | yes | 0 | good | | gcc7 | yes | 3 | ugly | | gcc8 | yes | 0 | good | | gcc8 | yes | 1 | bad | | gcc8 | yes | 3 | true | | clang6 | yes | 0 | ok | | clang7 | no | 0 | good | | clang7 | no | 1 | good | | clang7 | no | 3 | good | | clang7 | yes | 3 | good | | clang10 | no | 3 | good | | clang10 | yes | 3 | good | ****|] , testCase "medium sized table render, sorted, !blank, colstk optimization" $ cmpTables "medium table s 0blnk colstk=optimization" (KTRA.render (cfg0 { KTR.sortKeyVals = True , KTR.hideBlankRows = True , KTR.colStackAt = Just "optimization" }) mediumKVI) [sq| **** | compiler | debug | 0 | 1 | 3 | <- optimization +----------+-------+------+------+------+ | gcc7 | no | bad | good | | | gcc7 | yes | good | | ugly | | gcc8 | yes | good | bad | true | | clang6 | yes | ok | | | | clang7 | no | good | good | good | | clang7 | yes | | | good | | clang10 | no | | | good | | clang10 | yes | | | good | ****|] , testCase "medium, sorted, !blank, !row rpt, rgrp compiler colstk optimization" $ cmpTables "medium table s 0blnk colstk=optimization rowgrp=compiler" (KTRA.render (cfg0 { KTR.sortKeyVals = True , KTR.hideBlankRows = True , KTR.colStackAt = Just "optimization" , KTR.rowRepeat = False , KTR.rowGroup = [ "compiler" ] }) mediumKVI) [sq| **** | compiler | debug | 0 | 1 | 3 | <- optimization +----------+-------+------+------+------+ | gcc7 | no | bad | good | | | | yes | good | | ugly | +----------+-------+------+------+------+ | gcc8 | yes | good | bad | true | +----------+-------+------+------+------+ | clang6 | yes | ok | | | +----------+-------+------+------+------+ | clang7 | no | good | good | good | | | yes | | | good | +----------+-------+------+------+------+ | clang10 | no | | | good | | | yes | | | good | +----------+-------+------+------+------+ ****|] , testCase "medium sized table render, sorted, !blank, equisize, colstack debug" $ cmpTables "medium table s 0blnk equisize colstk=debug" (KTRA.render (cfg0 { KTR.sortKeyVals = True , KTR.hideBlankRows = True , KTR.equisizedCols = True , KTR.colStackAt = Just "debug" }) mediumKVI) [sq| **** | compiler | _______ no _______ | ______ yes _______ | <- debug | | 0 | 1 | 3 | 0 | 1 | 3 | <- optimization +----------+------+------+------+------+------+------+ | gcc7 | bad | good | | good | | ugly | | gcc8 | | | | good | bad | true | | clang6 | | | | ok | | | | clang7 | good | good | good | | | good | | clang10 | | | good | | | good | ****|] , testCase "medium sized table render, sorted, !blank, fitsize, colstack debug" $ cmpTables "medium table s 0blnk fitsize colstk=debug" (KTRA.render (cfg0 { KTR.sortKeyVals = True , KTR.hideBlankRows = True , KTR.equisizedCols = False , KTR.colStackAt = Just "debug" }) mediumKVI) [sq| **** | compiler | _______ no _______ | ______ yes ______ | <- debug | | 0 | 1 | 3 | 0 | 1 | 3 | <- optimization +----------+------+------+------+------+-----+------+ | gcc7 | bad | good | | good | | ugly | | gcc8 | | | | good | bad | true | | clang6 | | | | ok | | | | clang7 | good | good | good | | | good | | clang10 | | | good | | | good | ****|] , testCaseSteps "small table right aligned" $ \step -> let tbl = foldl KVI.foldlInsert (mempty & KVI.valueColName .~ "name" :: KVI.KVITable Text) inp inp = [ ([("id", "2")], "Layla") , ([("id", "3")], "Jack Gabriel") , ([("id", "1")], "Sam") ] in do step "rows" -- generally in insert order (foldr pushes from end) KVI.rows tbl @?= [ (["1"], "Sam") , (["3"], "Jack Gabriel") , (["2"], "Layla") ] step "ASCII rendering unsorted" cmpTables "small table right aligned unsorted" (KTRA.render (cfg0 { KTR.sortKeyVals = False }) tbl) [sq| **** | id | name | +----+--------------+ | 1 | Sam | | 3 | Jack Gabriel | | 2 | Layla | ****|] step "ASCII rendering sorted" cmpTables "small table right aligned sorted" (KTRA.render (cfg0 { KTR.sortKeyVals = True }) tbl) [sq| **** | id | name | +----+--------------+ | 1 | Sam | | 2 | Layla | | 3 | Jack Gabriel | ****|] , testCase "small multi-column float value table rendering" $ let tbl = foldl KVI.foldlInsert (mempty & KVI.valueColName .~ "Annual Rainfall" :: KVI.KVITable Float) inp inp = [ ([("City name", "Adelaide"), ("Area", "1295"), ("Population", "1158259")], 600.5) , ([("City name", "Brisbane"), ("Area", "5905"), ("Population", "1857594")], 1146.4) , ([("City name", "Darwin"), ("Area", "112"), ("Population", "120900")], 1714.7) , ([("City name", "Hobart"), ("Area", "1357"), ("Population", "205556")], 619.5) , ([("City name", "Melbourne"),("Area", "1566"), ("Population", "3806092")], 646.9) , ([("City name", "Perth"), ("Area", "5386"), ("Population", "1554769")], 869.4) , ([("City name", "Sydney"), ("Area", "2058"), ("Population", "4336374")], 1214.8) ] in cmpTables "small table float value table" (KTRA.render (cfg0 { KTR.sortKeyVals = True }) tbl) [sq| **** | City name | Area | Population | Annual Rainfall | +-----------+------+------------+-----------------+ | Adelaide | 1295 | 1158259 | 600.5 | | Brisbane | 5905 | 1857594 | 1146.4 | | Darwin | 112 | 120900 | 1714.7 | | Hobart | 1357 | 205556 | 619.5 | | Melbourne | 1566 | 3806092 | 646.9 | | Perth | 5386 | 1554769 | 869.4 | | Sydney | 2058 | 4336374 | 1214.8 | ****|] , testCase "big table grouped sorted" $ cmpTables "big table grouped sorted" (KTRA.render (cfg0 { KTR.sortKeyVals = True , KTR.rowRepeat = False , KTR.rowGroup = [ "Location", "Biome", "Category" ] }) zooTable2) [uq_f|examples/zoo.md|] , testCase "big table grouped sorted no-subtype colstack" $ let zt = KVI.fromList $ foldl rmvSubtype [] $ KVI.toList zooTable2 rmvSubtype newl (keyspec, v) = let ks = filter (("Subtype" /=) . fst) keyspec in case lookup ks newl of Nothing -> (ks,v) : newl Just v' -> (ks, v' + v) : filter ((ks /=) . fst) newl in cmpTables "big table grouped sorted no-subtype colstack" (KTRA.render (cfg0 { KTR.sortKeyVals = True , KTR.rowRepeat = False , KTR.rowGroup = [ "Location", "Biome", "Category" ] , KTR.colStackAt = Just "Name" , KTR.equisizedCols = False }) zt) [uq2_f|examples/zoo.md|] , testCase "big table grouped sorted equisized" $ cmpTables "big table grouped sorted equisized" (KTRA.render (cfg0 { KTR.sortKeyVals = True , KTR.rowRepeat = False , KTR.hideBlankCols = False , KTR.equisizedCols = True , KTR.rowGroup = [ "Branch" ] , KTR.colStackAt = Just "ghcver" }) testedTable) [sq| # Note: no seplines under system because it wasn't included in the row_group **** | system | Branch | Strategy | ___ ghc844 ____ | ___ ghc865 ____ | ___ ghc882 ____ | ___ ghc890 ____ | <- ghcver | | | | N | Y | N | Y | N | Y | N | Y | <- debug +---------------+------------+------------+--------+--------+--------+--------+--------+--------+--------+--------+ | x86_64-darwin | develop | HEADs | + | | | | | | | | | |------------+------------+--------+--------+--------+--------+--------+--------+--------+--------+ | x86_64-linux | PR-feature | HEADs | | | FAIL*2 | | FAIL*1 | | | | | | | submodules | + | + | + | | FAIL*1 | | | | | |------------+------------+--------+--------+--------+--------+--------+--------+--------+--------+ | | develop | HEADs | + | + | + | | | | | | | | | submodules | + | | | | FAIL*1 | | | | | |------------+------------+--------+--------+--------+--------+--------+--------+--------+--------+ | | master | HEADs | | FAIL*1 | FAIL*1 | | FAIL*1 | | | | | | | submodules | + | FAIL*1 | FAIL*1 | | | | | | | |------------+------------+--------+--------+--------+--------+--------+--------+--------+--------+ ****|] , testCase "big table grouped sorted fitsize colstack=ghcver" $ cmpTables "big table grouped sorted fitsize colstack=ghcver" (KTRA.render (cfg0 { KTR.sortKeyVals = True , KTR.rowRepeat = False , KTR.hideBlankCols = False , KTR.equisizedCols = False , KTR.rowGroup = [ "Branch" ] , KTR.colStackAt = Just "ghcver" }) testedTable) [sq| # Note: no seplines under system because it wasn't included in the row_group **** | system | Branch | Strategy | _ ghc844 _ | _ ghc865 _ | _ ghc882 _ | ghc890 | <- ghcver | | | | N | Y | N | Y | N | Y | N | Y | <- debug +---------------+------------+------------+---+--------+--------+---+--------+---+----+---+ | x86_64-darwin | develop | HEADs | + | | | | | | | | | |------------+------------+---+--------+--------+---+--------+---+----+---+ | x86_64-linux | PR-feature | HEADs | | | FAIL*2 | | FAIL*1 | | | | | | | submodules | + | + | + | | FAIL*1 | | | | | |------------+------------+---+--------+--------+---+--------+---+----+---+ | | develop | HEADs | + | + | + | | | | | | | | | submodules | + | | | | FAIL*1 | | | | | |------------+------------+---+--------+--------+---+--------+---+----+---+ | | master | HEADs | | FAIL*1 | FAIL*1 | | FAIL*1 | | | | | | | submodules | + | FAIL*1 | FAIL*1 | | | | | | | |------------+------------+---+--------+--------+---+--------+---+----+---+ ****|] , testCase "big table grouped sorted fitsize colstack=Strategy" $ cmpTables "big table grouped sorted fitsize colstack=Strategy" (KTRA.render (cfg0 { KTR.sortKeyVals = True , KTR.rowRepeat = False , KTR.hideBlankCols = False , KTR.equisizedCols = False , KTR.rowGroup = [ "Branch" ] , KTR.colStackAt = Just "Strategy" }) testedTable) [sq| # Note: no seplines under system because it wasn't included in the row_group **** | system | Branch | ___________________ HEADs ___________________ | ________________ submodules _________________ | <- Strategy | | | _ ghc844 _ | _ ghc865 _ | _ ghc882 _ | ghc890 | _ ghc844 _ | _ ghc865 _ | _ ghc882 _ | ghc890 | <- ghcver | | | N | Y | N | Y | N | Y | N | Y | N | Y | N | Y | N | Y | N | Y | <- debug +---------------+------------+---+--------+--------+---+--------+---+----+---+---+--------+--------+---+--------+---+----+---+ | x86_64-darwin | develop | + | | | | | | | | | | | | | | | | | |------------+---+--------+--------+---+--------+---+----+---+---+--------+--------+---+--------+---+----+---+ | x86_64-linux | PR-feature | | | FAIL*2 | | FAIL*1 | | | | + | + | + | | FAIL*1 | | | | | |------------+---+--------+--------+---+--------+---+----+---+---+--------+--------+---+--------+---+----+---+ | | develop | + | + | + | | | | | | + | | | | FAIL*1 | | | | | |------------+---+--------+--------+---+--------+---+----+---+---+--------+--------+---+--------+---+----+---+ | | master | | FAIL*1 | FAIL*1 | | FAIL*1 | | | | + | FAIL*1 | FAIL*1 | | | | | | | |------------+---+--------+--------+---+--------+---+----+---+---+--------+--------+---+--------+---+----+---+ ****|] , testCase "nested table hide=blankRows,blankCols colstack=ones" $ cmpTables "nested table hide=blankRows,blankCols colstack=ones" (KTRA.render (cfg0 { KTR.sortKeyVals = True , KTR.rowRepeat = False , KTR.hideBlankCols = True , KTR.hideBlankRows = True , KTR.equisizedCols = False , KTR.colStackAt = Just "ones" }) nestedTable) [sq| **** | millions | thousands | hundreds | tens | 0 | 1 | <- ones +----------+-----------+----------+------+------+-----+ | 0 | 0 | 1 | 2 | even | odd | | | | 2 | 2 | even | odd | | | 1 | 1 | 2 | even | odd | | | | 2 | 2 | even | odd | | | 2 | 1 | 2 | even | odd | | | | 2 | 2 | even | odd | | 1 | 0 | 1 | 2 | even | odd | | | | 2 | 2 | even | odd | | | 1 | 1 | 2 | even | odd | | | | 2 | 2 | even | odd | | | 2 | 1 | 2 | even | odd | | | | 2 | 2 | even | odd | | 2 | 0 | 1 | 2 | even | odd | | | | 2 | 2 | even | odd | | | 1 | 1 | 2 | even | odd | | | | 2 | 2 | even | odd | | | 2 | 1 | 2 | even | odd | | | | 2 | 2 | even | odd | ****|] , testCase "nested table colstack=tens" $ cmpTables "nested table colstack=tens" (KTRA.render (cfg0 { KTR.sortKeyVals = True , KTR.rowRepeat = False , KTR.hideBlankCols = True , KTR.hideBlankRows = True , KTR.equisizedCols = False , KTR.colStackAt = Just "tens" }) nestedTable) -- Note: the nestedTable declares a KeyVal of 0 for each key; -- without hideBlankCols true, this test would show a 0 value -- column for the tens stacked column. [sq| **** | millions | thousands | hundreds | ___ 2 ____ | <- tens | | | | 0 | 1 | <- ones +----------+-----------+----------+------+-----+ | 0 | 0 | 1 | even | odd | | | | 2 | even | odd | | | 1 | 1 | even | odd | | | | 2 | even | odd | | | 2 | 1 | even | odd | | | | 2 | even | odd | | 1 | 0 | 1 | even | odd | | | | 2 | even | odd | | | 1 | 1 | even | odd | | | | 2 | even | odd | | | 2 | 1 | even | odd | | | | 2 | even | odd | | 2 | 0 | 1 | even | odd | | | | 2 | even | odd | | | 1 | 1 | even | odd | | | | 2 | even | odd | | | 2 | 1 | even | odd | | | | 2 | even | odd | ****|] , testCase "nested table hide=blankCols,blankRows colstack=hundreds" $ cmpTables "nested table hide-blankCols,blankRows colstack=hundreds" (KTRA.render (cfg0 { KTR.sortKeyVals = True , KTR.rowRepeat = False , KTR.hideBlankCols = True , KTR.hideBlankRows = True , KTR.equisizedCols = False , KTR.colStackAt = Just "hundreds" }) nestedTable) [uq_f|README.md|] , testCase "nested table hide=none colstack=hundreds" $ cmpTables "nested table hide=none colstack=hundreds" (KTRA.render (cfg0 { KTR.sortKeyVals = True , KTR.rowRepeat = False , KTR.hideBlankCols = False , KTR.hideBlankRows = False , KTR.equisizedCols = False , KTR.colStackAt = Just "hundreds" }) nestedTable) [uq_f|examples/hundreds_all.md|] , testCase "nested table hide=none colstack=hundreds equisized" $ cmpTables "nested table hide=none colstack=hundreds equisized" (KTRA.render (cfg0 { KTR.sortKeyVals = True , KTR.rowRepeat = False , KTR.hideBlankCols = False , KTR.hideBlankRows = False , KTR.equisizedCols = True , KTR.colStackAt = Just "hundreds" }) nestedTable) [uq2_f|examples/hundreds_all.md|] , testCase "nested table hideBlank=rol,col colstack=thousands" $ cmpTables "nested table hideBlank=row,col colstack=thousands" (KTRA.render (cfg0 { KTR.sortKeyVals = True , KTR.rowRepeat = False , KTR.hideBlankCols = True , KTR.hideBlankRows = True , KTR.equisizedCols = False , KTR.colStackAt = Just "thousands" }) nestedTable) [uq2_f|README.md|] , testCase "nested table hideBlank=rol,col" $ cmpTables "nested table hideBlank=row,col" (KTRA.render (cfg0 { KTR.sortKeyVals = True , KTR.rowRepeat = False , KTR.hideBlankCols = True , KTR.hideBlankRows = True , KTR.equisizedCols = False }) nestedTable) [uq3_f|README.md|] , testCase "nested table hideBlank=none" $ cmpTables "nested table hideBlank=none" (KTRA.render (cfg0 { KTR.sortKeyVals = True , KTR.rowRepeat = False , KTR.hideBlankCols = False , KTR.hideBlankRows = False , KTR.equisizedCols = False }) nestedTable) [sq| **** | millions | thousands | hundreds | tens | ones | Value | +----------+-----------+----------+------+------+-------+ | 0 | 0 | 0 | 0 | 0 | | | | | | | 1 | | | | | | 2 | 0 | | | | | | | 1 | | | | | 1 | 0 | 0 | | | | | | | 1 | | | | | | 2 | 0 | even | | | | | | 1 | odd | | | | 2 | 0 | 0 | | | | | | | 1 | | | | | | 2 | 0 | even | | | | | | 1 | odd | | | 1 | 0 | 0 | 0 | | | | | | | 1 | | | | | | 2 | 0 | | | | | | | 1 | | | | | 1 | 0 | 0 | | | | | | | 1 | | | | | | 2 | 0 | even | | | | | | 1 | odd | | | | 2 | 0 | 0 | | | | | | | 1 | | | | | | 2 | 0 | even | | | | | | 1 | odd | | | 2 | 0 | 0 | 0 | | | | | | | 1 | | | | | | 2 | 0 | | | | | | | 1 | | | | | 1 | 0 | 0 | | | | | | | 1 | | | | | | 2 | 0 | even | | | | | | 1 | odd | | | | 2 | 0 | 0 | | | | | | | 1 | | | | | | 2 | 0 | even | | | | | | 1 | odd | | 1 | 0 | 0 | 0 | 0 | | | | | | | 1 | | | | | | 2 | 0 | | | | | | | 1 | | | | | 1 | 0 | 0 | | | | | | | 1 | | | | | | 2 | 0 | even | | | | | | 1 | odd | | | | 2 | 0 | 0 | | | | | | | 1 | | | | | | 2 | 0 | even | | | | | | 1 | odd | | | 1 | 0 | 0 | 0 | | | | | | | 1 | | | | | | 2 | 0 | | | | | | | 1 | | | | | 1 | 0 | 0 | | | | | | | 1 | | | | | | 2 | 0 | even | | | | | | 1 | odd | | | | 2 | 0 | 0 | | | | | | | 1 | | | | | | 2 | 0 | even | | | | | | 1 | odd | | | 2 | 0 | 0 | 0 | | | | | | | 1 | | | | | | 2 | 0 | | | | | | | 1 | | | | | 1 | 0 | 0 | | | | | | | 1 | | | | | | 2 | 0 | even | | | | | | 1 | odd | | | | 2 | 0 | 0 | | | | | | | 1 | | | | | | 2 | 0 | even | | | | | | 1 | odd | | 2 | 0 | 0 | 0 | 0 | | | | | | | 1 | | | | | | 2 | 0 | | | | | | | 1 | | | | | 1 | 0 | 0 | | | | | | | 1 | | | | | | 2 | 0 | even | | | | | | 1 | odd | | | | 2 | 0 | 0 | | | | | | | 1 | | | | | | 2 | 0 | even | | | | | | 1 | odd | | | 1 | 0 | 0 | 0 | | | | | | | 1 | | | | | | 2 | 0 | | | | | | | 1 | | | | | 1 | 0 | 0 | | | | | | | 1 | | | | | | 2 | 0 | even | | | | | | 1 | odd | | | | 2 | 0 | 0 | | | | | | | 1 | | | | | | 2 | 0 | even | | | | | | 1 | odd | | | 2 | 0 | 0 | 0 | | | | | | | 1 | | | | | | 2 | 0 | | | | | | | 1 | | | | | 1 | 0 | 0 | | | | | | | 1 | | | | | | 2 | 0 | even | | | | | | 1 | odd | | | | 2 | 0 | 0 | | | | | | | 1 | | | | | | 2 | 0 | even | | | | | | 1 | odd | ****|] ] kvitable-1.0.3.0/test/HTMLRenderTests.hs0000644000000000000000000001570007346545000016110 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE TypeApplications #-} module HTMLRenderTests where import Control.Monad ( unless ) import qualified Data.List as L import Data.Text ( Text ) import qualified Data.Text as T import qualified Data.Text.Lazy as TL import Lens.Micro ( (^.), (.~), (%~), (&) ) import Test.Tasty import Test.Tasty.HUnit import Text.HTML.Parser ( parseTokens, renderToken , canonicalizeTokens , Token( TagOpen, TagSelfClose ) ) import SampleTables import TestQQDefs import qualified Data.KVITable as KVI import qualified Data.KVITable.Render as KTR import qualified Data.KVITable.Render.HTML as KTRH cmpTables :: Text -> Text -> Text -> IO () cmpTables nm actual expected = do let expH = normalize $ parseTokens $ T.concat $ fmap T.strip $ T.lines expected actH = normalize $ parseTokens actual normalize = fmap sortAttrs . canonicalizeTokens sortAttrs (TagOpen n a) = TagOpen n $ L.sort a sortAttrs (TagSelfClose n a) = TagSelfClose n $ L.sort a sortAttrs t = t unless (expH == actH) $ do let dl (e,a) = if e == a then db e else de " ↱" e <> "\n " <> da " ↳" a db b = "| > " <> b de m e = "|" <> m <> "expect> " <> e da m a = "|" <> m <> "actual> " <> a el = fmap (TL.toStrict . renderToken) expH al = fmap (TL.toStrict . renderToken) actH addnum n l = let nt = T.pack (show n) nl = T.length nt in T.take (4 - nl) " " <> nt <> l let details = ("MISMATCH between " <> T.pack (show $ length el) <> " expected and " <> T.pack (show $ length al) <> " actual for " <> nm) : (fmap (uncurry addnum) $ zip [1..] $ concat $ -- Highly simplistic "diff" output assumes -- correlated lines: added or removed lines just -- cause everything to shown as different from that -- point forward. [ fmap dl $ zip el al , fmap (de "∌ ") $ drop (length al) el , fmap (da "∹ ") $ drop (length el) al ]) assertFailure $ T.unpack $ T.unlines details testHTMLRendering = testGroup "HTML rendering" $ let kvi0 = mempty :: KVI.KVITable Text cfg0 = KTR.defaultRenderConfig cfgWBlankRows = cfg0 { KTR.hideBlankRows = False } in [ testCase "empty table, hide blank" $ cmpTables "empty table, hide blank" (KTRH.render cfg0 kvi0) [sq| ****
Value
**** |] , testCase "empty table, show blank" $ cmpTables "empty table, show blank" (KTRH.render cfgWBlankRows kvi0) [sq| ****
Value
**** |] , testCase "empty table with labels" $ let kvi = mempty & KVI.keyVals @Float .~ [ ("foo", []), ("dog", []) ] in cmpTables "empty table with labels" (KTRH.render cfg0 kvi) [sq| ****
foo dog Value
**** |] , testCase "nested table hideBlank=rows,cols, fitted, colstack=hundreds" $ cmpTables "nested table hideBlank=rows,cols, fitted, colstack=hundreds" (KTRH.render (cfg0 { KTR.sortKeyVals = True , KTR.rowRepeat = False , KTR.hideBlankCols = True , KTR.hideBlankRows = True , KTR.equisizedCols = False , KTR.colStackAt = Just "hundreds" }) nestedTable) [sq_f|README.md|] , testCase "nested table hide=none, fitted, colstack=hundreds" $ cmpTables "nested table hide=none, fitted, colstack=hundreds" (KTRH.render (cfg0 { KTR.sortKeyVals = True , KTR.rowRepeat = False , KTR.hideBlankCols = False , KTR.hideBlankRows = False , KTR.equisizedCols = False , KTR.colStackAt = Just "hundreds" }) nestedTable) [sq_f|examples/hundreds_all.md|] , testCase "nested table hideBlank=rol,col colstack=thousands" $ cmpTables "nested table hideBlank=row,col colstack=thousands" (KTRH.render (cfg0 { KTR.sortKeyVals = True , KTR.rowRepeat = False , KTR.hideBlankCols = True , KTR.hideBlankRows = True , KTR.equisizedCols = False , KTR.colStackAt = Just "thousands" }) nestedTable) [sq2_f|README.md|] , testCase "nested table hideBlank=rol,col" $ cmpTables "nested table hideBlank=row,col" (KTRH.render (cfg0 { KTR.sortKeyVals = True , KTR.rowRepeat = False , KTR.hideBlankCols = True , KTR.hideBlankRows = True , KTR.equisizedCols = False }) nestedTable) [sq3_f|README.md|] , testCase "big table grouped sorted" $ cmpTables "big table grouped sorted" (KTRH.render (cfg0 { KTR.sortKeyVals = True , KTR.rowRepeat = False , KTR.rowGroup = [ "Location", "Biome", "Category" ] }) zooTable2) [sq_f|examples/zoo.md|] , testCase "big table grouped sorted no-subtype colstack" $ let zt = KVI.fromList $ foldl rmvSubtype [] $ KVI.toList zooTable2 rmvSubtype newl (keyspec, v) = let ks = filter (("Subtype" /=) . fst) keyspec in case lookup ks newl of Nothing -> (ks,v) : newl Just v' -> (ks, v' + v) : filter ((ks /=) . fst) newl in cmpTables "big table grouped sorted no-subtype colstack" (KTRH.render (cfg0 { KTR.sortKeyVals = True , KTR.rowRepeat = False , KTR.rowGroup = [ "Location", "Biome", "Category" ] , KTR.colStackAt = Just "Name" , KTR.equisizedCols = False }) zt) [sq2_f|examples/zoo.md|] ] kvitable-1.0.3.0/test/SampleTables.hs0000644000000000000000000002367307346545000015545 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} module SampleTables where import Data.KVITable import Data.Text ( Text ) import qualified Data.Text as T import Lens.Micro ( (^.), (.~), (%~), (&) ) listing1 :: [ ( [(Key, KeyVal)], Text ) ] listing1 = [ ( [("foo", "bar"), ("moo", "cow")], "one" ) , ( [("moo", "cow"), ("foo", "bar"), ("goose", "honk")], "two" ) , ( [("moo", "cow")], "three" ) , ( [("foo", "baz"), ("moo", "cow")], "four") ] kvi1 = fromList listing1 kvi1_1 = fromList $ take 2 listing1 kvi1_2 = fromList $ drop 2 listing1 mediumKVI = foldl foldlInsert (mempty & keyVals .~ [ ("compiler", [ "gcc7", "gcc8", "clang6", "clang10", "clang7" ]) , ("debug", [ "yes", "no" ]) , ("optimization", [ "0", "1", "3" ]) ]) [ ([("compiler", "gcc7"), ("debug", "yes"), ("optimization", "0")], "good") , ([("compiler", "gcc7"), ("debug", "no" ), ("optimization", "0")], "bad") , ([("compiler", "gcc7"), ("debug", "yes"), ("optimization", "3")], "ugly") , ([("compiler", "gcc8"), ("debug", "yes"), ("optimization", "0")], "good") , ([("compiler", "clang6"), ("debug", "yes"), ("optimization", "0")], "ok") , ([("compiler", "clang7"), ("debug", "no"), ("optimization", "1")], "good") , ([("compiler", "clang7"), ("debug", "no"), ("optimization", "3")], "good") , ([("compiler", "clang7"), ("debug", "yes"), ("optimization", "3")], "good") , ([("compiler", "clang10"), ("debug", "no"), ("optimization", "3")], "good") , ([("compiler", "clang10"), ("debug", "yes"), ("optimization", "3")], "good") , ([("compiler", "gcc8"), ("debug", "yes"), ("optimization", "3")], "true") , ([("compiler", "gcc8"), ("debug", "yes"), ("optimization", "1")], "bad") , ([("compiler", "clang7"), ("debug", "no"), ("optimization", "0")], "good") , ([("compiler", "gcc7"), ("debug", "no"), ("optimization", "1")], "good") ] -- this table has floating values and keys with spaces ptable = foldl foldlInsert (mempty & valueColName .~ "Annual Rainfall") [ ([("City name", "Adelaide"), ("Area", "1295"), ("Population", "1158259")], 600.5) , ([("City name", "Brisbane"), ("Area", "5905"), ("Population", "1857594")], 1146.4) , ([("City name", "Darwin"), ("Area", "112"), ("Population", "120900")], 1714.7) , ([("City name", "Hobart"), ("Area", "1357"), ("Population", "205556")], 619.5) , ([("City name", "Melbourne"), ("Area", "1566"), ("Population", "3806092")], 646.9) , ([("City name", "Perty"), ("Area", "5386"), ("Population", "1554769")], 869.4) , ([("City name", "Sydney"), ("Area", "2058"), ("Population", "4336374")], 1214.8) ] -- big and complicated zooTable = foldl foldlInsert (mempty & valueColName .~ "Count" & keyVals .~ [ ("Location", ["San Diego", "LA", "Miami", "New York"]) , ("Biome", ["Savannah", "Jungle", "Polar"]) , ("Category", ["Animal", "Reptile", "Bird"]) , ("Diet", ["Herbivore", "Carnivore"]) , ("Name", []) ]) [ ([ ("Diet", "Carnivore") , ("Category", "Animal") , ("Biome", "Savannah") , ("Name", "Lion") , ("Location", "New York")], 3) , ([ ("Diet", "Carnivore") , ("Category", "Animal") , ("Biome", "Savannah") , ("Name", "Lion") , ("Location", "Miami")], 2) , ([ ("Diet", "Carnivore") , ("Category", "Animal") , ("Biome", "Savannah") , ("Name", "Lion") , ("Location", "LA")], 4) , ([ ("Diet", "Carnivore") , ("Category", "Animal") , ("Biome", "Savannah") , ("Name", "Lion") , ("Location", "San Diego")], 8) , ([ ("Location", "LA") , ("Biome", "Savannah") , ("Category", "Animal") , ("Name", "Giraffe") , ("Diet", "Herbivore")], 2) , ([ ("Location", "LA") , ("Biome", "Jungle") , ("Category", "Animal") , ("Name", "Hippo") , ("Diet", "Herbivore")], 1) , ([ ("Location", "LA") , ("Biome", "Savannah") , ("Category", "Animal") , ("Diet", "Herbivore") , ("Name", "Rhino")], 3) , ([ ("Location", "Miami") , ("Biome", "Polar") , ("Category", "Bird") , ("Diet", "Carnivore") , ("Subtype", "Gentoo") -- new key , ("Name", "Penguin")], 20) , ([ ("Location", "San Diego") , ("Biome", "Polar") , ("Category", "Bird") , ("Diet", "Carnivore") , ("Subtype", "Emperor") , ("Name", "Penguin")], 8) , ([ ("Location", "San Diego") , ("Biome", "Polar") , ("Category", "Bird") , ("Diet", "Carnivore") , ("Subtype", "Gentoo") , ("Name", "Penguin")], 2) , ([ ("Location", "Miami") , ("Biome", "Savannah") , ("Category", "Animal") , ("Diet", "Herbivore") , ("Name", "Giraffe") , ("Subtype", "Reticulated")], 3) ] zooTable2 = insert [ ("Location", "San Diego"), ("Biome", "Plains") , ("Category", "Animal"), ("Subtype", "Black") , ("Name", "Bear"), ("Diet", "Omnivore") ] 1 $ insert [ ("Location", "San Diego"), ("Biome", "Plains") , ("Category", "Animal"), ("Subtype", "Brown") , ("Name", "Bear"), ("Diet", "Omnivore") ] 1 $ insert [ ("Location", "San Diego"), ("Biome", "Jungle") , ("Category", "Animal"), ("Subtype", "Sun") , ("Name", "Bear"), ("Diet", "Omnivore") ] 1 $ insert [ ("Location", "San Diego"), ("Biome", "Polar") , ("Category", "Animal"), ("Subtype", "Polar") , ("Name", "Bear"), ("Diet", "Omnivore") ] 1 $ adjust succ ([ ("Category", "Animal") , ("Diet", "Carnivore") , ("Biome", "Savannah") , ("Location", "San Diego") , ("Name", "Lion")]) zooTable testedTable = foldl foldlInsert (mempty & keyVals .~ [ ("system", ["x86_64-linux", "x86_64-darwin"]) , ("Branch", ["master", "develop", "PR-feature"]) , ("Strategy", ["submodules", "HEADs"]) , ("ghcver", ["ghc844", "ghc865", "ghc882", "ghc890"]) , ("debug", ["Y", "N"]) ]) $ let ls g b d v = ([ ("system", "x86_64-linux") , ("Strategy", "submodules") , ("ghcver", g), ("Branch", b) , ("debug", d) ], v) lH g b d v = ([ ("system", "x86_64-linux") , ("Strategy", "HEADs") , ("ghcver", g), ("Branch", b) , ("debug", d) ], v) ms g b d v = ([ ("system", "x86_64-darwin") , ("Strategy", "submodules") , ("ghcver", g), ("Branch", b) , ("debug", d) ], v) mH g b d v = ([ ("system", "x86_64-darwin") , ("Strategy", "HEADs") , ("ghcver", g), ("Branch", b) , ("debug", d) ], v) in [ ls "ghc844" "PR-feature" "Y" "+" , ls "ghc844" "PR-feature" "N" "+" , lH "ghc865" "PR-feature" "N" "FAIL*2" , ls "ghc882" "develop" "N" "FAIL*1" , lH "ghc865" "develop" "N" "+" , ls "ghc844" "master" "Y" "FAIL*1" , ls "ghc844" "master" "N" "+" , lH "ghc844" "master" "Y" "FAIL*1" , lH "ghc865" "master" "N" "FAIL*1" , lH "ghc882" "master" "N" "FAIL*1" , ls "ghc865" "master" "N" "FAIL*1" , lH "ghc844" "develop" "Y" "+" , lH "ghc844" "develop" "N" "+" , lH "ghc882" "PR-feature" "N" "FAIL*1" , ls "ghc882" "PR-feature" "N" "FAIL*1" , ls "ghc865" "PR-feature" "N" "+" , ls "ghc844" "develop" "N" "+" , lH "ghc844" "develop" "Y" "+" , mH "ghc844" "develop" "N" "+" ] nestedTable = foldl foldlInsert (mempty & keyVals .~ [ ("millions", ["0"]) , ("thousands", ["0"]) , ("hundreds", ["0"]) , ("tens", ["0"]) , ("ones", ["0"]) ] ) [ let keyvals = [("millions", T.pack $ show m) ,("thousands", T.pack $ show t) ,("hundreds", T.pack $ show h) ,("tens", T.pack $ show d) ,("ones", T.pack $ show o)] value = if (o `rem` 2) == 1 then "odd" else "even" in (keyvals, value) | m <- [0..2 :: Int] , t <- [0..2 :: Int] , h <- [1..2 :: Int] , d <- [2..2 :: Int] , o <- [0..1 :: Int] ] kvitable-1.0.3.0/test/TestMain.hs0000644000000000000000000002135707346545000014712 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} module Main where import Data.List ( sort ) import Data.Maybe ( catMaybes ) import Data.Text ( Text ) import qualified Data.Text as T import Lens.Micro ( (^.), (.~), (%~), (&) ) import Test.Tasty import Test.Tasty.HUnit import Data.KVITable import Prelude hiding ( filter, lookup ) import AsciiRenderTests import HTMLRenderTests import SampleTables main :: IO () main = defaultMain $ testGroup "kvitable tests" $ let kvi0 = mempty :: KVITable Text in [ testCase "empty table" $ (mempty :: KVITable Bool) @=? (mempty :: KVITable Bool) , testCase "to and from" $ length listing1 @=? length (toList kvi1) , testCase "length" $ length listing1 @=? length kvi1 , testCase "mappable" $ sum (snd <$> (fmap T.length) <$> listing1) @=? sum (snd <$> toList (T.length <$> kvi1)) , testCase "traversable" $ Just (sort $ snd <$> listing1) @=? sort . fmap snd . toList <$> (traverse Just kvi1) , testCaseSteps "semigroup" $ \step -> do step "empty to full" mempty <> kvi1 @?= kvi1 step "full to empty" kvi1 <> mempty @?= kvi1 step "idempotent" kvi1 <> kvi1 @?= kvi1 step "join parts" kvi1_1 <> kvi1_2 @?= kvi1 -- happens to be the right order -- note: it is *not* the case that -- -- > kvi1_2 <> kvi1_1 == kvi1 -- -- because the keyvals from a semigroup operation are -- built dynamically and this particular kvi1_1 / -- kvi1_2 will result in a different key order in -- reverse. However, specifying the keyVals -- explicitly can eliminate key detection ordering concerns. step "keyed" let keyed = mempty & keyVals .~ [ ("foo", ["baz", "", "bar"]) , ("moo", ["cow"]) , ("goose", ["honk", ""]) ] keyed <> kvi1_1 <> kvi1_2 @?= kvi1 , testCase "empty lookup fails" $ Nothing @=? lookup [("foo", "bar"), ("moo", "cow")] (mempty :: KVITable Bool) , testCase "regular lookup" $ Just "one" @=? lookup [("foo", "bar"), ("moo", "cow")] kvi1 , testCase "add to empty table" $ let keyvals = [ ("foo", "bar"), ("moo", "cow") ] in [ (keyvals, "hi") ] @=? toList (insert keyvals "hi" kvi0) , testCase "getRows on empty table" $ [] @=? rows kvi0 , testCase "rows in simple table" $ let keyvals = [ ("foo", "bar"), ("moo", "cow") ] in [ (["bar", "cow"], "hi") ] @=? rows (insert keyvals "hi" kvi0) , testCaseSteps "non-leaf kvitable insert uses default key value" $ \step -> do let keyvals = [ ("foo", "bar"), ("moo", "cow") ] t1 = insert keyvals "hi" kvi0 step "at start" let t2 = insert [ ("moo", "dog") ] "oops" t1 rows t2 @?= [ ([ "", "dog" ], "oops") , ([ "bar", "cow" ], "hi") ] step "at end" let t3 = insert [ ("foo", "dog") ] "oops" t1 rows t3 @?= [ ([ "dog", "" ], "oops") , ([ "bar", "cow" ], "hi") ] step "in middle" let keyvals' = [ ("foo", "bar"), ("moo", "cow"), ("oink", "pig") ] t1' = insert keyvals' "hi" kvi0 t4 = insert [ ("foo", "baz"), ("oink", "hog") ] "oops" t1' rows t4 @?= [ ([ "baz", "", "hog" ], "oops") , ([ "bar", "cow", "pig" ], "hi") ] , testCaseSteps "valueColName" $ \step -> do step "fetch" "Value" @=? kvi1 ^. valueColName step "set" "says" @=? (kvi1 & valueColName .~ "says") ^. valueColName step "update" "says Value" @=? (kvi1 & valueColName %~ ("says " <>)) ^. valueColName , testCase "keyVals fetch" $ [ ("foo", ["baz", "", "bar"]) , ("moo", ["cow"]) , ("goose", ["honk", ""]) ] @=? kvi1 ^. keyVals , testCaseSteps "lookup" $ \step -> do step "valid #1" Just "three" @=? lookup [("moo", "cow")] kvi1 step "valid #2" Just "two" @=? lookup [("goose", "honk"), ("moo", "cow"), ("foo", "bar")] kvi1 step "valid #3" Just "four" @=? lookup [("moo", "cow"), ("foo", "baz")] kvi1 step "valid #4" Just "one" @=? lookup [("moo", "cow"), ("foo", "bar")] kvi1 step "valid with dups" -- Note: ok to duplicate key values with identical entries Just "one" @=? lookup [("moo", "cow"), ("foo", "bar"), ("moo", "cow")] kvi1 step "invalid #1" Nothing @=? lookup [("moo", "bar")] kvi1 step "invalid #2" Nothing @=? lookup [("foo", "moo"), ("cow", "moo")] kvi1 step "invalid #3" Nothing @=? lookup [] kvi1 , testCase "multiply-specified lookups" $ -- one of these will work, one will fail, but it's -- indeterminate which one. This is not a recommended -- usage, but rather than waste computational resources -- to prevent it, this is simply documenting this as a -- known behavior and users are discouraged from using -- it. 1 @=? (length $ catMaybes [ lookup [("moo", "sheep"), ("foo", "bar"), ("moo", "cow")] kvi1 , lookup [("moo", "cow"), ("foo", "bar"), ("moo", "sheep")] kvi1 ]) , testCase "deep add" $ let t0 = mempty & keyVals .~ [ ("foo", ["bar", "baz"]) , ("moon", ["beam", "pie"]) ] & valueColName .~ "says" t1 = insert [ ("foo", "Bill"), ("moon", "Ted"), ("dog", "arf arf") ] "Excellent!" $ insert [ ("foo", "baz"), ("moon", "beam"), ("dog", "woof") ] "yo" $ insert [ ("foo", "bar"), ("moon", "pie") ] "hi" t0 in rows t1 @?= [ ([ "Bill", "Ted", "arf arf" ], "Excellent!") , ([ "bar", "pie", "" ], "hi") , ([ "baz", "beam", "woof"], "yo") ] , testCase "medium sized table rows" $ rows mediumKVI @?= [ ([ "gcc7", "yes", "0"], "good" ) , ([ "gcc7", "yes", "3"], "ugly" ) , ([ "gcc7", "no", "0"], "bad" ) , ([ "gcc7", "no", "1"], "good" ) , ([ "gcc8", "yes", "0"], "good" ) , ([ "gcc8", "yes", "1"], "bad" ) , ([ "gcc8", "yes", "3"], "true" ) , ([ "clang6", "yes", "0"], "ok" ) , ([ "clang10", "yes", "3"], "good" ) , ([ "clang10", "no", "3"], "good" ) , ([ "clang7", "yes", "3"], "good" ) , ([ "clang7", "no", "0"], "good" ) , ([ "clang7", "no", "1"], "good" ) , ([ "clang7", "no", "3"], "good" ) ] , testCase "filter" $ rows (filter (\(spec,val) -> ("compiler", "gcc7") `elem` spec) mediumKVI) @?= [ ([ "gcc7", "yes", "0"], "good" ) , ([ "gcc7", "yes", "3"], "ugly" ) , ([ "gcc7", "no", "0"], "bad" ) , ([ "gcc7", "no", "1"], "good" ) ] , testCaseSteps "zoo contents" $ \step -> do step "LA Lions" Just 4 @=? lookup [ ("Location", "LA"), ("Name", "Lion") , ("Diet", "Carnivore"), ("Category", "Animal") , ("Biome", "Savannah"), ("Subtype", "") ] zooTable2 step "No polar lions" Nothing @=? lookup [ ("Location", "LA"), ("Name", "Lion") , ("Diet", "Carnivore"), ("Category", "Animal") , ("Biome", "Polar"), ("Subtype", "") ] zooTable2 , testGroup "rendering" [ testAsciiRendering , testHTMLRendering ] ] kvitable-1.0.3.0/test/TestQQDefs.hs0000644000000000000000000000367707346545000015156 0ustar0000000000000000{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE TemplateHaskell #-} module TestQQDefs where import Data.String import Language.Haskell.TH.Quote sq :: QuasiQuoter sq = qqExtractor 1 "\n****" sq_f = quoteFile sq sq2_f = quoteFile $ qqExtractor 2 "\n****" sq3_f = quoteFile $ qqExtractor 3 "\n****" uq :: QuasiQuoter uq = qqExtractor 1 "\n____" uq_f = quoteFile uq uq2_f = quoteFile $ qqExtractor 2 "\n____" uq3_f = quoteFile $ qqExtractor 3 "\n____" qqExtractor idx sep = QuasiQuoter (extractor idx sep) (error "no patterns supported") (error "no types supported") (error "no declarations supported") -- extractor :: String -> String -> QState extractor idx sep s = case inSeps idx sep $ filter (/= '\r') s of Post a -> [|fromString a|] Pre n _ -> error $ "No starting line found for block " <> show n MatchLine n -> error $ "Only starting line found for block " <> show n Pass n _ -> error $ "No ending line found for block " <> show n data QState = Pre Int String | MatchLine Int | Pass Int String | Post String inSeps :: Int -> String -> String -> QState inSeps idx sep = let sepl = length sep nxtC :: QState -> Char -> QState nxtC (Pre n p) c = let p' = c : p l = length p' in if reverse p' == take l sep then if l == sepl then MatchLine n else Pre n p' else Pre n $ take (sepl-1) p' nxtC p@(MatchLine n) c = if '\n' == c then Pass n "" else p nxtC (Pass n s) c = let s' = c : s sl = reverse $ take sepl s' in if sl == sep then if n == 1 then Post (reverse $ drop (sepl-1) s') else Pre (n - 1) "" else Pass n s' nxtC (Post s) _ = Post s in foldl nxtC (Pre idx "")