packages feed

music-sibelius 1.6.2 → 1.7

raw patch · 3 files changed

+432/−432 lines, 3 filesdep ~lensdep ~music-pitch-literaldep ~music-preludesPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: lens, music-pitch-literal, music-preludes, music-score

API changes (from Hackage documentation)

- Music.Score.Import.Sibelius: fromSibelius :: IsSibelius a => SibeliusScore -> Score a
- Music.Score.Import.Sibelius: readSibelius :: IsSibelius a => FilePath -> IO (Score a)
- Music.Score.Import.Sibelius: readSibeliusEither :: IsSibelius a => FilePath -> IO (Either String (Score a))
- Music.Score.Import.Sibelius: readSibeliusMaybe :: IsSibelius a => FilePath -> IO (Maybe (Score a))
- Music.Score.Import.Sibelius: type IsSibelius a = (IsPitch a, HasPart' a, Enum (Part a), HasPitch' a, Num (Pitch a), HasTremolo a, HasArticulation a, HasText a, Tiable a)
- Music.Sibelius: Accent :: SibeliusArticulation
- Music.Sibelius: DownBow :: SibeliusArticulation
- Music.Sibelius: Harmonic :: SibeliusArticulation
- Music.Sibelius: Marcato :: SibeliusArticulation
- Music.Sibelius: Plus :: SibeliusArticulation
- Music.Sibelius: SibeliusBar :: [SibeliusBarObject] -> SibeliusBar
- Music.Sibelius: SibeliusBarObjectChord :: SibeliusChord -> SibeliusBarObject
- Music.Sibelius: SibeliusBarObjectClef :: SibeliusClef -> SibeliusBarObject
- Music.Sibelius: SibeliusBarObjectCrescendoLine :: SibeliusCrescendoLine -> SibeliusBarObject
- Music.Sibelius: SibeliusBarObjectDiminuendoLine :: SibeliusDiminuendoLine -> SibeliusBarObject
- Music.Sibelius: SibeliusBarObjectKeySignature :: SibeliusKeySignature -> SibeliusBarObject
- Music.Sibelius: SibeliusBarObjectSlur :: SibeliusSlur -> SibeliusBarObject
- Music.Sibelius: SibeliusBarObjectText :: SibeliusText -> SibeliusBarObject
- Music.Sibelius: SibeliusBarObjectTimeSignature :: SibeliusTimeSignature -> SibeliusBarObject
- Music.Sibelius: SibeliusBarObjectTuplet :: SibeliusTuplet -> SibeliusBarObject
- Music.Sibelius: SibeliusChord :: Int -> Int -> Int -> [SibeliusArticulation] -> Int -> Int -> Bool -> Bool -> [SibeliusNote] -> SibeliusChord
- Music.Sibelius: SibeliusClef :: Int -> Int -> String -> SibeliusClef
- Music.Sibelius: SibeliusCrescendoLine :: Int -> Int -> Int -> String -> SibeliusCrescendoLine
- Music.Sibelius: SibeliusDiminuendoLine :: Int -> Int -> Int -> String -> SibeliusDiminuendoLine
- Music.Sibelius: SibeliusKeySignature :: Int -> Int -> Bool -> Int -> Bool -> SibeliusKeySignature
- Music.Sibelius: SibeliusNote :: Int -> Int -> Int -> Bool -> Int -> SibeliusNote
- Music.Sibelius: SibeliusScore :: String -> String -> String -> Double -> Bool -> [SibeliusStaff] -> () -> SibeliusScore
- Music.Sibelius: SibeliusSlur :: Int -> Int -> Int -> String -> SibeliusSlur
- Music.Sibelius: SibeliusStaff :: [SibeliusBar] -> String -> String -> SibeliusStaff
- Music.Sibelius: SibeliusText :: Int -> Int -> String -> String -> SibeliusText
- Music.Sibelius: SibeliusTimeSignature :: Int -> Int -> Rational -> Bool -> Bool -> SibeliusTimeSignature
- Music.Sibelius: SibeliusTuplet :: Int -> Int -> Int -> Int -> Rational -> SibeliusTuplet
- Music.Sibelius: Staccatissimo :: SibeliusArticulation
- Music.Sibelius: Staccato :: SibeliusArticulation
- Music.Sibelius: Tenuto :: SibeliusArticulation
- Music.Sibelius: UpBow :: SibeliusArticulation
- Music.Sibelius: Wedge :: SibeliusArticulation
- Music.Sibelius: barElements :: SibeliusBar -> [SibeliusBarObject]
- Music.Sibelius: chordAcciaccatura :: SibeliusChord -> Bool
- Music.Sibelius: chordAppoggiatura :: SibeliusChord -> Bool
- Music.Sibelius: chordArticulations :: SibeliusChord -> [SibeliusArticulation]
- Music.Sibelius: chordDoubleTremolos :: SibeliusChord -> Int
- Music.Sibelius: chordDuration :: SibeliusChord -> Int
- Music.Sibelius: chordNotes :: SibeliusChord -> [SibeliusNote]
- Music.Sibelius: chordPosition :: SibeliusChord -> Int
- Music.Sibelius: chordSingleTremolos :: SibeliusChord -> Int
- Music.Sibelius: chordVoice :: SibeliusChord -> Int
- Music.Sibelius: clefPosition :: SibeliusClef -> Int
- Music.Sibelius: clefStyle :: SibeliusClef -> String
- Music.Sibelius: clefVoice :: SibeliusClef -> Int
- Music.Sibelius: crescDuration :: SibeliusCrescendoLine -> Int
- Music.Sibelius: crescPosition :: SibeliusCrescendoLine -> Int
- Music.Sibelius: crescStyle :: SibeliusCrescendoLine -> String
- Music.Sibelius: crescVoice :: SibeliusCrescendoLine -> Int
- Music.Sibelius: data SibeliusArticulation
- Music.Sibelius: data SibeliusBar
- Music.Sibelius: data SibeliusBarObject
- Music.Sibelius: data SibeliusChord
- Music.Sibelius: data SibeliusClef
- Music.Sibelius: data SibeliusCrescendoLine
- Music.Sibelius: data SibeliusDiminuendoLine
- Music.Sibelius: data SibeliusKeySignature
- Music.Sibelius: data SibeliusNote
- Music.Sibelius: data SibeliusScore
- Music.Sibelius: data SibeliusSlur
- Music.Sibelius: data SibeliusStaff
- Music.Sibelius: data SibeliusText
- Music.Sibelius: data SibeliusTimeSignature
- Music.Sibelius: data SibeliusTuplet
- Music.Sibelius: dimDuration :: SibeliusDiminuendoLine -> Int
- Music.Sibelius: dimPosition :: SibeliusDiminuendoLine -> Int
- Music.Sibelius: dimStyle :: SibeliusDiminuendoLine -> String
- Music.Sibelius: dimVoice :: SibeliusDiminuendoLine -> Int
- Music.Sibelius: instance Enum SibeliusArticulation
- Music.Sibelius: instance Eq SibeliusArticulation
- Music.Sibelius: instance Eq SibeliusBar
- Music.Sibelius: instance Eq SibeliusBarObject
- Music.Sibelius: instance Eq SibeliusChord
- Music.Sibelius: instance Eq SibeliusClef
- Music.Sibelius: instance Eq SibeliusCrescendoLine
- Music.Sibelius: instance Eq SibeliusDiminuendoLine
- Music.Sibelius: instance Eq SibeliusKeySignature
- Music.Sibelius: instance Eq SibeliusNote
- Music.Sibelius: instance Eq SibeliusScore
- Music.Sibelius: instance Eq SibeliusSlur
- Music.Sibelius: instance Eq SibeliusStaff
- Music.Sibelius: instance Eq SibeliusText
- Music.Sibelius: instance Eq SibeliusTimeSignature
- Music.Sibelius: instance Eq SibeliusTuplet
- Music.Sibelius: instance FromJSON SibeliusBar
- Music.Sibelius: instance FromJSON SibeliusBarObject
- Music.Sibelius: instance FromJSON SibeliusChord
- Music.Sibelius: instance FromJSON SibeliusClef
- Music.Sibelius: instance FromJSON SibeliusCrescendoLine
- Music.Sibelius: instance FromJSON SibeliusDiminuendoLine
- Music.Sibelius: instance FromJSON SibeliusKeySignature
- Music.Sibelius: instance FromJSON SibeliusNote
- Music.Sibelius: instance FromJSON SibeliusScore
- Music.Sibelius: instance FromJSON SibeliusSlur
- Music.Sibelius: instance FromJSON SibeliusStaff
- Music.Sibelius: instance FromJSON SibeliusText
- Music.Sibelius: instance FromJSON SibeliusTimeSignature
- Music.Sibelius: instance FromJSON SibeliusTuplet
- Music.Sibelius: instance Ord SibeliusArticulation
- Music.Sibelius: instance Ord SibeliusBar
- Music.Sibelius: instance Ord SibeliusBarObject
- Music.Sibelius: instance Ord SibeliusChord
- Music.Sibelius: instance Ord SibeliusClef
- Music.Sibelius: instance Ord SibeliusCrescendoLine
- Music.Sibelius: instance Ord SibeliusDiminuendoLine
- Music.Sibelius: instance Ord SibeliusKeySignature
- Music.Sibelius: instance Ord SibeliusNote
- Music.Sibelius: instance Ord SibeliusScore
- Music.Sibelius: instance Ord SibeliusSlur
- Music.Sibelius: instance Ord SibeliusStaff
- Music.Sibelius: instance Ord SibeliusText
- Music.Sibelius: instance Ord SibeliusTimeSignature
- Music.Sibelius: instance Ord SibeliusTuplet
- Music.Sibelius: instance Show SibeliusArticulation
- Music.Sibelius: instance Show SibeliusBar
- Music.Sibelius: instance Show SibeliusBarObject
- Music.Sibelius: instance Show SibeliusChord
- Music.Sibelius: instance Show SibeliusClef
- Music.Sibelius: instance Show SibeliusCrescendoLine
- Music.Sibelius: instance Show SibeliusDiminuendoLine
- Music.Sibelius: instance Show SibeliusKeySignature
- Music.Sibelius: instance Show SibeliusNote
- Music.Sibelius: instance Show SibeliusScore
- Music.Sibelius: instance Show SibeliusSlur
- Music.Sibelius: instance Show SibeliusStaff
- Music.Sibelius: instance Show SibeliusText
- Music.Sibelius: instance Show SibeliusTimeSignature
- Music.Sibelius: instance Show SibeliusTuplet
- Music.Sibelius: keyIsOpen :: SibeliusKeySignature -> Bool
- Music.Sibelius: keyMajor :: SibeliusKeySignature -> Bool
- Music.Sibelius: keyPosition :: SibeliusKeySignature -> Int
- Music.Sibelius: keySharps :: SibeliusKeySignature -> Int
- Music.Sibelius: keyVoice :: SibeliusKeySignature -> Int
- Music.Sibelius: noteAccidental :: SibeliusNote -> Int
- Music.Sibelius: noteDiatonicPitch :: SibeliusNote -> Int
- Music.Sibelius: notePitch :: SibeliusNote -> Int
- Music.Sibelius: noteStyle :: SibeliusNote -> Int
- Music.Sibelius: noteTied :: SibeliusNote -> Bool
- Music.Sibelius: readSibeliusArticulation :: String -> Maybe SibeliusArticulation
- Music.Sibelius: scoreComposer :: SibeliusScore -> String
- Music.Sibelius: scoreInformation :: SibeliusScore -> String
- Music.Sibelius: scoreStaffHeight :: SibeliusScore -> Double
- Music.Sibelius: scoreStaves :: SibeliusScore -> [SibeliusStaff]
- Music.Sibelius: scoreSystemStaff :: SibeliusScore -> ()
- Music.Sibelius: scoreTitle :: SibeliusScore -> String
- Music.Sibelius: scoreTransposing :: SibeliusScore -> Bool
- Music.Sibelius: slurDuration :: SibeliusSlur -> Int
- Music.Sibelius: slurPosition :: SibeliusSlur -> Int
- Music.Sibelius: slurStyle :: SibeliusSlur -> String
- Music.Sibelius: slurVoice :: SibeliusSlur -> Int
- Music.Sibelius: staffBars :: SibeliusStaff -> [SibeliusBar]
- Music.Sibelius: staffName :: SibeliusStaff -> String
- Music.Sibelius: staffShortName :: SibeliusStaff -> String
- Music.Sibelius: textPosition :: SibeliusText -> Int
- Music.Sibelius: textStyle :: SibeliusText -> String
- Music.Sibelius: textText :: SibeliusText -> String
- Music.Sibelius: textVoice :: SibeliusText -> Int
- Music.Sibelius: timeIsAllaBreve :: SibeliusTimeSignature -> Bool
- Music.Sibelius: timeIsCommon :: SibeliusTimeSignature -> Bool
- Music.Sibelius: timePosition :: SibeliusTimeSignature -> Int
- Music.Sibelius: timeValue :: SibeliusTimeSignature -> Rational
- Music.Sibelius: timeVoice :: SibeliusTimeSignature -> Int
- Music.Sibelius: tupletDuration :: SibeliusTuplet -> Int
- Music.Sibelius: tupletPlayedDuration :: SibeliusTuplet -> Int
- Music.Sibelius: tupletPosition :: SibeliusTuplet -> Int
- Music.Sibelius: tupletValue :: SibeliusTuplet -> Rational
- Music.Sibelius: tupletVoice :: SibeliusTuplet -> Int

