Sibelius.hs

{-# 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