-- 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

{- | Instances to serialize and unserialize data types used by Ui.Ui.State.

    Types that I think might change have versions.  If the type changes,
    increment the put_version and add a new branch to the get_version case.

    Generally, the various parts of ADTs are unpacked with explicit type
    signatures.  That way, if one of the types is changed, there will be
    a type error over here pointing at the get/put code that needs to be
    updated.
-}
module Cmd.Serialize (
    allocations_magic, score_magic, views_magic
    , is_old_settings
) where
import qualified Data.Set as Set
import qualified Data.Text as Text
import qualified Data.Time as Time

import qualified Util.Rect as Rect
import qualified Util.Seq as Seq
import qualified Util.Serialize as Serialize
import           Util.Serialize
    (Serialize, bad_enum, bad_tag, bad_version, get, get_enum, get_tag,
     get_version, put, put_enum, put_tag, put_version)

import qualified Derive.REnv as REnv
import qualified Derive.ScoreT as ScoreT
import qualified Instrument.Common as Common
import qualified Instrument.InstT as InstT
import           Midi.Instances ()
import qualified Perform.Lilypond.Types as Lilypond
import qualified Perform.Midi.Control as Midi.Control
import qualified Perform.Midi.Patch as Patch
import qualified Perform.Signal as Signal

import qualified Ui.Block as Block
import qualified Ui.Color as Color
import qualified Ui.Events as Events
import qualified Ui.Id as Id
import qualified Ui.Meter.Make as Meter.Make
import qualified Ui.Meter.Mark as Mark
import qualified Ui.Meter.Meter as Meter
import qualified Ui.Ruler as Ruler
import qualified Ui.Sel as Sel
import qualified Ui.Skeleton as Skeleton
import qualified Ui.Track as Track
import qualified Ui.Types as Types
import qualified Ui.Ui as Ui
import qualified Ui.UiConfig as UiConfig
import qualified Ui.Zoom as Zoom

import           Global
import           Types


allocations_magic :: Serialize.Magic UiConfig.Allocations
allocations_magic :: Magic Allocations
allocations_magic = Char -> Char -> Char -> Char -> Magic Allocations
forall {k} (a :: k). Char -> Char -> Char -> Char -> Magic a
Serialize.Magic Char
'a' Char
'l' Char
'l' Char
'o'

score_magic :: Serialize.Magic Ui.State
score_magic :: Magic State
score_magic = Char -> Char -> Char -> Char -> Magic State
forall {k} (a :: k). Char -> Char -> Char -> Char -> Magic a
Serialize.Magic Char
's' Char
'c' Char
'o' Char
'r'

views_magic :: Serialize.Magic (Map ViewId Block.View)
views_magic :: Magic (Map ViewId View)
views_magic = Char -> Char -> Char -> Char -> Magic (Map ViewId View)
forall {k} (a :: k). Char -> Char -> Char -> Char -> Magic a
Serialize.Magic Char
'v' Char
'i' Char
'e' Char
'w'

-- * Serialize instances

instance Serialize Ui.State where
    put :: Putter State
put (Ui.State Map ViewId View
a Map BlockId Block
b Map TrackId Track
c Map RulerId Ruler
d Config
e) = Word8 -> Put
put_version Word8
6
        Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter (Map ViewId View)
forall a. Serialize a => Putter a
put Map ViewId View
a Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter (Map BlockId Block)
forall a. Serialize a => Putter a
put Map BlockId Block
b Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter (Map TrackId Track)
forall a. Serialize a => Putter a
put Map TrackId Track
c Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter (Map RulerId Ruler)
forall a. Serialize a => Putter a
put Map RulerId Ruler
d Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter Config
forall a. Serialize a => Putter a
put Config
e
    get :: Get State
get = do
        Word8
v <- Get Word8
get_version
        case Word8
v of
            Word8
6 -> do
                Map ViewId View
views :: Map Types.ViewId Block.View <- Get (Map ViewId View)
forall a. Serialize a => Get a
get
                Map BlockId Block
blocks :: Map Types.BlockId Block.Block <- Get (Map BlockId Block)
forall a. Serialize a => Get a
get
                Map TrackId Track
tracks :: Map Types.TrackId Track.Track <- Get (Map TrackId Track)
forall a. Serialize a => Get a
get
                Map RulerId Ruler
rulers :: Map Types.RulerId Ruler.Ruler <- Get (Map RulerId Ruler)
forall a. Serialize a => Get a
get
                Config
config :: UiConfig.Config <- Get Config
forall a. Serialize a => Get a
get
                State -> Get State
forall (m :: * -> *) a. Monad m => a -> m a
return (State -> Get State) -> State -> Get State
forall a b. (a -> b) -> a -> b
$ Map ViewId View
-> Map BlockId Block
-> Map TrackId Track
-> Map RulerId Ruler
-> Config
-> State
Ui.State Map ViewId View
views Map BlockId Block
blocks Map TrackId Track
tracks Map RulerId Ruler
rulers Config
config
            Word8
_ -> String -> Word8 -> Get State
forall a. Stack => String -> Word8 -> a
bad_version String
"Ui.State" Word8
v

instance Serialize UiConfig.Config where
    put :: Putter Config
put (UiConfig.Config Namespace
ns Meta
meta Maybe BlockId
root Allocations
allocs Config
lilypond Default
defaults
            SavedViews
saved_views Text
ky Text
tscore)
        =  Word8 -> Put
put_version Word8
14
            Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter Namespace
forall a. Serialize a => Putter a
put Namespace
ns Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter Meta
forall a. Serialize a => Putter a
put Meta
meta Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter (Maybe BlockId)
forall a. Serialize a => Putter a
put Maybe BlockId
root Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter Allocations
forall a. Serialize a => Putter a
put Allocations
allocs Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter Config
forall a. Serialize a => Putter a
put Config
lilypond
            Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter Default
forall a. Serialize a => Putter a
put Default
defaults Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter SavedViews
forall a. Serialize a => Putter a
put SavedViews
saved_views Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter Text
forall a. Serialize a => Putter a
put Text
ky Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter Text
forall a. Serialize a => Putter a
put Text
tscore
    get :: Get Config
get = Get Word8
get_version Get Word8 -> (Word8 -> Get Config) -> Get Config
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Word8
v -> case Word8
v of
        Word8
11 -> do
            Namespace
ns :: Id.Namespace <- Get Namespace
forall a. Serialize a => Get a
get
            Meta
meta :: UiConfig.Meta <- Get Meta
forall a. Serialize a => Get a
get
            Maybe BlockId
root :: Maybe BlockId <- Get (Maybe BlockId)
forall a. Serialize a => Get a
get
            Text
transform :: Text <- Get Text
forall a. Serialize a => Get a
get
            Allocations
insts :: UiConfig.Allocations <- Get Allocations
forall a. Serialize a => Get a
get
            Config
lilypond :: Lilypond.Config <- Get Config
forall a. Serialize a => Get a
get
            Default
defaults :: UiConfig.Default <- Get Default
forall a. Serialize a => Get a
get
            SavedViews
saved_views :: UiConfig.SavedViews <- Get SavedViews
forall a. Serialize a => Get a
get
            Maybe String
ky_file :: Maybe FilePath <- Get (Maybe String)
forall a. Serialize a => Get a
get
            Config -> Get Config
forall (m :: * -> *) a. Monad m => a -> m a
return (Config -> Get Config) -> Config -> Get Config
forall a b. (a -> b) -> a -> b
$ Namespace
-> Meta
-> Maybe BlockId
-> Allocations
-> Config
-> Default
-> SavedViews
-> Text
-> Text
-> Config
UiConfig.Config Namespace
ns Meta
meta Maybe BlockId
root Allocations
insts Config
lilypond Default
defaults
                SavedViews
saved_views
                (Text -> Text -> Text
upgrade_transform Text
transform
                    (Text -> (String -> Text) -> Maybe String -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" (\String
fn -> Text
"import '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
txt String
fn Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"'\n") Maybe String
ky_file))
                Text
""
        Word8
12 -> do
            Namespace
ns :: Id.Namespace <- Get Namespace
forall a. Serialize a => Get a
get
            Meta
meta :: UiConfig.Meta <- Get Meta
forall a. Serialize a => Get a
get
            Maybe BlockId
root :: Maybe BlockId <- Get (Maybe BlockId)
forall a. Serialize a => Get a
get
            Text
transform :: Text <- Get Text
forall a. Serialize a => Get a
get
            Allocations
insts :: UiConfig.Allocations <- Get Allocations
forall a. Serialize a => Get a
get
            Config
lilypond :: Lilypond.Config <- Get Config
forall a. Serialize a => Get a
get
            Default
defaults :: UiConfig.Default <- Get Default
forall a. Serialize a => Get a
get
            SavedViews
saved_views :: UiConfig.SavedViews <- Get SavedViews
forall a. Serialize a => Get a
get
            Text
ky :: Text <- Get Text
forall a. Serialize a => Get a
get
            Config -> Get Config
forall (m :: * -> *) a. Monad m => a -> m a
return (Config -> Get Config) -> Config -> Get Config
forall a b. (a -> b) -> a -> b
$ Namespace
-> Meta
-> Maybe BlockId
-> Allocations
-> Config
-> Default
-> SavedViews
-> Text
-> Text
-> Config
UiConfig.Config Namespace
ns Meta
meta Maybe BlockId
root Allocations
insts Config
lilypond
                Default
defaults SavedViews
saved_views (Text -> Text -> Text
upgrade_transform Text
transform Text
ky)
                Text
""
        Word8
13 -> do
            Namespace
ns :: Id.Namespace <- Get Namespace
forall a. Serialize a => Get a
get
            Meta
meta :: UiConfig.Meta <- Get Meta
forall a. Serialize a => Get a
get
            Maybe BlockId
root :: Maybe BlockId <- Get (Maybe BlockId)
forall a. Serialize a => Get a
get
            Allocations
insts :: UiConfig.Allocations <- Get Allocations
forall a. Serialize a => Get a
get
            Config
lilypond :: Lilypond.Config <- Get Config
forall a. Serialize a => Get a
get
            Default
defaults :: UiConfig.Default <- Get Default
forall a. Serialize a => Get a
get
            SavedViews
saved_views :: UiConfig.SavedViews <- Get SavedViews
forall a. Serialize a => Get a
get
            Text
ky :: Text <- Get Text
forall a. Serialize a => Get a
get
            Config -> Get Config
forall (m :: * -> *) a. Monad m => a -> m a
return (Config -> Get Config) -> Config -> Get Config
forall a b. (a -> b) -> a -> b
$ Namespace
-> Meta
-> Maybe BlockId
-> Allocations
-> Config
-> Default
-> SavedViews
-> Text
-> Text
-> Config
UiConfig.Config Namespace
ns Meta
meta Maybe BlockId
root Allocations
insts Config
lilypond Default
defaults
                SavedViews
saved_views Text
ky Text
""
        Word8
14 -> do
            Namespace
ns :: Id.Namespace <- Get Namespace
forall a. Serialize a => Get a
get
            Meta
meta :: UiConfig.Meta <- Get Meta
forall a. Serialize a => Get a
get
            Maybe BlockId
root :: Maybe BlockId <- Get (Maybe BlockId)
forall a. Serialize a => Get a
get
            Allocations
insts :: UiConfig.Allocations <- Get Allocations
forall a. Serialize a => Get a
get
            Config
lilypond :: Lilypond.Config <- Get Config
forall a. Serialize a => Get a
get
            Default
defaults :: UiConfig.Default <- Get Default
forall a. Serialize a => Get a
get
            SavedViews
saved_views :: UiConfig.SavedViews <- Get SavedViews
forall a. Serialize a => Get a
get
            Text
ky :: Text <- Get Text
forall a. Serialize a => Get a
get
            Text
tscore :: Text <- Get Text
forall a. Serialize a => Get a
get
            Config -> Get Config
forall (m :: * -> *) a. Monad m => a -> m a
return (Config -> Get Config) -> Config -> Get Config
forall a b. (a -> b) -> a -> b
$ Namespace
-> Meta
-> Maybe BlockId
-> Allocations
-> Config
-> Default
-> SavedViews
-> Text
-> Text
-> Config
UiConfig.Config Namespace
ns Meta
meta Maybe BlockId
root Allocations
insts Config
lilypond Default
defaults
                SavedViews
saved_views Text
ky Text
tscore
        Word8
_ -> String -> Word8 -> Get Config
forall a. Stack => String -> Word8 -> a
bad_version String
"UiConfig.Config" Word8
v
        where
        upgrade_transform :: Text -> Text -> Text
upgrade_transform Text
global_transform Text
ky
            | Text -> Bool
Text.null (Text -> Text
Text.strip Text
global_transform) = Text
ky
            | Bool
otherwise = Text
ky Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n\nnote transformer:\nGLOBAL = "
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
global_transform

instance Serialize UiConfig.Allocations where
    put :: Putter Allocations
put (UiConfig.Allocations Map Instrument Allocation
a) = Word8 -> Put
put_version Word8
1 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter (Map Instrument Allocation)
forall a. Serialize a => Putter a
put Map Instrument Allocation
a
    get :: Get Allocations
get = do
        Word8
v <- Get Word8
get_version
        case Word8
v of
            Word8
1 -> do
                Map Instrument Allocation
configs :: Map ScoreT.Instrument UiConfig.Allocation <- Get (Map Instrument Allocation)
forall a. Serialize a => Get a
get
                Allocations -> Get Allocations
forall (m :: * -> *) a. Monad m => a -> m a
return (Allocations -> Get Allocations) -> Allocations -> Get Allocations
forall a b. (a -> b) -> a -> b
$ Map Instrument Allocation -> Allocations
UiConfig.Allocations Map Instrument Allocation
configs
            Word8
_ -> String -> Word8 -> Get Allocations
forall a. Stack => String -> Word8 -> a
bad_version String
"UiConfig.Allocations" Word8
v

instance Serialize UiConfig.Allocation where
    put :: Putter Allocation
put (UiConfig.Allocation Qualified
a Config
b Backend
c) = Word8 -> Put
put_version Word8
0 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter Qualified
forall a. Serialize a => Putter a
put Qualified
a Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter Config
forall a. Serialize a => Putter a
put Config
b Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter Backend
forall a. Serialize a => Putter a
put Backend
c
    get :: Get Allocation
get = Get Word8
get_version Get Word8 -> (Word8 -> Get Allocation) -> Get Allocation
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Word8
0 -> do
            Qualified
