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 +5/−5
- src/Music/Score/Import/Sibelius.hs +123/−123
- src/Music/Sibelius.hs +304/−304
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"+-- +-- +-- +--