hamusic-0.1: src/Music/Analysis/MusicXML/Level3Num.lhs
\begin{code}
module Music.Analysis.MusicXML.Level3Num (
module Music.Analysis.MusicXML.Level3Num,
)where
import Music.Analysis.Base
import Music.Analysis.PF
import qualified Music.Analysis.MusicXML.Level1Num as Layer1Num
import qualified Music.Analysis.MusicXML.Level2Num as Layer2Num
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_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 Barline = MusicXML.Barline
-- |
type Note =
(Note_, Maybe Instrument, Editorial_Voice,
Maybe Type, [Dot], Maybe Accidental,
Maybe Staff)
-- |
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 = (Maybe MusicXML.Chord, Full_Note_)
-- |
data Full_Note_ = Full_Note_1 Layer2Num.Pitch
--- | Full_Note_2 Unpitched
| Full_Note_3 Rest
deriving (Eq, Show)
-- |
type Rest = () -- MusicXML.Rest
-- |
type Duration = IntegerNumber
-- |
type Editorial_Voice = MusicXML.Editorial_Voice
-- |
type Instrument = MusicXML.Instrument
-- |
type Type = Layer1Num.Type_
-- |
type Dot = MusicXML.Dot
-- |
type Accidental = Layer1Num.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_, [IntegerNumber])
-- |
data Key_ = Key_1 (Maybe MusicXML.Cancel, Layer2Num.Fifths, Maybe Layer2Num.Mode)
| Key_2 [(IntegerNumber, Number)]
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 = Layer2Num.Clef
--(Sign, Maybe Line, Clef_Octave_Change)
-- |
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 -> Layer2Num.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 -> Layer2Num.Measure
abst_Measure = catMaybes . fmap abst_Music_Data
-- |
abst_Music_Data :: Music_Data -> Maybe Layer2Num.Music_Data
abst_Music_Data (Music_Data_1 x) = Just (Layer2Num.Music_Data_1 (abst_Note x))
-- x' <- abst_Note x
-- return (Layer2Num.Music_Data_1 x')
-- Layer2Num.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 (Layer2Num.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 -> Layer2Num.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_ -> Layer2Num.Note_
--abst_Note_ (Note_1 _) = Nothing
-- Layer2Num.Note_1 (abst_Grace x1, abst_Full_Note x2,
-- fmap (abst_Tie >< fmap abst_Tie) x3)
--abst_Note_ (Note_2 _) = Nothing
-- Layer2Num.Note_2 (abst_Cue x1, abst_Full_Note x2, abst_Duration x3)
abst_Note_ (Note_3 (x1,x2)) =
Layer2Num.Note_3 (abst_Full_Note x1, abst_Duration x2)
-- x1' <- abst_Full_Note x1
-- return (Layer2Num.Note_3 (x1', abst_Duration x2))
-- |
abst_Full_Note :: Full_Note -> Layer2Num.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 Layer2Num.Chord, Maybe Layer2Num.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_ -> Layer2Num.Full_Note_
abst_Full_Note_ (Full_Note_1 x) = (Layer2Num.Full_Note_1 x)
--abst_Full_Note_ (Full_Note_2 _) = Nothing
abst_Full_Note_ (Full_Note_3 _) = (Layer2Num.Full_Note_3 ())
-- |
abst_Duration :: Duration -> Layer2Num.Duration
abst_Duration = id
-- |
abst_Type :: Type -> Layer2Num.Type
abst_Type = id
-- |
abst_Dot :: Dot -> Layer2Num.Dot
abst_Dot = const ()
-- |
abst_Accidental :: Accidental -> Layer2Num.Accidental
abst_Accidental = id
-- |
abst_Divisions :: Divisions -> Layer2Num.Divisions
abst_Divisions = id
-- |
abst_Attributes :: Attributes -> Layer2Num.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 -> Layer2Num.Key
abst_Key = (abst_Key_ >< fmap id)
-- |
abst_Key_ :: Key_ -> Layer2Num.Key_
abst_Key_ (Key_1 x) = (Layer2Num.Key_1 . p2 . unflatr) x
abst_Key_ (Key_2 x) = Layer2Num.Key_2 x
-- |
abst_Time :: Time -> Layer2Num.Time
abst_Time (Time_5 l) = Layer2Num.Time_5 l
abst_Time (Time_6 _) = Layer2Num.Time_5 []
-- |
abst_Clef :: Clef -> Layer2Num.Clef
abst_Clef = id
\end{code}
\begin{code}
-- |
map_Score_Partwise :: (Music_Data -> Music_Data) ->
Score_Partwise -> Score_Partwise
map_Score_Partwise f = (id >< (id >< fmap (map_Part f)))
-- |
map_Part :: (Music_Data -> Music_Data) -> Part -> Part
map_Part f = fmap (map_Measure f)
-- |
map_Measure :: (Music_Data -> Music_Data) -> Measure -> Measure
map_Measure f = fmap (map_Music_Data f)
-- |
map_Music_Data :: (Music_Data -> Music_Data) -> Music_Data -> Music_Data
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
\end{code}
\begin{nocode}
-- |
type Music = [Part]
-- |
type Part = (PartName, [Measure])
-- |
type PartName = Text
-- |
type Measure = [Either Attributes Note]
-- |
type Attributes = (Maybe Divisions, [Key], [Time], [Clef])
-- |
type Note = ((Maybe Chord, Maybe Instrument, Maybe Staff, Maybe Voice),
((Either Pitch Rest, Accidental), ((Duration, Maybe Type), Dots)))
-- |
type Chord = ()
-- |
type Instrument = Text
-- |
type Staff = Text
-- |
type Voice = Text
\end{nocode}
\begin{nocode}
rep :: Layer2Num.Music -> Music
rep = (:[]) .
split (const "noPartName")
((map . map) (rep_Settings -||- rep_Note)) where
rep_Settings :: Layer2Num.Settings -> Settings
rep_Settings = flatl .
(( e2m . (id -|- (rep_ClefSign >< id)) . m2e ><
e2m . (id -|- (id >< rep_KeyMode)) . m2e) >< id) .
unflatl
rep_Note :: Layer2Num.Note -> Note
rep_Note = split (const (Nothing, Nothing, Nothing))
((rep_Pitch -|- id) >< (rep_Type >< id))
rep_Pitch :: Layer2Num.Pitch -> Pitch
rep_Pitch = flatl .
((rep_Step >< e2m . (id -|- rep_Accidental) . m2e) >< id) .
unflatl
rep_Step :: Layer2Num.Step -> Step
rep_Step Layer2Num.A = A
rep_Step Layer2Num.B = B
rep_Step Layer2Num.C = C
rep_Step Layer2Num.D = D
rep_Step Layer2Num.E = E
rep_Step Layer2Num.F = F
rep_Step Layer2Num.G = G
rep_Type :: Layer2Num.Type -> Type
rep_Type Layer2Num.Whole = Whole
rep_Type Layer2Num.Half = Half
rep_Type Layer2Num.Quarter = Quarter
rep_Type Layer2Num.Eighth = Eighth
rep_Type Layer2Num.Th16 = Th16
rep_Type Layer2Num.Th32 = Th32
rep_Type Layer2Num.Th64 = Th64
-- ||
rep_Accidental :: Layer2Num.Accidental -> Accidental
rep_Accidental Layer2Num.DoubleFlat = DoubleFlat
rep_Accidental Layer2Num.Flat = Flat
rep_Accidental Layer2Num.Natural = Natural
rep_Accidental Layer2Num.Sharp = Sharp
rep_Accidental Layer2Num.DoubleSharp = DoubleSharp
-- ||
rep_ClefSign :: Layer2Num.ClefSign -> ClefSign
rep_ClefSign Layer2Num.SignC = SignC
rep_ClefSign Layer2Num.SignF = SignF
rep_ClefSign Layer2Num.SignG = SignG
-- ||
rep_KeyMode :: Layer2Num.KeyMode -> KeyMode
rep_KeyMode Layer2Num.Major = Major
rep_KeyMode Layer2Num.Minor = Minor
\end{nocode}
\begin{nocode}
abst :: Music -> Layer2Num.Music
abst = cond null (const [])
((map . map) (abst_Settings -|- abst_Note) . p2 . head) where
abst_Settings :: Settings -> Layer2Num.Settings
abst_Settings = flatl .
(( e2m . (id -|- (abst_ClefSign >< id)) . m2e ><
e2m . (id -|- (id >< abst_KeyMode)) . m2e) >< id) .
unflatl
abst_Note :: Note -> Layer2Num.Note
abst_Note = ((abst_Pitch -|- id) >< (abst_Type >< id)) . p2
abst_Pitch :: Pitch -> Layer2Num.Pitch
abst_Pitch = (flatl .
((abst_Step >< e2m . (id -||- abst_Accidental) . m2e) >< id) .
unflatl)
abst_Step :: Step -> Layer2Num.Step
abst_Step A = Layer2Num.A
abst_Step B = Layer2Num.B
abst_Step C = Layer2Num.C
abst_Step D = Layer2Num.D
abst_Step E = Layer2Num.E
abst_Step F = Layer2Num.F
abst_Step G = Layer2Num.G
abst_Type :: Type -> Layer2Num.Type
abst_Type Whole = Layer2Num.Whole
abst_Type Half = Layer2Num.Half
abst_Type Quarter = Layer2Num.Quarter
abst_Type Eighth = Layer2Num.Eighth
abst_Type Th16 = Layer2Num.Th16
abst_Type Th32 = Layer2Num.Th32
abst_Type Th64 = Layer2Num.Th64
abst_Accidental :: Accidental -> Layer2Num.Accidental
abst_Accidental DoubleFlat = Layer2Num.DoubleFlat
abst_Accidental Flat = Layer2Num.Flat
abst_Accidental Natural = Layer2Num.Natural
abst_Accidental Sharp = Layer2Num.Sharp
abst_Accidental DoubleSharp = Layer2Num.DoubleSharp
abst_ClefSign :: ClefSign -> Layer2Num.ClefSign
abst_ClefSign SignC = Layer2Num.SignC
abst_ClefSign SignF = Layer2Num.SignF
abst_ClefSign SignG = Layer2Num.SignG
abst_KeyMode :: KeyMode -> Layer2Num.KeyMode
abst_KeyMode Major = Layer2Num.Major
abst_KeyMode Minor = Layer2Num.Minor
\end{nocode}
\begin{nocode}
--mapLayer2Num :: (Layer2Num.Music -> Layer2Num.Music) -> Music -> Music
-- [(Text, [[Either Settings (Either Pitch Rest)]])]
--mapLayer2Num :: (Layer2Num.Music -> Layer2Num.Music) -> Music ->
-- [(PartName, ([[Either Settings (Maybe Instrument, Maybe Staff, Maybe Voice)]],
-- [[Either Settings (Either Pitch Rest, (Type, Dots))]]))]
mapLayer2Num :: ([[Either Settings (a,(Either Pitch Rest,(Type, Dots)))]] ->
[[Either Settings (a,(Either Pitch Rest,(Type, Dots)))]]) -> Music -> Music
mapLayer2Num f =
map (id >< (map.map) aux1) .
map (id >< map (uncurry zip) . uncurry zip ) . map (unflatr . flatl) .
map (id >< post2 . f . pre2) . map (unflatl . flatr) .
map (id ><
split ((map.map) ((id -|- p1))) ((map.map) (id -|- p2)))
where
aux1 :: (Either b a, Either b c) -> Either b (a,c)
aux1 (Right a, Right c) = Right (a,c)
aux1 (Left b, _) = Left b
aux1 (_, Left b) = Left b
pre2 :: [[Either Settings (Either Pitch Rest, (Type, Dots))]] ->
[[Either Settings (Either Pitch Rest, (Type, Dots))]]
pre2 = (map . map) (id -|- id) -- where
-- abst_Settings :: Settings -> Layer2Num.Settings
-- abst_Settings = flatl .
-- (( e2m . (id -|- (abst_ClefSign >< id)) . m2e ><
-- e2m . (id -|- (id >< abst_KeyMode)) . m2e) >< id) .
-- unflatl
-- abst_Note :: (Either Pitch Rest, (Type, Dots)) -> Layer2Num.Note
-- abst_Note = ((abst_Pitch -|- id) >< (abst_Type >< id))
-- abst_Pitch :: Pitch -> Layer2Num.Pitch
-- abst_Pitch = (flatl .
-- ((abst_Step >< e2m .(id -|- abst_Accidental). m2e) >< id) .
-- unflatl)
post2 :: [[Either Settings (Either Pitch Rest, (Type, Dots))]] ->
[[Either Settings (Either Pitch Rest, (Type, Dots))]]
post2 = ((map . map) (id -|- id)) -- where
-- rep_Settings :: Layer2Num.Settings -> Settings
-- rep_Settings = flatl .
-- (( e2m . (id -|- (rep_ClefSign >< id)) . m2e ><
-- e2m . (id -|- (id >< rep_KeyMode)) . m2e) >< id) .
-- unflatl
-- rep_Note :: Layer2Num.Note -> (Either Pitch Rest, (Type, Dots))
-- rep_Note = ((rep_Pitch -|- id) >< (rep_Type >< id))
-- rep_Pitch :: Layer2Num.Pitch -> Pitch
-- rep_Pitch = flatl .
-- ((rep_Step >< e2m . (id -|- rep_Accidental) . m2e) >< id) .
-- unflatl
\end{nocode}
\begin{nocode}
mapLayer2' :: (Either Attributes Note -> Either Attributes Note) ->
Music -> Music
mapLayer2' f =
-- map (id >< (map . map) (id -|- swap)) .
map (id >< (map . map) (post2 . f . pre2))
-- map (id >< (map . map) )
where
pre2 :: Either a Note -> Either a Note
pre2 = (id -|- (id >< id)) -- where
-- abst_Settings :: Settings -> Layer2Num.Settings
-- abst_Settings = flatl .
-- (( e2m . (id -|- (abst_ClefSign >< id)) . m2e ><
-- e2m . (id -|- (id >< abst_KeyMode)) . m2e) >< id) .
-- unflatl
-- abst_Note :: (Either Pitch Rest, (Type, Dots)) -> Layer2Num.Note
-- abst_Note = ((abst_Pitch -|- id) >< (abst_Type >< id))
-- abst_Pitch :: Pitch -> Layer2Num.Pitch
-- abst_Pitch = (flatl .
-- ((abst_Step >< e2m .(id -|- abst_Accidental). m2e) >< id) .
-- unflatl)
post2 :: Either a Note -> Either a Note
post2 = (id -|- (id >< id)) -- where
-- rep_Settings :: Layer2Num.Settings -> Settings
-- rep_Settings = flatl .
-- (( e2m . (id -|- (rep_ClefSign >< id)) . m2e ><
-- e2m . (id -|- (id >< rep_KeyMode)) . m2e) >< id) .
-- unflatl
-- rep_Note :: Layer2Num.Note -> (Either Pitch Rest, (Type, Dots))
-- rep_Note = ((rep_Pitch -|- id) >< (rep_Type >< id))
-- rep_Pitch :: Layer2Num.Pitch -> Pitch
-- rep_Pitch = flatl .
-- ((rep_Step >< e2m . (id -|- rep_Accidental) . m2e) >< id) .
-- unflatl
-- map (id >< (map . map) (id -|- swap))
\end{nocode}