qualified :: InstT.Qualified <- Get Qualified
forall a. Serialize a => Get a
get
            Config
config :: Common.Config <- Get Config
forall a. Serialize a => Get a
get
            Backend
backend :: UiConfig.Backend <- Get Backend
forall a. Serialize a => Get a
get
            Allocation -> Get Allocation
forall (m :: * -> *) a. Monad m => a -> m a
return (Allocation -> Get Allocation) -> Allocation -> Get Allocation
forall a b. (a -> b) -> a -> b
$ Qualified -> Config -> Backend -> Allocation
UiConfig.Allocation Qualified
qualified Config
config Backend
backend
        Word8
v -> String -> Word8 -> Get Allocation
forall a. Stack => String -> Word8 -> a
bad_version String
"UiConfig.Allocation" Word8
v

instance Serialize UiConfig.Backend where
    put :: Putter Backend
put = \case
        UiConfig.Midi Config
a -> Word8 -> Put
put_tag Word8
0 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter Config
forall a. Serialize a => Putter a
put Config
a
        Backend
UiConfig.Im -> Word8 -> Put
put_tag Word8
1
        UiConfig.Dummy Text
a -> Word8 -> Put
put_tag Word8
4 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter Text
forall a. Serialize a => Putter a
put Text
a
        Backend
UiConfig.Sc -> Word8 -> Put
put_tag Word8
3
    get :: Get Backend
get = Get Word8
get_tag Get Word8 -> (Word8 -> Get Backend) -> Get Backend
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Word8
0 -> do
            Config
config :: Patch.Config <- Get Config
forall a. Serialize a => Get a
get
            Backend -> Get Backend
forall (m :: * -> *) a. Monad m => a -> m a
return (Backend -> Get Backend) -> Backend -> Get Backend
forall a b. (a -> b) -> a -> b
$ Config -> Backend
UiConfig.Midi Config
config
        Word8
1 -> Backend -> Get Backend
forall (m :: * -> *) a. Monad m => a -> m a
return Backend
UiConfig.Im
        Word8
2 -> Backend -> Get Backend
forall (m :: * -> *) a. Monad m => a -> m a
return (Backend -> Get Backend) -> Backend -> Get Backend
forall a b. (a -> b) -> a -> b
$ Text -> Backend
UiConfig.Dummy Text
""
        Word8
3 -> Backend -> Get Backend
forall (m :: * -> *) a. Monad m => a -> m a
return Backend
UiConfig.Sc
        Word8
4 -> Text -> Backend
UiConfig.Dummy (Text -> Backend) -> Get Text -> Get Backend
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Get Text
forall a. Serialize a => Get a
get :: Serialize.Get Text)
        Word8
tag -> String -> Word8 -> Get Backend
forall a. String -> Word8 -> Get a
bad_tag String
"UiConfig.Backend" Word8
tag

-- | For backward compatibility.
newtype MidiConfigs = MidiConfigs (Map ScoreT.Instrument Patch.Config)
    deriving (Int -> MidiConfigs -> ShowS
[MidiConfigs] -> ShowS
MidiConfigs -> String
(Int -> MidiConfigs -> ShowS)
-> (MidiConfigs -> String)
-> ([MidiConfigs] -> ShowS)
-> Show MidiConfigs
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MidiConfigs] -> ShowS
$cshowList :: [MidiConfigs] -> ShowS
show :: MidiConfigs -> String
$cshow :: MidiConfigs -> String
showsPrec :: Int -> MidiConfigs -> ShowS
$cshowsPrec :: Int -> MidiConfigs -> ShowS
Show)

instance Serialize MidiConfigs where
    put :: Putter MidiConfigs
put (MidiConfigs Map Instrument Config
a) = Word8 -> Put
put_version Word8
5 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter (Map Instrument Config)
forall a. Serialize a => Putter a
put Map Instrument Config
a
    get :: Get MidiConfigs
get = Get Word8
get_version Get Word8 -> (Word8 -> Get MidiConfigs) -> Get MidiConfigs
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Word8
5 -> do
            Map Instrument Config
insts :: Map ScoreT.Instrument Patch.Config <- Get (Map Instrument Config)
forall a. Serialize a => Get a
get
            MidiConfigs -> Get MidiConfigs
forall (m :: * -> *) a. Monad m => a -> m a
return (MidiConfigs -> Get MidiConfigs) -> MidiConfigs -> Get MidiConfigs
forall a b. (a -> b) -> a -> b
$ Map Instrument Config -> MidiConfigs
MidiConfigs Map Instrument Config
insts
        Word8
v -> String -> Word8 -> Get MidiConfigs
forall a. Stack => String -> Word8 -> a
bad_version String
"Patch.MidiConfigs" Word8
v

instance Serialize UiConfig.Meta where
    put :: Putter Meta
put (UiConfig.Meta UTCTime
a UTCTime
b Text
c Map BlockId MidiPerformance
d Map BlockId LilypondPerformance
e Map BlockId ImPerformance
f) = Word8 -> Put
put_version Word8
4
        Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter UTCTime
forall a. Serialize a => Putter a
put UTCTime
a Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter UTCTime
forall a. Serialize a => Putter a
put UTCTime
b Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter Text
forall a. Serialize a => Putter a
put Text
c Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter (Map BlockId MidiPerformance)
forall a. Serialize a => Putter a
put Map BlockId MidiPerformance
d Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter (Map BlockId LilypondPerformance)
forall a. Serialize a => Putter a
put Map BlockId LilypondPerformance
e Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter (Map BlockId ImPerformance)
forall a. Serialize a => Putter a
put Map BlockId ImPerformance
f
    get :: Get Meta
get = Get Word8
get_version Get Word8 -> (Word8 -> Get Meta) -> Get Meta
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Word8
3 -> do
            UTCTime
creation :: Time.UTCTime <- Get UTCTime
forall a. Serialize a => Get a
get
            UTCTime
last_save :: Time.UTCTime <- Get UTCTime
forall a. Serialize a => Get a
get
            Text
notes :: Text <- Get Text
forall a. Serialize a => Get a
get
            Map BlockId MidiPerformance
midi :: Map BlockId UiConfig.MidiPerformance <- Get (Map BlockId MidiPerformance)
forall a. Serialize a => Get a
get
            Map BlockId LilypondPerformance
lily :: Map BlockId UiConfig.LilypondPerformance <- Get (Map BlockId LilypondPerformance)
forall a. Serialize a => Get a
get
            Meta -> Get Meta
forall (m :: * -> *) a. Monad m => a -> m a
return (Meta -> Get Meta) -> Meta -> Get Meta
forall a b. (a -> b) -> a -> b
$ UTCTime
-> UTCTime
-> Text
-> Map BlockId MidiPerformance
-> Map BlockId LilypondPerformance
-> Map BlockId ImPerformance
-> Meta
UiConfig.Meta UTCTime
creation UTCTime
last_save Text
notes Map BlockId MidiPerformance
midi Map BlockId LilypondPerformance
lily Map BlockId ImPerformance
forall a. Monoid a => a
mempty
        Word8
4 -> do
            UTCTime
creation :: Time.UTCTime <- Get UTCTime
forall a. Serialize a => Get a
get
            UTCTime
last_save :: Time.UTCTime <- Get UTCTime
forall a. Serialize a => Get a
get
            Text
notes :: Text <- Get Text
forall a. Serialize a => Get a
get
            Map BlockId MidiPerformance
midi :: Map BlockId UiConfig.MidiPerformance <- Get (Map BlockId MidiPerformance)
forall a. Serialize a => Get a
get
            Map BlockId LilypondPerformance
lily :: Map BlockId UiConfig.LilypondPerformance <- Get (Map BlockId LilypondPerformance)
forall a. Serialize a => Get a
get
            Map BlockId ImPerformance
im :: Map BlockId UiConfig.ImPerformance <- Get (Map BlockId ImPerformance)
forall a. Serialize a => Get a
get
            Meta -> Get Meta
forall (m :: * -> *) a. Monad m => a -> m a
return (Meta -> Get Meta) -> Meta -> Get Meta
forall a b. (a -> b) -> a -> b
$ UTCTime
-> UTCTime
-> Text
-> Map BlockId MidiPerformance
-> Map BlockId LilypondPerformance
-> Map BlockId ImPerformance
-> Meta
UiConfig.Meta UTCTime
creation UTCTime
last_save Text
notes Map BlockId MidiPerformance
midi Map BlockId LilypondPerformance
lily Map BlockId ImPerformance
im
        Word8
v -> String -> Word8 -> Get Meta
forall a. Stack => String -> Word8 -> a
bad_version String
"UiConfig.Meta" Word8
v

instance Serialize a => Serialize (UiConfig.Performance a) where
    put :: Putter (Performance a)
put (UiConfig.Performance a
a UTCTime
b Text
c) = Word8 -> Put
put_version Word8
0 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter a
forall a. Serialize a => Putter a
put a
a Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter UTCTime
forall a. Serialize a => Putter a
put UTCTime
b Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter Text
forall a. Serialize a => Putter a
put Text
c
    get :: Get (Performance a)
