Skip to content

Instantly share code, notes, and snippets.

@lovasko
Last active November 19, 2016 23:59
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save lovasko/27f0ac1f8e32a189fee5f2e4014e2680 to your computer and use it in GitHub Desktop.
Save lovasko/27f0ac1f8e32a189fee5f2e4014e2680 to your computer and use it in GitHub Desktop.

Module: Text.Tabl

Files

Text/Tabl.hs

{- |
Module      : Text.Tabl
Description : Table layout engine that provides alignment and decoration
Copyright   : (c) Daniel Lovasko, 2016
License     : BSD3

Maintainer  : Daniel Lovasko <daniel.lovasko@gmail.com>
Stability   : stable
Portability : portable

Text.Tabl arranges multiple Text instances into a table layout while
providing means of alignment visual decoration both horizontally and
vertically.
-}

module Text.Tabl
( Alignment(..)
, Decoration(..)
, Environment(..)
, tabl
) where

import Text.Tabl.Alignment
import Text.Tabl.Ascii
import Text.Tabl.Decoration
import Text.Tabl.Environment
import Text.Tabl.Latex
import Text.Tabl.Util

import qualified Data.Text as T

-- | Create a table layout based on specified output environment,
-- decorations and alignments.
tabl :: Environment -- ^ output environment
     -> Decoration  -- ^ horizontal decoration
     -> Decoration  -- ^ vertical decoration
     -> [Alignment] -- ^ column alignments
     -> [[T.Text]]  -- ^ table cell data
     -> T.Text      -- ^ final layout
tabl _   _      _      _      []    = T.empty
tabl _   _      _      _      [[]]  = T.empty
tabl env hdecor vdecor aligns cells = render env hpres vpres ealigns ecells
  where
    render EnvAscii = ascii
    render EnvLatex = latex
    hpres           = presence (length cells + 1) hdecor
    vpres           = presence (length (head cells) + 1) vdecor
    columnCount     = maximum $ map length cells
    ecells          = map (extend columnCount T.empty) cells
    ealigns         = extend columnCount AlignLeft aligns

Text/Tabl/Alignment.hs

{- |
Module      : Text.Tabl.Alignment
Description : Column alignments
Copyright   : (c) Daniel Lovasko, 2016
License     : BSD3

Maintainer  : Daniel Lovasko <daniel.lovasko@gmail.com>
Stability   : stable
Portability : portable

Definition of column alignment options.
-}

module Text.Tabl.Alignment
( Alignment(..)
) where

-- | Presentation style that is used to describe the alignment of each
-- column of the table.
data Alignment
  = AlignLeft   -- ^ left alignment
  | AlignCentre -- ^ centre
  | AlignRight  -- ^ right alignment
  deriving (Show)

Text/Tabl/Ascii.hs

{- |
Module      : Text.Tabl.Ascii
Description : ASCII-art table rendering engine
Copyright   : (c) Daniel Lovasko, 2016
License     : BSD3

Maintainer  : Daniel Lovasko <daniel.lovasko@gmail.com>
Stability   : stable
Portability : portable

Implementation of the ASCII-art environment for table rendering.
-}

