-- | Regular array data as plain text tables.
module Music.Theory.Array.Text where

import Data.List {- base -}

import qualified Data.List.Split as Split {- split -}

import qualified Music.Theory.Array as T {- hmt-base -}
import qualified Music.Theory.Function as T {- hmt-base -}
import qualified Music.Theory.List as T {- hmt-base -}
import qualified Music.Theory.String as T {- hmt-base -}

-- | Tabular text.
type Text_Table = [[String]]

-- | Split table at indicated places.
--
-- > let tbl = [["1","2","3","4"],["A","B","E","F"],["C","D","G","H"]]
-- > table_split [2,2] tbl
table_split :: [Int] -> Text_Table -> [Text_Table]
table_split :: [Int] -> Text_Table -> [Text_Table]
table_split [Int]
pl Text_Table
dat = forall a. [[a]] -> [[a]]
transpose (forall a b. (a -> b) -> [a] -> [b]
map (forall a e. Integral a => [a] -> [e] -> [[e]]
Split.splitPlaces [Int]
pl) Text_Table
dat)

-- | Join tables left to right.
--
-- > table_concat [[["1","2"],["A","B"],["C","D"]],[["3","4"],["E","F"],["G","H"]]]
table_concat :: [Text_Table] -> Text_Table
table_concat :: [Text_Table] -> Text_Table
table_concat [Text_Table]
sq = forall a b. (a -> b) -> [a] -> [b]
map forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (forall a. [[a]] -> [[a]]
transpose [Text_Table]
sq)

-- | Add a row number column at the front of the table.
--
-- > table_number_rows 0 tbl
table_number_rows :: Int -> Text_Table -> Text_Table
table_number_rows :: Int -> Text_Table -> Text_Table
table_number_rows Int
k = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Int
i [String]
r -> forall a. Show a => a -> String
show Int
i forall a. a -> [a] -> [a]
: [String]
r) [Int
k ..]

{- | (HEADER,PAD-LEFT,EQ-WIDTH,COL-SEP,TBL-DELIM).

Options are:
 has header
 pad text with space to left instead of right,
 make all columns equal width,
 column separator string,
 print table delimiters
-}
type Text_Table_Opt = (Bool,Bool,Bool,String,Bool)

-- | Options for @plain@ layout.
table_opt_plain :: Text_Table_Opt
table_opt_plain :: Text_Table_Opt
table_opt_plain = (Bool
False,Bool
True,Bool
False,String
" ",Bool
False)

-- | Options for @simple@ layout.
table_opt_simple :: Text_Table_Opt
table_opt_simple :: Text_Table_Opt
table_opt_simple = (Bool
True,Bool
True,Bool
False,String
" ",Bool
True)

-- | Options for @pipe@ layout.
table_opt_pipe :: Text_Table_Opt
table_opt_pipe :: Text_Table_Opt
table_opt_pipe = (Bool
True,Bool
True,Bool
False,String
" | ",Bool
False)

-- | Pretty-print table.  Table is in row order.
--
-- > let tbl = [["1","2","3","4"],["a","bc","def"],["ghij","klm","no","p"]]
-- > putStrLn$unlines$"": table_pp (True,True,True," ",True) tbl
-- > putStrLn$unlines$"": table_pp (False,False,True," ",False) tbl
table_pp :: Text_Table_Opt -> Text_Table -> [String]
table_pp :: Text_Table_Opt -> Text_Table -> [String]
table_pp (Bool
has_hdr,Bool
pad_left,Bool
eq_width,String
col_sep,Bool
print_eot) Text_Table
dat =
    let c :: Text_Table
c = forall a. [[a]] -> [[a]]
transpose (forall t. t -> Table t -> Table t
T.tbl_make_regular_nil String
"" Text_Table
dat)
        nc :: Int
nc = forall (t :: * -> *) a. Foldable t => t a -> Int
length Text_Table
c
        n :: [Int]
n = let k :: [Int]
k = forall a b. (a -> b) -> [a] -> [b]
map (forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall (t :: * -> *) a. Foldable t => t a -> Int
length) Text_Table
c
            in if Bool
eq_width then forall a. Int -> a -> [a]
replicate Int
nc (forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Int]
k) else [Int]
k
        ext :: Int -> String -> String
ext Int
k String
s = if Bool
pad_left then forall a. a -> Int -> [a] -> [a]
T.pad_left Char
' ' Int
k String
s else forall a. a -> Int -> [a] -> [a]
T.pad_right Char
' ' Int
k String
s
        jn :: [String] -> String
jn = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> [a] -> [a]
intersperse String
col_sep
        m :: String