get = Get Word8
get_version Get Word8 -> (Word8 -> Get (Performance a)) -> Get (Performance a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Word8
0 -> do
            a
perf :: a <- Get a
forall a. Serialize a => Get a
get
            UTCTime
creation :: Time.UTCTime <- Get UTCTime
forall a. Serialize a => Get a
get
            Text
patch :: Text <- Get Text
forall a. Serialize a => Get a
get
            Performance a -> Get (Performance a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Performance a -> Get (Performance a))
-> Performance a -> Get (Performance a)
forall a b. (a -> b) -> a -> b
$ a -> UTCTime -> Text -> Performance a
forall a. a -> UTCTime -> Text -> Performance a
UiConfig.Performance a
perf UTCTime
creation Text
patch
        Word8
v -> String -> Word8 -> Get (Performance a)
forall a. Stack => String -> Word8 -> a
bad_version String
"UiConfig.Performance" Word8
v

instance Serialize UiConfig.Default where
    put :: Putter Default
put (UiConfig.Default Y
a) = Word8 -> Put
put_version Word8
4 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter Y
forall a. Serialize a => Putter a
put Y
a
    get :: Get Default
get = Get Word8
get_version Get Word8 -> (Word8 -> Get Default) -> Get Default
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Word8
4 -> do
            Y
tempo :: Signal.Y <- Get Y
forall a. Serialize a => Get a
get
            Default -> Get Default
forall (m :: * -> *) a. Monad m => a -> m a
return (Default -> Get Default) -> Default -> Get Default
forall a b. (a -> b) -> a -> b
$ Y -> Default
UiConfig.Default Y
tempo
        Word8
v -> String -> Word8 -> Get Default
forall a. Stack => String -> Word8 -> a
bad_version String
"UiConfig.Default" Word8
v

-- ** Block

instance Serialize Block.Block where
    -- Config is not serialized because everything in the block config is
    -- either derived from the Cmd.State or is hardcoded.
    -- Except Block.config_skeleton breaks this rule :/
    put :: Putter Block
put (Block.Block Text
a Config
config [Track]
b Skeleton
c Maybe (BlockId, TrackDestinations)
d [(TrackId, TrackDestinations)]
e ManualDestinations
f Meta
g) = Word8 -> Put
put_version Word8
14
        Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter Text
forall a. Serialize a => Putter a
put Text
a Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter [Track]
forall a. Serialize a => Putter a
put [Track]
b Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter Skeleton
forall a. Serialize a => Putter a
put Skeleton
c Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter (Maybe (BlockId, TrackDestinations))
forall a. Serialize a => Putter a
put Maybe (BlockId, TrackDestinations)
d Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter [(TrackId, TrackDestinations)]
forall a. Serialize a => Putter a
put [(TrackId, TrackDestinations)]
e Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter ManualDestinations
forall a. Serialize a => Putter a
put ManualDestinations
f Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter Meta
forall a. Serialize a => Putter a
put Meta
g
        Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter Skeleton
forall a. Serialize a => Putter a
put (Config -> Skeleton
Block.config_skeleton Config
config)
    get :: Get Block
get = Get Word8
get_version Get Word8 -> (Word8 -> Get Block) -> Get Block
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Word8
11 -> do
            Text
title :: Text <- Get Text
forall a. Serialize a => Get a
get
            [Track]
tracks :: [Block.Track] <- Get [Track]
forall a. Serialize a => Get a
get
            Skeleton
skel :: Skeleton.Skeleton <- Get Skeleton
forall a. Serialize a => Get a
get
            Maybe (BlockId, TrackDestinations)
iblock :: Maybe (BlockId, Block.TrackDestinations) <- Get (Maybe (BlockId, TrackDestinations))
forall a. Serialize a => Get a
get
            [(TrackId, TrackDestinations)]
itracks :: [(TrackId, Block.TrackDestinations)] <- Get [(TrackId, TrackDestinations)]
forall a. Serialize a => Get a
get
            Meta
meta :: Map Text Text <- Get Meta
forall a. Serialize a => Get a
get
            Block -> Get Block
forall (m :: * -> *) a. Monad m => a -> m a
return (Block -> Get Block) -> Block -> Get Block
forall a b. (a -> b) -> a -> b
$ Text
-> Config
-> [Track]
-> Skeleton
-> Maybe (BlockId, TrackDestinations)
-> [(TrackId, TrackDestinations)]
-> ManualDestinations
-> Meta
-> Block
Block.Block Text
title Config
config [Track]
tracks Skeleton
skel Maybe (BlockId, TrackDestinations)
iblock [(TrackId, TrackDestinations)]
itracks ManualDestinations
forall a. Monoid a => a
mempty
                Meta
meta
        Word8
12 -> do
            Text
title :: Text <- Get Text
forall a. Serialize a => Get a
get
            [Track]
tracks :: [Block.Track] <- Get [Track]
forall a. Serialize a => Get a
get
            Skeleton
skel :: Skeleton.Skeleton <- Get Skeleton
forall a. Serialize a => Get a
get
            Maybe (BlockId, TrackDestinations)
iblock :: Maybe (BlockId, Block.TrackDestinations) <- Get (Maybe (BlockId, TrackDestinations))
forall a. Serialize a => Get a
get
            [(TrackId, TrackDestinations)]
itracks :: [(TrackId, Block.TrackDestinations)] <- Get [(TrackId, TrackDestinations)]
forall a. Serialize a => Get a
get
            Map Text [OldNoteDestination]
manual :: Map Block.SourceKey [OldNoteDestination] <- Get (Map Text [OldNoteDestination])
forall a. Serialize a => Get a
get
            Meta
meta :: Map Text Text <- Get Meta
forall a. Serialize a => Get a
get
            Block -> Get Block
forall (m :: * -> *) a. Monad m => a -> m a
return (Block -> Get Block) -> Block -> Get Block
forall a b. (a -> b) -> a -> b
$ Text
-> Config
-> [Track]
-> Skeleton
-> Maybe (BlockId, TrackDestinations)
-> [(TrackId, TrackDestinations)]
-> ManualDestinations
-> Meta
-> Block
Block.Block Text
title Config
config [Track]
tracks Skeleton
skel Maybe (BlockId, TrackDestinations)
iblock [(TrackId, TrackDestinations)]
itracks
                ((OldNoteDestination -> NoteDestination)
-> [OldNoteDestination] -> [NoteDestination]
forall a b. (a -> b) -> [a] -> [b]
map OldNoteDestination -> NoteDestination
upgrade_note_destination ([OldNoteDestination] -> [NoteDestination])
-> Map Text [OldNoteDestination] -> ManualDestinations
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Text [OldNoteDestination]
manual) Meta
meta
        Word8
13 -> do
            Text
title :: Text <- Get Text
forall a. Serialize a => Get a
get
            [Track]
tracks :: [Block.Track] <- Get [Track]
forall a. Serialize a => Get a
get
            Skeleton
skel :: Skeleton.Skeleton <- Get Skeleton
forall a. Serialize a => Get a
get
            Maybe (BlockId, TrackDestinations)
iblock :: Maybe (BlockId, Block.TrackDestinations) <- Get (Maybe (BlockId, TrackDestinations))
forall a. Serialize a => Get a
get
            [(TrackId, TrackDestinations)]
itracks :: [(TrackId, Block.TrackDestinations)] <- Get [(TrackId, TrackDestinations)]
forall a. Serialize a => Get a
get
            ManualDestinations
dtracks :: Block.ManualDestinations <- Get ManualDestinations
forall a. Serialize a => Get a
get
            Meta
meta :: Map Text Text <- Get Meta
forall a. Serialize a => Get a
get
            Block -> Get Block
forall (m :: * -> *) a. Monad m => a -> m a
return (Block -> Get Block) -> Block -> Get Block
forall a b. (a -> b) -> a -> b
$ Text
-> Config
-> [Track]
-> Skeleton
-> Maybe (BlockId, TrackDestinations)
-> [(TrackId, TrackDestinations)]
-> ManualDestinations
-> Meta
-> Block
Block.Block Text
title Config
config [Track]
tracks Skeleton
skel Maybe (BlockId, TrackDestinations)
iblock [(TrackId, TrackDestinations)]
itracks
                ManualDestinations
dtracks Meta
meta
        Word8
14 -> do
            Text
title :: Text <- Get Text
forall a. Serialize a => Get a
get
            [Track]
tracks :: [Block.Track] <- Get [Track]
forall a. Serialize a => Get a
get
            Skeleton
skel :: Skeleton.Skeleton <- Get Skeleton
forall a. Serialize a => Get a
get
            Maybe (BlockId, TrackDestinations)
iblock :: Maybe (BlockId, Block.TrackDestinations) <- Get (Maybe (BlockId, TrackDestinations))
forall a. Serialize a => Get a
get
            [(TrackId, TrackDestinations)]
itracks :: [(TrackId, Block.TrackDestinations)] <- Get [(TrackId, TrackDestinations)]
forall a. Serialize a => Get a
get
            ManualDestinations
dtracks :: Block.ManualDestinations <- Get ManualDestinations
forall a. Serialize a => Get a
get
            Meta
meta :: Map Text Text <- Get Meta
forall a. Serialize a => Get a
get
            Skeleton
skel_config :: Block.Skeleton <- Get Skeleton
forall a. Serialize a => Get a
get
            Block -> Get Block
forall (m :: * -> *) a. Monad m => a -> m a
return (Block -> Get Block) -> Block -> Get Block
forall a b. (a -> b) -> a -> b
$ Text
-> Config
-> [Track]
-> Skeleton
-> Maybe (BlockId, TrackDestinations)
-> [(TrackId, TrackDestinations)]
-> ManualDestinations
-> Meta
-> Block
Block.Block Text
title
                (Config
config { config_skeleton :: Skeleton
Block.config_skeleton = Skeleton
skel_config })
                [Track]
tracks Skeleton
skel Maybe (BlockId, TrackDestinations)
iblock [(TrackId, TrackDestinations)]
itracks ManualDestinations
dtracks Meta
meta
        Word8
v -> String -> Word8 -> Get Block
forall a. Stack => String -> Word8 -> a
bad_version String
"Block.Block" Word8
v
        where
        config :: Config
config = Config
Block.default_config { config_skeleton :: Skeleton
Block.config_skeleton = Skeleton
Block.Explicit }

instance Serialize Block.Skeleton where
    put :: Putter Skeleton
put = \case
        Skeleton
Block.Explicit -> Word8 -> Put
put_tag Word8
0
        Skeleton
Block.Implicit -> Word8 -> Put
put_tag Word8
1
    get :: Get Skeleton
get = Get Word8
get_tag Get Word8 -> (Word8 -> Get Skeleton) -> Get Skeleton
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Word8
0 -> Skeleton -> Get Skeleton
forall (f :: * -> *) a. Applicative f => a -> f a
pure Skeleton
Block.Explicit
        Word8
1 -> Skeleton -> Get Skeleton
forall (f :: * -> *) a. Applicative f => a -> f a
pure Skeleton
Block.Implicit
        Word8
tag -> String -> Word8 -> Get Skeleton
forall a. String -> Word8 -> Get a
bad_tag String
"Block.Skeleton" Word8
tag

instance Serialize Block.TrackDestinations where
    put :: Putter TrackDestinations
put (Block.DeriveDestinations [NoteDestination]
a) = Word8 -> Put
put_tag Word8
2 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter [NoteDestination]
forall a. Serialize a => Putter a
put [NoteDestination]
a
    put (Block.ScoreDestinations ScoreDestinations
a) = Word8 -> Put
put_tag Word8
1 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter ScoreDestinations
forall a. Serialize a => Putter a
put ScoreDestinations
a
    get :: Get TrackDestinations
get = Get Word8
get_tag Get Word8
-> (Word8 -> Get TrackDestinations) -> Get TrackDestinations
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Word8
0 -> [NoteDestination] -> TrackDestinations
Block.DeriveDestinations ([NoteDestination] -> TrackDestinations)
-> ([OldNoteDestination] -> [NoteDestination])
-> [OldNoteDestination]
-> TrackDestinations
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (OldNoteDestination -> NoteDestination)
-> [OldNoteDestination] -> [NoteDestination]
forall a b. (a -> b) -> [a] -> [b]
map OldNoteDestination -> NoteDestination
upgrade_note_destination ([OldNoteDestination] -> TrackDestinations)
-> Get [OldNoteDestination] -> Get TrackDestinations
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get [OldNoteDestination]
forall a. Serialize a => Get a
get
        Word8
1 -> ScoreDestinations -> TrackDestinations
Block.ScoreDestinations (ScoreDestinations -> TrackDestinations)
-> Get ScoreDestinations -> Get TrackDestinations
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ScoreDestinations
forall a. Serialize a => Get a
get
        Word8
2 -> [NoteDestination] -> TrackDestinations
Block.DeriveDestinations ([NoteDestination] -> TrackDestinations)
-> Get [NoteDestination] -> Get TrackDestinations
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get [NoteDestination]
forall a. Serialize a => Get a
get
        Word8
tag -> String -> Word8 -> Get TrackDestinations
forall a. String -> Word8 -> Get a
bad_tag String
"Block.TrackDestinations" Word8
tag

-- | Oops, I forgot to put a version on NoteDestination so of course this
-- happens...
data OldNoteDestination = OldNoteDestination
    (TrackId, Block.EventIndex)
    (Map Text (TrackId, Block.EventIndex))

upgrade_note_destination :: OldNoteDestination -> Block.NoteDestination
upgrade_note_destination :: OldNoteDestination -> NoteDestination
upgrade_note_destination (OldNoteDestination (TrackId, EventIndex)
a Map Text (TrackId, EventIndex)
b) = Text
-> (TrackId, EventIndex)
-> Map Text (TrackId, EventIndex)
-> NoteDestination
Block.NoteDestination Text
"" (TrackId, EventIndex)
a Map Text (TrackId, EventIndex)
b

instance Serialize OldNoteDestination where
    put :: Putter OldNoteDestination
put (OldNoteDestination (TrackId, EventIndex)
a Map Text (TrackId, EventIndex)
b) = Putter (TrackId, EventIndex)
forall a. Serialize a => Putter a
put (TrackId, EventIndex)
a Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter (Map Text (TrackId, EventIndex))
forall a. Serialize a => Putter a
put Map Text (TrackId, EventIndex)
b
    get :: Get OldNoteDestination
get = (TrackId, EventIndex)
-> Map Text (TrackId, EventIndex) -> OldNoteDestination
OldNoteDestination ((TrackId, EventIndex)
 -> Map Text (TrackId, EventIndex) -> OldNoteDestination)
-> Get (TrackId, EventIndex)
-> Get (Map Text (TrackId, EventIndex) -> OldNoteDestination)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (TrackId, EventIndex)
forall a. Serialize a => Get a
get Get (Map Text (TrackId, EventIndex) -> OldNoteDestination)
-> Get (Map Text (TrackId, EventIndex)) -> Get OldNoteDestination
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get (Map Text (TrackId, EventIndex))
forall a. Serialize a => Get a
get

instance Serialize Block.NoteDestination where
    put :: Putter NoteDestination
put (Block.NoteDestination Text
a (TrackId, EventIndex)
b Map Text (TrackId, EventIndex)
c) = Word8 -> Put
put_version Word8
0 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter Text
forall a. Serialize a => Putter a
put Text
a Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter (TrackId, EventIndex)
forall a. Serialize a => Putter a
put (TrackId, EventIndex)
b Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter (Map Text (TrackId, EventIndex))
forall a. Serialize a => Putter a
put Map Text (TrackId, EventIndex)
c
    get :: Get NoteDestination
get = Get Word8
get_version Get Word8 -> (Word8 -> Get NoteDestination) -> Get NoteDestination
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Word8
0 -> do
            Text
key :: Text <- Get Text
forall a. Serialize a => Get a
get
            (TrackId, EventIndex)
note :: (TrackId, Block.EventIndex) <- Get (TrackId, EventIndex)
forall a. Serialize a => Get a
get
            Map Text (TrackId, EventIndex)
controls :: (Map Text (TrackId, Block.EventIndex)) <- Get (Map Text (TrackId, EventIndex))
forall a. Serialize a => Get a
get
            NoteDestination -> Get NoteDestination
forall (m :: * -> *) a. Monad m => a -> m a
return (NoteDestination -> Get NoteDestination)
-> NoteDestination -> Get NoteDestination
forall a b. (a -> b) -> a -> b
$ Text
-> (TrackId, EventIndex)
-> Map Text (TrackId, EventIndex)
-> NoteDestination
Block.NoteDestination Text
key (TrackId, EventIndex)
note Map Text (TrackId, EventIndex)
controls
        Word8
v -> String -> Word8 -> Get NoteDestination
forall a. Stack => String -> Word8 -> a
bad_version String
"Block.Block" Word8
v

instance Serialize Block.Track where
    -- The suggested_width is actually derived from fltk, so don't save it.
    -- It's awkward to have it in Block.Track, I have another derived
    -- field like this in Ruler.Ruler's Marklist when there's a Meter.
    put :: Putter Track
put (Block.Track TracklikeId
id Int
width Int
_suggested Set TrackFlag
flags Set TrackId
merged) = Word8 -> Put
put_version Word8
3
        Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter TracklikeId
forall a. Serialize a => Putter a
put TracklikeId
id Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter Int
forall a. Serialize a => Putter a
put Int
widthPut -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter (Set TrackFlag)
forall a. Serialize a => Putter a
put Set TrackFlag
flags Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter (Set TrackId)
forall a. Serialize a => Putter a
put Set TrackId
merged
    get :: Get Track
get = Get Word8
get_version Get Word8 -> (Word8 -> Get Track) -> Get Track
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Word8
3 -> do
            TracklikeId
id :: Block.TracklikeId <- Get TracklikeId
forall a. Serialize a => Get a
get
            Int
width :: Types.Width <- Get Int
forall a. Serialize a => Get a
get
            Set TrackFlag
flags :: Set Block.TrackFlag <- Get (Set TrackFlag)
forall a. Serialize a => Get a
get
            Set TrackId
merged :: Set Types.TrackId <- Get (Set TrackId)
forall a. Serialize a => Get a
get
            Track -> Get Track
forall (m :: * -> *) a. Monad m => a -> m a
return (Track -> Get Track) -> Track -> Get Track
forall a b. (a -> b) -> a -> b
$ TracklikeId -> Int -> Int -> Set TrackFlag -> Set TrackId -> Track
Block.Track TracklikeId
id Int
width Int
width Set TrackFlag
flags Set TrackId
merged
        Word8
v -> String -> Word8 -> Get Track
forall a. Stack => String -> Word8 -> a
bad_version String
"Block.Track" Word8
v

instance Serialize Block.TrackFlag where
    put :: Putter TrackFlag
put TrackFlag
Block.Collapse = Word8 -> Put
put_tag Word8
0
    put TrackFlag
Block.Solo = Word8 -> Put
put_tag Word8
1
    put TrackFlag
Block.Mute = Word8 -> Put
put_tag Word8
2
    put TrackFlag
Block.Disable = Word8 -> Put
put_tag Word8
3
    get :: Get TrackFlag
get = do
        Word8
tag <- Get Word8
get_tag
        case Word8
tag of
            Word8
0 -> TrackFlag -> Get TrackFlag
forall (m :: * -> *) a. Monad m => a -> m a
return TrackFlag
Block.Collapse
            Word8
1 -> TrackFlag -> Get TrackFlag
forall (m :: * -> *) a. Monad m => a -> m a
return TrackFlag
Block.Solo
            Word8
2 -> TrackFlag -> Get TrackFlag
forall (m :: * -> *) a. Monad m => a -> m a
return TrackFlag
Block.Mute
            Word8
3 -> TrackFlag -> Get TrackFlag
forall (m :: * -> *) a. Monad m => a -> m a
return TrackFlag
Block.Disable
            Word8
_ -> String -> Word8 -> Get TrackFlag
forall a. String -> Word8 -> Get a
bad_tag String
"Block.TrackFlag" Word8
tag

instance Serialize Block.TracklikeId where
    put :: Putter TracklikeId
put (Block.TId TrackId
a RulerId
b) = Word8 -> Put
put_tag Word8
0 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter TrackId
forall a. Serialize a => Putter a
put TrackId
a Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter RulerId
forall a. Serialize a => Putter a
put RulerId
b
    put (Block.RId RulerId
a) = Word8 -> Put
put_tag Word8
1 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter RulerId
forall a. Serialize a => Putter a
put RulerId
a
    put (Block.DId Divider
a) = Word8 -> Put
put_tag Word8
2 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter Divider
forall a. Serialize a => Putter a
put Divider
a
    get :: Get TracklikeId
get = do
        Word8
tag <- Get Word8
get_tag
        case Word8
tag of
            Word8
0 -> do
                TrackId
tid :: TrackId <- Get TrackId
forall a. Serialize a => Get a
get
                RulerId
rid :: RulerId <- Get RulerId
forall a. Serialize a => Get a
get
                TracklikeId -> Get TracklikeId
forall (m :: * -> *) a. Monad m => a -> m a
return (TracklikeId -> Get TracklikeId) -> TracklikeId -> Get TracklikeId
forall a b. (a -> b) -> a -> b
$ TrackId -> RulerId -> TracklikeId
Block.TId TrackId
tid RulerId
rid
            Word8
1 -> do
                RulerId
rid :: RulerId <- Get RulerId
forall a. Serialize a => Get a
get
                TracklikeId -> Get TracklikeId
forall (m :: * -> *) a. Monad m => a -> m a
return (TracklikeId -> Get TracklikeId) -> TracklikeId -> Get TracklikeId
forall a b. (a -> b) -> a -> b
$ RulerId -> TracklikeId
Block.RId RulerId
rid
            Word8
2 -> do
                Divider
div :: Block.Divider <- Get Divider
forall a. Serialize a => Get a
get
                TracklikeId -> Get TracklikeId
forall (m :: * -> *) a. Monad m => a -> m a
return (TracklikeId -> Get TracklikeId) -> TracklikeId -> Get TracklikeId
forall a b. (a -> b) -> a -> b
$ Divider -> TracklikeId
Block.DId Divider
div
            Word8
_ -> String -> Word8 -> Get TracklikeId
forall a. String -> Word8 -> Get a
bad_tag String
"Block.TracklikeId" Word8
tag

instance Serialize Block.Divider where
    put :: Putter Divider
put (Block.Divider Color
a) = Putter Color
forall a. Serialize a => Putter a
put Color
a
    get :: Get Divider
get = Color -> Divider
Block.Divider (Color -> Divider) -> Get Color -> Get Divider
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Color
forall a. Serialize a => Get a
get

instance Serialize Block.View where
    put :: Putter View
put (Block.View BlockId
a Rect
b Padding
c Map (Int, Text) Text
d Int
e Zoom
f Map Int Selection
g) = Word8 -> Put
put_version Word8
7
        Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter BlockId
forall a. Serialize a => Putter a
put BlockId
a Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter Rect
forall a. Serialize a => Putter a
put Rect
b Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter Padding
forall a. Serialize a => Putter a
put Padding
c Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter (Map (Int, Text) Text)
forall a. Serialize a => Putter a
put Map (Int, Text) Text
d Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter Int
forall a. Serialize a => Putter a
put Int
e Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter Zoom
forall a. Serialize a => Putter a
put Zoom
f Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter (Map Int Selection)
forall a. Serialize a => Putter a
put Map Int Selection
g
    get :: Get View
get = Get Word8
get_version Get Word8 -> (Word8 -> Get View) -> Get View
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Word8
5 -> do
            BlockId
block :: Types.BlockId <- Get BlockId
forall a. Serialize a => Get a
get
            Rect
rect :: Rect.Rect <- Get Rect
forall a. Serialize a => Get a
get
            Int
track_padding :: Int <- Get Int
forall a. Serialize a => Get a
get
            Int
time_padding :: Int <- Get Int
forall a. Serialize a => Get a
get
            Map (Int, Text) Text
status :: Map (Int, Text) Text <- Get (Map (Int, Text) Text)
forall a. Serialize a => Get a
get
            Int
track_scroll :: Types.Width <- Get Int
forall a. Serialize a => Get a
get
            Zoom
zoom :: Zoom.Zoom <- Get Zoom
forall a. Serialize a => Get a
get
            Map Int OldSelection
selections :: Map Sel.Num OldSelection <- Get (Map Int OldSelection)
forall a. Serialize a => Get a
get
            let padding :: Padding
padding = Int -> Int -> Int -> Padding
Block.Padding Int
track_padding Int
time_padding Int
0
            View -> Get View
forall (m :: * -> *) a. Monad m => a -> m a
return (View -> Get View) -> View -> Get View
forall a b. (a -> b) -> a -> b
$ BlockId
-> Rect
-> Padding
-> Map (Int, Text) Text
-> Int
-> Zoom
-> Map Int Selection
-> View
Block.View BlockId
block Rect
rect Padding
padding Map (Int, Text) Text
status Int
track_scroll Zoom
zoom
                (OldSelection -> Selection
upgrade (OldSelection -> Selection)
-> Map Int OldSelection -> Map Int Selection
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Int OldSelection
selections)
        Word8
6 -> do
            BlockId
block :: Types.BlockId <- Get BlockId
forall a. Serialize a => Get a
get
            Rect
rect :: Rect.Rect <- Get Rect
forall a. Serialize a => Get a
get
            Padding
padding :: Block.Padding <- Get Padding
forall a. Serialize a => Get a
get
            Map (Int, Text) Text
status :: Map (Int, Text) Text <- Get (Map (Int, Text) Text)
forall a. Serialize a => Get a
get
            Int
track_scroll :: Types.Width <- Get Int
forall a. Serialize a => Get a
get
            Zoom
zoom :: Zoom.Zoom <- Get Zoom
forall a. Serialize a => Get a
get
            Map Int OldSelection
selections :: Map Sel.Num OldSelection <- Get (Map Int OldSelection)
forall a. Serialize a => Get a
get
            View -> Get View
forall (m :: * -> *) a. Monad m => a -> m a
return (View -> Get View) -> View -> Get View
forall a b. (a -> b) -> a -> b
$ BlockId
-> Rect
-> Padding
-> Map (Int, Text) Text
-> Int
-> Zoom
-> Map Int Selection
-> View
Block.View BlockId
block Rect
rect Padding
padding Map (Int, Text) Text
status Int
track_scroll Zoom
zoom
                (OldSelection -> Selection
upgrade (OldSelection -> Selection)
-> Map Int OldSelection -> Map Int Selection
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Int OldSelection
selections)
        Word8
7 -> do
            BlockId
block :: Types.BlockId <- Get BlockId
forall a. Serialize a => Get a
get
            Rect
rect :: Rect.Rect <- Get Rect
forall a. Serialize a => Get a
get
            Padding
padding :: Block.Padding <- Get Padding
forall a. Serialize a => Get a
get
            Map (Int, Text) Text
status :: Map (Int, Text) Text <- Get (Map (Int, Text) Text)
forall a. Serialize a => Get a
get
            Int
track_scroll :: Types.Width <- Get Int
forall a. Serialize a => Get a
get
            Zoom
zoom :: Zoom.Zoom <- Get Zoom
forall a. Serialize a => Get a
get
            Map Int Selection
selections :: Map Sel.Num Sel.Selection <- Get (Map Int Selection)
forall a. Serialize a => Get a
get
            View -> Get View
forall (m :: * -> *) a. Monad m => a -> m a
return (View -> Get View) -> View -> Get View
forall a b. (a -> b) -> a -> b
$ BlockId
-> Rect
-> Padding
-> Map (Int, Text) Text
-> Int
-> Zoom
-> Map Int Selection
-> View
Block.View BlockId
block Rect
rect Padding
padding Map (Int, Text) Text
status Int
track_scroll Zoom
zoom
                Map Int Selection
selections
        Word8
v -> String -> Word8 -> Get View
forall a. Stack => String -> Word8 -> a
bad_version String
"Block.View" Word8
v
        where
        upgrade :: OldSelection -> Selection
upgrade (OldSelection Int
a ScoreTime
b Int
c ScoreTime
d) = Int -> ScoreTime -> Int -> ScoreTime -> Orientation -> Selection
Sel.Selection Int
a ScoreTime
b Int
c ScoreTime
d Orientation
Sel.Positive

instance Serialize Block.Padding where
    put :: Putter Padding
put (Block.Padding Int
a Int
b Int
c) = Word8 -> Put
put_version Word8
0
        Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter Int
forall a. Serialize a => Putter a
put Int
a Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter Int
forall a. Serialize a => Putter a
put Int
b Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter Int
forall a. Serialize a => Putter a
put Int
c
    get :: Get Padding
get = Get Word8
get_version Get Word8 -> (Word8 -> Get Padding) -> Get Padding
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Word8
0 -> do
            Int
left :: Int <- Get Int
forall a. Serialize a => Get a
get
            Int
top :: Int <- Get Int
forall a. Serialize a => Get a
get
            Int
bottom :: Int <- Get Int
forall a. Serialize a => Get a
get
            Padding -> Get Padding
forall (m :: * -> *) a. Monad m => a -> m a
return (Padding -> Get Padding) -> Padding -> Get Padding
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int -> Padding
Block.Padding Int
left Int
top Int
bottom
        Word8
v -> String -> Word8 -> Get Padding
forall a. Stack => String -> Word8 -> a
bad_version String
"Block.Padding" Word8
v

instance Serialize Rect.Rect where
    put :: Putter Rect
put Rect
r = Putter Int
forall a. Serialize a => Putter a
put (Rect -> Int
Rect.x Rect
r) Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter Int
forall a. Serialize a => Putter a
put (Rect -> Int
Rect.y Rect
r) Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter Int
forall a. Serialize a => Putter a
put (Rect -> Int
Rect.w Rect
r) Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter Int
forall a. Serialize a => Putter a
put (Rect -> Int
Rect.h Rect
r)
    get :: Get Rect
get = Get Int
forall a. Serialize a => Get a
get Get Int -> (Int -> Get Rect) -> Get Rect
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Int
a -> Get Int
forall a. Serialize a => Get a
get Get Int -> (Int -> Get Rect) -> Get Rect
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Int
b -> Get Int
forall a. Serialize a => Get a
get Get Int -> (Int -> Get Rect) -> Get Rect
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Int
c -> Get Int
forall a. Serialize a => Get a
get Get Int -> (Int -> Get Rect) -> Get Rect
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Int
d ->
        Rect -> Get Rect
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Int -> Int -> Int -> Rect
Rect.xywh Int
a Int
b Int
c Int
d)

