src/Music/Analysis/MusicXML/Level3.lhs

\begin{code}

module Music.Analysis.MusicXML.Level3 (
    module Music.Analysis.MusicXML.Level3,
    )where
import Music.Analysis.Base (IntegerNumber)
import Music.Analysis.PF
import qualified Music.Analysis.MusicXML.Level1 as Layer1
import qualified Music.Analysis.MusicXML.Level2 as Layer2
import qualified Music.Analysis.MusicXML.Level2Num as Layer2Num
import qualified Music.Analysis.MusicXML.Level3Num as Layer3Num
import Data.Maybe 
import qualified Text.XML.MusicXML as MusicXML

\end{code} \begin{code}

-- |
type Score_Partwise = 
    (MusicXML.Document_Attributes, (MusicXML.Score_Header, [Part]))
-- |
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_5 Attributes 
    | Music_Data_10 Barline
      deriving (Eq, Show)
-- |
type Barline = MusicXML.Barline
-- |
type Note = 
    (Note_, Maybe Instrument, Editorial_Voice,
        Maybe Type, [Dot], Maybe Accidental, 
        Maybe Staff)
-- |
data Note_ = 
          Note_3 (Full_Note, Duration) 
          deriving (Eq, Show)
-- | 
type Full_Note = (Maybe MusicXML.Chord, Full_Note_)
-- |
data Full_Note_ = Full_Note_1 Layer2.Pitch
                | Full_Note_3 Rest
                  deriving (Eq, Show)
-- | 
type Rest = () 
-- |
type Duration = IntegerNumber
-- |
type Editorial_Voice = MusicXML.Editorial_Voice
-- |
type Instrument = MusicXML.Instrument
-- |
type Type = Layer1.Type_
-- |
type Dot = MusicXML.Dot
-- |
type Accidental = Layer1.Accidental_
-- | positive number
type Staff = IntegerNumber
-- |
type Attributes = (Maybe Divisions, [Key], [Time],
    Maybe Staves, Maybe Instruments,
    [Clef], Maybe Transpose)
-- | 
type Editorial = MusicXML.Editorial
-- |
type Divisions = IntegerNumber
-- |
type Key = (Key_, [Layer2.Key_Octave])
-- |
data Key_ = Key_1 (Maybe MusicXML.Cancel, Layer2.Fifths, Maybe Layer2.Mode)
          | Key_2 [(Layer2.Key_Step, Layer2.Key_Alter)]
            deriving (Eq, Show)
-- |
type Time = Time_B
-- |
data Time_B = Time_5 [(Beats, Beat_Type)]
            | Time_6 MusicXML.Senza_Misura
              deriving (Eq, Show)
-- | MusicXML Schema specify "xs:string"
type Beats = (IntegerNumber, Maybe IntegerNumber)
-- | MusicXML Schema specify "xs:string"
type Beat_Type = IntegerNumber
-- |
type Staves = MusicXML.Staves
-- |
type Part_Symbol = MusicXML.Part_Symbol
-- |
type Instruments = MusicXML.Instruments
-- |
type Clef = Layer2.Clef
-- |
type Staff_Details = MusicXML.Staff_Details
-- |
type Transpose = MusicXML.Transpose
-- |
type Directive = MusicXML.Directive
-- |
type Measure_Style = MusicXML.Measure_Style

\end{code} \begin{code}

-- |
abst_Score_Partwise :: Score_Partwise -> Layer2.Score_Partwise
abst_Score_Partwise = 
    (either (const []) (fmap abst_Measure . head) . grd null) . 
    p2 . p2
