-- | 
-- Maintainer : silva.samuel@alumni.uminho.pt
-- Stability  : experimental
-- Portability: portable
-- This module implements 
module Music.Analysis.MusicXML2ABC  where
import Music.Analysis.PF
import Music.Analysis.MusicXML.Level2 as Level2
import Music.Analysis.MusicXML.Level1 as Level1
import Music.Analysis.ABC as ABC
import Data.Ratio

mk_Pitch :: Level1.Step -> ABC.Pitch
mk_Pitch x = case x of
    Level1.C -> ABC.C; Level1.D -> ABC.D; 
    Level1.E -> ABC.E; Level1.F -> ABC.F; 
    Level1.G -> ABC.G; Level1.A -> ABC.A; Level1.B -> ABC.B; 

mk_Accident :: Maybe Level1.Alter -> Maybe Level2.Accidental -> ABC.Accident
mk_Accident Nothing _ = ABC.Accident Nothing
mk_Accident (Just n) _ | n > 0 = ABC.Accident (Just (ABC.Sharp (truncate n)))
                       | n < 0 = ABC.Accident (Just (ABC.Flat (truncate n)))
                       | otherwise = ABC.Accident (Just (ABC.Natural))

mk_Duration :: Int -> Level2.Duration -> Maybe Level2.Type -> [Level2.Dot] 
    -> ABC.Duration
mk_Duration n x _ _ = 
--    let d = duration (x%n, (length ly) % 1)
    let d = duration (x%n, (0::Int) % 1) 
    in Duration (numerator d, denominator d)
    where duration = hyloL 
            (maybe 0 (uncurry (+))) 
            (e2m . (const () -|- split p1 ((/2) >< pred)) . grd ((<=0).p2)) .
            (id >< succ)
--            where pred x = x - 1
--                  succ x = x + 1    

mk_Octave :: Level1.Octave -> ABC.Octave
mk_Octave o = Octave (o - 4)

mk_Dotted :: [Level1.Dot] -> ABC.Dotted
mk_Dotted _ = ABC.Increase 0

mk_Note :: Int -> Level2.Note -> ABC.ABCNote
mk_Note n (Level2.Note_3 (Level2.Full_Note_1 (ax,ay,az),a2),b,c,d) = 
    ABC.Pitch (mk_Pitch ax) (mk_Octave az) (mk_Accident ay d) 
                    (mk_Duration n a2 b c) (mk_Dotted c)
mk_Note n (Level2.Note_3 (Level2.Full_Note_3 _,a2),b,c,_) = 
    ABC.Rest True (mk_Duration n a2 b c)

mk_Music :: Level2.Score_Partwise -> ABC.ABCMusic
--    Motive (Melodic.MelodicClass, Rhythm.RhythmAbsolute)
--    [(Melodic.MelodicClass, Rhythm.RhythmAbsolute)]
mk_Music musicxml = 
    ABC.ABCMusic (mk_MetaData musicxml) (mk_MusicDatas 1 musicxml)
--                 ((mk_MusicData 1) (concat musicxml))

mk_MusicDatas :: Int -> [[Level2.Music_Data]] -> [ABC.ABCMusicData]
--mk_MusicDatas musicxml = --((mk_MusicData 1) (concat musicxml))
mk_MusicDatas _ [] = []
mk_MusicDatas n (x:xs) = 
    let n' = get_Divisions_MusicData x 
    in mk_MusicData n x ++ ABC.Bar : mk_MusicDatas (maybe n id n') xs
    
--        (foldr (\a b -> let (x,y) = mk_MusicData 1 a in y ++ ABC.Bar : y) [] musicxml)
--                 (foldr (\a b -> mk_MusicData 1 a ++ ABC.Bar : b) [] musicxml) --(mk_MusicData 1) (concat musicxml))

mk_MetaData :: Level2.Score_Partwise -> ABC.ABCMetaData
mk_MetaData s = ABC.ABCMetaData (ABC.ABCIndex "1") (mk_Title s)
                                (get_Meter_MusicData (concat s))
                                (get_Key_MusicData (concat s))
                                ABC.ABCL

mk_Title :: Level2.Score_Partwise -> ABC.ABCTitle
mk_Title _ = ABC.ABCTitle "no title"