instance Serialize Zoom.Zoom where
    put :: Putter Zoom
put (Zoom.Zoom ScoreTime
a Y
b) = Putter ScoreTime
forall a. Serialize a => Putter a
put ScoreTime
a Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter Y
forall a. Serialize a => Putter a
put Y
b
    get :: Get Zoom
get = do
        ScoreTime
offset :: ScoreTime <- Get ScoreTime
forall a. Serialize a => Get a
get
        Y
factor :: Double <- Get Y
forall a. Serialize a => Get a
get
        Zoom -> Get Zoom
forall (m :: * -> *) a. Monad m => a -> m a
return (Zoom -> Get Zoom) -> Zoom -> Get Zoom
forall a b. (a -> b) -> a -> b
$ ScoreTime -> Y -> Zoom
Zoom.Zoom ScoreTime
offset Y
factor

data OldSelection = OldSelection TrackNum TrackTime TrackNum TrackTime

instance Serialize OldSelection where
    put :: Putter OldSelection
put (OldSelection Int
a ScoreTime
b Int
c ScoreTime
d) = Putter Int
forall a. Serialize a => Putter a
put Int
a Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter ScoreTime
forall a. Serialize a => Putter a
put ScoreTime
b Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter Int
forall a. Serialize a => Putter a
put Int
c Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter ScoreTime
forall a. Serialize a => Putter a
put ScoreTime
d
    get :: Get OldSelection
get = Int -> ScoreTime -> Int -> ScoreTime -> OldSelection
OldSelection (Int -> ScoreTime -> Int -> ScoreTime -> OldSelection)
-> Get Int -> Get (ScoreTime -> Int -> ScoreTime -> OldSelection)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int
forall a. Serialize a => Get a
get Get (ScoreTime -> Int -> ScoreTime -> OldSelection)
-> Get ScoreTime -> Get (Int -> ScoreTime -> OldSelection)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get ScoreTime
forall a. Serialize a => Get a
get Get (Int -> ScoreTime -> OldSelection)
-> Get Int -> Get (ScoreTime -> OldSelection)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Int
forall a. Serialize a => Get a
get Get (ScoreTime -> OldSelection)
-> Get ScoreTime -> Get OldSelection
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get ScoreTime
forall a. Serialize a => Get a
get

instance Serialize Sel.Selection where
    put :: Putter Selection
put (Sel.Selection Int
a ScoreTime
b Int
c ScoreTime
d Orientation
e) = Word8 -> Put
put_version Word8
0
        Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter Int
forall a. Serialize a => Putter a
put Int
a Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter ScoreTime
forall a. Serialize a => Putter a
put ScoreTime
b Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter Int
forall a. Serialize a => Putter a
put Int
c Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter ScoreTime
forall a. Serialize a => Putter a
put ScoreTime
d Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter Orientation
forall a. Serialize a => Putter a
put Orientation
e
    get :: Get Selection
get = Get Word8
get_version Get Word8 -> (Word8 -> Get Selection) -> Get Selection
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Word8
0 -> do
            Int
strack :: Int <- Get Int
forall a. Serialize a => Get a
get
            ScoreTime
stime :: ScoreTime <- Get ScoreTime
forall a. Serialize a => Get a
get
            Int
ctrack :: Int <- Get Int
forall a. Serialize a => Get a
get
            ScoreTime
ctime :: ScoreTime <- Get ScoreTime
forall a. Serialize a => Get a
get
            Orientation
orient :: Sel.Orientation <- Get Orientation
forall a. Serialize a => Get a
get
            Selection -> Get Selection
forall (m :: * -> *) a. Monad m => a -> m a
return (Selection -> Get Selection) -> Selection -> Get Selection
forall a b. (a -> b) -> a -> b
$ Int -> ScoreTime -> Int -> ScoreTime -> Orientation -> Selection
Sel.Selection Int
strack ScoreTime
stime Int
ctrack ScoreTime
ctime Orientation
orient
        Word8
