Script.lhs

\begin{code}
-- | 
-- Maintainer : silva.samuel@alumni.uminho.pt
-- Stability  : experimental
-- Portability: portable
-- 
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 Music.Analysis.Definition.Layer3 as Layer3
--import Music.Analysis.Definition.Layer2 as Layer2
import Text.XML.HaXml.OneOfN
import Control.Exception (throw, Exception(..))
import qualified Haskore.Music.GeneralMIDI
--import System.Directory
--import Text.XML.HaXml.XmlContent
--import Data.List
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 .
--    Layer3.rep_Score_Partwise .
--    Layer3.abst_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 .
--    Layer3.rep_Score_Partwise .
--    Layer2.rep_Score_Partwise .
--    Layer2.abst_Score_Partwise . 
--    Layer3.abst_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 
--(procTimepart Timepart m)
--    playMidi "test.mid" (procTimepart Timepart music) >> return ()
--procMidi (Midi (Just filepath) Nothing) music = 
--    procMidi (Midi (Just filepath) (Just Midi_play_no)) music
--procMidi (Midi (Just filepath) (Just Midi_play_no)) music = 
--    saveMidi filepath music
--procMidi (Midi (Just filepath) (Just Midi_play_yes)) music = 
--    saveMidi filepath music >> 
--    playMidi filepath (procTimepart Timepart music) >> return ()
\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_ ((OneOf8 a):_) = i1 . i2 . procLength a 
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}