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

{-# LANGUAGE StrictData #-}
{-# LANGUAGE NamedFieldPuns #-}
{- | Updates are diffs against Ui.State and are used in a number of contexts.
    They are produced by "Ui.Diff".  The different uses all require slightly
    different data, and I capture the major differences in separate types.
-}
module Ui.Update where
import qualified Control.DeepSeq as DeepSeq
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified GHC.Generics as Generics

import qualified Util.Maps as Maps
import qualified Util.Pretty as Pretty
import qualified Util.Ranges as Ranges
import qualified Util.Rect as Rect
import qualified Util.Lists as Lists

import qualified Ui.Block as Block
import qualified Ui.Color as Color
import qualified Ui.Id as Id
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.UiConfig as UiConfig
import qualified Ui.Zoom as Zoom

import           Global
import           Types


-- | 'DisplayUpdate's are sent to the UI to update the windows.  Since the UI
-- only has Views, and has a lower level version of tracks, this includes
-- only updates that directly affect display.
type DisplayUpdate = Update Block.DisplayTrack ()

-- | 'UiUpdate's reflect all changes to the underlying UI state.  They're
-- used for incremental save, and by the deriver to determine ScoreDamage.
type UiUpdate = Update Block.Track State

-- | This collects damaged Ui.State elements, manually added by the various
-- Ui functions.  I use "Ui.Diff" to get the exact changes, but it's too
-- slow to compare the entire Ui.State, so UiDamage is used to restrict the
-- diff to just parts that may have changed.
--
-- There are also a few mutations that correspond directly 'UiUpdate's which
-- I just emit directly rather than relying on diff.  Those are converted from
-- UiDamage by 'to_ui'.
--
-- TODO The indirection for BringToFront, TitleFocus, seems a bit fussy.  Can I
-- just store some Updates in here?
data UiDamage = UiDamage {
    UiDamage -> Set ViewId
_views :: Set ViewId
    -- | This means there may have been any change at all inside these blocks,
    -- and Diff should check for them.  It doesn't mean it's an interesting
    -- change, that's up to Diff to decide!
    , UiDamage -> Set BlockId
_blocks :: Set BlockId
    -- | This specifically means there was change on the given tracks.
    , UiDamage -> Map TrackId (Ranges TrackTime)
_tracks :: Map TrackId (Ranges.Ranges TrackTime)
    , UiDamage -> Set RulerId
_rulers :: Set RulerId
    , UiDamage -> Set ViewId
_bring_to_front :: Set ViewId
    -- | If the TrackNum is set, set keyboard focus on that track's title.
    -- Otherwise, focus on the block title.
    , UiDamage -> Maybe (ViewId, Maybe Int)
_title_focus :: Maybe (ViewId, Maybe TrackNum)
    -- | This is purely to trigger 'is_score_damage'.
    -- TODO: Ui.state_config changes should do this so Diff.score_changed
    -- dosen't need to compare UiConfig.Config each time, but modification
    -- happens through lenses...
    , UiDamage -> Bool
_score_damage :: Bool
    } deriving (UiDamage -> UiDamage -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UiDamage -> UiDamage -> Bool
$c/= :: UiDamage -> UiDamage -> Bool
== :: UiDamage -> UiDamage -> Bool
$c== :: UiDamage -> UiDamage -> Bool
Eq, Int -> UiDamage -> ShowS
[UiDamage] -> ShowS
UiDamage -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UiDamage] -> ShowS
$cshowList :: [UiDamage] -> ShowS
show :: UiDamage -> String
$cshow :: UiDamage -> String
showsPrec :: Int -> UiDamage -> ShowS
$cshowsPrec :: Int -> UiDamage -> ShowS
Show, forall x. Rep UiDamage x -> UiDamage
forall x. UiDamage -> Rep UiDamage x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UiDamage x -> UiDamage
$cfrom :: forall x. UiDamage -> Rep UiDamage x
Generics.Generic)

instance Semigroup UiDamage where
    <> :: UiDamage -> UiDamage -> UiDamage
(<>)    (UiDamage Set ViewId
v1 Set BlockId
b1 Map TrackId (Ranges TrackTime)
t1 Set RulerId
r1 Set ViewId
bring1 Maybe (ViewId, Maybe Int)
title1 Bool
sd1)
            (UiDamage Set ViewId
v2 Set BlockId
b2 Map TrackId (Ranges TrackTime)
t2 Set RulerId
r2 Set ViewId
bring2 Maybe (ViewId, Maybe Int)
title2 Bool
sd2) =
        Set ViewId
-> Set BlockId
-> Map TrackId (Ranges TrackTime)
-> Set RulerId
-> Set ViewId
-> Maybe (ViewId, Maybe Int)
-> Bool
-> UiDamage
UiDamage (Set ViewId
v1forall a. Semigroup a => a -> a -> a
<>Set ViewId
v2) (Set BlockId
b1forall a. Semigroup a => a -> a -> a
<>Set BlockId
b2) (forall k a. (Ord k, Monoid a) => Map k a -> Map k a -> Map k a
Maps.mappend Map TrackId (Ranges TrackTime)
t1 Map TrackId (Ranges TrackTime)
t2) (Set RulerId
r1forall a. Semigroup a => a -> a -> a
<>Set RulerId
r2)
            (Set ViewId
bring1forall a. Semigroup a => a -> a -> a
<>Set ViewId
bring2) (Maybe (ViewId, Maybe Int)
title1forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>Maybe (ViewId, Maybe Int)
title2) (Bool
sd1Bool -> Bool -> Bool
||Bool
sd2)

instance Monoid UiDamage where
    mempty :: UiDamage
mempty = Set ViewId
-> Set BlockId
-> Map TrackId (Ranges TrackTime)
-> Set RulerId
-> Set ViewId
-> Maybe (ViewId, Maybe Int)
-> Bool
-> UiDamage
UiDamage forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty forall a. Maybe a
Nothing Bool
False
    mappend :: UiDamage -> UiDamage -> UiDamage
mappend = forall a. Semigroup a => a -> a -> a
(<>)

instance Pretty UiDamage where format :: UiDamage -> Doc
format = forall a. (PrettyG (Rep a), Generic a) => a -> Doc
Pretty.formatG_

view_damage :: ViewId -> UiDamage
view_damage :: ViewId -> UiDamage
view_damage ViewId
id = forall a. Monoid a => a
mempty { _views :: Set ViewId
_views = forall a. a -> Set a
Set.singleton ViewId
id }

block_damage :: BlockId -> UiDamage
block_damage :: BlockId -> UiDamage
block_damage BlockId
id = forall a. Monoid a => a
mempty { _blocks :: Set BlockId
_blocks = forall a. a -> Set a
Set.singleton BlockId
id }

track_damage :: TrackId -> Ranges.Ranges TrackTime -> UiDamage
track_damage :: TrackId -> Ranges TrackTime -> UiDamage
track_damage TrackId
id Ranges TrackTime
range = forall a. Monoid a => a
mempty { _tracks :: Map TrackId (Ranges TrackTime)
_tracks = forall k a. k -> a -> Map k a
Map.singleton TrackId
id Ranges TrackTime
range }

ruler_damage :: RulerId -> UiDamage
ruler_damage :: RulerId -> UiDamage
ruler_damage RulerId
id = forall a. Monoid a => a
mempty { _rulers :: Set RulerId
_rulers = forall a. a -> Set a
Set.singleton RulerId
id }

data Update t u =
    View ViewId View
    | Block BlockId (Block t)
    | Track TrackId Track
    -- | Since I expect rulers to be changed infrequently, the only kind of
    -- ruler update is a full update.
    | Ruler RulerId
    | State u
    deriving (Update t u -> Update t u -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall t u. (Eq t, Eq u) => Update t u -> Update t u -> Bool
/= :: Update t u -> Update t u -> Bool
$c/= :: forall t u. (Eq t, Eq u) => Update t u -> Update t u -> Bool
== :: Update t u -> Update t u -> Bool
$c== :: forall t u. (Eq t, Eq u) => Update t u -> Update t u -> Bool
Eq, Int -> Update t u -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall t u. (Show t, Show u) => Int -> Update t u -> ShowS
forall t u. (Show t, Show u) => [Update t u] -> ShowS
forall t u. (Show t, Show u) => Update t u -> String
showList :: [Update t u] -> ShowS
$cshowList :: forall t u. (Show t, Show u) => [Update t u] -> ShowS
show :: Update t u -> String
$cshow :: forall t u. (Show t, Show u) => Update t u -> String
showsPrec :: Int -> Update t u -> ShowS
$cshowsPrec :: forall t u. (Show t, Show u) => Int -> Update t u -> ShowS
Show)

data View =
    CreateView
    | DestroyView
    | ViewSize Rect.Rect
    | Status (Map (Int, Text) Text) Color.Color -- ^ background color
    | TrackScroll Types.Width
    | Zoom Zoom.Zoom
    | Selection Sel.Num (Maybe Sel.Selection)
    -- | Bring the window to the front.  Unlike most other updates, this is
    -- recorded directly and is not reflected in Ui.State.
    | BringToFront
    -- | Similar to BringToFront, but sets keyboard focus in a track title.
    -- If the TrackNum is not given, focus on the block title.
    | TitleFocus (Maybe TrackNum)
    deriving (View -> View -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: View -> View -> Bool
$c/= :: View -> View -> Bool
== :: View -> View -> Bool
$c== :: View -> View -> Bool
Eq, Int -> View -> ShowS
[View] -> ShowS
View -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [View] -> ShowS
$cshowList :: [View] -> ShowS
show :: View -> String
$cshow :: View -> String
showsPrec :: Int -> View -> ShowS
$cshowsPrec :: Int -> View -> ShowS
Show)

data Block t =
    BlockTitle Text
    | BlockConfig Block.Config
    -- | The second is the \"integrate skeleton\", which is drawn in the same
    -- place.  It could be Skeleton too, but since it never was a skeleton it
    -- seems pointless to convert it to one just so it can be flattened again.
    -- Arguably it's the first arg which should be edges, but at least this way
    -- the two args can't be mixed up.
    | BlockSkeleton Skeleton.Skeleton [(Color.Color, [(TrackNum, TrackNum)])]
    | RemoveTrack TrackNum
    | InsertTrack TrackNum t
    -- | Unlike 'Track', these settings are local to the block, not global to
    -- this track in all its blocks.
    | BlockTrack TrackNum t
    deriving (Block t -> Block t -> Bool
forall t. Eq t => Block t -> Block t -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Block t -> Block t -> Bool
$c/= :: forall t. Eq t => Block t -> Block t -> Bool
== :: Block t -> Block t -> Bool
$c== :: forall t. Eq t => Block t -> Block t -> Bool
Eq, Int -> Block t -> ShowS
forall t. Show t => Int -> Block t -> ShowS
forall t. Show t => [Block t] -> ShowS
forall t. Show t => Block t -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Block t] -> ShowS
$cshowList :: forall t. Show t => [Block t] -> ShowS
show :: Block t -> String
$cshow :: forall t. Show t => Block t -> String
showsPrec :: Int -> Block t -> ShowS
$cshowsPrec :: forall t. Show t => Int -> Block t -> ShowS
Show)