v -> String -> Word8 -> Get Selection
forall a. Stack => String -> Word8 -> a
bad_version String
"Sel.Selection" Word8
v

instance Serialize Sel.Orientation where
    put :: Putter Orientation
put = Putter Orientation
forall a. Enum a => a -> Put
Serialize.put_enum_unsafe
    get :: Get Orientation
get = Get Orientation
forall a. (Bounded a, Enum a) => Get a
Serialize.get_enum_unsafe

-- ** Types, Color, Font

instance Serialize Color.Color where
    put :: Putter Color
put (Color.Color Y
a Y
b Y
c Y
d) = Putter Y
forall a. Serialize a => Putter a
put Y
a Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter Y
forall a. Serialize a => Putter a
put Y
b Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter Y
forall a. Serialize a => Putter a
put Y
c Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter Y
forall a. Serialize a => Putter a
put Y
d
    get :: Get Color
get = Get Y
forall a. Serialize a => Get a
get Get Y -> (Y -> Get Color) -> Get Color
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Y
a -> Get Y
forall a. Serialize a => Get a
get Get Y -> (Y -> Get Color) -> Get Color
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Y
b -> Get Y
forall a. Serialize a => Get a
get Get Y -> (Y -> Get Color) -> Get Color
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Y
c -> Get Y
forall a. Serialize a => Get a
get Get Y -> (Y -> Get Color) -> Get Color
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Y
d ->
        Color -> Get Color
forall (m :: * -> *) a. Monad m => a -> m a
return (Y -> Y -> Y -> Y -> Color
Color.Color Y
a Y
b Y
c Y
d)

-- ** Ruler

instance Serialize Ruler.Ruler where
    put :: Putter Ruler
put (Ruler.Ruler Map Text (Maybe Meter, Marklist)
marklists Color
b Bool
c Bool
d) = do
        Word8 -> Put
put_version Word8
8
        Putter (Map Text (Maybe Meter, Marklist))
forall a. Serialize a => Putter a
put Putter (Map Text (Maybe Meter, Marklist))
-> Putter (Map Text (Maybe Meter, Marklist))
forall a b. (a -> b) -> a -> b
$ (Maybe Meter, Marklist) -> (Maybe Meter, Marklist)
forall {a}. (Maybe a, Marklist) -> (Maybe a, Marklist)
strip ((Maybe Meter, Marklist) -> (Maybe Meter, Marklist))
-> Map Text (Maybe Meter, Marklist)
-> Map Text (Maybe Meter, Marklist)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Text (Maybe Meter, Marklist)
marklists
        Putter Color
forall a. Serialize a => Putter a
put Color
b Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter Bool
forall a. Serialize a => Putter a
put Bool
c Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter Bool
forall a. Serialize a => Putter a
put Bool
d
        where
        -- I don't actually need to store the Marklist if Meter is set, becasue
        -- I can regenerate it.
        strip :: (Maybe a, Marklist) -> (Maybe a, Marklist)
strip (Just a
meter, Marklist
_mlist) = (a -> Maybe a
forall a. a -> Maybe a
Just a
meter, Marklist
Mark.empty)
        strip (Maybe a
Nothing, Marklist
mlist) = (Maybe a
forall a. Maybe a
Nothing, Marklist
mlist)
    get :: Get Ruler
get = Get Word8
get_version Get Word8 -> (Word8 -> Get Ruler) -> Get Ruler
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Word8
6 -> do
            Map Text (Maybe Text, Marklist)
marklists :: Map Ruler.Name (Maybe Text, Mark.Marklist) <- Get (Map Text (Maybe Text, Marklist))
forall a. Serialize a => Get a
get
            Color
bg :: Color.Color <- Get Color
forall a. Serialize a => Get a
get
            Bool
show_names :: Bool <- Get Bool
forall a. Serialize a => Get a
get
            Bool
align_to_bottom :: Bool <- Get Bool
forall a. Serialize a => Get a
get
            Ruler -> Get Ruler
forall (m :: * -> *) a. Monad m => a -> m a
return (Ruler -> Get Ruler) -> Ruler -> Get Ruler
forall a b. (a -> b) -> a -> b
$ Map Text (Maybe Meter, Marklist) -> Color -> Bool -> Bool -> Ruler
Ruler.Ruler ((Maybe Text, Marklist) -> (Maybe Meter, Marklist)
forall {a} {b} {a}. (a, b) -> (Maybe a, b)
upgrade ((Maybe Text, Marklist) -> (Maybe Meter, Marklist))
-> Map Text (Maybe Text, Marklist)
-> Map Text (Maybe Meter, Marklist)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Text (Maybe Text, Marklist)
marklists) Color
bg Bool
show_names
                Bool
align_to_bottom
            where
            upgrade :: (a, b) -> (Maybe a, b)
upgrade (a
_name, b
mlist) = (Maybe a
forall a. Maybe a
Nothing, b
mlist)
        Word8
7 -> do
            OldMarklists
marklists :: OldMarklists <- Get OldMarklists
forall a. Serialize a => Get a
get
            Color
bg :: Color.Color <- Get Color
forall a. Serialize a => Get a
get
            Bool
show_names :: Bool <- Get Bool
forall a. Serialize a => Get a
get
            Bool
align_to_bottom :: Bool <- Get Bool
forall a. Serialize a => Get a
get
            Ruler -> Get Ruler
forall (m :: * -> *) a. Monad m => a -> m a
return (Ruler -> Get Ruler) -> Ruler -> Get Ruler
forall a b. (a -> b) -> a -> b
$ Map Text (Maybe Meter, Marklist) -> Color -> Bool -> Bool -> Ruler
Ruler.Ruler (OldMarklists -> Map Text (Maybe Meter, Marklist)
upgrade OldMarklists
marklists) Color
bg Bool
show_names
                Bool
align_to_bottom
            where
            upgrade :: OldMarklists -> Ruler.Marklists
            upgrade :: OldMarklists -> Map Text (Maybe Meter, Marklist)
upgrade = ((Maybe OldMeterConfig, OldMarklist) -> (Maybe Meter, Marklist))
-> OldMarklists -> Map Text (Maybe Meter, Marklist)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((Maybe OldMeterConfig, OldMarklist) -> (Maybe Meter, Marklist))
 -> OldMarklists -> Map Text (Maybe Meter, Marklist))
-> ((Maybe OldMeterConfig, OldMarklist) -> (Maybe Meter, Marklist))
-> OldMarklists
-> Map Text (Maybe Meter, Marklist)
forall a b. (a -> b) -> a -> b
$ \(Maybe OldMeterConfig
_config, OldMarklist MarklistVector
mlist) ->
                (Maybe Meter
forall a. Maybe a
Nothing, MarklistVector -> Marklist
Mark.marklist_from_vector MarklistVector
mlist)
            -- Upgrade marklists by throwing out the OldMeterConfig.
            -- Alternately, I could try to automatically figure out what the
            -- Meter should be...
        Word8
8 -> do
            Map Text (Maybe Meter, Marklist)
marklists :: Map Ruler.Name (Maybe Meter.Meter, Mark.Marklist)
                <- Get (Map Text (Maybe Meter, Marklist))
forall a. Serialize a => Get a
get
            Color
bg :: Color.Color <- Get Color
forall a. Serialize a => Get a
get
            Bool
show_names :: Bool <- Get Bool
forall a. Serialize a => Get a
get
            Bool
align_to_bottom :: Bool <- Get Bool
forall a. Serialize a => Get a
get
            Ruler -> Get Ruler
forall (m :: * -> *) a. Monad m => a -> m a
return (Ruler -> Get Ruler) -> Ruler -> Get Ruler
forall a b. (a -> b) -> a -> b
$ Map Text (Maybe Meter, Marklist) -> Color -> Bool -> Bool -> Ruler
Ruler.Ruler ((Maybe Meter, Marklist) -> (Maybe Meter, Marklist)
add ((Maybe Meter, Marklist) -> (Maybe Meter, Marklist))
-> Map Text (Maybe Meter, Marklist)
-> Map Text (Maybe Meter, Marklist)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Text (Maybe Meter, Marklist)
marklists) Color
bg Bool
show_names
                Bool
align_to_bottom
            where
            add :: (Maybe Meter, Marklist) -> (Maybe Meter, Marklist)
add (Just Meter
meter, Marklist
_) = (Meter -> Maybe Meter
forall a. a -> Maybe a
Just Meter
meter, Meter -> Marklist
Meter.Make.make_marklist Meter
meter)
            add (Maybe Meter
Nothing, Marklist
mlist) = (Maybe Meter
forall a. Maybe a
Nothing, Marklist
mlist)
        Word8
v -> String -> Word8 -> Get Ruler
forall a. Stack => String -> Word8 -> a
bad_version String
"Ruler.Ruler" Word8
v

type OldMarklists = Map Text (Maybe OldMeterConfig, OldMarklist)

instance Serialize OldMeterConfig where
    put :: Putter OldMeterConfig
put (OldMeterConfig Text
a Int
b) = Word8 -> Put
put_version Word8
0 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter Text
forall a. Serialize a => Putter a
put Text
a Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter Int
forall a. Serialize a => Putter a
put Int
b
    get :: Get OldMeterConfig
get = Get Word8
get_version Get Word8 -> (Word8 -> Get OldMeterConfig) -> Get OldMeterConfig
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Word8
0 -> Text -> Int -> OldMeterConfig
OldMeterConfig (Text -> Int -> OldMeterConfig)
-> Get Text -> Get (Int -> OldMeterConfig)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Text
forall a. Serialize a => Get a
get Get (Int -> OldMeterConfig) -> Get Int -> Get OldMeterConfig
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Int
forall a. Serialize a => Get a
get
        Word8
v -> String -> Word8 -> Get OldMeterConfig
forall a. Stack => String -> Word8 -> a
bad_version String
"OldMeterConfig" Word8
v

-- | Configuration specific to the 'meter' marklist.
data OldMeterConfig = OldMeterConfig {
    -- | The type of meter that this marklist represents.  This is looked up in
    -- a table of meter types to figure out how to do transformations on the
    -- meter, since different meters follow different rules.
    OldMeterConfig -> Text
config_name :: !Text
    , OldMeterConfig -> Int
config_start_measure :: !Int
    } deriving (OldMeterConfig -> OldMeterConfig -> Bool
(OldMeterConfig -> OldMeterConfig -> Bool)
-> (OldMeterConfig -> OldMeterConfig -> Bool) -> Eq OldMeterConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OldMeterConfig -> OldMeterConfig -> Bool
$c/= :: OldMeterConfig -> OldMeterConfig -> Bool
== :: OldMeterConfig -> OldMeterConfig -> Bool
$c== :: OldMeterConfig -> OldMeterConfig -> Bool
Eq, Int -> OldMeterConfig -> ShowS
[OldMeterConfig] -> ShowS
OldMeterConfig -> String
(Int -> OldMeterConfig -> ShowS)
-> (OldMeterConfig -> String)
-> ([OldMeterConfig] -> ShowS)
-> Show OldMeterConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OldMeterConfig] -> ShowS
$cshowList :: [OldMeterConfig] -> ShowS
show :: OldMeterConfig -> String
$cshow :: OldMeterConfig -> String
showsPrec :: Int -> OldMeterConfig -> ShowS
$cshowsPrec :: Int -> OldMeterConfig -> ShowS
Show)

instance Serialize Meter.Meter where
    put :: Putter Meter
put (Meter.Meter Config
a [MSection]
b) = Word8 -> Put
put_version Word8
0 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter Config
forall a. Serialize a => Putter a
put Config
a Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter [MSection]
forall a. Serialize a => Putter a
put [MSection]
b
    get :: Get Meter
get = Get Word8
get_version Get Word8 -> (Word8 -> Get Meter) -> Get Meter
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Word8
0 -> do
            Config
config :: Meter.Config <- Get Config
forall a. Serialize a => Get a
get
            [MSection]
sections :: [Meter.MSection] <- Get [MSection]
forall a. Serialize a => Get a
get
            Meter -> Get Meter
forall (m :: * -> *) a. Monad m => a -> m a
return (Meter -> Get Meter) -> Meter -> Get Meter
forall a b. (a -> b) -> a -> b
$ Config -> [MSection] -> Meter
Meter.Meter Config
config [MSection]
sections
        Word8
v -> String -> Word8 -> Get Meter
forall a. Stack => String -> Word8 -> a
bad_version String
"Meter.Meter" Word8
v

instance Serialize Meter.MSection where
    put :: Putter MSection
put (Meter.MSection Int
a ScoreTime
b AbstractMeter
c) = Word8 -> Put
put_version Word8
0 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter Int
forall a. Serialize a => Putter a
put Int
a Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter ScoreTime
forall a. Serialize a => Putter a
put ScoreTime
b Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter AbstractMeter
forall a. Serialize a => Putter a
put AbstractMeter
c
    get :: Get MSection
get = Get Word8
get_version Get Word8 -> (Word8 -> Get MSection) -> Get MSection
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Word8
0 -> do
            Int
count :: Meter.Measures <- Get Int
forall a. Serialize a => Get a
get
            ScoreTime
measure_duration :: Meter.Duration <- Get ScoreTime
forall a. Serialize a => Get a
get
            AbstractMeter
measure :: Meter.AbstractMeter <- Get AbstractMeter
forall a. Serialize a => Get a
get
            MSection -> Get MSection
forall (m :: * -> *) a. Monad m => a -> m a
return (MSection -> Get MSection) -> MSection -> Get MSection
forall a b. (a -> b) -> a -> b
$ Int -> ScoreTime -> AbstractMeter -> MSection
Meter.MSection Int
count ScoreTime
measure_duration AbstractMeter
measure
        Word8
v -> String -> Word8 -> Get MSection
forall a. Stack => String -> Word8 -> a
bad_version String
"Meter.MSection" Word8
v

instance Serialize Meter.Config where
    put :: Putter Config
put (Meter.Config Set Rank
a LabelConfig
b Int
c Int
d Int
e) = Word8 -> Put
put_version Word8
0
        Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter (Set Rank)
forall a. Serialize a => Putter a
put Set Rank
a Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter LabelConfig
forall a. Serialize a => Putter a
put LabelConfig
b Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter Int
forall a. Serialize a => Putter a
put Int
c Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter Int
forall a. Serialize a => Putter a
put Int
d Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter Int
forall a. Serialize a => Putter a
put Int
e
    get :: Get Config
