src/Music/Analysis/MusicXML/Level2.lhs

\begin{code}

module Music.Analysis.MusicXML.Level2 (
    module Music.Analysis.MusicXML.Level2,
    ) where
import qualified Music.Analysis.MusicXML.Level1 as Layer1
import Music.Analysis.PF 
import Music.Analysis.Base (IntegerNumber)
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 Layer1.Rest
                  deriving (Eq, Show)
-- | 
type Pitch = (Layer1.Step, Maybe Layer1.Alter, Layer1.Octave)
-- |
type Duration = IntegerNumber
-- |
type Type = Layer1.Type_
-- |
type Dot = ()
-- |
type Accidental = Layer1.Accidental_
-- |
type Attributes = (Maybe Divisions, [Key], [Time], [Clef])
-- |
type Divisions = IntegerNumber
-- |
type Key = (Key_, [Key_Octave])
-- |
data Key_ = Key_1 (Fifths, Maybe Mode)
          | Key_2 [(Key_Step, Key_Alter)]
            deriving (Eq, Show)
-- |
type Fifths = IntegerNumber
-- |
data Mode = Major | Minor | 
    Dorian | Phrygian | Lydian | Mixolydian |
    Aeolian | Ionian | Locrian
    deriving (Eq, Show)
-- |
type Key_Step = Layer1.Step
-- |
type Key_Alter = Layer1.Alter
-- |
type Key_Octave = Layer1.Octave
-- |
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)
-- |
data Sign = 
    Clef_Sign_G | Clef_Sign_F | Clef_Sign_C |
    Clef_Sign_Percussion | Clef_Sign_TAB | 
    Clef_Sign_None
    deriving (Eq, Show, Enum)
-- |
type Line = IntegerNumber
-- | 
type Clef_Octave_Change = IntegerNumber

\end{code} \begin{code}

-- |
abst_Score_Partwise :: Score_Partwise -> Layer1.Score_Partwise
abst_Score_Partwise = catMaybes . fmap abst_Music_Data . concat
--(id -|- fmap abst_Measure . head) . grd null . p2 . p2
--- |
--- abst_Measure :: Measure -> Layer1.Measure
--- abst_Measure = catMaybes . fmap abst_Music_Data
-- |
abst_Music_Data :: Music_Data -> Maybe Layer1.Music_Data
abst_Music_Data (Music_Data_1 x) = Just (Layer1.Music_Data_1 (abst_Note x))
--    x' <- abst_Note x
--    return (Layer1.Music_Data_1 x')
--    Layer1.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 (Layer1.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 -> Layer1.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_ -> Layer1.Note_
--abst_Note_ (Note_1 _) = Nothing
--    Layer1.Note_1 (abst_Grace x1, abst_Full_Note x2, 
--      fmap (abst_Tie >< fmap abst_Tie) x3)
--abst_Note_ (Note_2 _) = Nothing
--    Layer1.Note_2 (abst_Cue x1, abst_Full_Note x2, abst_Duration x3)
abst_Note_ (Note_3 (x1,_)) = Layer1.Note_3 (abst_Full_Note x1)
--    x1' <- abst_Full_Note x1
--    return (Layer1.Note_3 (x1', abst_Duration x2))
-- |
abst_Full_Note :: Full_Note -> Layer1.Full_Note
abst_Full_Note = abst_Full_Note_ 
--    b' <- abst_Full_Note_ b
--    return (fmap id a, b')
--abst_Full_Note :: Full_Note -> (Maybe Layer1.Chord, Maybe Layer1.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_ -> Layer1.Full_Note_
abst_Full_Note_ (Full_Note_1 x) = (Layer1.Full_Note_1 (abst_Pitch x))
--abst_Full_Note_ (Full_Note_2 _) = Nothing 
abst_Full_Note_ (Full_Note_3 x) = (Layer1.Full_Note_3 x)
-- |
abst_Pitch :: Pitch -> Layer1.Pitch
abst_Pitch = id
-- |
abst_Type :: Type -> Layer1.Type
abst_Type = id
-- |
abst_Dot :: Dot -> Layer1.Dot
abst_Dot = id
-- |
abst_Accidental :: Accidental -> Layer1.Accidental
abst_Accidental = id

\end{code} \begin{code}

-- |
split_Measure :: Measure -> ((), [Maybe Layer1.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 -> Layer1.Measure
--- abst_Measure = catMaybes . fmap abst_Music_Data
-- |
split_Music_Data :: Music_Data -> (Music_Data, Maybe Layer1.Music_Data)
--Maybe Layer1.Music_Data
split_Music_Data (Music_Data_1 x) = 
    split Music_Data_1 (Just . Layer1.Music_Data_1 . p2 . split_Note) x
--    x' <- abst_Note x
--    return (Layer1.Music_Data_1 x')
--    Layer1.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 (Layer1.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, Layer1.Note)
split_Note = split id (\(a,b,c,d) -> ((Layer1.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, Layer1.Full_Note_)
--abst_Note_ (Note_1 _) = Nothing
--    Layer1.Note_1 (abst_Grace x1, abst_Full_Note x2, 
--      fmap (abst_Tie >< fmap abst_Tie) x3)
--abst_Note_ (Note_2 _) = Nothing
--    Layer1.Note_2 (abst_Cue x1, abst_Full_Note x2, abst_Duration x3)
--split_Note_ (Note_3 (x1,x2)) = split (const x2) (Layer1.Note_3 (abst_Full_Note x1))
split_Note_ = split p2 (p2 . split_Full_Note . p1) . (\(Note_3 x) -> x)
--split (const x2) (Layer1.Note_3 (abst_Full_Note x1))
--    x1' <- abst_Full_Note x1
--    return (Layer1.Note_3 (x1', abst_Duration x2))
-- |
split_Full_Note :: Full_Note -> (Full_Note, Layer1.Full_Note)
split_Full_Note = split_Full_Note_ 
--    b' <- abst_Full_Note_ b
--    return (fmap id a, b')
--abst_Full_Note :: Full_Note -> (Maybe Layer1.Chord, Maybe Layer1.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_, Layer1.Full_Note_)
split_Full_Note_ (Full_Note_1 x) = 
    ((id >< Layer1.Full_Note_1) . split Full_Note_1 (p2.split_Pitch)) x
--(Layer1.Full_Note_1 (split_Pitch x))
--abst_Full_Note_ (Full_Note_2 _) = Nothing 
split_Full_Note_ (Full_Note_3 x) = split Full_Note_3 (Layer1.Full_Note_3) x
--(Layer1.Full_Note_3 x)
-- |
split_Pitch :: Pitch -> (Pitch, Layer1.Pitch)
split_Pitch = split id id
-- |
split_Type :: Type -> (Type, Layer1.Type)
split_Type = split id id
-- |
split_Dot :: Dot -> (Dot, Layer1.Dot)
split_Dot = split id (const ())
-- |
split_Accidental :: Accidental -> (Accidental, Layer1.Accidental)
split_Accidental = split id id

\end{code}