mk_Meter :: Level2.Time -> ABC.ABCMeter
mk_Meter (Level2.Time_5 l) = (ABC.ABCMeter . unwords) 
    (map (\((a,b),c) -> maybe "" (\y -> show y ++ "+") b ++ 
                        show a ++ "/" ++ show c) l)

get_Meter_MusicData :: [Level2.Music_Data] -> ABC.ABCMeter
get_Meter_MusicData = foldr 
    (\a b -> case a of;Level2.Music_Data_5 x -> get_Meter x;_ -> b) (ABC.ABCMeter "C")

get_Meter :: Level2.Attributes -> ABC.ABCMeter
get_Meter (_,_,[],_) = ABC.ABCMeter "C"
get_Meter (_,_,(x:_),_) = mk_Meter x

get_Key_MusicData :: [Level2.Music_Data] -> ABC.ABCKey
get_Key_MusicData = foldr 
    (\a b -> case a of;Level2.Music_Data_5 x -> get_Key x;_ -> b) (ABC.ABCKey "MusicDataC")

get_Key :: Level2.Attributes -> ABC.ABCKey
get_Key (_,[],_,_) = ABC.ABCKey "C"
get_Key (_,((Key_1 (a,b),_):_),_,_) = 
    ABC.ABCKey (get_KeyN (a + (maybe 0 get_Key_adjust b)) ++ maybe [] get_Key_1b b)
--ABC.ABCKey (show a ++ maybe [] get_Key_1b b)
get_Key (_,((Key_2 [],_):_),_,_) = ABC.ABCKey "Key2"
get_Key (_,((Key_2 ((a,b):_),_):_),_,_) = ABC.ABCKey (show a ++ show b)

get_KeyN :: Int -> String
get_KeyN (-8) = "Fb"
get_KeyN (-7) = "Cb"
get_KeyN (-6) = "Gb"
get_KeyN (-5) = "Db"
get_KeyN (-4) = "Ab"
get_KeyN (-3) = "Eb"
get_KeyN (-2) = "Bb"
get_KeyN (-1) = "F"
get_KeyN 0 = "C"
get_KeyN 1 = "G"
get_KeyN 2 = "D"
get_KeyN 3 = "A"
get_KeyN 4 = "E"
get_KeyN 5 = "B"
get_KeyN 6 = "F#"
get_KeyN 7 = "C#"
get_KeyN 8 = "G#"
get_KeyN 9 = "D#"
get_KeyN 10 = "A#"
get_KeyN 11 = "E#"
get_KeyN 12 = "B#"
get_KeyN _ = "KeyN"

get_Key_1b :: Level2.Mode -> String
get_Key_1b (Major) = ""
get_Key_1b (Minor) = "m"
get_Key_1b m = take 3 (show m)

get_Key_adjust :: Level2.Mode -> Int
get_Key_adjust Major = 0
get_Key_adjust Minor = 3
get_Key_adjust Ionian = 0
get_Key_adjust Aeolian = 3
get_Key_adjust Mixolydian = 1
get_Key_adjust Dorian = 2
get_Key_adjust Phrygian = 4
get_Key_adjust Lydian = (-1)
get_Key_adjust Locrian = (-2)

--mk_MusicData :: [Level2.Music_Data] ->     
--    [(Melodic.MelodicClass, Rhythm.RhythmAbsolute)]
mk_MusicData :: Int -> [Level2.Music_Data] -> [ABC.ABCMusicData]
mk_MusicData _ [] = []
mk_MusicData n ((Level2.Music_Data_1 x):xs) = 
    (ABC.Single (mk_Note n x)) : (mk_MusicData n xs)
mk_MusicData n ((Level2.Music_Data_5 x):xs) = 
    let n' = (maybe n id (get_Divisions x)) in mk_MusicData n' xs

--    map (ABC.Single . mk_Note)
--    map mk_Note . map (\(Level2.Music_Data_1 x) -> x) . filter p 
--    where p (Level2.Music_Data_1 _) = True
--          p _ = False

get_Divisions :: Level2.Attributes -> Maybe Int
get_Divisions (Nothing,_,_,_) = Nothing
get_Divisions (Just n,_,_,_) = Just (n)

get_Divisions_MusicData :: [Level2.Music_Data] -> Maybe Int
get_Divisions_MusicData = foldr 
    (\a b -> case a of;Level2.Music_Data_5 x -> get_Divisions x;_ -> b) Nothing