Files

music-sibelius.cabal view
@@ -1,6 +1,6 @@  name:                   music-sibelius-version:                1.6.2+version:                1.7 author:                 Hans Hoglund maintainer:             Hans Hoglund <hans@hanshoglund.se> license:                BSD3@@ -23,13 +23,13 @@ library                         build-depends:      base                     >= 4 && < 5,                         semigroups               >= 0.13.0.1 && < 1,-                        lens                     >= 4.0 && < 4.1,+                        lens				            >= 4.1.2 && < 4.2,                         monadplus,                         unordered-containers,                         bytestring,-                        music-score              == 1.6.2,-                        music-pitch-literal      == 1.6.2,-                        music-preludes           == 1.6.2,+                        music-score              == 1.7,+                        music-pitch-literal      == 1.7,+                        music-preludes           == 1.7,                         aeson     exposed-modules:    Music.Sibelius                         Music.Score.Import.Sibelius
src/Music/Score/Import/Sibelius.hs view
@@ -3,132 +3,132 @@              ConstraintKinds, FlexibleContexts #-}  module Music.Score.Import.Sibelius (-        IsSibelius(..),-        fromSibelius,-        readSibelius,-        readSibeliusMaybe,-        readSibeliusEither+        -- IsSibelius(..),+        -- fromSibelius,+        -- readSibelius,+        -- readSibeliusMaybe,+        -- readSibeliusEither   ) where -import Control.Lens-import Music.Sibelius-import Music.Score-import Data.Aeson-import Music.Pitch.Literal (IsPitch)--import qualified Music.Pitch.Literal as Pitch-import qualified Data.ByteString.Lazy as ByteString---- |--- Convert a score from a Sibelius representation.----fromSibelius :: IsSibelius a => SibeliusScore -> Score a-fromSibelius (SibeliusScore title composer info staffH transp staves systemStaff) =-    foldr (</>) mempty $ fmap fromSibeliusStaff staves-    -- TODO meta information--fromSibeliusStaff :: IsSibelius a => SibeliusStaff -> Score a-fromSibeliusStaff (SibeliusStaff bars name shortName) =-    removeRests $ scat $ fmap fromSibeliusBar bars-    -- TODO bar length hardcoded-    -- TODO meta information-    -- NOTE slur pos/dur always "stick" to an adjacent note, regardless of visual position-    --      for other lines (cresc etc) this might not be the case-    -- WARNING key sig changes goes at end of previous bar--fromSibeliusBar :: IsSibelius a => SibeliusBar -> Score (Maybe a)-fromSibeliusBar (SibeliusBar elems) = -    fmap Just (pcat $ fmap fromSibeliusChordElem chords) <> return Nothing^*1-    where-        chords   = filter isChord elems-        tuplets  = filter isTuplet elems -- TODO use these-        floating = filter isFloating elems--fromSibeliusChordElem :: IsSibelius a => SibeliusBarObject -> Score a-fromSibeliusChordElem = go where-    go (SibeliusBarObjectChord chord) = fromSibeliusChord chord-    go _                         = error "fromSibeliusChordElem: Expected chord"---- handleFloatingElem :: IsSibelius a => SibeliusBarObject -> [Score a] -> [Score a]--isChord (SibeliusBarObjectChord _) = True-isChord _                     = False--isTuplet (SibeliusBarObjectTuplet _) = True-isTuplet _                      = False--isFloating x = not (isChord x) && not (isTuplet x) -    --fromSibeliusChord :: IsSibelius a => SibeliusChord -> Score a-fromSibeliusChord (SibeliusChord pos dur voice ar strem dtrem acci appo notes) = -    showVals $ setTime $ setDur $ every setArt ar $ tremolo strem $ pcat $ fmap fromSibeliusNote notes-    where     -        showVals = text (show pos ++ " " ++ show dur) -- TODO DEBUG-        -- WARNING for tuplets, positions are absolute (sounding), but durations are relative (written)-        -- To retrieve sounding duration we must find floating tuplet objects and use-        -- the duration/playedDuration fields-        setTime = delay (fromIntegral pos / kTicksPerWholeNote)-        setDur  = stretch (fromIntegral dur / kTicksPerWholeNote)-        setArt Marcato         = marcato-        setArt Accent          = accent-        setArt Tenuto          = tenuto-        setArt Staccato        = staccato-        setArt a               = error $ "fromSibeliusChord: Unsupported articulation" ++ show a        -    -- TODO tremolo and appogiatura/acciaccatura support--fromSibeliusNote :: IsSibelius a => SibeliusNote -> Score a-fromSibeliusNote (SibeliusNote pitch diatonicPitch acc tied style) =-    (if tied then fmap beginTie else id)-    $ fmap (up' (fromIntegral pitch - 60)) Pitch.c-    -- TODO spell correctly if this is Common.Pitch (how to distinguish)-    where-        up' x = pitch' %~ (+ x)-        -- up' x = mapPitch' (+ x)---- |--- Read a Sibelius score from a file. Fails if the file could not be read or if a parsing--- error occurs.+-- import Control.Lens+-- import Music.Sibelius+-- import Music.Score+-- import Data.Aeson+-- import Music.Pitch.Literal (IsPitch) -- -readSibelius :: IsSibelius a => FilePath -> IO (Score a)-readSibelius path = fmap (either (\x -> error $ "Could not read score " ++ x) id) $ readSibeliusEither path---- |--- Read a Sibelius score from a file. Fails if the file could not be read, and returns--- @Nothing@ if a parsing error occurs.+-- import qualified Music.Pitch.Literal as Pitch+-- import qualified Data.ByteString.Lazy as ByteString -- -readSibeliusMaybe :: IsSibelius a => FilePath -> IO (Maybe (Score a))-readSibeliusMaybe path = fmap (either (const Nothing) Just) $ readSibeliusEither path---- |--- Read a Sibelius score from a file. Fails if the file could not be read, and returns--- @Left m@ if a parsing error occurs.+-- -- |+-- -- Convert a score from a Sibelius representation.+-- --+-- fromSibelius :: IsSibelius a => SibeliusScore -> Score a+-- fromSibelius (SibeliusScore title composer info staffH transp staves systemStaff) =+--     foldr (</>) mempty $ fmap fromSibeliusStaff staves+--     -- TODO meta information -- -readSibeliusEither :: IsSibelius a => FilePath -> IO (Either String (Score a))-readSibeliusEither path = do-    json <- ByteString.readFile path-    return $ fmap fromSibelius $ eitherDecode' json---- |--- This constraint includes all note types that can be constructed from a Sibelius representation.----type IsSibelius a = (-    IsPitch a, -    HasPart' a, -    Enum (Part a), -    HasPitch' a, -    Num (Pitch a), -    HasTremolo a, -    HasArticulation a,-    HasText a,-    Tiable a-    )----- Util--every :: (a -> b -> b) -> [a] -> b -> b-every f = flip (foldr f)--kTicksPerWholeNote = 1024 -- Always in Sibelius+-- fromSibeliusStaff :: IsSibelius a => SibeliusStaff -> Score a+-- fromSibeliusStaff (SibeliusStaff bars name shortName) =+--     removeRests $ scat $ fmap fromSibeliusBar bars+--     -- TODO bar length hardcoded+--     -- TODO meta information+--     -- NOTE slur pos/dur always "stick" to an adjacent note, regardless of visual position+--     --      for other lines (cresc etc) this might not be the case+--     -- WARNING key sig changes goes at end of previous bar+-- +-- fromSibeliusBar :: IsSibelius a => SibeliusBar -> Score (Maybe a)+-- fromSibeliusBar (SibeliusBar elems) = +--     fmap Just (pcat $ fmap fromSibeliusChordElem chords) <> return Nothing^*1+--     where+--         chords   = filter isChord elems+--         tuplets  = filter isTuplet elems -- TODO use these+--         floating = filter isFloating elems+-- +-- fromSibeliusChordElem :: IsSibelius a => SibeliusBarObject -> Score a+-- fromSibeliusChordElem = go where+--     go (SibeliusBarObjectChord chord) = fromSibeliusChord chord+--     go _                         = error "fromSibeliusChordElem: Expected chord"+-- +-- -- handleFloatingElem :: IsSibelius a => SibeliusBarObject -> [Score a] -> [Score a]+-- +-- isChord (SibeliusBarObjectChord _) = True+-- isChord _                     = False+-- +-- isTuplet (SibeliusBarObjectTuplet _) = True+-- isTuplet _                      = False+-- +-- isFloating x = not (isChord x) && not (isTuplet x) +--     +-- +-- fromSibeliusChord :: IsSibelius a => SibeliusChord -> Score a+-- fromSibeliusChord (SibeliusChord pos dur voice ar strem dtrem acci appo notes) = +--     showVals $ setTime $ setDur $ every setArt ar $ tremolo strem $ pcat $ fmap fromSibeliusNote notes+--     where     +--         showVals = text (show pos ++ " " ++ show dur) -- TODO DEBUG+--         -- WARNING for tuplets, positions are absolute (sounding), but durations are relative (written)+--         -- To retrieve sounding duration we must find floating tuplet objects and use+--         -- the duration/playedDuration fields+--         setTime = delay (fromIntegral pos / kTicksPerWholeNote)+--         setDur  = stretch (fromIntegral dur / kTicksPerWholeNote)+--         setArt Marcato         = marcato+--         setArt Accent          = accent+--         setArt Tenuto          = tenuto+--         setArt Staccato        = staccato+--         setArt a               = error $ "fromSibeliusChord: Unsupported articulation" ++ show a        +--     -- TODO tremolo and appogiatura/acciaccatura support+-- +-- fromSibeliusNote :: IsSibelius a => SibeliusNote -> Score a+-- fromSibeliusNote (SibeliusNote pitch diatonicPitch acc tied style) =+--     (if tied then fmap beginTie else id)+--     $ fmap (up' (fromIntegral pitch - 60)) Pitch.c+--     -- TODO spell correctly if this is Common.Pitch (how to distinguish)+--     where+--         up' x = pitch' %~ (+ x)+--         -- up' x = mapPitch' (+ x)+-- +-- -- |+-- -- Read a Sibelius score from a file. Fails if the file could not be read or if a parsing+-- -- error occurs.+-- -- +-- readSibelius :: IsSibelius a => FilePath -> IO (Score a)+-- readSibelius path = fmap (either (\x -> error $ "Could not read score " ++ x) id) $ readSibeliusEither path+-- +-- -- |+-- -- Read a Sibelius score from a file. Fails if the file could not be read, and returns+-- -- @Nothing@ if a parsing error occurs.+-- -- +-- readSibeliusMaybe :: IsSibelius a => FilePath -> IO (Maybe (Score a))+-- readSibeliusMaybe path = fmap (either (const Nothing) Just) $ readSibeliusEither path+-- +-- -- |+-- -- Read a Sibelius score from a file. Fails if the file could not be read, and returns+-- -- @Left m@ if a parsing error occurs.+-- -- +-- readSibeliusEither :: IsSibelius a => FilePath -> IO (Either String (Score a))+-- readSibeliusEither path = do+--     json <- ByteString.readFile path+--     return $ fmap fromSibelius $ eitherDecode' json+-- +-- -- |+-- -- This constraint includes all note types that can be constructed from a Sibelius representation.+-- --+-- type IsSibelius a = (+--     IsPitch a, +--     HasPart' a, +--     Enum (Part a), +--     HasPitch' a, +--     Num (Pitch a), +--     HasTremolo a, +--     HasArticulation a,+--     HasText a,+--     Tiable a+--     )+-- +-- +-- -- Util+-- +-- every :: (a -> b -> b) -> [a] -> b -> b+-- every f = flip (foldr f)+-- +-- kTicksPerWholeNote = 1024 -- Always in Sibelius 
src/Music/Sibelius.hs view
@@ -4,310 +4,310 @@  module Music.Sibelius ( -        -- * Scores and staves-        SibeliusScore(..),-        SibeliusStaff(..),-        SibeliusBar(..),-        -        -- * Bar objects-        SibeliusBarObject(..),--        -- ** Notes-        SibeliusChord(..),-        SibeliusNote(..),--        -- ** Lines-        SibeliusSlur(..),-        SibeliusCrescendoLine(..),-        SibeliusDiminuendoLine(..),--        -- ** Tuplets-        SibeliusTuplet(..),-        SibeliusArticulation(..),-        readSibeliusArticulation,--        -- ** Miscellaneous-        SibeliusClef(..),-        SibeliusKeySignature(..),-        SibeliusTimeSignature(..),-        SibeliusText(..),+        -- -- * Scores and staves+        -- SibeliusScore(..),+        -- SibeliusStaff(..),+        -- SibeliusBar(..),+        -- +        -- -- * Bar objects+        -- SibeliusBarObject(..),+        -- +        -- -- ** Notes+        -- SibeliusChord(..),+        -- SibeliusNote(..),+        -- +        -- -- ** Lines+        -- SibeliusSlur(..),+        -- SibeliusCrescendoLine(..),+        -- SibeliusDiminuendoLine(..),+        -- +        -- -- ** Tuplets+        -- SibeliusTuplet(..),+        -- SibeliusArticulation(..),+        -- readSibeliusArticulation,+        -- +        -- -- ** Miscellaneous+        -- SibeliusClef(..),+        -- SibeliusKeySignature(..),+        -- SibeliusTimeSignature(..),+        -- SibeliusText(..),    ) where -import Control.Monad.Plus-import Control.Applicative-import Data.Semigroup-import Data.Aeson--import qualified Data.HashMap.Strict as HashMap---{--setTitle :: String -> Score a -> Score a-setTitle = setMeta "title"-setComposer :: String -> Score a -> Score a-setComposer = setMeta "composer"-setInformation :: String -> Score a -> Score a-setInformation = setMeta "information"-setMeta :: String -> String -> Score a -> Score a-setMeta _ _ = id--}---data SibeliusScore = SibeliusScore {-            scoreTitle             :: String,-            scoreComposer          :: String,-            scoreInformation       :: String,-            scoreStaffHeight       :: Double,-            scoreTransposing       :: Bool,-            scoreStaves            :: [SibeliusStaff],-            scoreSystemStaff       :: ()-    }-    deriving (Eq, Ord, Show)-instance FromJSON SibeliusScore where-    parseJSON (Object v) = SibeliusScore-        <$> v .: "title" -        <*> v .: "composer"-        <*> v .: "information"-        <*> v .: "staffHeight"-        <*> v .: "transposing"-        <*> v .: "staves"          -        -- TODO system staff-        <*> return ()---data SibeliusStaff = SibeliusStaff {-            staffBars                :: [SibeliusBar],-            staffName                :: String,-            staffShortName           :: String-    }-    deriving (Eq, Ord, Show)-instance FromJSON SibeliusStaff where-    parseJSON (Object v) = SibeliusStaff-        <$> v .: "bars"-        <*> v .: "name"-        <*> v .: "shortName"--data SibeliusBar = SibeliusBar {-            barElements            :: [SibeliusBarObject]-    }-    deriving (Eq, Ord, Show)-instance FromJSON SibeliusBar where-    parseJSON (Object v) = SibeliusBar-        <$> v .: "elements"--data SibeliusBarObject -    = SibeliusBarObjectText SibeliusText-    | SibeliusBarObjectClef SibeliusClef-    | SibeliusBarObjectSlur SibeliusSlur-    | SibeliusBarObjectCrescendoLine SibeliusCrescendoLine-    | SibeliusBarObjectDiminuendoLine SibeliusDiminuendoLine-    | SibeliusBarObjectTimeSignature SibeliusTimeSignature-    | SibeliusBarObjectKeySignature SibeliusKeySignature-    | SibeliusBarObjectTuplet SibeliusTuplet-    | SibeliusBarObjectChord SibeliusChord-    deriving (Eq, Ord, Show)--- TODO highlights, lyric, barlines, comment, other lines and symbols--instance FromJSON SibeliusBarObject where-    parseJSON x@(Object v) = case HashMap.lookup "type" v of    -        -- TODO-        Just "text"      -> SibeliusBarObjectText <$> parseJSON x-        Just "clef"      -> SibeliusBarObjectClef <$> parseJSON x-        Just "slur"      -> SibeliusBarObjectSlur <$> parseJSON x-        Just "cresc"     -> SibeliusBarObjectCrescendoLine <$> parseJSON x-        Just "dim"       -> SibeliusBarObjectDiminuendoLine <$> parseJSON x-        Just "time"      -> SibeliusBarObjectTimeSignature <$> parseJSON x-        Just "key"       -> SibeliusBarObjectKeySignature <$> parseJSON x-        Just "tuplet"    -> SibeliusBarObjectTuplet <$> parseJSON x-        Just "chord"     -> SibeliusBarObjectChord <$> parseJSON x-        _                -> mempty -- failure--data SibeliusText = SibeliusText {-            textVoice               :: Int,-            textPosition            :: Int,-            textText                :: String,-            textStyle               :: String-    }-    deriving (Eq, Ord, Show)-instance FromJSON SibeliusText where-    parseJSON (Object v) = SibeliusText-        <$> v .: "voice" -        <*> v .: "position"-        <*> v .: "text"-        <*> v .: "style"-     -data SibeliusClef = SibeliusClef {-            clefVoice               :: Int,-            clefPosition            :: Int,-            clefStyle               :: String-    }-    deriving (Eq, Ord, Show)-instance FromJSON SibeliusClef where-    parseJSON (Object v) = SibeliusClef-        <$> v .: "voice" -        <*> v .: "position"-        <*> v .: "style"--data SibeliusSlur = SibeliusSlur {-            slurVoice               :: Int,-            slurPosition            :: Int,-            slurDuration            :: Int,-            slurStyle               :: String-    }-    deriving (Eq, Ord, Show)-instance FromJSON SibeliusSlur where-    parseJSON (Object v) = SibeliusSlur-        <$> v .: "voice" -        <*> v .: "position"-        <*> v .: "duration"-        <*> v .: "style"--data SibeliusCrescendoLine = SibeliusCrescendoLine {  -            crescVoice               :: Int,-            crescPosition            :: Int,-            crescDuration            :: Int,-            crescStyle               :: String-    }-    deriving (Eq, Ord, Show)-instance FromJSON SibeliusCrescendoLine where-    parseJSON (Object v) = SibeliusCrescendoLine-        <$> v .: "voice" -        <*> v .: "position"-        <*> v .: "duration"-        <*> v .: "style"--data SibeliusDiminuendoLine = SibeliusDiminuendoLine {-            dimVoice               :: Int,-            dimPosition            :: Int,-            dimDuration            :: Int,-            dimStyle               :: String-    }-    deriving (Eq, Ord, Show)-instance FromJSON SibeliusDiminuendoLine where-    parseJSON (Object v) = SibeliusDiminuendoLine-        <$> v .: "voice" -        <*> v .: "position"-        <*> v .: "duration"-        <*> v .: "style"--data SibeliusTimeSignature = SibeliusTimeSignature {-            timeVoice               :: Int,-            timePosition            :: Int,-            timeValue               :: Rational,-            timeIsCommon            :: Bool,-            timeIsAllaBreve         :: Bool-    }-    deriving (Eq, Ord, Show)-instance FromJSON SibeliusTimeSignature where-    parseJSON (Object v) = SibeliusTimeSignature-        <$> v .: "voice" -        <*> v .: "position"-        <*> fmap (\[x,y] -> (x::Rational) / (y::Rational)) (v .: "value")-        <*> v .: "common"-        <*> v .: "allaBreve"--data SibeliusKeySignature = SibeliusKeySignature {-            keyVoice               :: Int,-            keyPosition            :: Int,-            keyMajor               :: Bool,-            keySharps              :: Int,-            keyIsOpen              :: Bool-    }-    deriving (Eq, Ord, Show)-instance FromJSON SibeliusKeySignature where-    parseJSON (Object v) = SibeliusKeySignature-        <$> v .: "voice" -        <*> v .: "position"-        <*> v .: "major"-        <*> v .: "sharps"-        <*> v .: "isOpen"--data SibeliusTuplet = SibeliusTuplet {-            tupletVoice               :: Int,-            tupletPosition            :: Int,-            tupletDuration            :: Int,-            tupletPlayedDuration      :: Int,-            tupletValue               :: Rational-    }-    deriving (Eq, Ord, Show)-instance FromJSON SibeliusTuplet where-    parseJSON (Object v) = SibeliusTuplet -        <$> v .: "voice" -        <*> v .: "position"-        <*> v .: "duration"-        <*> v .: "playedDuration"-        <*> (v .: "value" >>= \[x,y] -> return $ x / y) -- TODO unsafe--data SibeliusArticulation-    = UpBow-    | DownBow-    | Plus-    | Harmonic-    | Marcato-    | Accent-    | Tenuto-    | Wedge-    | Staccatissimo-    | Staccato-    deriving (Eq, Ord, Show, Enum)--readSibeliusArticulation :: String -> Maybe SibeliusArticulation-readSibeliusArticulation = go-    where-        go "upbow"          = Just UpBow-        go "downBow"        = Just DownBow-        go "plus"           = Just Plus-        go "harmonic"       = Just Harmonic-        go "marcato"        = Just Marcato-        go "accent"         = Just Accent-        go "tenuto"         = Just Tenuto-        go "wedge"          = Just Wedge-        go "staccatissimo"  = Just Staccatissimo-        go "staccato"       = Just Staccato-        go _                = Nothing-    -data SibeliusChord = SibeliusChord { -            chordPosition            :: Int,-            chordDuration            :: Int,-            chordVoice               :: Int,-            chordArticulations       :: [SibeliusArticulation], -- TODO-            chordSingleTremolos      :: Int,-            chordDoubleTremolos      :: Int,-            chordAcciaccatura        :: Bool,-            chordAppoggiatura        :: Bool,-            chordNotes               :: [SibeliusNote]-    }-    deriving (Eq, Ord, Show)--instance FromJSON SibeliusChord where-    parseJSON (Object v) = SibeliusChord -        <$> v .: "position" -        <*> v .: "duration"-        <*> v .: "voice"-        <*> fmap (mmapMaybe readSibeliusArticulation) (v .: "articulations")-        <*> v .: "singleTremolos"-        <*> v .: "doubleTremolos"-        <*> v .: "acciaccatura"-        <*> v .: "appoggiatura"-        <*> v .: "notes"--data SibeliusNote = SibeliusNote {-            notePitch               :: Int,-            noteDiatonicPitch       :: Int,-            noteAccidental          :: Int,-            noteTied                :: Bool,-            noteStyle               :: Int -- not String?-    }-    deriving (Eq, Ord, Show)-instance FromJSON SibeliusNote where-    parseJSON (Object v) = SibeliusNote -        <$> v .: "pitch" -        <*> v .: "diatonicPitch"-        <*> v .: "accidental"-        <*> v .: "tied"-        <*> v .: "style"----    +-- import Control.Monad.Plus+-- import Control.Applicative+-- import Data.Semigroup+-- import Data.Aeson+-- +-- import qualified Data.HashMap.Strict as HashMap+-- +-- +-- {-+-- setTitle :: String -> Score a -> Score a+-- setTitle = setMeta "title"+-- setComposer :: String -> Score a -> Score a+-- setComposer = setMeta "composer"+-- setInformation :: String -> Score a -> Score a+-- setInformation = setMeta "information"+-- setMeta :: String -> String -> Score a -> Score a+-- setMeta _ _ = id+-- -}+-- +-- +-- data SibeliusScore = SibeliusScore {+--             scoreTitle             :: String,+--             scoreComposer          :: String,+--             scoreInformation       :: String,+--             scoreStaffHeight       :: Double,+--             scoreTransposing       :: Bool,+--             scoreStaves            :: [SibeliusStaff],+--             scoreSystemStaff       :: ()+--     }+--     deriving (Eq, Ord, Show)+-- instance FromJSON SibeliusScore where+--     parseJSON (Object v) = SibeliusScore+--         <$> v .: "title" +--         <*> v .: "composer"+--         <*> v .: "information"+--         <*> v .: "staffHeight"+--         <*> v .: "transposing"+--         <*> v .: "staves"          +--         -- TODO system staff+--         <*> return ()+-- +-- +-- data SibeliusStaff = SibeliusStaff {+--             staffBars                :: [SibeliusBar],+--             staffName                :: String,+--             staffShortName           :: String+--     }+--     deriving (Eq, Ord, Show)+-- instance FromJSON SibeliusStaff where+--     parseJSON (Object v) = SibeliusStaff+--         <$> v .: "bars"+--         <*> v .: "name"+--         <*> v .: "shortName"+-- +-- data SibeliusBar = SibeliusBar {+--             barElements            :: [SibeliusBarObject]+--     }+--     deriving (Eq, Ord, Show)+-- instance FromJSON SibeliusBar where+--     parseJSON (Object v) = SibeliusBar+--         <$> v .: "elements"+-- +-- data SibeliusBarObject +--     = SibeliusBarObjectText SibeliusText+--     | SibeliusBarObjectClef SibeliusClef+--     | SibeliusBarObjectSlur SibeliusSlur+--     | SibeliusBarObjectCrescendoLine SibeliusCrescendoLine+--     | SibeliusBarObjectDiminuendoLine SibeliusDiminuendoLine+--     | SibeliusBarObjectTimeSignature SibeliusTimeSignature+--     | SibeliusBarObjectKeySignature SibeliusKeySignature+--     | SibeliusBarObjectTuplet SibeliusTuplet+--     | SibeliusBarObjectChord SibeliusChord+--     deriving (Eq, Ord, Show)+-- -- TODO highlights, lyric, barlines, comment, other lines and symbols+-- +-- instance FromJSON SibeliusBarObject where+--     parseJSON x@(Object v) = case HashMap.lookup "type" v of    +--         -- TODO+--         Just "text"      -> SibeliusBarObjectText <$> parseJSON x+--         Just "clef"      -> SibeliusBarObjectClef <$> parseJSON x+--         Just "slur"      -> SibeliusBarObjectSlur <$> parseJSON x+--         Just "cresc"     -> SibeliusBarObjectCrescendoLine <$> parseJSON x+--         Just "dim"       -> SibeliusBarObjectDiminuendoLine <$> parseJSON x+--         Just "time"      -> SibeliusBarObjectTimeSignature <$> parseJSON x+--         Just "key"       -> SibeliusBarObjectKeySignature <$> parseJSON x+--         Just "tuplet"    -> SibeliusBarObjectTuplet <$> parseJSON x+--         Just "chord"     -> SibeliusBarObjectChord <$> parseJSON x+--         _                -> mempty -- failure+-- +-- data SibeliusText = SibeliusText {+--             textVoice               :: Int,+--             textPosition            :: Int,+--             textText                :: String,+--             textStyle               :: String+--     }+--     deriving (Eq, Ord, Show)+-- instance FromJSON SibeliusText where+--     parseJSON (Object v) = SibeliusText+--         <$> v .: "voice" +--         <*> v .: "position"+--         <*> v .: "text"+--         <*> v .: "style"+--      +-- data SibeliusClef = SibeliusClef {+--             clefVoice               :: Int,+--             clefPosition            :: Int,+--             clefStyle               :: String+--     }+--     deriving (Eq, Ord, Show)+-- instance FromJSON SibeliusClef where+--     parseJSON (Object v) = SibeliusClef+--         <$> v .: "voice" +--         <*> v .: "position"+--         <*> v .: "style"+-- +-- data SibeliusSlur = SibeliusSlur {+--             slurVoice               :: Int,+--             slurPosition            :: Int,+--             slurDuration            :: Int,+--             slurStyle               :: String+--     }+--     deriving (Eq, Ord, Show)+-- instance FromJSON SibeliusSlur where+--     parseJSON (Object v) = SibeliusSlur+--         <$> v .: "voice" +--         <*> v .: "position"+--         <*> v .: "duration"+--         <*> v .: "style"+-- +-- data SibeliusCrescendoLine = SibeliusCrescendoLine {  +--             crescVoice               :: Int,+--             crescPosition            :: Int,+--             crescDuration            :: Int,+--             crescStyle               :: String+--     }+--     deriving (Eq, Ord, Show)+-- instance FromJSON SibeliusCrescendoLine where+--     parseJSON (Object v) = SibeliusCrescendoLine+--         <$> v .: "voice" +--         <*> v .: "position"+--         <*> v .: "duration"+--         <*> v .: "style"+-- +-- data SibeliusDiminuendoLine = SibeliusDiminuendoLine {+--             dimVoice               :: Int,+--             dimPosition            :: Int,+--             dimDuration            :: Int,+--             dimStyle               :: String+--     }+--     deriving (Eq, Ord, Show)+-- instance FromJSON SibeliusDiminuendoLine where+--     parseJSON (Object v) = SibeliusDiminuendoLine+--         <$> v .: "voice" +--         <*> v .: "position"+--         <*> v .: "duration"+--         <*> v .: "style"+-- +-- data SibeliusTimeSignature = SibeliusTimeSignature {+--             timeVoice               :: Int,+--             timePosition            :: Int,+--             timeValue               :: Rational,+--             timeIsCommon            :: Bool,+--             timeIsAllaBreve         :: Bool+--     }+--     deriving (Eq, Ord, Show)+-- instance FromJSON SibeliusTimeSignature where+--     parseJSON (Object v) = SibeliusTimeSignature+--         <$> v .: "voice" +--         <*> v .: "position"+--         <*> fmap (\[x,y] -> (x::Rational) / (y::Rational)) (v .: "value")+--         <*> v .: "common"+--         <*> v .: "allaBreve"+-- +-- data SibeliusKeySignature = SibeliusKeySignature {+--             keyVoice               :: Int,+--             keyPosition            :: Int,+--             keyMajor               :: Bool,+--             keySharps              :: Int,+--             keyIsOpen              :: Bool+--     }+--     deriving (Eq, Ord, Show)+-- instance FromJSON SibeliusKeySignature where+--     parseJSON (Object v) = SibeliusKeySignature+--         <$> v .: "voice" +--         <*> v .: "position"+--         <*> v .: "major"+--         <*> v .: "sharps"+--         <*> v .: "isOpen"+-- +-- data SibeliusTuplet = SibeliusTuplet {+--             tupletVoice               :: Int,+--             tupletPosition            :: Int,+--             tupletDuration            :: Int,+--             tupletPlayedDuration      :: Int,+--             tupletValue               :: Rational+--     }+--     deriving (Eq, Ord, Show)+-- instance FromJSON SibeliusTuplet where+--     parseJSON (Object v) = SibeliusTuplet +--         <$> v .: "voice" +--         <*> v .: "position"+--         <*> v .: "duration"+--         <*> v .: "playedDuration"+--         <*> (v .: "value" >>= \[x,y] -> return $ x / y) -- TODO unsafe+-- +-- data SibeliusArticulation+--     = UpBow+--     | DownBow+--     | Plus+--     | Harmonic+--     | Marcato+--     | Accent+--     | Tenuto+--     | Wedge+--     | Staccatissimo+--     | Staccato+--     deriving (Eq, Ord, Show, Enum)+-- +-- readSibeliusArticulation :: String -> Maybe SibeliusArticulation+-- readSibeliusArticulation = go+--     where+--         go "upbow"          = Just UpBow+--         go "downBow"        = Just DownBow+--         go "plus"           = Just Plus+--         go "harmonic"       = Just Harmonic+--         go "marcato"        = Just Marcato+--         go "accent"         = Just Accent+--         go "tenuto"         = Just Tenuto+--         go "wedge"          = Just Wedge+--         go "staccatissimo"  = Just Staccatissimo+--         go "staccato"       = Just Staccato+--         go _                = Nothing+--     +-- data SibeliusChord = SibeliusChord { +--             chordPosition            :: Int,+--             chordDuration            :: Int,+--             chordVoice               :: Int,+--             chordArticulations       :: [SibeliusArticulation], -- TODO+--             chordSingleTremolos      :: Int,+--             chordDoubleTremolos      :: Int,+--             chordAcciaccatura        :: Bool,+--             chordAppoggiatura        :: Bool,+--             chordNotes               :: [SibeliusNote]+--     }+--     deriving (Eq, Ord, Show)+-- +-- instance FromJSON SibeliusChord where+--     parseJSON (Object v) = SibeliusChord +--         <$> v .: "position" +--         <*> v .: "duration"+--         <*> v .: "voice"+--         <*> fmap (mmapMaybe readSibeliusArticulation) (v .: "articulations")+--         <*> v .: "singleTremolos"+--         <*> v .: "doubleTremolos"+--         <*> v .: "acciaccatura"+--         <*> v .: "appoggiatura"+--         <*> v .: "notes"+-- +-- data SibeliusNote = SibeliusNote {+--             notePitch               :: Int,+--             noteDiatonicPitch       :: Int,+--             noteAccidental          :: Int,+--             noteTied                :: Bool,+--             noteStyle               :: Int -- not String?+--     }+--     deriving (Eq, Ord, Show)+-- instance FromJSON SibeliusNote where+--     parseJSON (Object v) = SibeliusNote +--         <$> v .: "pitch" +--         <*> v .: "diatonicPitch"+--         <*> v .: "accidental"+--         <*> v .: "tied"+--         <*> v .: "style"+-- +-- +-- +--