safe-coloured-text-layout (empty) → 0.0.0.0
raw patch · 5 files changed
+256/−0 lines, 5 filesdep +basedep +bytestringdep +safe-coloured-text
Dependencies added: base, bytestring, safe-coloured-text, safe-coloured-text-layout, sydtest, text, validity
Files
- LICENSE +21/−0
- safe-coloured-text-layout.cabal +56/−0
- src/Text/Colour/Layout.hs +91/−0
- test/Spec.hs +1/−0
- test/Text/Colour/LayoutSpec.hs +87/−0
+ LICENSE view
@@ -0,0 +1,21 @@+MIT License++Copyright (c) 2021 Tom Sydney Kerckhove++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.
+ safe-coloured-text-layout.cabal view
@@ -0,0 +1,56 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.34.4.+--+-- see: https://github.com/sol/hpack++name: safe-coloured-text-layout+version: 0.0.0.0+synopsis: Safely layout output coloured text+category: User Interfaces+homepage: https://github.com/NorfairKing/safe-coloured-text#readme+bug-reports: https://github.com/NorfairKing/safe-coloured-text/issues+author: Tom Sydney Kerckhove+maintainer: syd@cs-syd.eu+copyright: Copyright (c) 2020 Tom Sydney Kerckhove+license: MIT+license-file: LICENSE+build-type: Simple++source-repository head+ type: git+ location: https://github.com/NorfairKing/safe-coloured-text++library+ exposed-modules:+ Text.Colour.Layout+ other-modules:+ Paths_safe_coloured_text_layout+ hs-source-dirs:+ src+ build-depends:+ base >=4.7 && <5+ , safe-coloured-text+ , text+ , validity+ default-language: Haskell2010++test-suite safe-coloured-text-layout-test+ type: exitcode-stdio-1.0+ main-is: Spec.hs+ other-modules:+ Text.Colour.LayoutSpec+ Paths_safe_coloured_text_layout+ hs-source-dirs:+ test+ ghc-options: -threaded -rtsopts -with-rtsopts=-N+ build-tool-depends:+ sydtest-discover:sydtest-discover+ build-depends:+ base >=4.7 && <5+ , bytestring+ , safe-coloured-text+ , safe-coloured-text-layout+ , sydtest+ , text+ default-language: Haskell2010
+ src/Text/Colour/Layout.hs view
@@ -0,0 +1,91 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}++module Text.Colour.Layout where++import Control.Applicative+import Data.List+import qualified Data.Text as T+import Data.Validity+import GHC.Generics (Generic)+import Text.Colour++layoutAsTable :: [[Chunk]] -> [Chunk]+layoutAsTable = renderTable . table++table :: [[Chunk]] -> Table+table cs =+ Table+ { tableCells = cs,+ tableColumnSeparator = " ",+ tableBackground = Nothing+ }++data Table = Table+ { -- | A list of rows. They must be of the same length.+ tableCells :: [[Chunk]],+ tableColumnSeparator :: Chunk,+ tableBackground :: Maybe TableBackground+ }+ deriving (Show, Eq, Generic)++instance Validity Table++data TableBackground+ = SingleColour Colour+ | Bicolour+ (Maybe Colour) -- Even-numbered table rows (0-indexed)+ (Maybe Colour) -- Odd-numbered table rows+ deriving (Show, Eq, Generic)++instance Validity TableBackground++renderTable :: Table -> [Chunk]+renderTable Table {..} =+ let asColumns = transpose (padRows tableCells)+ addLengthsToColumn :: [Chunk] -> [(Int, Chunk)]+ addLengthsToColumn = map (\c -> (T.length (chunkText c), c))+ maxLengthOfColum :: [(Int, Chunk)] -> Int+ maxLengthOfColum = maximum . map fst+ padColumn :: Int -> [(Int, Chunk)] -> [(Chunk, Chunk)]+ padColumn maxLength = map (\(l, c) -> (c, paddingChunk (maxLength - l) ' '))+ padEntireColumn :: [(Int, Chunk)] -> [(Chunk, Chunk)]+ padEntireColumn col =+ let maxLength = maxLengthOfColum col+ in padColumn maxLength col+ paddedColumns :: [[(Chunk, Chunk)]]+ paddedColumns = map (padEntireColumn . addLengthsToColumn) asColumns+ paddedRows :: [[(Chunk, Chunk)]]+ paddedRows = transpose paddedColumns+ withBg :: Int -> Chunk -> Chunk+ withBg i = possiblyAddBackground $ backgroundForRow i tableBackground+ renderRow :: Int -> [(Chunk, Chunk)] -> [Chunk]+ renderRow i = go+ where+ go [] = ["\n"]+ go [(c, p)] = withBg i c : withBg i p : go []+ go ((c1, p1) : t2 : rest) = withBg i c1 : withBg i p1 : withBg i tableColumnSeparator : go (t2 : rest)+ in concat $ iterateLikeInPython renderRow paddedRows++iterateLikeInPython :: (Int -> a -> b) -> [a] -> [b]+iterateLikeInPython f = zipWith f [0 ..]++padRows :: [[Chunk]] -> [[Chunk]]+padRows [] = []+padRows css =+ let withLengths = map (\ls -> (length ls, ls)) css+ maximumLength = maximum $ map fst withLengths+ pad (l, cs) = cs ++ replicate (maximumLength - l) ""+ in map pad withLengths++paddingChunk :: Int -> Char -> Chunk+paddingChunk l c = chunk $ T.pack $ replicate l c++possiblyAddBackground :: Maybe Colour -> Chunk -> Chunk+possiblyAddBackground mb c = c {chunkBackground = chunkBackground c <|> mb}++backgroundForRow :: Int -> Maybe TableBackground -> Maybe Colour+backgroundForRow _ Nothing = Nothing+backgroundForRow _ (Just (SingleColour c)) = Just c+backgroundForRow i (Just (Bicolour ec oc)) = if even i then ec else oc
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF sydtest-discover #-}
+ test/Text/Colour/LayoutSpec.hs view
@@ -0,0 +1,87 @@+{-# LANGUAGE OverloadedStrings #-}++module Text.Colour.LayoutSpec (spec) where++import qualified Data.Text as T+import Test.Syd+import Text.Colour+import Text.Colour.Layout++spec :: Spec+spec = do+ let gf = ("test_resources/" ++)+ describe "layoutAsTable" $ do+ it "outputs this list the same as before" $ do+ pureGoldenByteStringFile+ (gf "list.dat")+ ( renderChunksBS+ With24BitColours+ ( layoutAsTable+ [ ["this"],+ ["is"],+ ["a"],+ ["list"]+ ]+ )+ )+ it "outputs this two-column table the same as before" $ do+ pureGoldenByteStringFile+ (gf "two-columns.dat")+ ( renderChunksBS+ With24BitColours+ ( layoutAsTable+ [ ["this", "this"],+ ["is", "is"],+ ["a", "another"],+ ["list", "list"]+ ]+ )+ )+ it "outputs this weird two-column table the same as before" $ do+ pureGoldenByteStringFile+ (gf "table-with-rows-of-unequal-length.dat")+ ( renderChunksBS+ With24BitColours+ ( layoutAsTable+ [ ["what", "the", ""],+ ["is", "this", "", "-ing", ""],+ ["I", "don't", "understand", "one", "", "of", "it"]+ ]+ )+ )+ it "outputs this two-column table with a custom column separator the same as before" $ do+ pureGoldenByteStringFile+ (gf "custom-column-separator.dat")+ ( renderChunksBS+ With24BitColours+ ( renderTable $+ ( table $ [[chunk (T.pack (show (x + y))) | x <- [0 :: Int .. 9]] | y <- [0 :: Int .. 9]]+ )+ { tableColumnSeparator = "@"+ }+ )+ )+ it "outputs this table with a background colour the same as before" $ do+ pureGoldenByteStringFile+ (gf "background.dat")+ ( renderChunksBS+ With24BitColours+ ( renderTable $+ ( table $ [[fore red $ chunk (T.pack (show (x ^ y))) | x <- [0 :: Int .. 4]] | y <- [0 :: Int .. 4]]+ )+ { tableBackground = Just (SingleColour black)+ }+ )+ )+ it "outputs this table with a bicoloured background the same as before" $ do+ pureGoldenByteStringFile+ (gf "bicolour-background.dat")+ ( renderChunksBS+ With24BitColours+ ( renderTable $+ ( table $ [[fore red $ chunk (T.pack (show (x ^ y))) | x <- [0 :: Int .. 4]] | y <- [0 :: Int .. 4]]+ )+ { tableBackground = Just (Bicolour (Just black) (Just brightBlack))+ }+ )+ )