-- Copyright 2013 Evan Laforge
-- This program is distributed under the terms of the GNU General Public
-- License 3.0, see COPYING or http://www.gnu.org/licenses/gpl-3.0.txt

{-# LANGUAGE StandaloneDeriving #-}
{- | Functions to save and load the midi db.

    Unlike in "Cmd.Serialize", I don't bother with versions here, because this
    is intended to be just a cache.
-}
module Instrument.Serialize (serialize, unserialize, InstrumentDb(..)) where
import qualified Data.Map as Map
import qualified Data.Time as Time

import qualified Util.Serialize as Serialize
import Util.Serialize (Serialize, get, put, get_tag, put_tag, bad_tag)
import Midi.Instances ()
import Cmd.Serialize ()
import qualified Perform.Midi.Patch as Patch
import qualified Instrument.Common as Common
import qualified Instrument.InstT as InstT
import qualified Instrument.Search as Search
import Global


-- | Serialize instrument definitions to a file.
serialize :: FilePath -> InstrumentDb -> IO ()
serialize :: FilePath -> InstrumentDb -> IO ()
serialize FilePath
fn = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Serialize a => Magic a -> FilePath -> a -> IO Bool
Serialize.serialize Magic InstrumentDb
instrument_db_magic FilePath
fn

-- | Unserialize instrument definitions.
unserialize :: FilePath -> IO (Either Serialize.UnserializeError InstrumentDb)
unserialize :: FilePath -> IO (Either UnserializeError InstrumentDb)
unserialize = forall a.
Serialize a =>
Magic a -> FilePath -> IO (Either UnserializeError a)
Serialize.unserialize Magic InstrumentDb
instrument_db_magic

instrument_db_magic :: Serialize.Magic InstrumentDb
instrument_db_magic :: Magic InstrumentDb
instrument_db_magic = forall {k} (a :: k). Char -> Char -> Char -> Char -> Magic a
Serialize.Magic Char
'i' Char
'n' Char
's' Char
't'

-- | Time serialized, patches.
data InstrumentDb = InstrumentDb
    Time.UTCTime (Map.Map InstT.Name (Patch.Patch, Common.Common ()))

-- * instances

instance Serialize InstrumentDb where
    put :: Putter InstrumentDb
put (InstrumentDb UTCTime
a Map Name (Patch, Common ())
b) = forall a. Serialize a => Putter a
put UTCTime
a forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Serialize a => Putter a
put Map Name (Patch, Common ())
b
    get :: Get InstrumentDb
get = UTCTime -> Map Name (Patch, Common ()) -> InstrumentDb
InstrumentDb forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Serialize a => Get a
get forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Serialize a => Get a
get

instance Serialize (Common.Common ()) where
    put :: Putter (Common ())
put (Common.Common ()
a Environ
b [Tag]
c Doc
d Set Flag
e CallMap
f) =
        forall a. Serialize a => Putter a
put ()
a forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Serialize a => Putter a
put Environ
b forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Serialize a => Putter a
put [Tag]
c forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Serialize a => Putter a
put Doc
d forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Serialize a => Putter a
put Set Flag
e forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Serialize a => Putter a
put CallMap
f
    get :: Get (Common ())
get = forall code.
code
-> Environ -> [Tag] -> Doc -> Set Flag -> CallMap -> Common code
Common.Common forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Serialize a => Get a
get forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Serialize a => Get a
get forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Serialize a => Get a
get forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Serialize a => Get a
get forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Serialize a => Get a
get forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Serialize a => Get a
get

instance Serialize Search.Index where
    put :: Putter Index
put (Search.Index Map Name (Map Name [Qualified])
a Map Qualified [Tag]
b) = forall a. Serialize a => Putter a
put Map Name (Map Name [Qualified])
a forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Serialize a => Putter a
put Map Qualified [Tag]
b
    get :: Get Index
get = forall a. Serialize a => Get a
get forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Map Name (Map Name [Qualified])
a -> forall a. Serialize a => Get a
get forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Map Qualified [Tag]
b -> forall (m :: * -> *) a. Monad m => a -> m a
return (Map Name (Map Name [Qualified]) -> Map Qualified [Tag] -> Index
Search.Index Map Name (Map Name [Qualified])
a Map Qualified [Tag]
b)

instance Serialize Patch.Patch where
    put :: Putter Patch
put (Patch.Patch Name
a ControlMap
b InitializePatch
c AttributeMap
d ModeMap
e Settings
f) = forall a. Serialize a => Putter a
put Name
a forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Serialize a => Putter a
put ControlMap
b forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Serialize a => Putter a
put InitializePatch
c
        forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Serialize a => Putter a
put AttributeMap
d forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Serialize a => Putter a
put ModeMap
e forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Serialize a => Putter a
put Settings
f
    get :: Get Patch
get = Name
-> ControlMap
-> InitializePatch
-> AttributeMap
-> ModeMap
-> Settings
-> Patch
Patch.Patch forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Serialize a => Get a
get forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Serialize a => Get a
get forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Serialize a => Get a
get forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Serialize a => Get a
get forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Serialize a => Get a
get forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Serialize a => Get a
get

instance Serialize Patch.InitializePatch where
    put :: Putter InitializePatch
put (Patch.InitializeMidi [Message]
a) = Word8 -> PutM ()
put_tag Word8
0 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Serialize a => Putter a
put [Message]
a
    put (Patch.InitializeMessage Name
a) = Word8 -> PutM ()
put_tag Word8
1 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Serialize a => Putter a
put Name
a
    put InitializePatch
Patch.NoInitialization = Word8 -> PutM ()
put_tag Word8
2
    get :: Get InitializePatch
get = do
        Word8
tag <- Get Word8
get_tag
        case Word8
tag of
            Word8
0 -> forall a. Serialize a => Get a
get forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \[Message]
a -> forall (m :: * -> *) a. Monad m => a -> m a
return ([Message] -> InitializePatch
Patch.InitializeMidi [Message]
a)
            Word8
1 -> forall a. Serialize a => Get a
get forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Name
a -> forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> InitializePatch
Patch.InitializeMessage Name
a)
            Word8