get = Get Word8
get_version Get Word8 -> (Word8 -> Get Config) -> Get Config
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Word8
0 -> do
            Set Rank
labeled_ranks :: Set Meter.Rank <- Get (Set Rank)
forall a. Serialize a => Get a
get
            LabelConfig
label :: Meter.LabelConfig <- Get LabelConfig
forall a. Serialize a => Get a
get
            Int
start_measure :: Meter.Measures <- Get Int
forall a. Serialize a => Get a
get
            Int
min_depth :: Int <- Get Int
forall a. Serialize a => Get a
get
            Int
strip_depth :: Int <- Get Int
forall a. Serialize a => Get a
get
            Config -> Get Config
forall (m :: * -> *) a. Monad m => a -> m a
return (Config -> Get Config) -> Config -> Get Config
forall a b. (a -> b) -> a -> b
$ Set Rank -> LabelConfig -> Int -> Int -> Int -> Config
Meter.Config Set Rank
labeled_ranks LabelConfig
label Int
start_measure Int
min_depth
                Int
strip_depth
        Word8
v -> String -> Word8 -> Get Config
forall a. Stack => String -> Word8 -> a
bad_version String
"Meter.Config" Word8
v

instance Serialize Meter.Rank where
    put :: Putter Rank
put Rank
a = (Word8 -> Put
put_version Word8
1 >>) (Put -> Put) -> Put -> Put
forall a b. (a -> b) -> a -> b
$ Word8 -> Put
put_enum (Word8 -> Put) -> Word8 -> Put
forall a b. (a -> b) -> a -> b
$ case Rank
a of
        Rank
Meter.Section -> Word8
0
        Rank
Meter.W -> Word8
1
        Rank
Meter.H -> Word8
2
        Rank
Meter.Q -> Word8
3
        Rank
Meter.E -> Word8
4
        Rank
Meter.S -> Word8
5
        Rank
Meter.T32 -> Word8
6
        Rank
Meter.T64 -> Word8
7
        Rank
Meter.T128 -> Word8
8
        Rank
Meter.T256 -> Word8
9
    get :: Get Rank
get = Get Word8
get_version Get Word8 -> (Word8 -> Get Rank) -> Get Rank
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Word8
0 -> Get Rank
forall a. (Bounded a, Enum a) => Get a
Serialize.get_enum_unsafe
        Word8
1 -> Get Word8
get_enum Get Word8 -> (Word8 -> Get Rank) -> Get Rank
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Word8
0 -> Rank -> Get Rank
forall (f :: * -> *) a. Applicative f => a -> f a
pure Rank
Meter.Section
            Word8
1 -> Rank -> Get Rank
forall (f :: * -> *) a. Applicative f => a -> f a
pure Rank
Meter.W
            Word8
2 -> Rank -> Get Rank
forall (f :: * -> *) a. Applicative f => a -> f a
pure Rank
Meter.H
            Word8
3 -> Rank -> Get Rank
forall (f :: * -> *) a. Applicative f => a -> f a
pure Rank
Meter.Q
            Word8
4 -> Rank -> Get Rank
forall (f :: * -> *) a. Applicative f => a -> f a
pure Rank
Meter.E
            Word8
5 -> Rank -> Get Rank
forall (f :: * -> *) a. Applicative f => a -> f a
pure Rank
Meter.S
            Word8
6 -> Rank -> Get Rank
forall (f :: * -> *) a. Applicative f => a -> f a
pure Rank
Meter.T32
            Word8
7 -> Rank -> Get Rank
forall (f :: * -> *) a. Applicative f => a -> f a
pure Rank
Meter.T64
            Word8
8 -> Rank -> Get Rank
forall (f :: * -> *) a. Applicative f => a -> f a
pure Rank
Meter.T128
            Word8
9 -> Rank -> Get Rank
forall (f :: * -> *) a. Applicative f => a -> f a
pure Rank
Meter.T256
            Word8
n -> String -> Word8 -> Get Rank
forall a. String -> Word8 -> Get a
bad_enum String
"Meter.Rank" Word8
n
        Word8
v -> String -> Word8 -> Get Rank
forall a. Stack => String -> Word8 -> a
bad_version String
"Meter.Rank" Word8
v

instance Serialize Meter.LabelConfig where
    put :: Putter LabelConfig
put LabelConfig
a = Word8 -> Put
put_version Word8
0 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> case LabelConfig
a of
        Meter.BigNumber Int
a -> Word8 -> Put
put_tag Word8
0 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter Int
forall a. Serialize a => Putter a
put Int
a
        Meter.Cycle [Text]
a -> Word8 -> Put
put_tag Word8
1 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter [Text]
forall a. Serialize a => Putter a
put [Text]
a
    get :: Get LabelConfig
get = Get Word8
get_version Get Word8 -> (Word8 -> Get LabelConfig) -> Get LabelConfig
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Word8
0 -> Get Word8
get_tag Get Word8 -> (Word8 -> Get LabelConfig) -> Get LabelConfig
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Word8
0 -> Int -> LabelConfig
Meter.BigNumber (Int -> LabelConfig) -> Get Int -> Get LabelConfig
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int
forall a. Serialize a => Get a
get
            Word8
1 -> [Text] -> LabelConfig
Meter.Cycle ([Text] -> LabelConfig) -> Get [Text] -> Get LabelConfig
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get [Text]
forall a. Serialize a => Get a
get
            Word8
t -> String -> Word8 -> Get LabelConfig
forall a. String -> Word8 -> Get a
bad_tag String
"Meter.LabelConfig" Word8
t
        Word8
v -> String -> Word8 -> Get LabelConfig
forall a. Stack => String -> Word8 -> a
bad_version String
"Meter.LabelConfig" Word8
v

instance Serialize Meter.AbstractMeter where
    put :: Putter AbstractMeter
put = \case
        AbstractMeter
Meter.T -> Word8 -> Put
put_tag Word8
0
        Meter.D [AbstractMeter]
ts -> Word8 -> Put
put_tag Word8
1 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter [AbstractMeter]
forall a. Serialize a => Putter a
put [AbstractMeter]
ts
    get :: Get AbstractMeter
get = Get Word8
get_tag Get Word8 -> (Word8 -> Get AbstractMeter) -> Get AbstractMeter
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Word8
0 -> AbstractMeter -> Get AbstractMeter
forall (f :: * -> *) a. Applicative f => a -> f a
pure AbstractMeter
Meter.T
        Word8
1 -> [AbstractMeter] -> AbstractMeter
Meter.D ([AbstractMeter] -> AbstractMeter)
-> Get [AbstractMeter] -> Get AbstractMeter
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get [AbstractMeter]
forall a. Serialize a => Get a
get
        Word8
tag -> String -> Word8 -> Get AbstractMeter
forall a. String -> Word8 -> Get a
bad_tag String
"Meter.AbstractMeter" Word8
tag

-- The old version is unversioned
newtype OldMarklist = OldMarklist Mark.MarklistVector
    deriving (Get OldMarklist
Putter OldMarklist
Putter OldMarklist -> Get OldMarklist -> Serialize OldMarklist
forall a. Putter a -> Get a -> Serialize a
get :: Get OldMarklist
$cget :: Get OldMarklist
put :: Putter OldMarklist
$cput :: Putter OldMarklist
Serialize)

instance Serialize Mark.Marklist where
    put :: Putter Marklist
put Marklist
mlist = Word8 -> Put
put_version Word8
0 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter MarklistVector
forall a. Serialize a => Putter a
put (Marklist -> MarklistVector
Mark.marklist_vec Marklist
mlist)
    get :: Get Marklist
get = Get Word8
get_version Get Word8 -> (Word8 -> Get Marklist) -> Get Marklist
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Word8
0 -> do
            MarklistVector
vec :: Mark.MarklistVector <- Get MarklistVector
forall a. Serialize a => Get a
get
            Marklist -> Get Marklist
forall (m :: * -> *) a. Monad m => a -> m a
return (Marklist -> Get Marklist) -> Marklist -> Get Marklist
forall a b. (a -> b) -> a -> b
$ MarklistVector -> Marklist
Mark.marklist_from_vector MarklistVector
vec
        Word8
v -> String -> Word8 -> Get Marklist
forall a. Stack => String -> Word8 -> a
bad_version String
"Mark.Marklist" Word8
v

-- TODO I thought to make a new Mark with typed Mark.Rank, but it's
-- easier to just fromEnum it.
instance Serialize Mark.Mark where
    put :: Putter Mark
put (Mark.Mark Rank
a Int
b Color
c Text
d Y
e Y
f) =
        Putter Int
forall a. Serialize a => Putter a
put (Rank -> Int
forall a. Enum a => a -> Int
fromEnum Rank
a) Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter Int
forall a. Serialize a => Putter a
put Int
b Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter Color
forall a. Serialize a => Putter a
put Color
c Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter Text
forall a. Serialize a => Putter a
put Text
d Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter Y
forall a. Serialize a => Putter a
put Y
e Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter Y
forall a. Serialize a => Putter a
put Y
f
    get :: Get Mark
get = do
        Int
rank :: Int <- Get Int
forall a. Serialize a => Get a
get
        Int
width :: Int <- Get Int
forall a. Serialize a => Get a
get
        Color
color :: Color.Color <- Get Color
forall a. Serialize a => Get a
get
        Text
name :: Text <- Get Text
forall a. Serialize a => Get a
get
        Y
name_zoom :: Double <- Get Y
forall a. Serialize a => Get a
get
        Y
zoom :: Double <- Get Y
forall a. Serialize a => Get a
get
        Mark -> Get Mark
forall (m :: * -> *) a. Monad m => a -> m a
return (Mark -> Get Mark) -> Mark -> Get Mark
forall a b. (a -> b) -> a -> b
$ Rank -> Int -> Color -> Text -> Y -> Y -> Mark
Mark.Mark (Int -> Rank
forall a. Enum a => Int -> a
toEnum Int
rank) Int
width Color
color Text
name Y
name_zoom Y
zoom

-- ** Track

instance Serialize Track.Track where
    put :: Putter Track
put (Track.Track Text
a Events
b Color
c RenderConfig
d Bool
e) = Word8 -> Put
put_version Word8
5
        Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter Text
forall a. Serialize a => Putter a
put Text
a Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter Events
forall a. Serialize a => Putter a
put Events
b Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter Color
forall a. Serialize a => Putter a
put Color
c Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter RenderConfig
forall a. Serialize a => Putter a
put RenderConfig
d Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter Bool
forall a. Serialize a => Putter a
put Bool
e
    get :: Get Track
get = Get Word8
get_version Get Word8 -> (Word8 -> Get Track) -> Get Track
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Word8
4 -> do
            Text
title :: Text <- Get Text
forall a. Serialize a => Get a
get
            Events
events :: Events.Events <- Get Events
forall a. Serialize a => Get a
get
            Color
color :: Color.Color <- Get Color
forall a. Serialize a => Get a
get
            RenderConfig
render :: Track.RenderConfig <- Get RenderConfig
forall a. Serialize a => Get a
get
            Track -> Get Track
forall (m :: * -> *) a. Monad m => a -> m a
return (Track -> Get Track) -> Track -> Get Track
forall a b. (a -> b) -> a -> b
$ Text -> Events -> Color -> RenderConfig -> Bool -> Track
Track.Track Text
title Events
events Color
color RenderConfig
render Bool
True
        Word8
5 -> do
            Text
title :: Text <- Get Text
forall a. Serialize a => Get a
get
            Events
events :: Events.Events <- Get Events
forall a. Serialize a => Get a
get
            Color
color :: Color.Color <- Get Color
forall a. Serialize a => Get a
get
            RenderConfig
render :: Track.RenderConfig <- Get RenderConfig
forall a. Serialize a => Get a
get
            Bool
waveform :: Bool <- Get Bool
forall a. Serialize a => Get a
get
            Track -> Get Track
forall (m :: * -> *) a. Monad m => a -> m a
return (Track -> Get Track) -> Track -> Get Track
forall a b. (a -> b) -> a -> b
$ Text -> Events -> Color -> RenderConfig -> Bool -> Track
Track.Track Text
title Events
events Color
color RenderConfig
render Bool
waveform
        Word8
v -> String -> Word8 -> Get Track
forall a. Stack => String -> Word8 -> a
bad_version String
"Track.Track" Word8
v

instance Serialize Track.RenderConfig where
    put :: Putter RenderConfig
put (Track.RenderConfig RenderStyle
a Color
b) = Word8 -> Put
put_version Word8
1 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter RenderStyle
forall a. Serialize a => Putter a
put RenderStyle
a Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter Color
forall a. Serialize a => Putter a
put Color
b
    get :: Get RenderConfig
get = Get Word8
get_version Get Word8 -> (Word8 -> Get RenderConfig) -> Get RenderConfig
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Word8
1 -> do
            RenderStyle
style :: Track.RenderStyle <- Get RenderStyle
forall a. Serialize a => Get a
get
            Color
color :: Color.Color <- Get Color
forall a. Serialize a => Get a
get
            RenderConfig -> Get RenderConfig
forall (m :: * -> *) a. Monad m => a -> m a
return (RenderConfig -> Get RenderConfig)
-> RenderConfig -> Get RenderConfig
forall a b. (a -> b) -> a -> b
$ RenderStyle -> Color -> RenderConfig
Track.RenderConfig RenderStyle
style Color
color
        Word8
v -> String -> Word8 -> Get RenderConfig
forall a. Stack => String -> Word8 -> a
bad_version String
"Track.RenderConfig" Word8
v

instance Serialize Track.RenderStyle where
    put :: Putter RenderStyle
put RenderStyle
Track.NoRender = Word8 -> Put
put_tag Word8
0
    put (Track.Line Maybe RenderSource
a) = Word8 -> Put
put_tag Word8
1 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter (Maybe RenderSource)
forall a. Serialize a => Putter a
put Maybe RenderSource
a
    put (Track.Filled Maybe RenderSource
a) = Word8 -> Put
put_tag Word8
2 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter (Maybe RenderSource)
forall a. Serialize a => Putter a
put Maybe RenderSource
a
    get :: Get RenderStyle
get = Get Word8
get_tag Get Word8 -> (Word8 -> Get RenderStyle) -> Get RenderStyle
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Word8
0 -> RenderStyle -> Get RenderStyle
forall (m :: * -> *) a. Monad m => a -> m a
return RenderStyle
Track.NoRender
        Word8
1 -> do
            Maybe RenderSource