data Track =
    -- | Low pos, high pos.
    TrackEvents ScoreTime ScoreTime
    -- | Update the entire track.
    | TrackAllEvents
    | TrackTitle Text
    | TrackBg Color.Color
    | TrackRender Track.RenderConfig
    deriving (Track -> Track -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Track -> Track -> Bool
$c/= :: Track -> Track -> Bool
== :: Track -> Track -> Bool
$c== :: Track -> Track -> Bool
Eq, Int -> Track -> ShowS
[Track] -> ShowS
Track -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Track] -> ShowS
$cshowList :: [Track] -> ShowS
show :: Track -> String
$cshow :: Track -> String
showsPrec :: Int -> Track -> ShowS
$cshowsPrec :: Int -> Track -> ShowS
Show)

-- | These are updates to 'Ui.Ui.State' that have no UI presence.
data State =
    Config UiConfig.Config
    | CreateBlock BlockId Block.Block
    | DestroyBlock BlockId
    | CreateTrack TrackId Track.Track
    | DestroyTrack TrackId
    | CreateRuler RulerId Ruler.Ruler
    | DestroyRuler RulerId
    deriving (State -> State -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: State -> State -> Bool
$c/= :: State -> State -> Bool
== :: State -> State -> Bool
$c== :: State -> State -> Bool
Eq, Int -> State -> ShowS
[State] -> ShowS
State -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [State] -> ShowS
$cshowList :: [State] -> ShowS
show :: State -> String
$cshow :: State -> String
showsPrec :: Int -> State -> ShowS
$cshowsPrec :: Int -> State -> ShowS
Show)