2 -> forall (m :: * -> *) a. Monad m => a -> m a
return InitializePatch
Patch.NoInitialization
            Word8
_ -> forall a. FilePath -> Word8 -> Get a
bad_tag FilePath
"Patch.InitializePatch" Word8
tag

instance Serialize Patch.Keymap where
    put :: Putter Keymap
put (Patch.UnpitchedKeymap Key
a) = Word8 -> PutM ()
put_tag Word8
0 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Serialize a => Putter a
put Key
a
    put (Patch.PitchedKeymap Key
a Key
b Key
c) = Word8 -> PutM ()
put_tag Word8
1 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Serialize a => Putter a
put Key
a forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Serialize a => Putter a
put Key
b forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Serialize a => Putter a
put Key
c
    get :: Get Keymap
get = do
        Word8
tag <- Get Word8
get_tag
        case Word8
tag of
            Word8
0 -> Key -> Keymap
Patch.UnpitchedKeymap forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Serialize a => Get a
get
            Word8
1 -> Key -> Key -> Key -> Keymap
Patch.PitchedKeymap forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Serialize a => Get a
get forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Serialize a => Get a
get forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Serialize a => Get a
get
            Word8
_ -> forall a. FilePath -> Word8 -> Get a
bad_tag FilePath
"Patch.Keymap" Word8
tag

instance Serialize Patch.Keyswitch where
    put :: Putter Keyswitch
put (Patch.Keyswitch Key
a) = Word8 -> PutM ()
put_tag Word8
0 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Serialize a => Putter a
put Key
a
    put (Patch.ControlSwitch Word8
a Word8
b) = Word8 -> PutM ()
put_tag Word8
1 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Serialize a => Putter a
put Word8
a forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Serialize a => Putter a
put Word8
b
    put (Patch.Aftertouch Word8
a) = Word8 -> PutM ()
put_tag Word8
2 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Serialize a => Putter a
put Word8
a
    get :: Get Keyswitch
get = do
        Word8
tag <- Get Word8
get_tag
        case Word8
tag of
            Word8
0 -> Key -> Keyswitch
Patch.Keyswitch forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Serialize a => Get a
get
            Word8
1 -> Word8 -> Word8 -> Keyswitch
Patch.ControlSwitch forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Serialize a => Get a
get forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Serialize a => Get a
get
            Word8
2 -> Word8 -> Keyswitch
Patch.Aftertouch forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Serialize a => Get a
get
            Word8
_ -> forall a. FilePath -> Word8 -> Get a
bad_tag FilePath
"Patch.Keyswitch" Word8
tag

-- Define it here rather than in Patch, or else it doesn't see the Keyswitch
-- instance.
deriving instance Serialize Patch.ModeMap