{-# LANGUAGE OverloadedStrings, GeneralizedNewtypeDeriving, NoMonomorphismRestriction, ConstraintKinds, FlexibleContexts #-} module Music.Score.Import.Sibelius ( -- 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. -- -- -- 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