{-# LANGUAGE OverloadedStrings, GeneralizedNewtypeDeriving, NoMonomorphismRestriction,
ConstraintKinds, FlexibleContexts #-}
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(..),
) 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"
--
--
--
--