\begin{code}
module Music.Analysis.Script where
import Script
import qualified Text.XML.MusicXML as MusicXML
import Music.Analysis.PF
import Music.Analysis.MusicXML2Haskore as IHaskore
import Music.Analysis.MusicXML as Interface
import Music.Analysis.MusicXML.Functions
import Music.Analysis.MusicXML.Level5 as Layer5
import Music.Analysis.MusicXML.Level4 as Layer4
import Text.XML.HaXml.OneOfN
import Control.Exception (throw, Exception(..))
import qualified Haskore.Music.GeneralMIDI
import System.IO (hFlush, stdout)
import Prelude
\end{code}
\begin{nocode}
-- |
procLength :: Length -> MusicXML.MusicXMLDoc -> String
procLength (Length Length_select_part Nothing) =
procLength (Length Length_select_part (Just Length_mode_simple))
procLength (Length Length_select_part (Just Length_mode_simple)) =
show . length_Part
procLength (Length Length_select_part (Just Length_mode_map)) =
unwords . map show . length_Part_map
procLength (Length Length_select_part (Just Length_mode_concat)) =
show . length_Part_concat
procLength (Length Length_select_measure Nothing) =
procLength (Length Length_select_measure (Just Length_mode_simple))
procLength (Length Length_select_measure (Just Length_mode_simple)) =
show . length_Measure
procLength (Length Length_select_measure (Just Length_mode_map)) =
unwords . map show . length_Measure_map
procLength (Length Length_select_measure (Just Length_mode_concat)) =
show . length_Measure_concat
\end{nocode}
\begin{code}
procFilter :: Filter -> MusicXML.MusicXMLDoc -> MusicXML.MusicXMLDoc
procFilter (Filter Filter_select_note Nothing) =
procFilter (Filter Filter_select_note (Just Filter_mode_yes))
procFilter (Filter Filter_select_note (Just Filter_mode_yes)) =
mapMusicXML filterNote
procFilter (Filter Filter_select_note (Just Filter_mode_no)) =
mapMusicXML filterNotNote
procFilter (Filter Filter_select_note_normal Nothing) =
procFilter (Filter Filter_select_note_normal (Just Filter_mode_yes))
procFilter (Filter Filter_select_note_normal (Just Filter_mode_yes)) =
mapMusicXML filterNormalNote
procFilter (Filter Filter_select_note_normal (Just Filter_mode_no)) =
mapMusicXML filterNotNormalNote
procFilter (Filter Filter_select_note_cue Nothing) =
procFilter (Filter Filter_select_note_cue (Just Filter_mode_yes))
procFilter (Filter Filter_select_note_cue (Just Filter_mode_yes)) =
mapMusicXML filterCueNote
procFilter (Filter Filter_select_note_cue (Just Filter_mode_no)) =
mapMusicXML filterNotCueNote
procFilter (Filter Filter_select_note_grace Nothing) =
procFilter (Filter Filter_select_note_grace (Just Filter_mode_yes))
procFilter (Filter Filter_select_note_grace (Just Filter_mode_yes)) =
mapMusicXML filterGraceNote
procFilter (Filter Filter_select_note_grace (Just Filter_mode_no)) =
mapMusicXML filterNotGraceNote
onlyPartwise :: (MusicXML.Score_Partwise -> MusicXML.Score_Partwise) ->
MusicXML.MusicXMLDoc -> MusicXML.MusicXMLDoc
onlyPartwise f (MusicXML.Score (MusicXML.Partwise x)) =
MusicXML.Score (MusicXML.Partwise (f x))
onlyPartwise _ x = x
procReification :: Reification ->
MusicXML.Score_Partwise -> MusicXML.Score_Partwise
procReification (Reification Reification_value_5) =
Interface.rep_Score_Partwise .
Interface.abst_Score_Partwise
procReification (Reification Reification_value_4) =
Interface.rep_Score_Partwise .
Layer5.rep_Score_Partwise .
Layer5.abst_Score_Partwise .
Interface.abst_Score_Partwise
procReification (Reification Reification_value_3) =
Interface.rep_Score_Partwise .
Layer5.rep_Score_Partwise .
Layer4.rep_Score_Partwise .
Layer4.abst_Score_Partwise .
Layer5.abst_Score_Partwise .
Interface.abst_Score_Partwise
procReification (Reification Reification_value_2) =
Interface.rep_Score_Partwise .
Layer5.rep_Score_Partwise .
Layer4.rep_Score_Partwise .
Layer4.abst_Score_Partwise .
Layer5.abst_Score_Partwise .
Interface.abst_Score_Partwise
procReification (Reification Reification_value_1) =
Interface.rep_Score_Partwise .
Layer5.rep_Score_Partwise .
Layer4.rep_Score_Partwise .
Layer4.abst_Score_Partwise .
Layer5.abst_Score_Partwise .
Interface.abst_Score_Partwise
procCount :: Count -> MusicXML.MusicXMLDoc -> (String, Int)
procCount (Count Count_select_part) =
\m -> ("part", count_part m)
procCount (Count Count_select_measure) =
\m -> ("measure", count_measure m)
procCount (Count Count_select_music_data) =
\m -> ("music-data", count_music_data m)
procCount (Count Count_select_note) =
\m -> ("note", count_note m)
procCount (Count Count_select_note_normal) =
\m -> ("note-normal", count_note_normal m)
procCount (Count Count_select_note_grace) =
\m -> ("note-grace", count_note_grace m)
procCount (Count Count_select_note_cue) =
\m -> ("note-cue", count_note_cue m)
procStat :: Stat -> MusicXML.MusicXMLDoc -> String
procStat (Stat (Stat_Attrs Nothing) list) =
procStat (Stat (Stat_Attrs (Just Stat_verbose_yes)) list)
procStat (Stat (Stat_Attrs (Just Stat_verbose_no)) list) =
\m -> unlines (map (show.p2) (map (flip procCount m) list))
procStat (Stat (Stat_Attrs (Just Stat_verbose_yes)) list) =
\m -> unlines (map (uncurry (++) . ((++": ") >< show))
(map (flip procCount m) list))
procParttime :: a -> MusicXML.MusicXMLDoc -> MusicXML.MusicXMLDoc
procParttime _ (MusicXML.Score (MusicXML.Partwise music)) =
(MusicXML.Score (MusicXML.Timewise (Interface.toTimewise music)))
procParttime _ music = music
procTimepart :: a -> MusicXML.MusicXMLDoc -> MusicXML.MusicXMLDoc
procTimepart _ (MusicXML.Score (MusicXML.Timewise music)) =
(MusicXML.Score (MusicXML.Partwise (Interface.toPartwise music)))
procTimepart _ music = music
procHaskore :: a -> MusicXML.MusicXMLDoc -> String
procHaskore _ (MusicXML.Score (MusicXML.Partwise music)) = "music = " ++
show (IHaskore.partwise2haskore music)
procHaskore _ (MusicXML.Score (MusicXML.Timewise music)) = "music = " ++
show (IHaskore.partwise2haskore (Interface.toPartwise music))
procHaskore _ _ = []
procMidi :: Midi -> MusicXML.MusicXMLDoc -> Either Haskore.Music.GeneralMIDI.T ()
procMidi (Midi Nothing) = procMidi (Midi (Just Midi_play_no))
procMidi (Midi (Just Midi_play_no)) = i2 . const ()
procMidi (Midi (Just Midi_play_yes)) = i1 . toMidi . procTimepart Timepart
\end{code}
\begin{code}
procWarn :: Maybe Action_warnings -> Bool
procWarn Nothing = procWarn (Just Action_warnings_no)
procWarn (Just Action_warnings_no) = False
procWarn (Just Action_warnings_yes) = True
procOutput :: Maybe FilePath ->
Either (Either MusicXML.MusicXMLDoc String)
(Either Haskore.Music.GeneralMIDI.T ()) -> IO ()
procOutput Nothing x = do
let f = MusicXML.show_CONTENTS MusicXML.show_MusicXMLDoc
either (either (putStrLn . f) putStrLn)
(either (return . const ()) (return . const ())) x
hFlush stdout
procOutput (Just output) x = do
let f = MusicXML.show_FILE MusicXML.show_MusicXMLDoc
either (either (f output) (writeFile output))
(either (\m -> saveMidi output m >>
playMidi output m >> return ())
(return . const ())) x
fromError :: MusicXML.Result a -> String
fromError (MusicXML.Error e) = e
fromError (MusicXML.Ok _) = throw (ErrorCall "internal error")
procAction_ ::
[OneOf7 Filter Reification Stat Parttime Timepart Haskore Midi] ->
MusicXML.MusicXMLDoc ->
Either (Either MusicXML.MusicXMLDoc String)
(Either Haskore.Music.GeneralMIDI.T ())
procAction_ [] = i1 . i1
procAction_ ((OneOf7 b):t) = \m -> procAction_ t (procFilter b m)
procAction_ ((TwoOf7 c):t) =
\m -> procAction_ t (onlyPartwise (procReification c) m)
procAction_ ((ThreeOf7 d):_) = i1 . i2 . procStat d
procAction_ ((FourOf7 e):t) = \m -> procAction_ t (procParttime e m)
procAction_ ((FiveOf7 f):t) = \m -> procAction_ t (procTimepart f m)
procAction_ ((SixOf7 g):_) = i1 . i2 . procHaskore g
procAction_ ((SevenOf7 h):_) = i2 . procMidi h
procAction :: Action -> IO ()
procAction (Action (Action_Attrs input output w) x) = do
musicxml <- MusicXML.read_FILE MusicXML.read_MusicXMLDoc input
case MusicXML.isOK musicxml of
True -> procOutput output
(procAction_ x (MusicXML.fromOK musicxml))
False ->
if procWarn w
then procOutput output ((i1 . i2) (fromError musicxml))
else return ()
procScript :: Script -> IO ()
procScript (Script _ actions) = mapM_ procAction actions
\end{code}