instance DeepSeq.NFData (Update t u) where
    rnf :: Update t u -> ()
rnf Update t u
update = case Update t u
update of
        View ViewId
view_id View
update -> ViewId
view_id seq :: forall a b. a -> b -> b
`seq` View
update seq :: forall a b. a -> b -> b
`seq` ()
        Block BlockId
block_id Block t
update -> BlockId
block_id seq :: forall a b. a -> b -> b
`seq` Block t
update seq :: forall a b. a -> b -> b
`seq` ()
        Track TrackId
track_id Track
update -> TrackId
track_id seq :: forall a b. a -> b -> b
`seq` Track
update seq :: forall a b. a -> b -> b
`seq` ()
        Ruler RulerId
ruler_id -> RulerId
ruler_id seq :: forall a b. a -> b -> b
`seq` ()
        State u
u -> u
u seq :: forall a b. a -> b -> b
`seq` ()

instance (Pretty t, Pretty u) => Pretty (Update t u) where
    format :: Update t u -> Doc
format = \case
        View ViewId
view_id View
update -> Text -> [Doc] -> Doc
Pretty.constructor Text
"View"
            [forall a. Pretty a => a -> Doc
Pretty.format ViewId
view_id, forall a. Pretty a => a -> Doc
Pretty.format View
update]
        Block BlockId
