packages feed

hamusic-0.1: src/Music/Analysis/MusicXML/Level2Num.lhs

\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 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 Note = (Note_, Maybe Type, [Dot], Maybe Accidental)
-- |
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 = Full_Note_
-- |
data Full_Note_ = Full_Note_1 Pitch
---                | Full_Note_2 Unpitched
                | 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)
-- | 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)
-- |
type Sign = IntegerNumber
--    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
\end{code}


\begin{code}
-- |
abst_Score_Partwise :: Score_Partwise -> Layer1Num.Score_Partwise
abst_Score_Partwise = catMaybes . fmap abst_Music_Data . concat
--(id -|- fmap abst_Measure . head) . grd null . p2 . p2
--- |
--- abst_Measure :: Measure -> Layer1Num.Measure
--- abst_Measure = catMaybes . fmap abst_Music_Data
-- |
abst_Music_Data :: Music_Data -> Maybe Layer1Num.Music_Data
abst_Music_Data (Music_Data_1 x) = Just (Layer1Num.Music_Data_1 (abst_Note x))
--    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
abst_Music_Data (Music_Data_5 _) = Nothing
--    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
-- |
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_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)
abst_Note_ (Note_3 (x1,_)) = Layer1Num.Note_3 (abst_Full_Note x1)
--    x1' <- abst_Full_Note x1
--    return (Layer1Num.Note_3 (x1', abst_Duration x2))
-- |
abst_Full_Note :: Full_Note -> Layer1Num.Full_Note
abst_Full_Note = abst_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
--    ))
-- |
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_2 _) = Nothing 
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))
--catMaybes . fmap abst_Music_Data . concat
--(id -|- fmap abst_Measure . head) . grd null . p2 . p2
--- |
--- abst_Measure :: Measure -> Layer1Num.Measure
--- abst_Measure = catMaybes . fmap abst_Music_Data
-- |
split_Music_Data :: Music_Data -> (Music_Data, Maybe Layer1Num.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
--    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
split_Music_Data (Music_Data_5 x) = split Music_Data_5 (const Nothing) x
--    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
-- |
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))
--    (\(x1,x4,x5,x6) -> 
--        (abst_Note_ x1, fmap abst_Type x4, 
--         fmap abst_Dot x5, fmap abst_Accidental x6)) 
-- |
split_Note_ :: Note_ -> (Duration, Layer1Num.Full_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)
--split_Note_ (Note_3 (x1,x2)) = split (const x2) (Layer1Num.Note_3 (abst_Full_Note x1))
split_Note_ = split p2 (p2 . split_Full_Note . p1) . (\(Note_3 x) -> x)
--split (const x2) (Layer1Num.Note_3 (abst_Full_Note x1))
--    x1' <- abst_Full_Note x1
--    return (Layer1Num.Note_3 (x1', abst_Duration x2))
-- |
split_Full_Note :: Full_Note -> (Full_Note, Layer1Num.Full_Note)
split_Full_Note = split_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
--    ))
-- |
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
--(Layer1Num.Full_Note_1 (split_Pitch x))
--abst_Full_Note_ (Full_Note_2 _) = Nothing 
split_Full_Note_ (Full_Note_3 x) = split Full_Note_3 (Layer1Num.Full_Note_3) x
--(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><i1) . unflatl) >< map (flatl . (id><i2) . unflatl)) . 
    (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}