\begin{code} module Music.Analysis.MusicXML.Level2Num ( module Music.Analysis.MusicXML.Level2Num, ) where import qualified Music.Analysis.MusicXML.Level1Num as Layer1Num import Music.Analysis.PF import Music.Analysis.Base import Data.Maybe (catMaybes) import Prelude \end{code} \begin{code} -- | type Score_Partwise = [Measure] --- | --- type Part = [Measure] -- | type Measure = [Music_Data] -- | data Music_Data = Music_Data_1 Note --- | Music_Data_2 MusicXML.Backup --- | Music_Data_3 MusicXML.Forward --- | Music_Data_4 MusicXML.Direction | Music_Data_5 Attributes --- | Music_Data_6 MusicXML.Harmony --- | Music_Data_7 MusicXML.Figured_Bass --- | Music_Data_8 MusicXML.Print --- | Music_Data_9 MusicXML.Sound --- | Music_Data_10 Barline --- | Music_Data_11 MusicXML.Grouping --- | Music_Data_12 MusicXML.Link --- | Music_Data_13 MusicXML.Bookmark deriving (Eq, Show) -- | type Note = (Note_, Maybe Type, [Dot], Maybe Accidental) -- | data Note_ = --- Note_1 (Grace, Full_Note, Maybe (Tie, Maybe Tie)) --- | Note_2 (Cue, Full_Note, Duration) Note_3 (Full_Note, Duration) -- , Maybe (Tie, Maybe Tie)) deriving (Eq, Show) -- | type Full_Note = Full_Note_ -- | data Full_Note_ = Full_Note_1 Pitch --- | Full_Note_2 Unpitched | Full_Note_3 Layer1Num.Rest deriving (Eq, Show) -- | type Pitch = Layer1Num.Pitch -- | type Duration = IntegerNumber -- | type Type = Layer1Num.Type_ -- | type Dot = () -- | type Accidental = Layer1Num.Accidental_ -- | type Attributes = (Maybe Divisions, [Key], [Time], [Clef]) -- | type Divisions = IntegerNumber -- | type Key = (Key_, [IntegerNumber]) -- | data Key_ = Key_1 (Fifths, Maybe Mode) | Key_2 [(IntegerNumber, Number)] deriving (Eq, Show) -- | type Fifths = IntegerNumber -- | data Mode = Major | Minor | Dorian | Phrygian | Lydian | Mixolydian | Aeolian | Ionian | Locrian deriving (Eq, Show) -- | type Time = Time_B -- | data Time_B = Time_5 [(Beats, Beat_Type)] deriving (Eq, Show) -- | MusicXML Schema specify "xs:string" type Beats = (IntegerNumber, Maybe IntegerNumber) -- | MusicXML Schema specify "xs:string" type Beat_Type = IntegerNumber -- | type Clef = (Sign, Maybe Line, Maybe Clef_Octave_Change) -- | type Sign = IntegerNumber -- Clef_Sign_G | Clef_Sign_F | Clef_Sign_C | -- Clef_Sign_Percussion | Clef_Sign_TAB | -- Clef_Sign_None -- deriving (Eq, Show) -- | type Line = IntegerNumber -- | type Clef_Octave_Change = IntegerNumber \end{code} \begin{code} -- | abst_Score_Partwise :: Score_Partwise -> Layer1Num.Score_Partwise abst_Score_Partwise = catMaybes . fmap abst_Music_Data . concat --(id -|- fmap abst_Measure . head) . grd null . p2 . p2 --- | --- abst_Measure :: Measure -> Layer1Num.Measure --- abst_Measure = catMaybes . fmap abst_Music_Data -- | abst_Music_Data :: Music_Data -> Maybe Layer1Num.Music_Data abst_Music_Data (Music_Data_1 x) = Just (Layer1Num.Music_Data_1 (abst_Note x)) -- x' <- abst_Note x -- return (Layer1Num.Music_Data_1 x') -- Layer1Num.Music_Data_1 ((catMaybes . (fmap abst_Note)) x) --abst_Music_Data (Music_Data_2 _) = Nothing --abst_Music_Data (Music_Data_3 _) = Nothing --abst_Music_Data (Music_Data_4 _) = Nothing abst_Music_Data (Music_Data_5 _) = Nothing -- Just (Layer1Num.Music_Data_5 (abst_Attributes x)) --abst_Music_Data (Music_Data_6 _) = Nothing --abst_Music_Data (Music_Data_7 _) = Nothing --abst_Music_Data (Music_Data_8 _) = Nothing --abst_Music_Data (Music_Data_9 _) = Nothing --abst_Music_Data (Music_Data_10 _) = Nothing --abst_Music_Data (Music_Data_11 _) = Nothing --abst_Music_Data (Music_Data_12 _) = Nothing --abst_Music_Data (Music_Data_13 _) = Nothing -- | abst_Note :: Note -> Layer1Num.Note abst_Note = (\(x1,x4,x5,x6) -> (abst_Note_ x1, fmap abst_Type x4, fmap abst_Dot x5, fmap abst_Accidental x6)) -- | abst_Note_ :: Note_ -> Layer1Num.Note_ --abst_Note_ (Note_1 _) = Nothing -- Layer1Num.Note_1 (abst_Grace x1, abst_Full_Note x2, -- fmap (abst_Tie >< fmap abst_Tie) x3) --abst_Note_ (Note_2 _) = Nothing -- Layer1Num.Note_2 (abst_Cue x1, abst_Full_Note x2, abst_Duration x3) abst_Note_ (Note_3 (x1,_)) = Layer1Num.Note_3 (abst_Full_Note x1) -- x1' <- abst_Full_Note x1 -- return (Layer1Num.Note_3 (x1', abst_Duration x2)) -- | abst_Full_Note :: Full_Note -> Layer1Num.Full_Note abst_Full_Note = abst_Full_Note_ -- b' <- abst_Full_Note_ b -- return (fmap id a, b') --abst_Full_Note :: Full_Note -> (Maybe Layer1Num.Chord, Maybe Layer1Num.Full_Note_) --abst_Full_Note = (fmap id >< abst_Full_Note_) --abst_Full_Note (x,y) = do -- y' <- abst_Full_Note_ y -- return (fmap id x >< fmap id y')) -- (fmap id >< (\x -> do -- y <- abst_Full_Note_ x -- )) -- | abst_Full_Note_ :: Full_Note_ -> Layer1Num.Full_Note_ abst_Full_Note_ (Full_Note_1 x) = (Layer1Num.Full_Note_1 (abst_Pitch x)) --abst_Full_Note_ (Full_Note_2 _) = Nothing abst_Full_Note_ (Full_Note_3 x) = (Layer1Num.Full_Note_3 x) -- | abst_Pitch :: Pitch -> Layer1Num.Pitch abst_Pitch = id -- | abst_Type :: Type -> Layer1Num.Type abst_Type = id -- | abst_Dot :: Dot -> Layer1Num.Dot abst_Dot = const () -- | abst_Accidental :: Accidental -> Layer1Num.Accidental abst_Accidental = id \end{code} \begin{code} -- | split_Measure :: Measure -> ((), [Maybe Layer1Num.Music_Data]) split_Measure = split (const ()) (fmap (p2 .split_Music_Data)) --catMaybes . fmap abst_Music_Data . concat --(id -|- fmap abst_Measure . head) . grd null . p2 . p2 --- | --- abst_Measure :: Measure -> Layer1Num.Measure --- abst_Measure = catMaybes . fmap abst_Music_Data -- | split_Music_Data :: Music_Data -> (Music_Data, Maybe Layer1Num.Music_Data) --Maybe Layer1Num.Music_Data split_Music_Data (Music_Data_1 x) = split Music_Data_1 (Just . Layer1Num.Music_Data_1 . p2 . split_Note) x -- x' <- abst_Note x -- return (Layer1Num.Music_Data_1 x') -- Layer1Num.Music_Data_1 ((catMaybes . (fmap abst_Note)) x) --abst_Music_Data (Music_Data_2 _) = Nothing --abst_Music_Data (Music_Data_3 _) = Nothing --abst_Music_Data (Music_Data_4 _) = Nothing split_Music_Data (Music_Data_5 x) = split Music_Data_5 (const Nothing) x -- Just (Layer1Num.Music_Data_5 (abst_Attributes x)) --abst_Music_Data (Music_Data_6 _) = Nothing --abst_Music_Data (Music_Data_7 _) = Nothing --abst_Music_Data (Music_Data_8 _) = Nothing --abst_Music_Data (Music_Data_9 _) = Nothing --abst_Music_Data (Music_Data_10 _) = Nothing --abst_Music_Data (Music_Data_11 _) = Nothing --abst_Music_Data (Music_Data_12 _) = Nothing --abst_Music_Data (Music_Data_13 _) = Nothing -- | split_Note :: Note -> (Note, Layer1Num.Note) split_Note = split id (\(a,b,c,d) -> ((Layer1Num.Note_3 . p2.split_Note_) a, fmap (p2.split_Type) b, fmap (p2.split_Dot) c, fmap (p2.split_Accidental) d)) -- (\(x1,x4,x5,x6) -> -- (abst_Note_ x1, fmap abst_Type x4, -- fmap abst_Dot x5, fmap abst_Accidental x6)) -- | split_Note_ :: Note_ -> (Duration, Layer1Num.Full_Note_) --abst_Note_ (Note_1 _) = Nothing -- Layer1Num.Note_1 (abst_Grace x1, abst_Full_Note x2, -- fmap (abst_Tie >< fmap abst_Tie) x3) --abst_Note_ (Note_2 _) = Nothing -- Layer1Num.Note_2 (abst_Cue x1, abst_Full_Note x2, abst_Duration x3) --split_Note_ (Note_3 (x1,x2)) = split (const x2) (Layer1Num.Note_3 (abst_Full_Note x1)) split_Note_ = split p2 (p2 . split_Full_Note . p1) . (\(Note_3 x) -> x) --split (const x2) (Layer1Num.Note_3 (abst_Full_Note x1)) -- x1' <- abst_Full_Note x1 -- return (Layer1Num.Note_3 (x1', abst_Duration x2)) -- | split_Full_Note :: Full_Note -> (Full_Note, Layer1Num.Full_Note) split_Full_Note = split_Full_Note_ -- b' <- abst_Full_Note_ b -- return (fmap id a, b') --abst_Full_Note :: Full_Note -> (Maybe Layer1Num.Chord, Maybe Layer1Num.Full_Note_) --abst_Full_Note = (fmap id >< abst_Full_Note_) --abst_Full_Note (x,y) = do -- y' <- abst_Full_Note_ y -- return (fmap id x >< fmap id y')) -- (fmap id >< (\x -> do -- y <- abst_Full_Note_ x -- )) -- | split_Full_Note_ :: Full_Note_ -> (Full_Note_, Layer1Num.Full_Note_) split_Full_Note_ (Full_Note_1 x) = ((id >< Layer1Num.Full_Note_1) . split Full_Note_1 (p2.split_Pitch)) x --(Layer1Num.Full_Note_1 (split_Pitch x)) --abst_Full_Note_ (Full_Note_2 _) = Nothing split_Full_Note_ (Full_Note_3 x) = split Full_Note_3 (Layer1Num.Full_Note_3) x --(Layer1Num.Full_Note_3 x) -- | split_Pitch :: Pitch -> (Pitch, Layer1Num.Pitch) split_Pitch = split id id -- | split_Type :: Type -> (Type, Layer1Num.Type) split_Type = split id id -- | split_Dot :: Dot -> (Dot, Layer1Num.Dot) split_Dot = split id (const ()) -- | split_Accidental :: Accidental -> (Accidental, Layer1Num.Accidental) split_Accidental = split id id \end{code} \begin{nocode} --join :: Functor f => f a -> f b -> (a -> b -> b) -> f b --join a b f = fmap (\x -> (f x) b) a --- | --join_Score_Partwise :: Layer1Num.Score_Partwise -> Score_Partwise --join_Score_Partwise = --catMaybes . fmap abst_Music_Data . concat --(id -|- fmap abst_Measure . head) . grd null . p2 . p2 --- | join_Measure :: [Layer1Num.Music_Data] -> Measure -> Measure join_Measure a b = fmap (join_Music_Data ) -- | join_Music_Data :: Maybe Layer1Num.Music_Data -> Music_Data -> Music_Data join_Music_Data (Just (Layer1Num.Music_Data_1 x)) (Music_Data_1 y) = (Music_Data_1 (join_Note x y)) -- x' <- abst_Note x -- return (Layer1Num.Music_Data_1 x') -- Layer1Num.Music_Data_1 ((catMaybes . (fmap abst_Note)) x) --abst_Music_Data (Music_Data_2 _) = Nothing --abst_Music_Data (Music_Data_3 _) = Nothing --abst_Music_Data (Music_Data_4 _) = Nothing join_Music_Data Nothing y = y join_Music_Data _ y = y -- Just (Layer1Num.Music_Data_5 (abst_Attributes x)) --abst_Music_Data (Music_Data_6 _) = Nothing --abst_Music_Data (Music_Data_7 _) = Nothing --abst_Music_Data (Music_Data_8 _) = Nothing --abst_Music_Data (Music_Data_9 _) = Nothing --abst_Music_Data (Music_Data_10 _) = Nothing --abst_Music_Data (Music_Data_11 _) = Nothing --abst_Music_Data (Music_Data_12 _) = Nothing --abst_Music_Data (Music_Data_13 _) = Nothing -- | join_Note :: Layer1Num.Note -> Note -> Note join_Note (a,b,c,d) (a',_,_,_) = (join_Note_ a a', b, c, d) -- (join_Note_ a a', fmap join_Type b b') -- (\(x1,x4,x5,x6) -> -- (abst_Note_ x1, fmap abst_Type x4, -- fmap abst_Dot x5, fmap abst_Accidental x6)) -- | join_Note_ :: Layer1Num.Note_ -> Note_ -> Note_ --abst_Note_ (Note_1 _) = Nothing -- Layer1Num.Note_1 (abst_Grace x1, abst_Full_Note x2, -- fmap (abst_Tie >< fmap abst_Tie) x3) --abst_Note_ (Note_2 _) = Nothing -- Layer1Num.Note_2 (abst_Cue x1, abst_Full_Note x2, abst_Duration x3) join_Note_ (Layer1Num.Note_3 x1) (Note_3 (x1',x2')) = Note_3 (join_Full_Note x1 x1', x2') -- x1' <- abst_Full_Note x1 -- return (Layer1Num.Note_3 (x1', abst_Duration x2)) -- | join_Full_Note :: Layer1Num.Full_Note -> Full_Note -> Full_Note join_Full_Note = join_Full_Note_ -- b' <- abst_Full_Note_ b -- return (fmap id a, b') --abst_Full_Note :: Full_Note -> (Maybe Layer1Num.Chord, Maybe Layer1Num.Full_Note_) --abst_Full_Note = (fmap id >< abst_Full_Note_) --abst_Full_Note (x,y) = do -- y' <- abst_Full_Note_ y -- return (fmap id x >< fmap id y')) -- (fmap id >< (\x -> do -- y <- abst_Full_Note_ x -- )) -- | join_Full_Note_ :: Layer1Num.Full_Note_ -> Full_Note_ -> Full_Note_ join_Full_Note_ (Layer1Num.Full_Note_1 x) (Full_Note_1 x') = Full_Note_1 (join_Pitch x x') join_Full_Note_ (Layer1Num.Full_Note_1 x) _ = Full_Note_1 x --abst_Full_Note_ (Full_Note_2 _) = Nothing join_Full_Note_ (Layer1Num.Full_Note_3 x) _ = Full_Note_3 x --join_Full_Note_ x _ = x -- | join_Pitch :: Layer1Num.Pitch -> Pitch -> Pitch join_Pitch x _ = x -- | join_Type :: Layer1Num.Type -> Type -> Type join_Type x _ = x -- | join_Dot :: Layer1Num.Dot -> Dot -> Dot join_Dot _ y = y -- | join_Accidental :: Layer1Num.Accidental -> Accidental -> Accidental join_Accidental x _ = x \end{nocode} \begin{nocode} --map_Score_Partwise f = f map_Music_Data (Music_Data_1 x) = Music_Data_1 (map_Note x) map_Music_Data (Music_Data_5 x) = Music_Data_5 x map_Note (a,b,c,d) = (map_Note_ a, fmap map_Type b, fmap map_Dot c, fmap map_Accidental d) map_Note_ (Note_3 x) = Note_3 ((map_Full_Note >< id) x) map_Type = id map_Dot = id map_Accidental = id map_Full_Note = map_Full_Note_ map_Full_Note_ (Full_Note_1 x) = Full_Note_1 (map_Pitch id x) map_Full_Note_ (Full_Note_3 x) = Full_Note_3 x map_Pitch :: (Layer1Num.Pitch -> Layer1Num.Pitch) -> Pitch -> Pitch map_Pitch _ = id --(map_Step id a, fmap (map_Alter id) b, map_Octave id c) --map_Step = id --map_Alter = id --map_Octave = id \end{nocode} \begin{nocode} -- | type Music = [Measure] -- | type Measure = [Either Attributes Note] -- | type Attributes = (Maybe Divisions, [Key], [Time], [Clef]) -- | type Divisions = IntegerNumber -- | type Key = (Fifths, Mode) -- | type Fifths = IntegerNumber -- | data Mode = Major | Minor | Dorian | Phrygian | Lydian | Mixolydian | Aeolian | Ionian | Locrian deriving (Eq, Show) -- | In case of empty list means "senza-misura". type Time = [(Beats, Beat_Type)] -- | type Beats = (IntegerNumber, Maybe IntegerNumber) -- | type Beat_Type = IntegerNumber -- | type Clef = (Sign, Maybe Line, Clef_Octave_Change) -- | data Sign = Clef_Sign_G | Clef_Sign_F | Clef_Sign_C | Clef_Sign_Percussion | Clef_Sign_TAB | Clef_Sign_None deriving (Eq, Show) -- | type Line = IntegerNumber -- | type Clef_Octave_Change = IntegerNumber -- | type Note = ((Either Pitch Rest, Accidental), ((Duration, Maybe Type), Dots)) -- | type Duration = IntegerNumber -- | data Accidental = Sharp || Natural || Flat || Double_Sharp || Sharp_Sharp || Flat_Flat || Natural_Sharp || Natural_Flat || Quarter_Sharp || Quarter_Flat || Three_Quarters_Sharp || Three_Quarters_Flat deriving (Eq, Show) \end{nocode} \begin{nocode} rep :: Layer1Num.Music -> Music rep l = [map (Right . ((rep_Pitch -||- id ) >< (rep_Type >< id))) l] where rep_Pitch :: Layer1Num.Pitch -> Pitch rep_Pitch = (flatl . ((rep_Step >< maybe Nothing (Just . rep_Accidental)) >< id) . unflatl) rep_Step :: Layer1Num.Step -> Step rep_Step Layer1Num.A = A rep_Step Layer1Num.B = B rep_Step Layer1Num.C = C rep_Step Layer1Num.D = D rep_Step Layer1Num.E = E rep_Step Layer1Num.F = F rep_Step Layer1Num.G = G rep_Type :: Layer1Num.Type -> Type rep_Type Layer1Num.Whole = Whole rep_Type Layer1Num.Half = Half rep_Type Layer1Num.Quarter = Quarter rep_Type Layer1Num.Eighth = Eighth rep_Type Layer1Num.Th16 = Th16 rep_Type Layer1Num.Th32 = Th32 rep_Type Layer1Num.Th64 = Th64 rep_Accidental :: Layer1Num.Accidental -> Accidental rep_Accidental Layer1Num.DoubleFlat = DoubleFlat rep_Accidental Layer1Num.Flat = Flat rep_Accidental Layer1Num.Natural = Natural rep_Accidental Layer1Num.Sharp = Sharp rep_Accidental Layer1Num.DoubleSharp = DoubleSharp \end{nocode} \begin{nocode} -- || abst :: Music -> Layer1Num.Music abst = map ((abst_Pitch -||- id ) >< (abst_Type >< id)) . concat . map (either (const []) (:[])) . concat where abst_Pitch :: Pitch -> Layer1Num.Pitch abst_Pitch = (flatl . ((abst_Step >< maybe Nothing (Just . abst_Accidental)) >< id) . unflatl) -- || abst_Step :: Step -> Layer1Num.Step abst_Step A = Layer1Num.A abst_Step B = Layer1Num.B abst_Step C = Layer1Num.C abst_Step D = Layer1Num.D abst_Step E = Layer1Num.E abst_Step F = Layer1Num.F abst_Step G = Layer1Num.G -- || abst_Type :: Type -> Layer1Num.Type abst_Type Whole = Layer1Num.Whole abst_Type Half = Layer1Num.Half abst_Type Quarter = Layer1Num.Quarter abst_Type Eighth = Layer1Num.Eighth abst_Type Th16 = Layer1Num.Th16 abst_Type Th32 = Layer1Num.Th32 abst_Type Th64 = Layer1Num.Th64 -- || abst_Accidental :: Accidental -> Layer1Num.Accidental abst_Accidental DoubleFlat = Layer1Num.DoubleFlat abst_Accidental Flat = Layer1Num.Flat abst_Accidental Natural = Layer1Num.Natural abst_Accidental Sharp = Layer1Num.Sharp abst_Accidental DoubleSharp = Layer1Num.DoubleSharp \end{nocode} \begin{nocode} mapLayer1Num :: ([Note] -> [Note]) -> Music -> Music mapLayer1Num f = map concat . (map . map . map) (p2 . unflatl) . map (groupBy (\(_,x2,_) (_,y2,_) -> x2 == y2)) . (groupBy (\(x1,_,_) (y1,_,_) -> x1 == y1)) . map flatl . uncurry zip . (sort >< id) . unzip . map unflatl . uncurry (++) . (map (flatl . (id>< map (flatl . (id>< map flatl . uncurry zip) . (id >< (id >< post1 . f . pre1)) . (id >< unzip . map unflatl) . foldr (\(a,b,c) (z1,z2) -> either (\x -> ((a,b,x):z1,z2)) (\x -> (z1,(a,b,x):z2)) c) ([],[]) . foldr (\(x1,x2) y -> foldr (\(a1,a2) b -> (x1,a1,a2):b) [] x2 ++ y) [] . (zip ([1..]::[Int]) . map (zip ([1..]::[Int]))) where pre1 :: [Note] -> [Note] pre1 = map id -- ((abst_Pitch -||- id ) >< (abst_Type >< id)) -- where -- abst_Pitch :: Pitch -> Layer1Num.Pitch -- abst_Pitch = (flatl . -- ((abst_Step >< e2m.( id-||-abst_Accidental).m2e) >< id) . -- unflatl) post1 :: [Note] -> [Note] post1 = map id -- (((rep_Pitch -||- id ) {-><-} (rep_Type {-><-} id))) -- where -- rep_Pitch :: Layer1Num.Pitch -> Pitch -- rep_Pitch = (flatl . -- ((rep_Step >< e2m.(id-||-rep_Accidental).m2e) {-><-} id) . -- unflatl) \end{nocode} \begin{nocode} mapLayer1' :: (Note -> Note) -> Music -> Music mapLayer1' f = map concat . (map . map . map) p2 . map (groupBy (\((_,x2),_) ((_,y2),_) -> x2 == y2)) . (groupBy (\((x1,_),_) ((y1,_),_) -> x1 == y1)) . map (id >< post1 . (id -||- f) . pre1) . foldr (\(x1,x2) y -> foldr (\(a1,a2) b -> ((x1,a1),a2):b) [] x2 ++ y) [] . zip ([1..]::[Int]) . map (zip ([1..]::[Int])) where pre1 :: Either a Note -> Either a Note pre1 = id -||- id -- ((abst_Pitch -||- id ) >< (abst_Type >< id)) -- where -- abst_Pitch :: Pitch -> Pitch -- abst_Pitch = (flatl . -- ((abst_Step >< e2m.( id-||-abst_Accidental).m2e) >< id) . -- unflatl) post1 :: Either a Note -> Either a Note post1 = id -||- id -- (((rep_Pitch -||- id ) >< (rep_Type {-><-} id))) -- where -- rep_Pitch :: Pitch -> Pitch -- rep_Pitch = (flatl . -- ((rep_Step >< e2m.(id-||-rep_Accidental).m2e) {-><-} id) . -- unflatl) \end{nocode}