\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 Measure = [Music_Data]
data Music_Data =
Music_Data_1 Note
| Music_Data_5 Attributes
deriving (Eq, Show)
type Note = (Note_, Maybe Type, [Dot], Maybe Accidental)
data Note_ =
Note_3 (Full_Note, Duration)
deriving (Eq, Show)
type Full_Note = Full_Note_
data Full_Note_ = Full_Note_1 Pitch
| 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)
type Beats = (IntegerNumber, Maybe IntegerNumber)
type Beat_Type = IntegerNumber
type Clef = (Sign, Maybe Line, Maybe Clef_Octave_Change)
type Sign = IntegerNumber
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
abst_Music_Data :: Music_Data -> Maybe Layer1Num.Music_Data
abst_Music_Data (Music_Data_1 x) = Just (Layer1Num.Music_Data_1 (abst_Note x))
abst_Music_Data (Music_Data_5 _) = 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_3 (x1,_)) = Layer1Num.Note_3 (abst_Full_Note x1)
abst_Full_Note :: Full_Note -> Layer1Num.Full_Note
abst_Full_Note = abst_Full_Note_
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_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))
split_Music_Data :: Music_Data -> (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
split_Music_Data (Music_Data_5 x) = split Music_Data_5 (const Nothing) x
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))
split_Note_ :: Note_ -> (Duration, Layer1Num.Full_Note_)
split_Note_ = split p2 (p2 . split_Full_Note . p1) . (\(Note_3 x) -> x)
split_Full_Note :: Full_Note -> (Full_Note, Layer1Num.Full_Note)
split_Full_Note = split_Full_Note_
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
split_Full_Note_ (Full_Note_3 x) = split Full_Note_3 (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}