    -- | Text.Tabular.AsciiArt from tabular-0.2.2.7, modified to treat
    -- wide characters as double width.

    module Text.Tabular.AsciiWide where

    import Data.List (intersperse, transpose)
    import Text.Tabular
    import Hledger.Utils.String

    -- | for simplicity, we assume that each cell is rendered
    --   on a single line
    render :: Bool -- ^ pretty tables
           -> (rh -> String)
           -> (ch -> String)
           -> (a -> String)
           -> Table rh ch a
           -> String
    render :: Bool
    -> (rh -> String)
    -> (ch -> String)
    -> (a -> String)
    -> Table rh ch a
    -> String
    render pretty :: Bool
    pretty fr :: rh -> String
    fr fc :: ch -> String
    fc f :: a -> String
    f (Table rh :: Header rh
    rh ch :: Header ch
    ch cells :: [[a]]
    cells) =
      [String] -> String
    unlines ([String] -> String) -> [String] -> String
    forall a b. (a -> b) -> a -> b
    $ [ VPos -> Properties -> String
    bar VPos
    VT Properties
    SingleLine   -- +--------------------------------------+
                , Bool -> [Int] -> Header String -> String
    renderColumns Bool
    pretty [Int]
    sizes Header String
    ch2
                , VPos -> Properties -> String
    bar VPos
    VM Properties
    DoubleLine   -- +======================================+
                ] [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++
                (Header String -> [String]
    renderRs (Header String -> [String]) -> Header String -> [String]
    forall a b. (a -> b) -> a -> b
    $ (([a], String) -> String) -> Header ([a], String) -> Header String
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ([a], String) -> String
    renderR (Header ([a], String) -> Header String)
    -> Header ([a], String) -> Header String
    forall a b. (a -> b) -> a -> b
    $ [a] -> [[a]] -> Header String -> Header ([a], String)
    forall h a. h -> [h] -> Header a -> Header (h, a)
    zipHeader [] [[a]]
    cells (Header String -> Header ([a], String))
    -> Header String -> Header ([a], String)
    forall a b. (a -> b) -> a -> b
    $ (rh -> String) -> Header rh -> Header String
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap rh -> String
    fr Header rh
    rh) [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++
                [ VPos -> Properties -> String
    bar VPos
    VB Properties
    SingleLine ] -- +--------------------------------------+
     where
      bar :: VPos -> Properties -> String
    bar vpos :: VPos
    vpos prop :: Properties
    prop = [String] -> String
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat (VPos -> Bool -> [Int] -> Header String -> Properties -> [String]
    renderHLine VPos
    vpos Bool
    pretty [Int]
    sizes Header String
    ch2 Properties
    prop)
      -- ch2 and cell2 include the row and column labels
      ch2 :: Header String
    ch2 = Properties -> [Header String] -> Header String
    forall h. Properties -> [Header h] -> Header h
    Group Properties
    DoubleLine [String -> Header String
    forall h. h -> Header h
    Header "", (ch -> String) -> Header ch -> Header String
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ch -> String
    fc Header ch
    ch]
      cells2 :: [[String]]
    cells2 = Header String -> [String]
    forall h. Header h -> [h]
    headerContents Header String
    ch2
             [String] -> [[String]] -> [[String]]
    forall a. a -> [a] -> [a]
    : (String -> [a] -> [String]) -> [String] -> [[a]] -> [[String]]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith (\h :: String
    h cs :: [a]
    cs -> String
    h String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    : (a -> String) -> [a] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map a -> String
    f [a]
    cs) [String]
    rhStrings [[a]]
    cells
      --
      renderR :: ([a], String) -> String
    renderR (cs :: [a]
    cs,h :: String
    h) = Bool -> [Int] -> Header String -> String
    renderColumns Bool
    pretty [Int]
    sizes (Header String -> String) -> Header String -> String
    forall a b. (a -> b) -> a -> b
    $ Properties -> [Header String] -> Header String
    forall h. Properties -> [Header h] -> Header h
    Group Properties
    DoubleLine
                        [ String -> Header String
    forall h. h -> Header h
    Header String
    h
                        , ((String, ch) -> String) -> Header (String, ch) -> Header String
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (String, ch) -> String
    forall a b. (a, b) -> a
    fst (Header (String, ch) -> Header String)
    -> Header (String, ch) -> Header String
    forall a b. (a -> b) -> a -> b
    $ String -> [String] -> Header ch -> Header (String, ch)
    forall h a. h -> [h] -> Header a -> Header (h, a)
    zipHeader "" ((a -> String) -> [a] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map a -> String
    f [a]
    cs) Header ch
    ch]
      rhStrings :: [String]
    rhStrings = (rh -> String) -> [rh] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map rh -> String
    fr ([rh] -> [String]) -> [rh] -> [String]
    forall a b. (a -> b) -> a -> b
    $ Header rh -> [rh]
    forall h. Header h -> [h]
    headerContents Header rh
    rh
      -- maximum width for each column
      sizes :: [Int]
    sizes   = ([String] -> Int) -> [[String]] -> [Int]
    forall a b. (a -> b) -> [a] -> [b]
    map ([Int] -> Int
    forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
    maximum ([Int] -> Int) -> ([String] -> [Int]) -> [String] -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String -> Int) -> [String] -> [Int]
    forall a b. (a -> b) -> [a] -> [b]
    map String -> Int
    strWidth) ([[String]] -> [Int])
    -> ([[String]] -> [[String]]) -> [[String]] -> [Int]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [[String]] -> [[String]]
    forall a. [[a]] -> [[a]]
    transpose ([[String]] -> [Int]) -> [[String]] -> [Int]
    forall a b. (a -> b) -> a -> b
    $ [[String]]
    cells2
      renderRs :: Header String -> [String]
    renderRs (Header s :: String
    s)   = [String
    s]
      renderRs (Group p :: Properties
    p hs :: [Header String]
    hs) = [[String]] -> [String]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat ([[String]] -> [String])
    -> ([Header String] -> [[String]]) -> [Header String] -> [String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [String] -> [[String]] -> [[String]]
    forall a. a -> [a] -> [a]
    intersperse [String]
    sep ([[String]] -> [[String]])
    -> ([Header String] -> [[String]]) -> [Header String] -> [[String]]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Header String -> [String]) -> [Header String] -> [[String]]
    forall a b. (a -> b) -> [a] -> [b]
    map Header String -> [String]
    renderRs ([Header String] -> [String]) -> [Header String] -> [String]
    forall a b. (a -> b) -> a -> b
    $ [Header String]
    hs
        where sep :: [String]
    sep = VPos -> Bool -> [Int] -> Header String -> Properties -> [String]
    renderHLine VPos
    VM Bool
    pretty [Int]
    sizes Header String
    ch2 Properties
    p

    verticalBar :: Bool -> Char
    verticalBar :: Bool -> Char
    verticalBar pretty :: Bool
    pretty = if Bool
    pretty then '│' else '|'

    leftBar :: Bool -> String
    leftBar :: Bool -> String
    leftBar pretty :: Bool
    pretty = Bool -> Char
    verticalBar Bool
    pretty Char -> String -> String
    forall a. a -> [a] -> [a]
    : " "

    rightBar :: Bool -> String
    rightBar :: Bool -> String
    rightBar pretty :: Bool
    pretty = " " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ [Bool -> Char
    verticalBar Bool
    pretty]

    midBar :: Bool -> String
    midBar :: Bool -> String
    midBar pretty :: Bool
    pretty = " " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Bool -> Char
    verticalBar Bool
    pretty Char -> String -> String
    forall a. a -> [a] -> [a]
    : " "

    doubleMidBar :: Bool -> String
    doubleMidBar :: Bool -> String
    doubleMidBar pretty :: Bool
    pretty = if Bool
    pretty then " ║ " else " || "

    -- | We stop rendering on the shortest list!
    renderColumns :: Bool -- ^ pretty
                  -> [Int] -- ^ max width for each column
                  -> Header String
                  -> String
    renderColumns :: Bool -> [Int] -> Header String -> String
    renderColumns pretty :: Bool
    pretty is :: [Int]
    is h :: Header String
    h = Bool -> String
    leftBar Bool
    pretty String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    coreLine String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Bool -> String
    rightBar Bool
    pretty
     where
      coreLine :: String
    coreLine = (Either Properties (Int, String) -> String)
    -> [Either Properties (Int, String)] -> String
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap Either Properties (Int, String) -> String
    helper ([Either Properties (Int, String)] -> String)
    -> [Either Properties (Int, String)] -> String
    forall a b. (a -> b) -> a -> b
    $ Header (Int, String) -> [Either Properties (Int, String)]
    forall h. Header h -> [Either Properties h]
    flattenHeader (Header (Int, String) -> [Either Properties (Int, String)])
    -> Header (Int, String) -> [Either Properties (Int, String)]
    forall a b. (a -> b) -> a -> b
    $ Int -> [Int] -> Header String -> Header (Int, String)
    forall h a. h -> [h] -> Header a -> Header (h, a)
    zipHeader 0 [Int]
    is Header String
    h
      helper :: Either Properties (Int, String) -> String
    helper = (Properties -> String)
    -> ((Int, String) -> String)
    -> Either Properties (Int, String)
    -> String
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either Properties -> String
    hsep ((Int -> String -> String) -> (Int, String) -> String
    forall a b c. (a -> b -> c) -> (a, b) -> c
    uncurry Int -> String -> String
    padLeftWide)
      hsep :: Properties -> String
      hsep :: Properties -> String
    hsep NoLine     = "  "
      hsep SingleLine = Bool -> String
    midBar Bool
    pretty
      hsep DoubleLine = Bool -> String
    doubleMidBar Bool
    pretty

    renderHLine :: VPos
                -> Bool -- ^ pretty
                -> [Int] -- ^ width specifications
                -> Header String
                -> Properties
                -> [String]
    renderHLine :: VPos -> Bool -> [Int] -> Header String -> Properties -> [String]
    renderHLine _ _ _ _ NoLine = []
    renderHLine vpos :: VPos
    vpos pretty :: Bool
    pretty w :: [Int]
    w h :: Header String
    h prop :: Properties
    prop = [VPos -> Bool -> Properties -> [Int] -> Header String -> String
    renderHLine' VPos
    vpos Bool
    pretty Properties
    prop [Int]
    w Header String
    h]

    renderHLine' :: VPos -> Bool -> Properties -> [Int] -> Header String -> String
    renderHLine' :: VPos -> Bool -> Properties -> [Int] -> Header String -> String
    renderHLine' vpos :: VPos
    vpos pretty :: Bool
    pretty prop :: Properties
    prop is :: [Int]
    is h :: Header String
    h = HPos -> String
    edge HPos
    HL String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    sep String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    coreLine String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    sep String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ HPos -> String
    edge HPos
    HR
     where
      edge :: HPos -> String
    edge hpos :: HPos
    hpos       = VPos -> HPos -> Properties -> Properties -> Bool -> String
    boxchar VPos
    vpos HPos
    hpos Properties
    SingleLine Properties
    prop Bool
    pretty
      coreLine :: String
    coreLine        = (Either Properties (Int, String) -> String)
    -> [Either Properties (Int, String)] -> String
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap Either Properties (Int, String) -> String
    forall b. Either Properties (Int, b) -> String
    helper ([Either Properties (Int, String)] -> String)
    -> [Either Properties (Int, String)] -> String
    forall a b. (a -> b) -> a -> b
    $ Header (Int, String) -> [Either Properties (Int, String)]
    forall h. Header h -> [Either Properties h]
    flattenHeader (Header (Int, String) -> [Either Properties (Int, String)])
    -> Header (Int, String) -> [Either Properties (Int, String)]
    forall a b. (a -> b) -> a -> b
    $ Int -> [Int] -> Header String -> Header (Int, String)
    forall h a. h -> [h] -> Header a -> Header (h, a)
    zipHeader 0 [Int]
    is Header String
    h
      helper :: Either Properties (Int, b) -> String
    helper          = (Properties -> String)
    -> ((Int, b) -> String) -> Either Properties (Int, b) -> String
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either Properties -> String
    vsep (Int, b) -> String
    forall b. (Int, b) -> String
    dashes
      dashes :: (Int, b) -> String
    dashes (i :: Int
    i,_)    = [String] -> String
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat (Int -> String -> [String]
    forall a. Int -> a -> [a]
    replicate Int
    i String
    sep)
      sep :: String
    sep             = VPos -> HPos -> Properties -> Properties -> Bool -> String
    boxchar VPos
    vpos HPos
    HM Properties
    NoLine Properties
    prop Bool
    pretty
      vsep :: Properties -> String
    vsep v :: Properties
    v          = case Properties
    v of
                          NoLine -> String
    sep String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    sep
                          _      -> String
    sep String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Properties -> Properties -> String
    cross Properties
    v Properties
    prop String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    sep
      cross :: Properties -> Properties -> String
    cross v :: Properties
    v h :: Properties
    h       = VPos -> HPos -> Properties -> Properties -> Bool -> String
    boxchar VPos
    vpos HPos
    HM Properties
    v Properties
    h Bool
    pretty

    data VPos = VT | VM | VB -- top middle bottom
    data HPos = HL | HM | HR -- left middle right

    boxchar :: VPos -> HPos -> Properties -> Properties -> Bool -> String
    boxchar :: VPos -> HPos -> Properties -> Properties -> Bool -> String
    boxchar vpos :: VPos
    vpos hpos :: HPos
    hpos vert :: Properties
    vert horiz :: Properties
    horiz = Properties
    -> Properties -> Properties -> Properties -> Bool -> String
    lineart Properties
    u Properties
    d Properties
    l Properties
    r
      where
        u :: Properties
    u =
          case VPos
    vpos of
            VT -> Properties
    NoLine
            _  -> Properties
    vert
        d :: Properties
    d =
          case VPos
    vpos of
            VB -> Properties
    NoLine
            _  -> Properties
    vert
        l :: Properties
    l =
          case HPos
    hpos of
            HL -> Properties
    NoLine
            _  -> Properties
    horiz
        r :: Properties
    r =
          case HPos
    hpos of
            HR -> Properties
    NoLine
            _  -> Properties
    horiz

    pick :: String -> String -> Bool -> String
    pick :: String -> String -> Bool -> String
    pick x :: String
    x _ True  = String
    x
    pick _ x :: String
    x False = String
    x

    lineart :: Properties -> Properties -> Properties -> Properties -> Bool -> String
    --      up         down       left      right
    lineart :: Properties
    -> Properties -> Properties -> Properties -> Bool -> String
    lineart SingleLine SingleLine SingleLine SingleLine = String -> String -> Bool -> String
    pick "┼" "+"
    lineart SingleLine SingleLine SingleLine NoLine     = String -> String -> Bool -> String
    pick "┤" "+"
    lineart SingleLine SingleLine NoLine     SingleLine = String -> String -> Bool -> String
    pick "├" "+"
    lineart SingleLine NoLine     SingleLine SingleLine = String -> String -> Bool -> String
    pick "┴" "+"
    lineart NoLine     SingleLine SingleLine SingleLine = String -> String -> Bool -> String
    pick "┬" "+"
    lineart SingleLine NoLine     NoLine     SingleLine = String -> String -> Bool -> String
    pick "└" "+"
    lineart SingleLine NoLine     SingleLine NoLine     = String -> String -> Bool -> String
    pick "┘" "+"
    lineart NoLine     SingleLine SingleLine NoLine     = String -> String -> Bool -> String
    pick "┐" "+"
    lineart NoLine     SingleLine NoLine     SingleLine = String -> String -> Bool -> String
    pick "┌" "+"
    lineart SingleLine SingleLine NoLine     NoLine     = String -> String -> Bool -> String
    pick "│" "|"
    lineart NoLine     NoLine     SingleLine SingleLine = String -> String -> Bool -> String
    pick "─" "-"

    lineart DoubleLine DoubleLine DoubleLine DoubleLine = String -> String -> Bool -> String
    pick "╬" "++"
    lineart DoubleLine DoubleLine DoubleLine NoLine     = String -> String -> Bool -> String
    pick "╣" "++"
    lineart DoubleLine DoubleLine NoLine     DoubleLine = String -> String -> Bool -> String
    pick "╠" "++"
    lineart DoubleLine NoLine     DoubleLine DoubleLine = String -> String -> Bool -> String
    pick "╩" "++"
    lineart NoLine     DoubleLine DoubleLine DoubleLine = String -> String -> Bool -> String
    pick "╦" "++"
    lineart DoubleLine NoLine     NoLine     DoubleLine = String -> String -> Bool -> String
    pick "╚" "++"
    lineart DoubleLine NoLine     DoubleLine NoLine     = String -> String -> Bool -> String
    pick "╝" "++"
    lineart NoLine     DoubleLine DoubleLine NoLine     = String -> String -> Bool -> String
    pick "╗" "++"
    lineart NoLine     DoubleLine NoLine     DoubleLine = String -> String -> Bool -> String
    pick "╔" "++"
    lineart DoubleLine DoubleLine NoLine     NoLine     = String -> String -> Bool -> String
    pick "║" "||"
    lineart NoLine     NoLine     DoubleLine DoubleLine = String -> String -> Bool -> String
    pick "═" "="

    lineart DoubleLine NoLine     NoLine     SingleLine = String -> String -> Bool -> String
    pick "╙" "++"
    lineart DoubleLine NoLine     SingleLine NoLine     = String -> String -> Bool -> String
    pick "╜" "++"
    lineart NoLine     DoubleLine SingleLine NoLine     = String -> String -> Bool -> String
    pick "╖" "++"
    lineart NoLine     DoubleLine NoLine     SingleLine = String -> String -> Bool -> String
    pick "╓" "++"

    lineart SingleLine NoLine     NoLine     DoubleLine = String -> String -> Bool -> String
    pick "╘" "+"
    lineart SingleLine NoLine     DoubleLine NoLine     = String -> String -> Bool -> String
    pick "╛" "+"
    lineart NoLine     SingleLine DoubleLine NoLine     = String -> String -> Bool -> String
    pick "╕" "+"
    lineart NoLine     SingleLine NoLine     DoubleLine = String -> String -> Bool -> String
    pick "╒" "+"

    lineart DoubleLine DoubleLine SingleLine NoLine     = String -> String -> Bool -> String
    pick "╢" "++"
    lineart DoubleLine DoubleLine NoLine     SingleLine = String -> String -> Bool -> String
    pick "╟" "++"
    lineart DoubleLine NoLine     SingleLine SingleLine = String -> String -> Bool -> String
    pick "╨" "++"
    lineart NoLine     DoubleLine SingleLine SingleLine = String -> String -> Bool -> String
    pick "╥" "++"

    lineart SingleLine SingleLine DoubleLine NoLine     = String -> String -> Bool -> String
    pick "╡" "+"
    lineart SingleLine SingleLine NoLine     DoubleLine = String -> String -> Bool -> String
    pick "╞" "+"
    lineart SingleLine NoLine     DoubleLine DoubleLine = String -> String -> Bool -> String
    pick "╧" "+"
    lineart NoLine     SingleLine DoubleLine DoubleLine = String -> String -> Bool -> String
    pick "╤" "+"

    lineart SingleLine SingleLine DoubleLine DoubleLine = String -> String -> Bool -> String
    pick "╪" "+"
    lineart DoubleLine DoubleLine SingleLine SingleLine = String -> String -> Bool -> String
    pick "╫" "++"

    lineart _          _          _          _          = String -> Bool -> String
    forall a b. a -> b -> a
    const ""

    --