block_id Block t
update -> Text -> [Doc] -> Doc
Pretty.constructor Text
"Block"
            [forall a. Pretty a => a -> Doc
Pretty.format BlockId
block_id, forall a. Pretty a => a -> Doc
Pretty.format Block t
update]
        Track TrackId
track_id Track
update -> Text -> [Doc] -> Doc
Pretty.constructor Text
"Track"
            [forall a. Pretty a => a -> Doc
Pretty.format TrackId
track_id, forall a. Pretty a => a -> Doc
Pretty.format Track
update]
        Ruler RulerId
ruler_id -> Text -> [Doc] -> Doc
Pretty.constructor Text
"Ruler" [forall a. Pretty a => a -> Doc
Pretty.format RulerId
ruler_id]
        State u
update -> Text -> [Doc] -> Doc
Pretty.constructor Text
"State" [forall a. Pretty a => a -> Doc
Pretty.format u
update]

instance Pretty View where
    format :: View -> Doc
format View
update = case View
update of
        View
CreateView -> Doc
"CreateView"
        View
DestroyView -> Doc
"DestroyView"
        ViewSize Rect
rect -> Text -> [Doc] -> Doc
Pretty.constructor Text
"ViewSize" [forall a. Pretty a => a -> Doc
Pretty.format Rect
rect]
        Status Map (Int, Text) Text
status Color
is_root -> Text -> [Doc] -> Doc
Pretty.constructor Text
"Status"
            [forall a. Pretty a => a -> Doc
Pretty.format Map (Int, Text) Text
status, forall a. Pretty a => a -> Doc
Pretty.format Color
is_root]
        TrackScroll Int
width ->
            Text -> [Doc] -> Doc
Pretty.constructor Text
"TrackScroll" [forall a. Pretty a => a -> Doc
Pretty.format Int
width]
        Zoom Zoom
zoom -> Text -> [Doc] -> Doc
Pretty.constructor Text
"Zoom" [forall a. Pretty a => a -> Doc
Pretty.format Zoom
zoom]
        Selection Int
selnum Maybe Selection
sel -> Text -> [Doc] -> Doc
Pretty.constructor Text
"Selection"
            [forall a. Pretty a => a -> Doc
Pretty.format Int
selnum, forall a. Pretty a => a -> Doc
Pretty.format Maybe Selection
sel]
        View
BringToFront -> Doc
"BringToFront"
        TitleFocus Maybe Int
tracknum ->
            Text -> [Doc] -> Doc
Pretty.constructor Text
"TitleFocus" [forall a. Pretty a => a -> Doc
Pretty.format Maybe Int
tracknum]

instance Pretty t => Pretty (Block t) where
    format :: Block t -> Doc
format Block t
update = case Block t
update of
        BlockTitle Text
s -> Text -> [Doc] -> Doc
Pretty.constructor Text
"BlockTitle"
            [forall a. Pretty a => a -> Doc
Pretty.format Text
s]
        BlockConfig Config
config -> Text -> [Doc] -> Doc
Pretty.constructor Text
"BlockConfig"
            [forall a. Pretty a => a -> Doc
Pretty.format Config
config]
        BlockSkeleton Skeleton
skel [(Color, [(Int, Int)])]
int_skel -> Text -> [Doc] -> Doc
Pretty.constructor Text
"BlockSkeleton"
            [forall a. Pretty a => a -> Doc
Pretty.format Skeleton
skel, forall a. Pretty a => a -> Doc
Pretty.format [(Color, [(Int, Int)])]
int_skel]
        RemoveTrack Int
n -> Text -> [Doc] -> Doc
Pretty.constructor Text
"RemoveTrack"
            [forall a. Pretty a => a -> Doc
Pretty.format Int
n]
        InsertTrack Int
n t
t -> Text -> [Doc] -> Doc
Pretty.constructor Text
"InsertTrack"
            [forall a. Pretty a => a -> Doc
Pretty.format Int
n, forall a. Pretty a => a -> Doc
Pretty.format t
t]
        BlockTrack Int
n t
t -> Text -> [Doc] -> Doc
Pretty.constructor Text
"BlockTrack"
            [forall a. Pretty a => a -> Doc
Pretty.format Int
n, forall a. Pretty a => a -> Doc
Pretty.format t
t]

instance Pretty Track where
    format :: Track -> Doc
format Track
update = case Track
update of
        TrackEvents TrackTime
s TrackTime
e -> Text -> [Doc] -> Doc
Pretty.constructor Text
"TrackEvents"
            [forall a. Pretty a => a -> Doc
Pretty.format TrackTime
s, forall a. Pretty a => a -> Doc
Pretty.format TrackTime
e]
        Track
TrackAllEvents -> Text -> Doc
Pretty.text Text
"TrackAllEvents"
        TrackTitle Text
s -> Text -> [Doc] -> Doc
Pretty.constructor Text
"TrackTitle" [forall a. Pretty a => a -> Doc
Pretty.format Text
s]
        TrackBg Color
c -> Text -> [Doc] -> Doc
Pretty.constructor Text
"TrackTitle" [forall a. Pretty a => a -> Doc
Pretty.format Color
c]
        TrackRender RenderConfig
config -> Text -> [Doc] -> Doc
Pretty.constructor Text
"TrackTitle"
            [forall a. Pretty a => a -> Doc
Pretty.format RenderConfig
config]

instance Pretty State where
    format :: State -> Doc
format State
update = case State
update of
        Config Config
config -> Text -> [Doc] -> Doc
Pretty.constructor Text
"Config" [forall a. Pretty a => a -> Doc
Pretty.format Config
config]
        CreateBlock BlockId
block_id Block
_ -> Text -> [Doc] -> Doc
Pretty.constructor Text
"CreateBlock"
            [forall a. Pretty a => a -> Doc
Pretty.format BlockId
block_id]
        DestroyBlock BlockId
block_id -> Text -> [Doc] -> Doc
Pretty.constructor Text
"DestroyBlock"
            [forall a. Pretty a => a -> Doc
Pretty.format BlockId
block_id]
        CreateTrack TrackId
track_id Track
_ -> Text -> [Doc] -> Doc
Pretty.constructor Text
"CreateTrack"
            [forall a. Pretty a => a -> Doc
Pretty.format TrackId
track_id]
        DestroyTrack TrackId