source :: Maybe Track.RenderSource <- Get (Maybe RenderSource)
forall a. Serialize a => Get a
get
            RenderStyle -> Get RenderStyle
forall (m :: * -> *) a. Monad m => a -> m a
return (RenderStyle -> Get RenderStyle) -> RenderStyle -> Get RenderStyle
forall a b. (a -> b) -> a -> b
$ Maybe RenderSource -> RenderStyle
Track.Line Maybe RenderSource
source
        Word8
2 -> do
            Maybe RenderSource
source :: Maybe Track.RenderSource <- Get (Maybe RenderSource)
forall a. Serialize a => Get a
get
            RenderStyle -> Get RenderStyle
forall (m :: * -> *) a. Monad m => a -> m a
return (RenderStyle -> Get RenderStyle) -> RenderStyle -> Get RenderStyle
forall a b. (a -> b) -> a -> b
$ Maybe RenderSource -> RenderStyle
Track.Filled Maybe RenderSource
source
        Word8
tag -> String -> Word8 -> Get RenderStyle
forall a. String -> Word8 -> Get a
bad_tag String
"Track.RenderStyle" Word8
tag

instance Serialize Track.RenderSource where
    put :: Putter RenderSource
put (Track.Control Control
a) = Word8 -> Put
put_tag Word8
0 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter Control
forall a. Serialize a => Putter a
put Control
a
    put (Track.Pitch PControl
a) = do
        Word8 -> Put
put_tag Word8
1
        -- It used to be @Maybe ScoreT.Control@ but changed to ScoreT.PControl.
        -- RenderSource isn't versioned so adjust here.
        let c :: Maybe PControl
c = if PControl
a PControl -> PControl -> Bool
forall a. Eq a => a -> a -> Bool
== PControl
ScoreT.default_pitch then Maybe PControl
forall a. Maybe a
Nothing else PControl -> Maybe PControl
forall a. a -> Maybe a
Just PControl
a
        Putter (Maybe PControl)
forall a. Serialize a => Putter a
put Maybe PControl
c
    get :: Get RenderSource
get = Get Word8
get_tag Get Word8 -> (Word8 -> Get RenderSource) -> Get RenderSource
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Word8
0 -> do
            Control
control :: ScoreT.Control <- Get Control
forall a. Serialize a => Get a
get
            RenderSource -> Get RenderSource
forall (m :: * -> *) a. Monad m => a -> m a
return (RenderSource -> Get RenderSource)
-> RenderSource -> Get RenderSource
forall a b. (a -> b) -> a -> b
$ Control -> RenderSource
Track.Control Control
control
        Word8
1 -> do
            Maybe PControl
control :: Maybe ScoreT.PControl <- Get (Maybe PControl)
forall a. Serialize a => Get a
get
            RenderSource -> Get RenderSource
forall (m :: * -> *) a. Monad m => a -> m a
return (RenderSource -> Get RenderSource)
-> RenderSource -> Get RenderSource
forall a b. (a -> b) -> a -> b
$ PControl -> RenderSource
Track.Pitch (PControl -> Maybe PControl -> PControl
forall a. a -> Maybe a -> a
fromMaybe PControl
ScoreT.default_pitch Maybe PControl
control)
        Word8
tag -> String -> Word8 -> Get RenderSource
forall a. String -> Word8 -> Get a
bad_tag String
"Track.RenderSource" Word8
tag

-- ** Perform.Midi.Patch

instance Serialize Patch.Config where
    put :: Putter Config
put (Patch.Config [(Addr, Maybe Int)]
a Maybe Initialization
b Settings
c) = Word8 -> Put
put_version Word8
11 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter [(Addr, Maybe Int)]
forall a. Serialize a => Putter a
put [(Addr, Maybe Int)]
a Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter (Maybe Initialization)
forall a. Serialize a => Putter a
put Maybe Initialization
b Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter Settings
forall a. Serialize a => Putter a
put Settings
c
    get :: Get Config
get = Get Word8
get_version Get Word8 -> (Word8 -> Get Config) -> Get Config
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Word8
7 -> do
            [(Addr, Maybe Int)]
alloc :: [(Patch.Addr, Maybe Patch.Voices)] <- Get [(Addr, Maybe Int)]
forall a. Serialize a => Get a
get
            Maybe Scale
scale :: Maybe Patch.Scale <- Get (Maybe Scale)
forall a. Serialize a => Get a
get
            ControlValMap
control_defaults :: ScoreT.ControlValMap <- Get ControlValMap
forall a. Serialize a => Get a
get
            let settings :: Settings
settings = Settings
old_settings
                    { config_scale :: Maybe Scale
Patch.config_scale = Maybe Scale
scale
                    , config_control_defaults :: Maybe ControlValMap
Patch.config_control_defaults = ControlValMap -> Maybe ControlValMap
forall {a}. (Eq a, Monoid a) => a -> Maybe a
nonempty ControlValMap
control_defaults
                    }
            Config -> Get Config
forall (m :: * -> *) a. Monad m => a -> m a
return (Config -> Get Config) -> Config -> Get Config
forall a b. (a -> b) -> a -> b
$ [(Addr, Maybe Int)] -> Maybe Initialization -> Settings -> Config
Patch.Config [(Addr, Maybe Int)]
alloc Maybe Initialization
forall a. Maybe a
Nothing Settings
settings
        Word8
8 -> do
            [(Addr, Maybe Int)]
alloc :: [(Patch.Addr, Maybe Patch.Voices)] <- Get [(Addr, Maybe Int)]
forall a. Serialize a => Get a
get
            Maybe Scale
scale :: Maybe Patch.Scale <- Get (Maybe Scale)
forall a. Serialize a => Get a
get
            ControlValMap
control_defaults :: ScoreT.ControlValMap <- Get ControlValMap
forall a. Serialize a => Get a
get
            Set Initialization
initialization :: Set Patch.Initialization <- Get (Set Initialization)
forall a. Serialize a => Get a
get
            let settings :: Settings
settings = Settings
old_settings
                    { config_scale :: Maybe Scale
Patch.config_scale = Maybe Scale
scale
                    , config_control_defaults :: Maybe ControlValMap
Patch.config_control_defaults = ControlValMap -> Maybe ControlValMap
forall {a}. (Eq a, Monoid a) => a -> Maybe a
nonempty ControlValMap
control_defaults
                    }
            Config -> Get Config
forall (m :: * -> *) a. Monad m => a -> m a
return (Config -> Get Config) -> Config -> Get Config
forall a b. (a -> b) -> a -> b
$ [(Addr, Maybe Int)] -> Maybe Initialization -> Settings -> Config
Patch.Config [(Addr, Maybe Int)]
alloc (Set Initialization -> Maybe Initialization
forall {a}. Set a -> Maybe a
upgrade_initialization Set Initialization
initialization)
                Settings
settings
        Word8
9 -> do
            [(Addr, Maybe Int)]
alloc :: [(Patch.Addr, Maybe Patch.Voices)] <- Get [(Addr, Maybe Int)]
forall a. Serialize a => Get a
get
            ControlValMap
control_defaults :: ScoreT.ControlValMap <- Get ControlValMap
forall a. Serialize a => Get a
get
            Set Initialization
initialization :: Set Patch.Initialization <- Get (Set Initialization)
forall a. Serialize a => Get a
get
            Settings
settings :: Patch.Settings <- Get Settings
forall a. Serialize a => Get a
get
            Config -> Get Config
forall (m :: * -> *) a. Monad m => a -> m a
return (Config -> Get Config) -> Config -> Get Config
forall a b. (a -> b) -> a -> b
$ [(Addr, Maybe Int)] -> Maybe Initialization -> Settings -> Config
Patch.Config [(Addr, Maybe Int)]
alloc
                (Set Initialization -> Maybe Initialization
forall {a}. Set a -> Maybe a
upgrade_initialization Set Initialization
initialization)
                (Settings
settings
                    { config_control_defaults :: Maybe ControlValMap
Patch.config_control_defaults = ControlValMap -> Maybe ControlValMap
forall {a}. (Eq a, Monoid a) => a -> Maybe a
nonempty ControlValMap
control_defaults
                    })
        Word8
10 -> do
            [(Addr, Maybe Int)]
alloc :: [(Patch.Addr, Maybe Patch.Voices)] <- Get [(Addr, Maybe Int)]
forall a. Serialize a => Get a
get
            Set Initialization
initialization :: Set Patch.Initialization <- Get (Set Initialization)
forall a. Serialize a => Get a
get
            Settings
settings :: Patch.Settings <- Get Settings
forall a. Serialize a => Get a
get
            Config -> Get Config
forall (m :: * -> *) a. Monad m => a -> m a
return (Config -> Get Config) -> Config -> Get Config
forall a b. (a -> b) -> a -> b
$ [(Addr, Maybe Int)] -> Maybe Initialization -> Settings -> Config
Patch.Config [(Addr, Maybe Int)]
alloc (Set Initialization -> Maybe Initialization
forall {a}. Set a -> Maybe a
upgrade_initialization Set Initialization
initialization)
                Settings
settings
        Word8
11 -> do
            [(Addr, Maybe Int)]
alloc :: [(Patch.Addr, Maybe Patch.Voices)] <- Get [(Addr, Maybe Int)]
forall a. Serialize a => Get a
get
            Maybe Initialization
initialization :: Maybe Patch.Initialization <- Get (Maybe Initialization)
forall a. Serialize a => Get a
get
            Settings
settings :: Patch.Settings <- Get Settings
forall a. Serialize a => Get a
get
            Config -> Get Config
forall (m :: * -> *) a. Monad m => a -> m a
return (Config -> Get Config) -> Config -> Get Config
forall a b. (a -> b) -> a -> b
$ [(Addr, Maybe Int)] -> Maybe Initialization -> Settings -> Config
Patch.Config [(Addr, Maybe Int)]
alloc Maybe Initialization
initialization Settings
settings
        Word8
v -> String -> Word8 -> Get Config
forall a. Stack => String -> Word8 -> a
bad_version String
"Patch.Config" Word8
v
        where
        nonempty :: a -> Maybe a
nonempty a
x = if a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
forall a. Monoid a => a
mempty then Maybe a
forall a. Maybe a
Nothing else a -> Maybe a
forall a. a -> Maybe a
Just a
x
        upgrade_initialization :: Set a -> Maybe a
upgrade_initialization = [a] -> Maybe a
forall a. [a] -> Maybe a
Seq.head ([a] -> Maybe a) -> (Set a -> [a]) -> Set a -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set a -> [a]
forall a. Set a -> [a]
Set.toList

-- | This tags Settings which will have to be upgraded by merging with patch
-- defaults.
old_settings :: Patch.Settings
old_settings :: Settings
old_settings = Settings
forall a. Monoid a => a
mempty

is_old_settings :: Patch.Settings -> Bool
is_old_settings :: Settings -> Bool
is_old_settings =
    (Maybe PbRange -> Maybe PbRange -> Bool
forall a. Eq a => a -> a -> Bool
== Settings -> Maybe PbRange
Patch.config_pitch_bend_range Settings
forall a. Monoid a => a
mempty) (Maybe PbRange -> Bool)
-> (Settings -> Maybe PbRange) -> Settings -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Settings -> Maybe PbRange
Patch.config_pitch_bend_range

instance Serialize Patch.Scale where
    put :: Putter Scale
put (Patch.Scale Text
a Vector Y
b) = Putter Text
forall a. Serialize a => Putter a
put Text
a Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter (Vector Y)
forall a. Serialize a => Putter a
put Vector Y
b
    get :: Get Scale
get = Text -> Vector Y -> Scale
Patch.Scale (Text -> Vector Y -> Scale) -> Get Text -> Get (Vector Y -> Scale)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Text
forall a. Serialize a => Get a
get Get (Vector Y -> Scale) -> Get (Vector Y) -> Get Scale
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get (Vector Y)
forall a. Serialize a => Get a
get

instance Serialize Patch.Initialization where
    put :: Putter Initialization
put Initialization
a = (Word8 -> Put
put_version Word8
1 >>) (Put -> Put) -> Put -> Put
forall a b. (a -> b) -> a -> b
$ Word8 -> Put
put_enum (Word8 -> Put) -> Word8 -> Put
forall a b. (a -> b) -> a -> b
$ case Initialization
a of
        Initialization
Patch.Tuning -> Word8
0
        Initialization
Patch.NrpnTuning -> Word8
1
    get :: Get Initialization
get = Get Word8
get_version Get Word8 -> (Word8 -> Get Initialization) -> Get Initialization
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Word8
0 -> Get Int
forall a. Serialize a => Get a
get Get Int -> (Int -> Get Initialization) -> Get Initialization
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Int
n -> case Int
n :: Int of
            Int
0 -> Initialization -> Get Initialization
forall (f :: * -> *) a. Applicative f => a -> f a
pure Initialization
Patch.Tuning
            Int
1 -> Initialization -> Get Initialization
forall (f :: * -> *) a. Applicative f => a -> f a
pure Initialization
Patch.NrpnTuning
            Int
n -> String -> Get Initialization
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get Initialization) -> String -> Get Initialization
forall a b. (a -> b) -> a -> b
$ String
"unknown enum val for Patch.Initialization " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
n
        Word8
1 -> Get Word8
get_enum Get Word8 -> (Word8 -> Get Initialization) -> Get Initialization
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Word8
0 -> Initialization -> Get Initialization
forall (f :: * -> *) a. Applicative f => a -> f a
pure Initialization
Patch.Tuning
            Word8
1 -> Initialization -> Get Initialization
forall (f :: * -> *) a. Applicative f => a -> f a
pure Initialization
Patch.NrpnTuning
            Word8
n -> String -> Word8 -> Get Initialization
forall a. String -> Word8 -> Get a
bad_enum String
"Patch.Initialization" Word8
n
        Word8
v -> String -> Word8 -> Get Initialization
forall a. Stack => String -> Word8 -> a
bad_version String
"Patch.Initialization" Word8
v

instance Serialize Patch.Settings where
    put :: Putter Settings
put (Patch.Settings Maybe (Set Flag)
a Maybe Scale
b Maybe RealTime
c Maybe PbRange
d Maybe ControlValMap
e) = Word8 -> Put
put_version Word8
2
        Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter (Maybe (Set Flag))
forall a. Serialize a => Putter a
put Maybe (Set Flag)
a Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter (Maybe Scale)
forall a. Serialize a => Putter a
put Maybe Scale
b Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter (Maybe RealTime)
forall a. Serialize a => Putter a
put Maybe RealTime
c Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter (Maybe PbRange)
forall a. Serialize a => Putter a
put Maybe PbRange
d Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter (Maybe ControlValMap)
forall a. Serialize a => Putter a
put Maybe ControlValMap
e
    get :: Get Settings
