1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
| -- 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
-- | Functions to compare a performance against a previous \"known good\" one.
-- This is used to detect when code changes cause a performance to change.
module Cmd.DiffPerformance (
-- * save and load
load_midi, save_midi, midi_magic
-- * diff lilypond
, diff_lilypond
-- * diff midi
, diff_midi_performance
-- * util
, show_midi
, diff_lines
) where
import qualified Control.Exception as Exception
import qualified Data.List as List
import qualified Data.Text as Text
import qualified Data.Vector as Vector
import qualified System.Directory as Directory
import System.FilePath ((</>))
import qualified System.IO.Error as IO.Error
import qualified System.Process as Process
import qualified Util.File as File
import qualified Util.Seq as Seq
import qualified Util.Serialize as Serialize
import qualified Midi.Encode as Encode
import Midi.Instances ()
import qualified Midi.Midi as Midi
import qualified Ui.Ui as Ui
import qualified Perform.RealTime as RealTime
import Global
type Messages = Vector.Vector Midi.WriteMessage
-- * save and load
load_midi :: FilePath -> IO (Either Text Messages)
load_midi fname =
first ((("loading " <> showt fname <> ": ") <>) . pretty) <$>
Serialize.unserialize midi_magic fname
-- | Perform the input score and save the midi msgs to the output file.
-- This creates the -perf files.
save_midi :: FilePath -> Messages -> IO ()
save_midi fn = void . Serialize.serialize midi_magic fn
-- | Saved MIDI performance.
midi_magic :: Serialize.Magic (Vector.Vector Midi.WriteMessage)
midi_magic = Serialize.Magic 'm' 'i' 'd' 'i'
-- * diff lilypond
diff_lilypond :: String -> FilePath -> Ui.LilypondPerformance -> Text
-> IO (Maybe Text, [FilePath])
diff_lilypond name dir performance ly_code =
first (fmap (info<>)) <$> diff_lines name dir
(Text.lines (Ui.perf_performance performance)) (Text.lines ly_code)
where info = diff_info performance <> "\n"
-- * diff midi
diff_midi_performance :: String -> FilePath
-> Ui.MidiPerformance -> [Midi.WriteMessage] -> IO (Maybe Text, [FilePath])
diff_midi_performance name dir performance msgs =
first (fmap (info<>)) <$> diff_lines name dir
(show_midi $ Vector.toList $ Ui.perf_performance performance)
(show_midi msgs)
where info = diff_info performance <> "\n"
-- | Write files in the given directory and run the @diff@ command on them.
diff_lines :: String -> FilePath -> [Text] -> [Text]
-> IO (Maybe Text, [FilePath])
-- ^ (abbreviated_diff, wrote_files)
diff_lines name dir expected got = do
Directory.createDirectoryIfMissing True dir
File.writeLines expected_fn expected
File.writeLines got_fn got
(_code, diff, stderr) <- Process.readProcessWithExitCode
"diff" [expected_fn, got_fn] ""
unless (null stderr) $
Exception.throwIO $ IO.Error.userError $ "diff failed: " ++ stderr
let abbreviated
| null diff = Nothing
| otherwise = Just $ show_diffs (txt diff)
return (abbreviated, [expected_fn, got_fn])
where
expected_fn = dir </> name ++ ".expected"
got_fn = dir </> name ++ ".got"
diff_info :: Ui.Performance a -> Text
diff_info perf =
"Diffs from " <> pretty (Ui.perf_creation perf)
<> "\nPatch: " <> Ui.perf_patch perf
show_diffs :: Text -> Text
show_diffs diff = Text.unlines (limit 50 (Text.lines diff))
limit :: Int -> [Text] -> [Text]
limit n xs = pre ++ if null post then [] else [msg]
where
msg = "... trimmed (" <> showt (length xs) <> " lines)"
(pre, post) = splitAt n xs
show_midi :: [Midi.WriteMessage] -> [Text]
show_midi = map pretty . normalize
-- | To better approximate audible differences, I strip excessive time
-- precision and ensure notes happening at the same time are in a consistent
-- order.
normalize :: [Midi.WriteMessage] -> [Midi.WriteMessage]
normalize = concatMap List.sort . Seq.group_adjacent Midi.wmsg_ts . map strip
where
strip wmsg = wmsg
{ Midi.wmsg_ts = strip_time (Midi.wmsg_ts wmsg)
, Midi.wmsg_msg = strip_msg (Midi.wmsg_msg wmsg)
}
-- It'll be rounded again by the pretty instance, since I actually diff
-- pretty output, so this is likely unnecessary.
strip_time = RealTime.seconds . round_to 3 . RealTime.to_seconds
-- PitchBends are serialized as 14-bit numbers, so when they get
-- deserialized they change.
strip_msg = Encode.decode . Encode.encode
round_to :: RealFrac d => Int -> d -> d
round_to n = (/ 10^n) . fromIntegral . round . (* 10^n)
|