track_id -> Text -> [Doc] -> Doc
Pretty.constructor Text
"DestroyTrack"
            [forall a. Pretty a => a -> Doc
Pretty.format TrackId
track_id]
        CreateRuler RulerId
ruler_id Ruler
_ -> Text -> [Doc] -> Doc
Pretty.constructor Text
"CreateRuler"
            [forall a. Pretty a => a -> Doc
Pretty.format RulerId
ruler_id]
        DestroyRuler RulerId
ruler_id -> Text -> [Doc] -> Doc
Pretty.constructor Text
"DestroyRuler"
            [forall a. Pretty a => a -> Doc
Pretty.format RulerId
ruler_id]

update_id :: Update t State -> Maybe Id.Id
update_id :: forall t. Update t State -> Maybe Id
update_id = \case
    View ViewId
view_id View
_ -> forall a. Ident a => a -> Maybe Id
ident ViewId
view_id
    Block BlockId
block_id Block t
_ -> forall a. Ident a => a -> Maybe Id
ident BlockId
block_id
    Track TrackId
track_id Track
_ -> forall a. Ident a => a -> Maybe Id
ident TrackId
track_id
    Ruler RulerId
ruler_id -> forall a. Ident a => a -> Maybe Id
ident RulerId
ruler_id
    State State
st -> case State
st of
        Config {} -> forall a. Maybe a
Nothing
        CreateBlock BlockId
block_id Block
_ -> forall a. Ident a => a -> Maybe Id
ident BlockId
block_id
        DestroyBlock BlockId
block_id -> forall a. Ident a => a -> Maybe Id
ident BlockId
block_id
        CreateTrack TrackId
track_id Track
_ -> forall a. Ident a => a -> Maybe Id
ident TrackId
track_id
        DestroyTrack TrackId
track_id -> forall a. Ident a => a -> Maybe Id
ident TrackId
track_id
        CreateRuler RulerId
ruler_id Ruler
_ -> forall a. Ident a => a -> Maybe Id
ident RulerId
ruler_id
        DestroyRuler RulerId
ruler_id -> forall a. Ident a => a -> Maybe Id
ident RulerId
ruler_id
    where
    ident :: Id.Ident a => a -> Maybe Id.Id
    ident :: forall a. Ident a => a -> Maybe Id
ident = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ident a => a -> Id
Id.unpack_id

-- | Convert a UiUpdate to a DisplayUpdate by stripping out all the UiUpdate
-- parts.
to_display :: UiUpdate -> Maybe DisplayUpdate
to_display :: UiUpdate -> Maybe DisplayUpdate
to_display = \case
    View ViewId
vid View
update -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall t u. ViewId -> View -> Update t u
View ViewId
vid View
update
    Block BlockId
bid Block Track
update -> forall t u. BlockId -> Block t -> Update t u
Block BlockId
bid forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case Block Track
update of
        BlockTitle Text
a -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall t. Text -> Block t
BlockTitle Text
a
        BlockConfig Config
a -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall t. Config -> Block t
BlockConfig Config
a
        BlockSkeleton Skeleton
a [(Color, [(Int, Int)])]
b -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall t. Skeleton -> [(Color, [(Int, Int)])] -> Block t
BlockSkeleton Skeleton
a [(Color, [(Int, Int)])]
b
        RemoveTrack {} -> forall a. Maybe a
Nothing
        InsertTrack {} -> forall a. Maybe a
Nothing
        BlockTrack {} -> forall a. Maybe a
Nothing
    Track TrackId
tid Track
update -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall t u. TrackId -> Track -> Update t u
Track TrackId
tid Track
update
    Ruler RulerId
rid -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall t u. RulerId -> Update t u
Ruler RulerId
rid
    State {} -> forall a. Maybe a
Nothing