{-# LANGUAGE OverloadedStrings #-}

module Text.Tabl.Ascii
( ascii
) where

import Text.Tabl.Alignment
import Text.Tabl.Util

import qualified Data.Text as T

-- | Compute the greatest cell width of each column.
columnWidths :: [[T.Text]] -- ^ table cell data
             -> [Int]      -- ^ column widths
columnWidths cells = foldr combine zeros cells
  where
    zeros   = replicate (length $ head cells) 0
    combine = zipWith (\txt len -> max len (T.length txt))

-- | Convert decoration presence to actual decorator text.
verticalDecorators :: [Bool]   -- ^ presence
                   -> [T.Text] -- ^ decorators
verticalDecorators pres  = [left $ head pres]
                        ++ map mid (drop 1 $ init pres)
                        ++ [right $ last pres]
  where
    left  = bool "| "  ""
    mid   = bool " | " " "
    right = bool " |"  ""

-- | Create the decorative horizontal line.
horizontalLine :: [T.Text] -- ^ first row
               -> [T.Text] -- ^ vertical decoration
               -> T.Text   -- ^ horizontal line
horizontalLine frow vdecor = zipcat isects dashes
  where
    dashes   = map (\cell -> T.replicate (T.length cell) "-") frow
    isects   = map (T.map conv) vdecor
    conv ' ' = '-'
    conv '|' = '+'
    conv _   = '?'

-- | Apply both vertical and horizontal decorations to the table.
applyDecoration :: [Bool]     -- ^ horizontal decoration
                -> [Bool]     -- ^ vertical decoration
                -> [[T.Text]] -- ^ table cell data
                -> [T.Text]   -- ^ decorated rows
applyDecoration hpres vpres cells = intersperseOn rows hpres hline
  where
    vdecor = verticalDecorators vpres
    hline  = horizontalLine (head cells) vdecor
    rows   = map (zipcat vdecor) cells

-- | Align a cell content based on specified width and style.
alignCell :: Alignment -- ^ alignment style
          -> Int       -- ^ width
          -> T.Text    -- ^ text
          -> T.Text    -- ^ aligned text
alignCell AlignLeft   = flip T.justifyLeft  ' '
alignCell AlignRight  = flip T.justifyRight ' '
alignCell AlignCentre = flip T.center       ' '

-- | Align each cell of the table based on the width and alignment of
-- the column it is in.
alignCells :: [[T.Text]]  -- ^ table cell data
           -> [Int]       -- ^ column widths
           -> [Alignment] -- ^ column alignments
           -> [[T.Text]]  -- ^ aligned table cell data
alignCells cells widths aligns = map (zipWith3 alignCell aligns widths) cells

-- | Create a table layout using elements of ASCII art, thus making the table
-- suitable for the command line environment.
ascii :: [Bool]      -- ^ horizontal decoration
      -> [Bool]      -- ^ vertical decoration
      -> [Alignment] -- ^ column alignments
      -> [[T.Text]]  -- ^ table cell data
      -> T.Text      -- ^ table
ascii hpres vpres aligns cells = T.intercalate "\n" drows
  where
    drows  = applyDecoration hpres vpres acells
    acells = alignCells cells (columnWidths cells) aligns

Text/Tabl/Decoration.hs

{- |
Module      : Text.Tabl.Decoration
Description : Table decoration
Copyright   : (c) Daniel Lovasko, 2016
License     : BSD3

Maintainer  : Daniel Lovasko <daniel.lovasko@gmail.com>
Stability   : stable
Portability : portable

Definition of type combinators that are used to describe both horizontal
and vertical table decoration.
-}

module Text.Tabl.Decoration
( Decoration(..)
, presence
) where

-- | Decoration style that defines which lines (horizontal or vertical)
-- will be visible in the resulting table.
data Decoration
  = DecorNone               -- ^ no lines
  | DecorAll                -- ^ all lines
  | DecorInner              -- ^ inner lines
  | DecorOuter              -- ^ outer lines
  | DecorOnly [Int]         -- ^ only certain lines
  | DecorExcept [Int]       -- ^ all but certain lines
  | DecorUnion [Decoration] -- ^ union of more decorations
  | DecorIsect [Decoration] -- ^ intersection of more decorations
  deriving (Show)

-- | Convert a decoration to a list of presence information.
presence :: Int        -- ^ width
         -> Decoration -- ^ decoration
         -> [Bool]     -- ^ presence
presence n DecorNone        = replicate n False
presence n DecorAll         = replicate n True
presence n DecorInner       = [False] ++ replicate (n-2) True ++ [False]
presence n DecorOuter       = [True] ++ replicate (n-2) False ++ [True]
presence n (DecorOnly is)   = map (`elem` is) [0..(n-1)]
presence n (DecorExcept is) = map not (presence n (DecorOnly is))
presence n (DecorUnion ds)  = combine (||) False n ds
presence n (DecorIsect ds)  = combine (&&) True  n ds

-- | Combine multiple decorations into one.
combine :: (Bool -> Bool -> Bool) -- ^ combination function
        -> Bool                   -- ^ default value
        -> Int                    -- ^ width
        -> [Decoration]           -- ^ decorations
        -> [Bool]                 -- ^ presence
combine fn def n ds = foldr step first presences
  where
    first     = replicate n def
    step      = zipWith fn
    presences = map (presence n) ds

Text/Tabl/Environment.hs

{- |
Module      : Text.Tabl.Environment
Description : Table environments
Copyright   : (c) Daniel Lovasko, 2016
License     : BSD3

Maintainer  : Daniel Lovasko <daniel.lovasko@gmail.com>
Stability   : stable
Portability : portable

Definition of various environments for table rendering.
-}

module Text.Tabl.Environment
( Environment(..)
) where

-- | Output environment that declares the way that the table will be
-- rendered.
data Environment
  = EnvAscii -- ^ ASCII art suitable for command line
  | EnvLatex -- ^ LaTeX source code
  deriving (Show)

Text/Tabl/Latex.hs

{- |
Module      : Text.Tabl.Latex
Description : LaTeX table rendering engine
Copyright   : (c) Daniel Lovasko, 2016
License     : BSD3

Maintainer  : Daniel Lovasko <daniel.lovasko@gmail.com>
Stability   : stable
Portability : portable

Implementation of the LaTeX environment for table rendering.
-}

{-# LANGUAGE OverloadedStrings #-}

module Text.Tabl.Latex
( latex
) where

import Text.Tabl.Alignment
import Text.Tabl.Util

import qualified Data.Text as T

-- | Convert the table cell data to LaTeX-compatible form.
createTable :: [[T.Text]] -- ^ table cells
            -> [T.Text]   -- ^ latexified rows
createTable = map (flip T.append " \\\\" . T.intercalate " & ")

-- | Create the table header with vertical decoration and column alignments.
alignSpecifier :: [Bool]      -- ^ vertical decoration
               -> [Alignment] -- ^ column alignments
               -> T.Text      -- ^ header
alignSpecifier vpres aligns = T.concat ["{ ", info, "}"]
  where
    info               = T.concat $ intersperseOn letters vpres "| "
    letters            = map letter aligns
    letter AlignLeft   = "l "
    letter AlignRight  = "r "
    letter AlignCentre = "c "

-- | Create a LaTeX-compatible source code that represents the requested
-- table layout.
latex :: [Bool]      -- ^ horizontal decoration
      -> [Bool]      -- ^ vertical decoration
      -> [Alignment] -- ^ column alignments
      -> [[T.Text]]  -- ^ table cell data
      -> T.Text      -- ^ table
latex hpres vpres aligns cells =
  T.concat [ "\\begin{tabular}"
           ,  alignSpecifier vpres aligns
           ,  "\n"
           ,  T.unlines table
           ,  "\\end{tabular}" ]
  where
    table = intersperseOn (createTable cells) hpres "\\hline"

Text/Tabl/Util.hs

{- |
Module      : Text.Tabl.Util
Description : Various utilities
Copyright   : (c) Daniel Lovasko, 2016
License     : BSD3

Maintainer  : Daniel Lovasko <daniel.lovasko@gmail.com>
Stability   : stable
Portability : portable

Set of general utilities that are used across the codebase.
-}

module Text.Tabl.Util
( bool
, extend
, intersperseOn
, zipcat
) where

-- | Extend a list to defined length with one repeated element.
extend :: Int -- ^ expected length
       -> a   -- ^ element to pad with
       -> [a] -- ^ original list
       -> [a] -- ^ extended list
extend n x xs = xs ++ replicate (n - length xs) x

-- | Insert an element before i-th position, if the i-th Bool is True.
intersperseOn :: (Monoid a)
              => [a]    -- ^ list
              -> [Bool] -- ^ insert rules
              -> a      -- ^ element to insert
              -> [a]    -- ^ new list
intersperseOn xs bs x = init $ concat $ zipWith glue bs (xs ++ [mempty])
  where
    glue True i  = [x, i]
    glue False i = [i]

-- | Endomorphism on the boolean type.
bool :: a    -- ^ True option
     -> a    -- ^ False option
     -> Bool -- ^ bool
     -> a    -- ^ result
bool x _ True  = x
bool _ y False = y

-- | Create an object by zipping two lists together. The second list is
-- expected to be one element shorter.
zipcat :: (Monoid a)
       => [a] -- ^ first list
       -> [a] -- ^ second list
       -> a   -- ^ result
zipcat xs ys = mconcat $ zipWith mappend xs (mappend ys [mempty])
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment