-- | JSON string association database. -- JSON objects do no allow multiple keys. -- Here multiple keys are read & written as arrays. module Music.Theory.DB.JSON where import qualified Data.Aeson as A {- aeson -} import qualified Data.ByteString.Lazy as B {- bytestring -} import qualified Data.Map as M {- containers -} import qualified Music.Theory.DB.Common as DB -- | Load 'DB' from 'FilePath'. db_load_utf8 :: FilePath -> IO DB.DB' db_load_utf8 fn = do b <- B.readFile fn case A.decode b of Just m -> let f = DB.record_uncollate . map (fmap maybe_list_to_list) . M.toList in return (map f m) Nothing -> return [] -- | Store 'DB' to 'FilePath'. -- -- > let fn = "/home/rohan/ut/www-spr/data/db.js" -- > db <- db_load_utf8 fn -- > length db == 1334 -- > db_store_utf8 "/tmp/sp.js" db db_store_utf8 :: FilePath -> DB.DB' -> IO () db_store_utf8 fn db = do let db' = let f = map (fmap list_to_maybe_list) . DB.record_collate in map f db b = A.encode (map M.fromList db') B.writeFile fn b -- * Maybe List of String data Maybe_List_Of_String = S String | L [String] deriving (Eq,Show) maybe_list_to_list :: Maybe_List_Of_String -> [String] maybe_list_to_list m = case m of S s -> [s] L l -> l list_to_maybe_list :: [String] -> Maybe_List_Of_String list_to_maybe_list l = case l of [s] -> S s _ -> L l -- > A.toJSON (S "x") -- > A.toJSON (L ["x","y"]) instance A.ToJSON Maybe_List_Of_String where toJSON (S s) = A.toJSON s toJSON (L l) = A.toJSON l -- > :set -XOverloadedStrings -- > A.decode "\"x\"" :: Maybe Maybe_List_Of_String -- > A.decode "[\"x\",\"y\"]" :: Maybe Maybe_List_Of_String instance A.FromJSON Maybe_List_Of_String where parseJSON v = case v of A.String _ -> fmap S (A.parseJSON v) A.Array _ -> fmap L (A.parseJSON v) _ -> error "parseJSON: Maybe_List_String"