--(id -|- fmap abst_Measure . head) . grd null . p2 . p2
-- |
abst_Measure :: Measure -> Layer2.Measure
abst_Measure = catMaybes . fmap abst_Music_Data
-- |
abst_Music_Data :: Music_Data -> Maybe Layer2.Music_Data
abst_Music_Data (Music_Data_1 x) = Just (Layer2.Music_Data_1 (abst_Note x))
--    x' <- abst_Note x
--    return (Layer2.Music_Data_1 x')
--    Layer2.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 x) = 
    Just (Layer2.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 -> Layer2.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_ -> Layer2.Note_
--abst_Note_ (Note_1 _) = Nothing
--    Layer2.Note_1 (abst_Grace x1, abst_Full_Note x2, 
--      fmap (abst_Tie >< fmap abst_Tie) x3)
--abst_Note_ (Note_2 _) = Nothing
--    Layer2.Note_2 (abst_Cue x1, abst_Full_Note x2, abst_Duration x3)
abst_Note_ (Note_3 (x1,x2)) = 
    Layer2.Note_3 (abst_Full_Note x1, abst_Duration x2)
--    x1' <- abst_Full_Note x1
--    return (Layer2.Note_3 (x1', abst_Duration x2))
-- |
abst_Full_Note :: Full_Note -> Layer2.Full_Note
abst_Full_Note = abst_Full_Note_ . p2
--    b' <- abst_Full_Note_ b
--    return (fmap id a, b')
--abst_Full_Note :: Full_Note -> 
--      (Maybe Layer2.Chord, Maybe Layer2.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_ -> Layer2.Full_Note_
abst_Full_Note_ (Full_Note_1 x) = (Layer2.Full_Note_1 x)
--abst_Full_Note_ (Full_Note_2 _) = Nothing 
abst_Full_Note_ (Full_Note_3 _) = (Layer2.Full_Note_3 ())
-- |
abst_Duration :: Duration -> Layer2.Duration
abst_Duration = id
-- |
abst_Type :: Type -> Layer2.Type
abst_Type = id
-- |
abst_Dot :: Dot -> Layer2.Dot
abst_Dot = const ()
-- |
abst_Accidental :: Accidental -> Layer2.Accidental
abst_Accidental = id
-- |
abst_Divisions :: Divisions -> Layer2.Divisions
abst_Divisions = id
-- |
abst_Attributes :: Attributes -> Layer2.Attributes
abst_Attributes (x2,x3,x4,_,_,x8,_) = 
    (fmap abst_Divisions x2, fmap abst_Key x3,
     fmap abst_Time x4, fmap abst_Clef x8)
-- |
abst_Key :: Key -> Layer2.Key
abst_Key = (abst_Key_ >< fmap id) 
-- |
abst_Key_ :: Key_ -> Layer2.Key_
abst_Key_ (Key_1 x) = (Layer2.Key_1 . p2 . unflatr) x
abst_Key_ (Key_2 x) = Layer2.Key_2 x
-- |
abst_Time :: Time -> Layer2.Time
abst_Time (Time_5 l) = Layer2.Time_5 l
abst_Time (Time_6 _) = Layer2.Time_5 []
-- |
abst_Clef :: Clef -> Layer2.Clef
abst_Clef = id

\end{code} \begin{code}

-- |
map_Score_Partwise :: (Music_Data -> b) -> Score_Partwise -> 
    (MusicXML.Document_Attributes, (MusicXML.Score_Header, [[[b]]]))
map_Score_Partwise f = (id >< (id >< fmap (map_Part f)))
-- |
map_Part :: (Music_Data -> b) -> Part -> [[b]]
map_Part f = fmap (map_Measure f)
-- |
map_Measure :: (Music_Data -> b) -> Measure -> [b]
map_Measure f = fmap (map_Music_Data f)
-- |
map_Music_Data :: (Music_Data -> b) -> Music_Data -> b
map_Music_Data f = f
--map_Music_Data :: Music_Data -> Music_Data
--map_Music_Data f (Music_Data_1 x) =  f (Music_Data_1 x)
--map_Music_Data f (Music_Data_2 x) =  f (Music_Data_2 x)
--map_Music_Data f (Music_Data_3 x) =  f (Music_Data_3 x)
--map_Music_Data (Music_Data_4 x) =  Music_Data_4 x
--map_Music_Data f (Music_Data_5 x) =  f (Music_Data_5 x)
--map_Music_Data (Music_Data_6 x) =  Music_Data_6 x
--map_Music_Data (Music_Data_7 x) =  Music_Data_7 x
--map_Music_Data (Music_Data_8 x) =  Music_Data_8 x
--map_Music_Data (Music_Data_9 x) =  Music_Data_9 x
--map_Music_Data f (Music_Data_10 x) = f (Music_Data_10 x)
--map_Music_Data (Music_Data_11 x) = Music_Data_11 x
--map_Music_Data (Music_Data_12 x) = Music_Data_12 x
--map_Music_Data (Music_Data_13 x) = Music_Data_13 x

toNum_Music_Data :: Music_Data -> Layer3Num.Music_Data 
toNum_Music_Data (Music_Data_1 x) = Layer3Num.Music_Data_1 (toNum_Note x)
toNum_Music_Data (Music_Data_2 x) = Layer3Num.Music_Data_2 x
toNum_Music_Data (Music_Data_3 x) = Layer3Num.Music_Data_3 x
toNum_Music_Data (Music_Data_5 x) = 
    Layer3Num.Music_Data_5 (toNum_Attributes x)
toNum_Music_Data (Music_Data_10 x) = Layer3Num.Music_Data_10 x

toNum_Note :: Note -> Layer3Num.Note
toNum_Note ((Note_3 (a1,a2)),b,c,d,e,f,g) = 
    ((Layer3Num.Note_3 (toNum_Full_Note a1, a2)),b,c, 
        fmap fromEnum d,e,fmap fromEnum f,g)

toNum_Full_Note :: Full_Note -> Layer3Num.Full_Note
toNum_Full_Note (a,Full_Note_1 (b1, b2, b3)) = 
    (a, Layer3Num.Full_Note_1 ((fromEnum b1)+(b3*7), b2))
toNum_Full_Note (a,Full_Note_3 b) = (a, Layer3Num.Full_Note_3 b)


toNum_Attributes :: Attributes -> Layer3Num.Attributes
toNum_Attributes (a,b,c,d,e,f,g) = 
    (a,fmap toNum_Key b,fmap toNum_Time c,d,e,fmap toNum_Clef f,g)

toNum_Key :: Key -> Layer3Num.Key
toNum_Key (Key_1 (a1,a2,a3),b) = 
    (Layer3Num.Key_1 (a1,a2,fmap toNum_Mode a3),b)
toNum_Key (Key_2 a,b) = 
    (Layer3Num.Key_2 (fmap (\(x,y) -> (fromEnum x,y)) a),b)

toNum_Mode :: Layer2.Mode -> Layer2Num.Mode
toNum_Mode Layer2.Major = Layer2Num.Major 
toNum_Mode Layer2.Minor = Layer2Num.Minor
toNum_Mode Layer2.Dorian = Layer2Num.Dorian
toNum_Mode Layer2.Phrygian = Layer2Num.Phrygian
toNum_Mode Layer2.Lydian = Layer2Num.Lydian 
toNum_Mode Layer2.Mixolydian = Layer2Num.Mixolydian
toNum_Mode Layer2.Aeolian = Layer2Num.Aeolian
toNum_Mode Layer2.Ionian = Layer2Num.Ionian 
toNum_Mode Layer2.Locrian = Layer2Num.Locrian

toNum_Time :: Time -> Layer3Num.Time
toNum_Time (Time_5 a) = Layer3Num.Time_5 a
toNum_Time (Time_6 a) = Layer3Num.Time_6 a

toNum_Clef :: Clef -> Layer2Num.Clef
toNum_Clef (a,b,c) = (fromEnum a, b, c)

\end{code}