get = Get Word8
get_version Get Word8 -> (Word8 -> Get Settings) -> Get Settings
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Word8
0 -> do
            Set Flag
flags :: Set Patch.Flag <- Get (Set Flag)
forall a. Serialize a => Get a
get
            Maybe Scale
scale :: Maybe Patch.Scale <- Get (Maybe Scale)
forall a. Serialize a => Get a
get
            Maybe RealTime
decay :: Maybe RealTime <- Get (Maybe RealTime)
forall a. Serialize a => Get a
get
            PbRange
_pitch_bend_range :: Midi.Control.PbRange <- Get PbRange
forall a. Serialize a => Get a
get
            Settings -> Get Settings
forall (m :: * -> *) a. Monad m => a -> m a
return (Settings -> Get Settings) -> Settings -> Get Settings
forall a b. (a -> b) -> a -> b
$ Maybe (Set Flag)
-> Maybe Scale
-> Maybe RealTime
-> Maybe PbRange
-> Maybe ControlValMap
-> Settings
Patch.Settings
                (if Set Flag -> Bool
forall a. Set a -> Bool
Set.null Set Flag
flags then Maybe (Set Flag)
forall a. Maybe a
Nothing else Set Flag -> Maybe (Set Flag)
forall a. a -> Maybe a
Just Set Flag
flags)
                Maybe Scale
scale Maybe RealTime
decay Maybe PbRange
forall a. Maybe a
Nothing Maybe ControlValMap
forall a. Maybe a
Nothing
        Word8
1 -> do
            Maybe (Set Flag)
flags :: Maybe (Set Patch.Flag) <- Get (Maybe (Set Flag))
forall a. Serialize a => Get a
get
            Maybe Scale
scale :: Maybe Patch.Scale <- Get (Maybe Scale)
forall a. Serialize a => Get a
get
            Maybe RealTime
decay :: Maybe RealTime <- Get (Maybe RealTime)
forall a. Serialize a => Get a
get
            Maybe PbRange
pitch_bend_range :: Maybe Midi.Control.PbRange <- Get (Maybe PbRange)
forall a. Serialize a => Get a
get
            Settings -> Get Settings
forall (m :: * -> *) a. Monad m => a -> m a
return (Settings -> Get Settings) -> Settings -> Get Settings
forall a b. (a -> b) -> a -> b
$ Maybe (Set Flag)
-> Maybe Scale
-> Maybe RealTime
-> Maybe PbRange
-> Maybe ControlValMap
-> Settings
Patch.Settings Maybe (Set Flag)
flags Maybe Scale
scale Maybe RealTime
decay Maybe PbRange
pitch_bend_range Maybe ControlValMap
forall a. Maybe a
Nothing
        Word8
2 -> do
            Maybe (Set Flag)
flags :: Maybe (Set Patch.Flag) <- Get (Maybe (Set Flag))
forall a. Serialize a => Get a
get
            Maybe Scale
scale :: Maybe Patch.Scale <- Get (Maybe Scale)
forall a. Serialize a => Get a
get
            Maybe RealTime
decay :: Maybe RealTime <- Get (Maybe RealTime)
forall a. Serialize a => Get a
get
            Maybe PbRange
pitch_bend_range :: Maybe Midi.Control.PbRange <- Get (Maybe PbRange)
forall a. Serialize a => Get a
get
            Maybe ControlValMap
control_defaults :: Maybe ScoreT.ControlValMap <- Get (Maybe ControlValMap)
forall a. Serialize a => Get a
get
            Settings -> Get Settings
forall (m :: * -> *) a. Monad m => a -> m a
return (Settings -> Get Settings) -> Settings -> Get Settings
forall a b. (a -> b) -> a -> b
$ Maybe (Set Flag)
-> Maybe Scale
-> Maybe RealTime
-> Maybe PbRange
-> Maybe ControlValMap
-> Settings
Patch.Settings Maybe (Set Flag)
flags Maybe Scale
scale Maybe RealTime
decay Maybe PbRange
pitch_bend_range
                Maybe ControlValMap
control_defaults
        Word8
v -> String -> Word8 -> Get Settings
forall a. Stack => String -> Word8 -> a
bad_version String
"Patch.Settings" Word8
v

-- TODO this should have had a version.  Add one when I next do an incompatible
-- update, and remove Old_Triggered.
instance Serialize Patch.Flag where
    -- The tag is Int rather than Word8, because this originally used
    -- Serialize.put_enum_unsafe and get_enum_unsafe.  Those are dangerous for
    -- compatibility though, because when I deleted a Flag it silently broke
    -- saves.
    put :: Putter Flag
put = \case
        Flag
Patch.Old_Triggered -> Putter Int
tag Int
0
        Flag
Patch.Pressure -> Putter Int
tag Int
1
        Flag
Patch.HoldKeyswitch -> Putter Int
tag Int
2
        Flag
Patch.ResumePlay -> Putter Int
tag Int
3
        Flag
Patch.UseFinalNoteOff -> Putter Int
tag Int
4
        where
        tag :: Putter Int
tag Int
n = Putter Int
forall a. Serialize a => Putter a
put (Int
n :: Int)
    get :: Get Flag
get = Get Int
forall a. Serialize a => Get a
get Get Int -> (Int -> Get Flag) -> Get Flag
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(Int
tag :: Int) -> case Int
tag of
        Int
0 -> Flag -> Get Flag
forall (m :: * -> *) a. Monad m => a -> m a
return Flag
Patch.Old_Triggered
        Int
1 -> Flag -> Get Flag
forall (m :: * -> *) a. Monad m => a -> m a
return Flag
Patch.Pressure
        Int
2 -> Flag -> Get Flag
forall (m :: * -> *) a. Monad m => a -> m a
return Flag
Patch.HoldKeyswitch
        Int
3 -> Flag -> Get Flag
forall (m :: * -> *) a. Monad m => a -> m a
return Flag
Patch.ResumePlay
        Int
4 -> Flag -> Get Flag
forall (m :: * -> *) a. Monad m => a -> m a
return Flag
Patch.UseFinalNoteOff
        Int
5 -> Flag -> Get Flag
forall (m :: * -> *) a. Monad m => a -> m a
return Flag
Patch.Old_Triggered
        Int
_ -> String -> Word8 -> Get Flag
forall a. String -> Word8 -> Get a
bad_tag String
"Flag" (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
tag)

-- ** Instrument.Common

instance Serialize Common.Config where
    -- This went from version 1 to 0 because I reverted the Maybe Environ.
    put :: Putter Config
put (Common.Config Environ
a ControlValMap
b Bool
c Bool
d) = Word8 -> Put
put_version Word8
0
        Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter Environ
forall a. Serialize a => Putter a
put Environ
a Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter ControlValMap
forall a. Serialize a => Putter a
put ControlValMap
b Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter Bool
forall a. Serialize a => Putter a
put Bool
c Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter Bool
forall a. Serialize a => Putter a
put Bool
d
    get :: Get Config
get = Get Word8
get_version Get Word8 -> (Word8 -> Get Config) -> Get Config
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Word8
0 -> do
            Environ
environ :: REnv.Environ <- Get Environ
forall a. Serialize a => Get a
get
            ControlValMap
controls :: ScoreT.ControlValMap <- Get ControlValMap
forall a. Serialize a => Get a
get
            Bool
mute :: Bool <- Get Bool
forall a. Serialize a => Get a
get
            Bool
solo :: Bool <- Get Bool
forall a. Serialize a => Get a
get
            Config -> Get Config
forall (m :: * -> *) a. Monad m => a -> m a
return (Config -> Get Config) -> Config -> Get Config
forall a b. (a -> b) -> a -> b
$ Environ -> ControlValMap -> Bool -> Bool -> Config
Common.Config Environ
environ ControlValMap
controls Bool
mute Bool
solo
        Word8
1 -> do
            Maybe Environ
environ :: Maybe REnv.Environ <- Get (Maybe Environ)
forall a. Serialize a => Get a
get
            ControlValMap
controls :: ScoreT.ControlValMap <- Get ControlValMap
forall a. Serialize a => Get a
get
            Bool
mute :: Bool <- Get Bool
forall a. Serialize a => Get a
get
            Bool
solo :: Bool <- Get Bool
forall a. Serialize a => Get a
get
            Config -> Get Config
forall (m :: * -> *) a. Monad m => a -> m a
return (Config -> Get Config) -> Config -> Get Config
forall a b. (a -> b) -> a -> b
$ Environ -> ControlValMap -> Bool -> Bool -> Config
Common.Config (Environ -> Maybe Environ -> Environ
forall a. a -> Maybe a -> a
fromMaybe Environ
forall a. Monoid a => a
mempty Maybe Environ
environ) ControlValMap
controls Bool
mute Bool
solo
        Word8
v -> String -> Word8 -> Get Config
forall a. Stack => String -> Word8 -> a
bad_version String
"Common.Config" Word8
v

instance Serialize Common.Flag where
    put :: Putter Flag
put Flag
a = (Word8 -> Put
put_version Word8
1 >>) (Put -> Put) -> Put -> Put
forall a b. (a -> b) -> a -> b
$ Word8 -> Put
put_enum (Word8 -> Put) -> Word8 -> Put
forall a b. (a -> b) -> a -> b
$ case Flag
a of
        Flag
Common.Triggered -> Word8
0
    get :: Get Flag
get = Get Word8
get_version Get Word8 -> (Word8 -> Get Flag) -> Get Flag
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Word8
0 -> Get Int
forall a. Serialize a => Get a
get Get Int -> (Int -> Get Flag) -> Get Flag
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(Int
t :: Int) -> case Int
t of
            Int
0 -> Flag -> Get Flag
forall (m :: * -> *) a. Monad m => a -> m a
return Flag
Common.Triggered
            Int
_ -> String -> Word8 -> Get Flag
forall a. String -> Word8 -> Get a
bad_tag String
name (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
t)
        Word8
1 -> Get Word8
get_enum Get Word8 -> (Word8 -> Get Flag) -> Get Flag
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Word8
0 -> Flag -> Get Flag
forall (f :: * -> *) a. Applicative f => a -> f a
pure Flag
Common.Triggered
            Word8
n -> String -> Word8 -> Get Flag
forall a. String -> Word8 -> Get a
bad_enum String
name Word8
n
        Word8
v -> String -> Word8 -> Get Flag
forall a. Stack => String -> Word8 -> a
bad_version String
name Word8
v
        where name :: String
name = String
"Common.Flag"

-- ** lilypond

instance Serialize Lilypond.Config where
    put :: Putter Config
put (Lilypond.Config RealTime
a Duration
b Bool
c [(Instrument, StaffConfig)]
d) = Word8 -> Put
put_version Word8
3
        Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter RealTime
forall a. Serialize a => Putter a
put RealTime
a Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter Duration
forall a. Serialize a => Putter a
put Duration
b Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter Bool
forall a. Serialize a => Putter a
put Bool
c Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter [(Instrument, StaffConfig)]
forall a. Serialize a => Putter a
put [(Instrument, StaffConfig)]
d
    get :: Get Config
get = do
        Word8
v <- Get Word8
get_version
        case Word8
v of
            Word8
3 -> do
                RealTime
quarter :: RealTime <- Get RealTime
forall a. Serialize a => Get a
get
                Duration
quantize :: Lilypond.Duration <- Get Duration
forall a. Serialize a => Get a
get
                Bool
dotted_rests :: Bool <- Get Bool
forall a. Serialize a => Get a
get
                [(Instrument, StaffConfig)]
staves :: [(ScoreT.Instrument, Lilypond.StaffConfig)] <- Get [(Instrument, StaffConfig)]
forall a. Serialize a => Get a
get
                Config -> Get Config
forall (m :: * -> *) a. Monad m => a -> m a
return (Config -> Get Config) -> Config -> Get Config
forall a b. (a -> b) -> a -> b
$ RealTime
-> Duration -> Bool -> [(Instrument, StaffConfig)] -> Config
Lilypond.Config RealTime
quarter Duration
quantize Bool
dotted_rests [(Instrument, StaffConfig)]
staves
            Word8
_ -> String -> Word8 -> Get Config
forall a. Stack => String -> Word8 -> a
bad_version String
"Lilypond.Config" Word8
v

instance Serialize Lilypond.StaffConfig where
    put :: Putter StaffConfig
put (Lilypond.StaffConfig Text
a Text
b [Text]
c Bool
d Bool
e) = Word8 -> Put
put_version Word8
2
        Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter Text
forall a. Serialize a => Putter a
put Text
a Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter Text
forall a. Serialize a => Putter a
put Text
b Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter [Text]
forall a. Serialize a => Putter a
put [Text]
c Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter Bool
forall a. Serialize a => Putter a
put Bool
d Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter Bool
forall a. Serialize a => Putter a
put Bool
e
    get :: Get StaffConfig
get = Get Word8
get_version Get Word8 -> (Word8 -> Get StaffConfig) -> Get StaffConfig
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Word8
2 -> do
            Text
long :: Lilypond.Instrument <- Get Text
forall a. Serialize a => Get a
get
            Text
short :: Lilypond.Instrument <- Get Text
forall a. Serialize a => Get a
get
            [Text]
code :: [Text] <- Get [Text]
forall a. Serialize a => Get a
get
            Bool
display :: Bool <- Get Bool
forall a. Serialize a => Get a
get
            Bool
add_bass :: Bool <- Get Bool
forall a. Serialize a => Get a
get
            StaffConfig -> Get StaffConfig
forall (m :: * -> *) a. Monad m => a -> m a
return (StaffConfig -> Get StaffConfig) -> StaffConfig -> Get StaffConfig
forall a b. (a -> b) -> a -> b
$ Text -> Text -> [Text] -> Bool -> Bool -> StaffConfig
Lilypond.StaffConfig Text
long Text
short [Text]
code Bool
display Bool
add_bass
        Word8
v -> String -> Word8 -> Get StaffConfig
forall a. Stack => String -> Word8 -> a
bad_version String
"Lilypond.StaffConfig" Word8
v

instance Serialize Lilypond.Duration where
    put :: Putter Duration
put = Putter Duration
forall a. Enum a => a -> Put
Serialize.put_enum_unsafe
    get :: Get Duration
get = Get Duration
forall a. (Bounded a, Enum a) => Get a
Serialize.get_enum_unsafe