module Music.Theory.Array.Csv where
import Data.List
import qualified Data.Array as A
import qualified Safe
import qualified Text.CSV.Lazy.String as C
import qualified Music.Theory.Array as T
import qualified Music.Theory.Array.Cell_Ref as R
import qualified Music.Theory.Io as T
import qualified Music.Theory.List as T
import qualified Music.Theory.Tuple as T
csv_requires_quote :: String -> Bool
csv_requires_quote :: String -> Bool
csv_requires_quote = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
"\",\n\r")
csv_quote :: String -> String
csv_quote :: String -> String
csv_quote String
fld =
let esc :: String -> String
esc String
s =
case String
s of
[] -> []
Char
'"':String
s' -> Char
'"' forall a. a -> [a] -> [a]
: Char
'"' forall a. a -> [a] -> [a]
: String -> String
esc String
s'
Char
c:String
s' -> Char
c forall a. a -> [a] -> [a]
: String -> String
esc String
s'
in Char
'"' forall a. a -> [a] -> [a]
: String -> String
esc String
fld forall a. [a] -> [a] -> [a]
++ String
"\""
csv_quote_if_req :: String -> String
csv_quote_if_req :: String -> String
csv_quote_if_req String
fld = if String -> Bool
csv_requires_quote String
fld then String -> String
csv_quote String
fld else String
fld
type = 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 :: Csv_Opt
def_csv_opt = (Bool
False,Char
',',Bool
False,Csv_Align_Columns
Csv_No_Align)
type Csv_Table a = (Maybe [String],T.Table a)
csv_table_read :: Csv_Opt -> (String -> a) -> FilePath -> IO (Csv_Table a)
csv_table_read :: forall a. Csv_Opt -> (String -> a) -> String -> IO (Csv_Table a)
csv_table_read (Bool
hdr,Char
delim,Bool
brk,Csv_Align_Columns
_) String -> a
f String
fn = do
String
s <- String -> IO String
T.read_file_utf8 String
fn
let t :: CSVTable
t = CSVResult -> CSVTable
C.csvTable (Bool -> Char -> String -> CSVResult
C.parseDSV Bool
brk Char
delim String
s)
p :: [[String]]
p = CSVTable -> [[String]]
C.fromCSVTable CSVTable
t
(Maybe [String]
h,[[String]]
d) = if Bool
hdr then (forall a. a -> Maybe a
Just (forall a. [a] -> a
head [[String]]
p),forall a. [a] -> [a]
tail [[String]]
p) else (forall a. Maybe a
Nothing,[[String]]
p)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe [String]
h,forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (a -> b) -> [a] -> [b]
map String -> a
f) [[String]]
d)
csv_table_read_def :: (String -> a) -> FilePath -> IO (T.Table a)
csv_table_read_def :: forall a. (String -> a) -> String -> IO (Table a)
csv_table_read_def String -> a
f = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Csv_Opt -> (String -> a) -> String -> IO (Csv_Table a)
csv_table_read Csv_Opt
def_csv_opt String -> a
f
csv_table_read_plain :: FilePath -> IO (T.Table String)
csv_table_read_plain :: String -> IO [[String]]
csv_table_read_plain = forall a. (String -> a) -> String -> IO (Table a)
csv_table_read_def forall a. a -> a
id
csv_table_with :: Csv_Opt -> (String -> a) -> FilePath -> (Csv_Table a -> b) -> IO b
csv_table_with :: forall a b.
Csv_Opt -> (String -> a) -> String -> (Csv_Table a -> b) -> IO b
csv_table_with Csv_Opt
opt String -> a
f String
fn Csv_Table a -> b
g = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Csv_Table a -> b
g (forall a. Csv_Opt -> (String -> a) -> String -> IO (Csv_Table a)
csv_table_read Csv_Opt
opt String -> a
f String
fn)
csv_table_align :: Csv_Align_Columns -> T.Table String -> T.Table String
csv_table_align :: Csv_Align_Columns -> [[String]] -> [[String]]
csv_table_align Csv_Align_Columns
align [[String]]
tbl =
let c :: [[String]]
c = forall a. [[a]] -> [[a]]
transpose [[String]]
tbl
n :: [Int]
n = 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) [[String]]
c
ext :: Int -> String -> String
ext Int
k String
s = let pd :: String
pd = forall a. Int -> a -> [a]
replicate (Int
k forall a. Num a => a -> a -> a
- forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s) Char
' '
in case Csv_Align_Columns
align of
Csv_Align_Columns
Csv_No_Align -> String
s
Csv_Align_Columns
Csv_Align_Left -> String
pd forall a. [a] -> [a] -> [a]
++ String
s
Csv_Align_Columns
Csv_Align_Right -> String
s forall a. [a] -> [a] -> [a]
++ String
pd
in 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 [[String]]
c)
csv_table_pp :: (a -> String) -> Csv_Opt -> Csv_Table a -> String
csv_table_pp :: forall a. (a -> String) -> Csv_Opt -> Csv_Table a -> String
csv_table_pp a -> String
f (Bool
_,Char
delim,Bool
brk,Csv_Align_Columns
align) (Maybe [String]
hdr,Table a
tbl) =
let tbl' :: [[String]]
tbl' = Csv_Align_Columns -> [[String]] -> [[String]]
csv_table_align Csv_Align_Columns
align (forall a. Maybe a -> [a] -> [a]
T.mcons Maybe [String]
hdr (forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (a -> b) -> [a] -> [b]
map a -> String
f) Table a
tbl))
([CSVError]
_,CSVTable
t) = [[String]] -> ([CSVError], CSVTable)
C.toCSVTable [[String]]
tbl'
in Bool -> Char -> CSVTable -> String
C.ppDSVTable Bool
brk Char
delim CSVTable
t
csv_table_write :: (a -> String) -> Csv_Opt -> FilePath -> Csv_Table a -> IO ()
csv_table_write :: forall a.
(a -> String) -> Csv_Opt -> String -> Csv_Table a -> IO ()
csv_table_write a -> String
f Csv_Opt
opt String
fn Csv_Table a
csv = String -> String -> IO ()
T.write_file_utf8 String
fn (forall a. (a -> String) -> Csv_Opt -> Csv_Table a -> String
csv_table_pp a -> String
f Csv_Opt
opt Csv_Table a
csv)
csv_table_write_def :: (a -> String) -> FilePath -> T.Table a -> IO ()
csv_table_write_def :: forall a. (a -> String) -> String -> Table a -> IO ()
csv_table_write_def a -> String
f String
fn Table a
tbl = forall a.
(a -> String) -> Csv_Opt -> String -> Csv_Table a -> IO ()
csv_table_write a -> String
f Csv_Opt
def_csv_opt String
fn (forall a. Maybe a
Nothing,Table a
tbl)
csv_table_write_plain :: FilePath -> T.Table String -> IO ()
csv_table_write_plain :: String -> [[String]] -> IO ()
csv_table_write_plain = forall a. (a -> String) -> String -> Table a -> IO ()
csv_table_write_def forall a. a -> a
id
table_lookup :: T.Table a -> (Int,Int) -> a
table_lookup :: forall a. Table a -> (Int, Int) -> a
table_lookup Table a
t (Int
r,Int
c) = let ix :: [a] -> Int -> a
ix = forall a. HasCallStack => String -> [a] -> Int -> a
Safe.atNote String
"table_lookup" in (Table a
t forall {a}. [a] -> Int -> a
`ix` Int
r) forall {a}. [a] -> Int -> a
`ix` Int
c
table_row :: T.Table a -> R.Row_Ref -> [a]
table_row :: forall a. Table a -> Int -> [a]
table_row Table a
t Int
r = forall a. HasCallStack => String -> [a] -> Int -> a
Safe.atNote String
"table_row" Table a
t (Int -> Int
R.row_index Int
r)
table_column :: T.Table a -> R.Column_Ref -> [a]
table_column :: forall a. Table a -> Column_Ref -> [a]
table_column Table a
t Column_Ref
c = forall a. HasCallStack => String -> [a] -> Int -> a
Safe.atNote String
"table_column" (forall a. [[a]] -> [[a]]
transpose Table a
t) (Column_Ref -> Int
R.column_index Column_Ref
c)
table_column_lookup :: Eq a => T.Table a -> (R.Column_Ref,R.Column_Ref) -> a -> Maybe a
table_column_lookup :: forall a.
Eq a =>
Table a -> (Column_Ref, Column_Ref) -> a -> Maybe a
table_column_lookup Table a
t (Column_Ref
c1,Column_Ref
c2) a
e =
let a :: [(a, a)]
a = forall a b. [a] -> [b] -> [(a, b)]
zip (forall a. Table a -> Column_Ref -> [a]
table_column Table a
t Column_Ref
c1) (forall a. Table a -> Column_Ref -> [a]
table_column Table a
t Column_Ref
c2)
in forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup a
e [(a, a)]
a
table_cell :: T.Table a -> R.Cell_Ref -> a
table_cell :: forall a. Table a -> Cell_Ref -> a
table_cell Table a
t (Column_Ref
c,Int
r) =
let (Int
r',Int
c') = (Int -> Int
R.row_index Int
r,Column_Ref -> Int
R.column_index Column_Ref
c)
in forall a. Table a -> (Int, Int) -> a
table_lookup Table a
t (Int
r',Int
c')
table_lookup_row_segment :: T.Table a -> (Int,(Int,Int)) -> [a]
table_lookup_row_segment :: forall a. Table a -> (Int, (Int, Int)) -> [a]
table_lookup_row_segment Table a
t (Int
r,(Int
c0,Int
c1)) =
let r' :: [a]
r' = forall a. HasCallStack => String -> [a] -> Int -> a
Safe.atNote String
"table_lookup_row_segment" Table a
t Int
r
in forall a. Int -> [a] -> [a]
take (Int
c1 forall a. Num a => a -> a -> a
- Int
c0 forall a. Num a => a -> a -> a
+ Int
1) (forall a. Int -> [a] -> [a]
drop Int
c0 [a]
r')
table_row_segment :: T.Table a -> (R.Row_Ref,R.Column_Range) -> [a]
table_row_segment :: forall a. Table a -> (Int, (Column_Ref, Column_Ref)) -> [a]
table_row_segment Table a
t (Int
r,(Column_Ref, Column_Ref)
c) =
let (Int
r',(Int, Int)
c') = (Int -> Int
R.row_index Int
r,(Column_Ref, Column_Ref) -> (Int, Int)
R.column_indices (Column_Ref, Column_Ref)
c)
in forall a. Table a -> (Int, (Int, Int)) -> [a]
table_lookup_row_segment Table a
t (Int
r',(Int, Int)
c')
table_to_array :: T.Table a -> A.Array R.Cell_Ref a
table_to_array :: forall a. Table a -> Array Cell_Ref a
table_to_array Table a
t =
let nr :: Int
nr = forall (t :: * -> *) a. Foldable t => t a -> Int
length Table a
t
nc :: Int
nc = forall (t :: * -> *) a. Foldable t => t a -> Int
length (forall a. HasCallStack => String -> [a] -> Int -> a
Safe.atNote String
"table_to_array" Table a
t Int
0)
bnd :: (Cell_Ref, Cell_Ref)
bnd = (Cell_Ref
R.cell_ref_minima,(forall a. Enum a => Int -> a
toEnum (Int
nc forall a. Num a => a -> a -> a
- Int
1),Int
nr))
asc :: [(Cell_Ref, a)]
asc = forall a b. [a] -> [b] -> [(a, b)]
zip ((Cell_Ref, Cell_Ref) -> [Cell_Ref]
R.cell_range_row_order (Cell_Ref, Cell_Ref)
bnd) (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat Table a
t)
in forall i e. Ix i => (i, i) -> [(i, e)] -> Array i e
A.array (Cell_Ref, Cell_Ref)
bnd [(Cell_Ref, a)]
asc
csv_array_read :: Csv_Opt -> (String -> a) -> FilePath -> IO (A.Array R.Cell_Ref a)
csv_array_read :: forall a.
Csv_Opt -> (String -> a) -> String -> IO (Array Cell_Ref a)
csv_array_read Csv_Opt
opt String -> a
f String
fn = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Table a -> Array Cell_Ref a
table_to_array forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) (forall a. Csv_Opt -> (String -> a) -> String -> IO (Csv_Table a)
csv_table_read Csv_Opt
opt String -> a
f String
fn)
csv_field_str :: C.CSVField -> String
csv_field_str :: CSVField -> String
csv_field_str CSVField
f =
case CSVField
f of
C.CSVField Int
_ Int
_ (Int, Int)
_ (Int, Int)
_ String
s Bool
_ -> String
s
C.CSVFieldError Int
_ Int
_ (Int, Int)
_ (Int, Int)
_ String
_ -> forall a. HasCallStack => String -> a
error String
"csv_field_str"
csv_error_recover :: C.CSVError -> C.CSVRow
csv_error_recover :: CSVError -> CSVRow
csv_error_recover CSVError
e =
case CSVError
e of
C.IncorrectRow Int
_ Int
_ Int
_ CSVRow
f -> CSVRow
f
C.BlankLine Int
_ Int
_ Int
_ CSVField
_ -> []
CSVError
_ -> forall a. HasCallStack => String -> a
error String
"csv_error_recover: not recoverable"
csv_row_recover :: Either [C.CSVError] C.CSVRow -> C.CSVRow
csv_row_recover :: Either [CSVError] CSVRow -> CSVRow
csv_row_recover Either [CSVError] CSVRow
r =
case Either [CSVError] CSVRow
r of
Left [CSVError
e] -> CSVError -> CSVRow
csv_error_recover CSVError
e
Left [CSVError]
_ -> forall a. HasCallStack => String -> a
error String
"csv_row_recover: multiple errors"
Right CSVRow
r' -> CSVRow
r'
csv_load_irregular :: (String -> a) -> FilePath -> IO [[a]]
csv_load_irregular :: forall a. (String -> a) -> String -> IO (Table a)
csv_load_irregular String -> a
f String
fn = do
String
s <- String -> IO String
T.read_file_utf8 String
fn
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (a -> b) -> [a] -> [b]
map (String -> a
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. CSVField -> String
csv_field_str) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either [CSVError] CSVRow -> CSVRow
csv_row_recover) (String -> CSVResult
C.parseCSV String
s))
csv_write_irregular :: (a -> String) -> Csv_Opt -> FilePath -> Csv_Table a -> IO ()
csv_write_irregular :: forall a.
(a -> String) -> Csv_Opt -> String -> Csv_Table a -> IO ()
csv_write_irregular a -> String
f Csv_Opt
opt String
fn (Maybe [String]
hdr,Table a
tbl) =
let tbl' :: [[String]]
tbl' = forall t. t -> Table t -> Table t
T.tbl_make_regular_nil String
"" (forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (a -> b) -> [a] -> [b]
map a -> String
f) Table a
tbl)
in String -> String -> IO ()
T.write_file_utf8 String
fn (forall a. (a -> String) -> Csv_Opt -> Csv_Table a -> String
csv_table_pp forall a. a -> a
id Csv_Opt
opt (Maybe [String]
hdr,[[String]]
tbl'))
csv_write_irregular_def :: (a -> String) -> FilePath -> T.Table a -> IO ()
csv_write_irregular_def :: forall a. (a -> String) -> String -> Table a -> IO ()
csv_write_irregular_def a -> String
f String
fn Table a
tbl = forall a.
(a -> String) -> Csv_Opt -> String -> Csv_Table a -> IO ()
csv_write_irregular a -> String
f Csv_Opt
def_csv_opt String
fn (forall a. Maybe a
Nothing,Table a
tbl)
type P2_Parser t1 t2 = (String -> t1,String -> t2)
csv_table_read_p2 :: P2_Parser t1 t2 -> Csv_Opt -> FilePath -> IO (Maybe (String,String),[(t1,t2)])
csv_table_read_p2 :: forall t1 t2.
P2_Parser t1 t2
-> Csv_Opt -> String -> IO (Maybe (String, String), [(t1, t2)])
csv_table_read_p2 P2_Parser t1 t2
f Csv_Opt
opt String
fn = do
(Maybe [String]
hdr,[[String]]
dat) <- forall a. Csv_Opt -> (String -> a) -> String -> IO (Csv_Table a)
csv_table_read Csv_Opt
opt forall a. a -> a
id String
fn
forall (m :: * -> *) a. Monad m => a -> m a
return (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall t. [t] -> T2 t
T.t2_from_list Maybe [String]
hdr,forall a b. (a -> b) -> [a] -> [b]
map (forall t t1 t2. (t -> t1, t -> t2) -> [t] -> (t1, t2)
T.p2_from_list P2_Parser t1 t2
f) [[String]]
dat)
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 :: forall t1 t2 t3 t4 t5.
P5_Parser t1 t2 t3 t4 t5
-> Csv_Opt -> String -> IO (Maybe [String], [(t1, t2, t3, t4, t5)])
csv_table_read_p5 P5_Parser t1 t2 t3 t4 t5
f Csv_Opt
opt String
fn = do
(Maybe [String]
hdr,[[String]]
dat) <- forall a. Csv_Opt -> (String -> a) -> String -> IO (Csv_Table a)
csv_table_read Csv_Opt
opt forall a. a -> a
id String
fn
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe [String]
hdr,forall a b. (a -> b) -> [a] -> [b]
map (forall t t1 t2 t3 t4 t5.
(t -> t1, t -> t2, t -> t3, t -> t4, t -> t5)
-> [t] -> (t1, t2, t3, t4, t5)
T.p5_from_list P5_Parser t1 t2 t3 t4 t5
f) [[String]]
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 :: forall t1 t2 t3 t4 t5.
P5_Writer t1 t2 t3 t4 t5
-> Csv_Opt
-> String
-> (Maybe [String], [(t1, t2, t3, t4, t5)])
-> IO ()
csv_table_write_p5 P5_Writer t1 t2 t3 t4 t5
f Csv_Opt
opt String
fn (Maybe [String]
hdr,[(t1, t2, t3, t4, t5)]
dat) = forall a.
(a -> String) -> Csv_Opt -> String -> Csv_Table a -> IO ()
csv_table_write forall a. a -> a
id Csv_Opt
opt String
fn (Maybe [String]
hdr,forall a b. (a -> b) -> [a] -> [b]
map (forall t1 t t2 t3 t4 t5.
(t1 -> t, t2 -> t, t3 -> t, t4 -> t, t5 -> t)
-> (t1, t2, t3, t4, t5) -> [t]
T.p5_to_list P5_Writer t1 t2 t3 t4 t5
f) [(t1, t2, t3, t4, t5)]
dat)
csv_table_read_t9 :: (String -> t) -> Csv_Opt -> FilePath -> IO (Maybe [String],[T.T9 t])
csv_table_read_t9 :: forall t.
(String -> t) -> Csv_Opt -> String -> IO (Maybe [String], [T9 t])
csv_table_read_t9 String -> t
f Csv_Opt
opt String
fn = do
(Maybe [String]
hdr,[[String]]
dat) <- forall a. Csv_Opt -> (String -> a) -> String -> IO (Csv_Table a)
csv_table_read Csv_Opt
opt forall a. a -> a
id String
fn
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe [String]
hdr,forall a b. (a -> b) -> [a] -> [b]
map (forall t. [t] -> T9 t
T.t9_from_list forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map String -> t
f) [[String]]
dat)