module Music.Theory.Array.CSV where
import qualified Data.Array as A
import Data.List
import qualified Text.CSV.Lazy.String as C
import qualified Music.Theory.Array.Cell_Ref as T
import qualified Music.Theory.IO as T
import qualified Music.Theory.List as T
import qualified Music.Theory.Tuple as T
type CSV_Has_Header = Bool
type CSV_Delimiter = Char
type CSV_Allow_Linebreaks = Bool
data CSV_Align_Columns = CSV_No_Align | CSV_Align_Left | CSV_Align_Right
type CSV_Opt = (CSV_Has_Header,CSV_Delimiter,CSV_Allow_Linebreaks,CSV_Align_Columns)
def_csv_opt :: CSV_Opt
def_csv_opt = (False,',',False,CSV_No_Align)
type Table a = [[a]]
type CSV_Table a = (Maybe [String],Table a)
csv_table_read :: CSV_Opt -> (String -> a) -> FilePath -> IO (CSV_Table a)
csv_table_read (hdr,delim,brk,_) f fn = do
s <- T.read_file_utf8 fn
let t = C.csvTable (C.parseDSV brk delim s)
p = C.fromCSVTable t
(h,d) = if hdr then (Just (head p),tail p) else (Nothing,p)
return (h,map (map f) d)
csv_table_read_def :: (String -> a) -> FilePath -> IO (Table a)
csv_table_read_def f = fmap snd . csv_table_read def_csv_opt f
csv_table_with :: CSV_Opt -> (String -> a) -> FilePath -> (CSV_Table a -> b) -> IO b
csv_table_with opt f fn g = fmap g (csv_table_read opt f fn)
csv_table_align :: CSV_Align_Columns -> Table String -> Table String
csv_table_align align tbl =
let c = transpose tbl
n = map (maximum . map length) c
ext k s = let pd = replicate (k length s) ' '
in case align of
CSV_No_Align -> s
CSV_Align_Left -> pd ++ s
CSV_Align_Right -> s ++ pd
in transpose (zipWith (map . ext) n c)
csv_table_pp :: (a -> String) -> CSV_Opt -> CSV_Table a -> String
csv_table_pp f (_,delim,brk,align) (hdr,tbl) =
let tbl' = csv_table_align align (T.mcons hdr (map (map f) tbl))
(_,t) = C.toCSVTable tbl'
in C.ppDSVTable brk delim t
csv_table_write :: (a -> String) -> CSV_Opt -> FilePath -> CSV_Table a -> IO ()
csv_table_write f opt fn csv = T.write_file_utf8 fn (csv_table_pp f opt csv)
csv_table_write_def :: (a -> String) -> FilePath -> Table a -> IO ()
csv_table_write_def f fn tbl = csv_table_write f def_csv_opt fn (Nothing,tbl)
table_lookup :: Table a -> (Int,Int) -> a
table_lookup t (r,c) = (t !! r) !! c
table_row :: Table a -> T.Row_Ref -> [a]
table_row t r = t !! T.row_index r
table_column :: Table a -> T.Column_Ref -> [a]
table_column t c = transpose t !! T.column_index c
table_column_lookup :: Eq a => Table a -> (T.Column_Ref,T.Column_Ref) -> a -> Maybe a
table_column_lookup t (c1,c2) e =
let a = zip (table_column t c1) (table_column t c2)
in lookup e a
table_cell :: Table a -> T.Cell_Ref -> a
table_cell t (c,r) =
let (r',c') = (T.row_index r,T.column_index c)
in table_lookup t (r',c')
table_lookup_row_segment :: Table a -> (Int,(Int,Int)) -> [a]
table_lookup_row_segment t (r,(c0,c1)) =
let r' = t !! r
in take (c1 c0 + 1) (drop c0 r')
table_row_segment :: Table a -> (T.Row_Ref,T.Column_Range) -> [a]
table_row_segment t (r,c) =
let (r',c') = (T.row_index r,T.column_indices c)
in table_lookup_row_segment t (r',c')
table_to_array :: Table a -> A.Array T.Cell_Ref a
table_to_array t =
let nr = length t
nc = length (t !! 0)
bnd = (T.cell_ref_minima,(toEnum (nc 1),nr))
asc = zip (T.cell_range_row_order bnd) (concat t)
in A.array bnd asc
csv_array_read :: CSV_Opt -> (String -> a) -> FilePath -> IO (A.Array T.Cell_Ref a)
csv_array_read opt f fn = fmap (table_to_array . snd) (csv_table_read opt f fn)
csv_field_str :: C.CSVField -> String
csv_field_str f =
case f of
C.CSVField _ _ _ _ s _ -> s
C.CSVFieldError _ _ _ _ _ -> error "csv_field_str"
csv_error_recover :: C.CSVError -> C.CSVRow
csv_error_recover e =
case e of
C.IncorrectRow _ _ _ f -> f
C.BlankLine _ _ _ _ -> []
_ -> error "csv_error_recover: not recoverable"
csv_row_recover :: Either [C.CSVError] C.CSVRow -> C.CSVRow
csv_row_recover r =
case r of
Left [e] -> csv_error_recover e
Left _ -> error "csv_row_recover: multiple errors"
Right r' -> r'
csv_load_irregular :: (String -> a) -> FilePath -> IO [[a]]
csv_load_irregular f fn = do
s <- T.read_file_utf8 fn
return (map (map (f . csv_field_str) . csv_row_recover) (C.parseCSV s))
type P5_Parser t1 t2 t3 t4 t5 = (String -> t1,String -> t2,String -> t3,String -> t4,String -> t5)
type P5_Writer t1 t2 t3 t4 t5 = (t1 -> String,t2 -> String,t3 -> String,t4 -> String,t5 -> String)
csv_table_read_p5 :: P5_Parser t1 t2 t3 t4 t5 -> CSV_Opt -> FilePath -> IO (Maybe [String],[(t1,t2,t3,t4,t5)])
csv_table_read_p5 f opt fn = do
(hdr,dat) <- csv_table_read opt id fn
return (hdr,map (T.p5_from_list f) dat)
csv_table_write_p5 :: P5_Writer t1 t2 t3 t4 t5 -> CSV_Opt -> FilePath -> (Maybe [String],[(t1,t2,t3,t4,t5)]) -> IO ()
csv_table_write_p5 f opt fn (hdr,dat) = csv_table_write id opt fn (hdr,map (T.p5_to_list f) dat)