to_ui :: UiDamage -> [UiUpdate]
to_ui :: UiDamage -> [UiUpdate]
to_ui (UiDamage { Map TrackId (Ranges TrackTime)
_tracks :: Map TrackId (Ranges TrackTime)
_tracks :: UiDamage -> Map TrackId (Ranges TrackTime)
_tracks, Set RulerId
_rulers :: Set RulerId
_rulers :: UiDamage -> Set RulerId
_rulers, Set ViewId
_bring_to_front :: Set ViewId
_bring_to_front :: UiDamage -> Set ViewId
_bring_to_front, Maybe (ViewId, Maybe Int)
_title_focus :: Maybe (ViewId, Maybe Int)
_title_focus :: UiDamage -> Maybe (ViewId, Maybe Int)
_title_focus }) = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ [ forall t u. TrackId -> Track -> Update t u
Track TrackId
tid forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe Track
TrackAllEvents (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry TrackTime -> TrackTime -> Track
TrackEvents) Maybe (TrackTime, TrackTime)
mb_range
      | (TrackId
tid, Ranges TrackTime
range) <- forall k a. Map k a -> [(k, a)]
Map.toList Map TrackId (Ranges TrackTime)
_tracks
      , Just Maybe (TrackTime, TrackTime)
mb_range <- [forall n. Ranges n -> Maybe (Maybe (n, n))
Ranges.extract1 Ranges TrackTime
range]
      ]
    , forall a b. (a -> b) -> [a] -> [b]
map forall t u. RulerId -> Update t u
Ruler (forall a. Set a -> [a]
Set.toList Set RulerId
_rulers)
    , forall a b. (a -> b) -> [a] -> [b]
map (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall t u. ViewId -> View -> Update t u
View View
BringToFront) (forall a. Set a -> [a]
Set.toList Set ViewId
_bring_to_front)
    , forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\(ViewId
vid, Maybe Int
tracknum) -> [forall t u. ViewId -> View -> Update t u
View ViewId
vid (Maybe Int -> View
TitleFocus Maybe Int
tracknum)])
        Maybe (ViewId, Maybe Int)
_title_focus
    ]
    -- views and blocks not converted, but they tell diff where to look.

-- | Reduce a UiUpdate to its corresponding UiDamage.  UiUpdates are more
-- specific, so this is discarding information, which I'll have to recover
-- later via Diff.
--
-- This seems silly, and maybe it is.  It's because I originally used only diff
-- for updates, but then added UiDamage to make diff more efficient.  Perhaps
-- I should move entirely to collecting updates and get rid of diff.  But as
-- long as diff is fairly efficient, when directed to the appropriate places
-- via UiDamage, then it still seems less error prone to do the diff.
to_damage :: UiUpdate -> UiDamage
to_damage :: UiUpdate -> UiDamage
to_damage = \case
    View ViewId
view_id View
view -> case View
view of
        -- I can discard BringToFront and TitleFocus because they're just
        -- instructions to Sync and don't indicate UI damage.
        BringToFront {} -> forall a. Monoid a => a
mempty
        TitleFocus {} -> forall a. Monoid a => a
mempty
        View
_ -> ViewId -> UiDamage
view_damage ViewId
view_id
    Block BlockId
block_id Block Track
_ -> BlockId -> UiDamage
block_damage BlockId
block_id
    Track TrackId
track_id Track
track -> TrackId -> Ranges TrackTime -> UiDamage
track_damage TrackId
track_id forall a b. (a -> b) -> a -> b
$ case Track
track of
        TrackEvents TrackTime
s TrackTime
e -> forall n. n -> n -> Ranges n
Ranges.range TrackTime
s TrackTime
e
        Track
_ -> forall n. Ranges n
Ranges.everything
    Ruler RulerId
ruler_id -> RulerId -> UiDamage
ruler_damage RulerId
ruler_id
    State State
state -> case State
state of
        Config {} -> forall a. Monoid a => a
mempty
        CreateBlock BlockId
block_id Block
_ -> BlockId -> UiDamage
block_damage BlockId
block_id
        DestroyBlock BlockId
block_id -> BlockId -> UiDamage
block_damage BlockId
block_id
        CreateTrack TrackId
track_id Track
_ -> TrackId -> Ranges TrackTime -> UiDamage
track_damage TrackId
track_id forall n. Ranges n
Ranges.everything
        DestroyTrack TrackId
track_id -> TrackId -> Ranges TrackTime -> UiDamage
track_damage TrackId
track_id forall n. Ranges n
Ranges.everything
        CreateRuler RulerId