m = [String] -> String
jn (forall a b. (a -> b) -> [a] -> [b]
map (forall a. Int -> a -> [a]
`replicate` Char
'-') [Int]
n)
        w :: [String]
w = forall a b. (a -> b) -> [a] -> [b]
map [String] -> String
jn (forall a. [[a]] -> [[a]]
transpose (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (forall a b. (a -> b) -> [a] -> [b]
map forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
ext) [Int]
n Text_Table
c))
        d :: [String]
d = forall a b. (a -> b) -> [a] -> [b]
map String -> String
T.delete_trailing_whitespace [String]
w
        pr :: [String] -> [String]
pr [String]
x = if Bool
print_eot then forall a. (a, a) -> [a] -> [a]
T.bracket (String
m,String
m) [String]
x else [String]
x
    in case [String]
d of
         [] -> forall a. HasCallStack => String -> a
error String
"table_pp"
         String
d0:[String]
dr -> if Bool
has_hdr then String
d0 forall a. a -> [a] -> [a]
: [String] -> [String]
pr [String]
dr else [String] -> [String]
pr [String]
d

-- | Variant relying on 'Show' instances.
--
-- > table_pp_show table_opt_simple [[1..4],[5..8],[9..12]]
table_pp_show :: Show t => Text_Table_Opt -> T.Table t -> [String]
table_pp_show :: forall t. Show t => Text_Table_Opt -> Table t -> [String]
table_pp_show Text_Table_Opt
opt = Text_Table_Opt -> Text_Table -> [String]
table_pp Text_Table_Opt
opt forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> String
show)

-- | Variant in column order (ie. 'transpose').
--
-- > table_pp_column_order table_opt_simple [["a","bc","def"],["ghij","klm","no"]]
table_pp_column_order :: Text_Table_Opt -> Text_Table -> [String]
table_pp_column_order :: Text_Table_Opt -> Text_Table -> [String]
table_pp_column_order Text_Table_Opt
opt = Text_Table_Opt -> Text_Table -> [String]
table_pp Text_Table_Opt
opt forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [[a]] -> [[a]]
transpose

{- | Matrix form, ie. header in both first row and first column, in
each case displaced by one location which is empty.

> let h = (map return "abc",map return "efgh")
> let t = table_matrix h (map (map show) [[1,2,3,4],[2,3,4,1],[3,4,1,2]])

>>> putStrLn $ unlines $ table_pp table_opt_simple t
- - - - -
  e f g h
a 1 2 3 4
b 2 3 4 1
c 3 4 1 2
- - - - -

-}
table_matrix :: ([String],[String]) -> Text_Table -> Text_Table
table_matrix :: ([String], [String]) -> Text_Table -> Text_Table
table_matrix ([String]
r,[String]
c) Text_Table
t = [Text_Table] -> Text_Table
table_concat [[String
""] forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map forall (m :: * -> *) a. Monad m => a -> m a
return [String]
r,[String]
c forall a. a -> [a] -> [a]
: Text_Table
t]

-- | Variant that takes a 'show' function and a /header decoration/ function.
--
-- > table_matrix_opt show id ([1,2,3],[4,5,6]) [[7,8,9],[10,11,12],[13,14,15]]
table_matrix_opt :: (a -> String) -> (String -> String) -> ([a],[a]) -> T.Table a -> Text_Table
table_matrix_opt :: forall a.
(a -> String)
-> (String -> String) -> ([a], [a]) -> Table a -> Text_Table
table_matrix_opt a -> String
show_f String -> String
hd_f ([a], [a])
nm Table a
t =
    let nm' :: ([String], [String])
nm' = forall t u. (t -> u) -> (t, t) -> (u, u)
T.bimap1 (forall a b. (a -> b) -> [a] -> [b]
map (String -> String
hd_f forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
show_f)) ([a], [a])
nm
        t' :: Text_Table
t' = forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (a -> b) -> [a] -> [b]
map a -> String
show_f) Table a
t
    in ([String], [String]) -> Text_Table -> Text_Table
table_matrix ([String], [String])
nm' Text_Table
t'

{-
-- | Two-tuple 'show' variant.
table_table_p2 :: (Show a,Show b) => Text_Table_Opt -> Maybe [String] -> ([a],[b]) -> [String]
table_table_p2 opt hdr (p,q) = table_table' opt hdr [map show p,map show q]

-- | Three-tuple 'show' variant.
table_table_p3 :: (Show a,Show b,Show c) => Text_Table_Opt -> Maybe [String] -> ([a],[b],[c]) -> [String]
table_table_p3 opt hdr (p,q,r) = table_table' opt hdr [map show p,map show q,map show r]

-}