-- | Keys are given in the header, empty fields are omitted from records.
module Music.Theory.Db.Csv where

import Data.Maybe {- base -}

import qualified Text.CSV.Lazy.String as C {- lazy-csv -}

import qualified Music.Theory.Io as T {- hmt-base -}

import Music.Theory.Db.Common {- hmt -}

-- | Load 'DB' from 'FilePath'.
db_load_utf8 :: FilePath -> IO Db'
db_load_utf8 :: FilePath -> IO Db'
db_load_utf8 FilePath
fn = do
  FilePath
s <- FilePath -> IO FilePath
T.read_file_utf8 FilePath
fn
  let p :: [[FilePath]]
p = CSVTable -> [[FilePath]]
C.fromCSVTable (CSVResult -> CSVTable
C.csvTable (FilePath -> CSVResult
C.parseCSV FilePath
s))
      ([FilePath]
h,[[FilePath]]
d) = (forall a. [a] -> a
head [[FilePath]]
p,forall a. [a] -> [a]
tail [[FilePath]]
p)
      f :: a -> t a -> Maybe (a, t a)
f a
k t a
v = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null t a
v then forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just (a
k,t a
v)
  forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. (a -> b) -> [a] -> [b]
map (forall a. [Maybe a] -> [a]
catMaybes forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall {t :: * -> *} {a} {a}.
Foldable t =>
a -> t a -> Maybe (a, t a)
f [FilePath]
h) [[FilePath]]
d)

db_store_utf8 :: FilePath -> Db' -> IO ()
db_store_utf8 :: FilePath -> Db' -> IO ()
db_store_utf8 FilePath
fn Db'
db = do
  let ([FilePath]
hdr,[[FilePath]]
tbl) = forall k v e. Ord k => (Maybe v -> e) -> Db k v -> ([k], [[e]])
db_to_table (forall a. a -> Maybe a -> a
fromMaybe FilePath
"") Db'
db
      ([CSVError]
_,CSVTable
tbl') = [[FilePath]] -> ([CSVError], CSVTable)
C.toCSVTable ([FilePath]
hdr forall a. a -> [a] -> [a]
: [[FilePath]]
tbl)
      str :: FilePath
str = CSVTable -> FilePath
C.ppCSVTable CSVTable
tbl'
  FilePath -> FilePath -> IO ()
T.write_file_utf8 FilePath
fn FilePath
str