ruler_id Ruler
_ -> RulerId -> UiDamage
ruler_damage RulerId
ruler_id
        DestroyRuler RulerId
ruler_id -> RulerId -> UiDamage
ruler_damage RulerId
ruler_id

-- * functions

-- | Updates which purely manipulate the view are not recorded by undo.
is_view_update :: UiUpdate -> Bool
is_view_update :: UiUpdate -> Bool
is_view_update = \case
    View ViewId
_ View
view_update -> case View
view_update of
        CreateView {} -> Bool
False
        View
DestroyView -> Bool
False
        View
_ -> Bool
True
    Block BlockId
_ Block Track
block_update -> case Block Track
block_update of
        BlockConfig Config
_ -> Bool
True
        Block Track
_ -> Bool
False
    Track TrackId
_ Track
track_update -> case Track
track_update of
        TrackBg {} -> Bool
True
        TrackRender {} -> Bool
True
        Track
_ -> Bool
False
    UiUpdate
_ -> Bool
False

-- | Score damage is used by Diff.score_changed to determine if a change has
-- happened which is worthy of saving to disk, or recording for undo.
is_score_damage :: UiDamage -> Bool
is_score_damage :: UiDamage -> Bool
is_score_damage (UiDamage { Map TrackId (Ranges TrackTime)
_tracks :: Map TrackId (Ranges TrackTime)
_tracks :: UiDamage -> Map TrackId (Ranges TrackTime)
_tracks, Set RulerId
_rulers :: Set RulerId
_rulers :: UiDamage -> Set RulerId
_rulers, Bool
_score_damage :: Bool
_score_damage :: UiDamage -> Bool
_score_damage }) =
    -- This doesn't check _blocks, because those happen on any block change at
    -- all, which includes UI-only things like Block.config_skel_box.
    Bool
_score_damage Bool -> Bool -> Bool
|| Bool -> Bool
not (forall k a. Map k a -> Bool
Map.null Map TrackId (Ranges TrackTime)
_tracks) Bool -> Bool -> Bool
|| Bool -> Bool
not (forall a. Set a -> Bool
Set.null Set RulerId
_rulers)

-- | Does an update imply a change which would require rederiving?
track_changed :: UiUpdate -> Maybe (TrackId, Ranges.Ranges ScoreTime)
track_changed :: UiUpdate -> Maybe (TrackId, Ranges TrackTime)
track_changed (Track TrackId
tid Track
update) = case Track
update of
    TrackEvents TrackTime
start TrackTime
end -> forall a. a -> Maybe a
Just (TrackId
tid, forall n. n -> n -> Ranges n
Ranges.range TrackTime
start TrackTime
end)
    Track
TrackAllEvents -> forall a. a -> Maybe a
Just (TrackId
tid, forall n. Ranges n
Ranges.everything)
    TrackTitle Text
_ -> forall a. a -> Maybe a
Just (TrackId
tid, forall n. Ranges n
Ranges.everything)
    Track
_ -> forall a. Maybe a
Nothing
track_changed UiUpdate
_ = forall a. Maybe a
Nothing

-- | Some Updates have to happen before others.
sort :: [DisplayUpdate] -> [DisplayUpdate]
sort :: [DisplayUpdate] -> [DisplayUpdate]
sort = forall k a. Ord k => (a -> k) -> [a] -> [a]
Lists.sortOn DisplayUpdate -> Int
sort_key

sort_key :: DisplayUpdate -> Int
sort_key :: DisplayUpdate -> Int
sort_key = \case
    -- Other updates may refer to the created view.
    View ViewId
_ (CreateView {}) -> Int
0
    -- No sense syncing updates to a view that's going to go away, so destroy
    -- it right away.
    View ViewId
_ View
DestroyView -> Int
0
    -- These may change the meaning of TrackNums.  Update TrackNums refer to
    -- the TrackNums of the destination state, except the ones for InsertTrack
    -- and RemoveTrack, of course.
    Block BlockId
_ (InsertTrack {}) -> Int
1
    Block BlockId
_ (RemoveTrack {}) -> Int
1
    -- Make sure to focus after creating it.
    View ViewId
_ (TitleFocus {}) -> Int
10
    DisplayUpdate
_ -> Int
2