{-# LANGUAGE OverloadedStrings, GeneralizedNewtypeDeriving, NoMonomorphismRestriction, 
             ConstraintKinds, FlexibleContexts, TypeFamilies, CPP, ViewPatterns #-}

module Music.Score.Import.Sibelius (
        IsSibelius(..),
        fromSibelius,
        readSibelius,
        readSibeliusMaybe,
        readSibeliusEither
  ) where

import Control.Lens
import Data.Music.Sibelius
import qualified Data.Maybe
import qualified Music.Score as S
import Data.Aeson
import qualified Music.Prelude
import Music.Pitch.Literal (IsPitch)
import Music.Score hiding (Pitch, Interval, Articulation, Part)
import Music.Pitch
import Music.Articulation
import Music.Dynamics
import Music.Parts
#ifdef GHCI
import qualified System.Process
import Music.Prelude
#endif

import qualified Music.Pitch.Literal as Pitch
import qualified Data.ByteString.Lazy as ByteString

-- |
-- 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
readSibeliusEither' :: FilePath -> IO (Either String SibeliusScore)
readSibeliusEither' path = do
    json <- ByteString.readFile path
    return $ eitherDecode' json

-- Get the eventual time signature changes in each bar
getSibeliusTimeSignatures :: SibeliusSystemStaff -> [Maybe TimeSignature]
getSibeliusTimeSignatures x = fmap (getTimeSignatureInBar) 
  $systemStaffBars x
  where
    getTimeSignatureInBar = fmap convertTimeSignature . Data.Maybe.listToMaybe . filter isTimeSignature . barElements

convertTimeSignature :: SibeliusBarObject -> TimeSignature
convertTimeSignature (SibeliusBarObjectTimeSignature (SibeliusTimeSignature voice position [m,n] isCommon isAllaBReve)) = 
    (fromIntegral m / fromIntegral n)  

-- |
-- Convert a score from a Sibelius representation.
--
fromSibelius :: IsSibelius a => SibeliusScore -> Score a
fromSibelius (SibeliusScore title composer info staffH transp staves systemStaff) =
    timeSig $ pcat $ fmap (\staff -> set (parts') (partFromSibeliusStaff staff) (fromSibeliusStaff barDur staff)) $ staves
    -- TODO meta information
        where
            -- FIXME only reads TS in first bar
            barDur = case head (getSibeliusTimeSignatures systemStaff) of
              Nothing -> 1
              Just ts -> barDuration ts
            timeSig = case head (getSibeliusTimeSignatures systemStaff) of
              Nothing -> id
              Just ts -> timeSignature ts
          
            partFromSibeliusStaff (SibeliusStaff bars name shortName) = partFromName (name, shortName)

            -- TODO something more robust (in part library...)
            partFromName ("Piccolo",_) = piccoloFlutes
            partFromName ("Piccolo Flute",_) = piccoloFlutes
            partFromName ("Flute",_) = flutes
            partFromName ("Flutes (a)",_) = (!! 0) $ divide 4 $ flutes
            partFromName ("Flutes (b)",_) = (!! 1) $ divide 4 $ flutes
            partFromName ("Flutes (c)",_) = (!! 2) $ divide 4 $ flutes
            partFromName ("Flutes (d)",_) = (!! 3) $ divide 4 $ flutes
            partFromName ("Oboe",_) = oboes
            partFromName ("Oboes (a)",_) = (!! 0) $ divide 4 $ oboes
            partFromName ("Oboes (b)",_) = (!! 1) $ divide 4 $ oboes
            partFromName ("Oboes (c)",_) = (!! 2) $ divide 4 $ oboes
            partFromName ("Oboes (d)",_) = (!! 3) $ divide 4 $ oboes
            partFromName ("Cor Anglais",_) = tutti corAnglais
            partFromName ("Clarinet",_) = clarinets
            partFromName ("Clarinet in Bb",_) = clarinets
            partFromName ("Clarinet in A",_) = clarinets
            partFromName ("Clarinets",_) = clarinets
            partFromName ("Clarinets in Bb",_) = clarinets
            partFromName ("Clarinets in Bb (a)",_) = (!! 0) $ divide 3 clarinets
            partFromName ("Clarinets in Bb (b)",_) = (!! 1) $ divide 3 clarinets
            partFromName ("Clarinets in Bb (c)",_) = (!! 2) $ divide 3 clarinets
            partFromName ("Clarinets in A",_) = clarinets
            partFromName ("Bassoon",_) = bassoons
            partFromName ("Bassoon (a)",_) = (!! 0) $ divide 4 bassoons
            partFromName ("Bassoon (b)",_) = (!! 1) $ divide 4 bassoons
            partFromName ("Bassoon (c)",_) = (!! 2) $ divide 4 bassoons
            partFromName ("Bassoon (d)",_) = (!! 3) $ divide 4 bassoons
            partFromName ("Horn",_) = horns
            partFromName ("Horn (a)",_) = (!! 0) $ divide 4 $ horns
            partFromName ("Horn (b)",_) = (!! 1) $ divide 4 $ horns
            partFromName ("Horn (c)",_) = (!! 2) $ divide 4 $ horns
            partFromName ("Horn (d)",_) = (!! 3) $ divide 4 $ horns

            partFromName ("Horns",_) = horns
            partFromName ("Horns (a)",_) = (!! 0) $ divide 4 $ horns
            partFromName ("Horns (b)",_) = (!! 1) $ divide 4 $ horns
            partFromName ("Horns (c)",_) = (!! 2) $ divide 4 $ horns
            partFromName ("Horns (d)",_) = (!! 3) $ divide 4 $ horns

            partFromName ("Horns in F",_) = horns
            partFromName ("Horns in F (a)",_) = (!! 0) $ divide 4 $ horns
            partFromName ("Horns in F (b)",_) = (!! 1) $ divide 4 $ horns
            partFromName ("Horns in F (c)",_) = (!! 2) $ divide 4 $ horns
            partFromName ("Horns in F (d)",_) = (!! 3) $ divide 4 $ horns
            partFromName ("Horn in F",_) = horns
            partFromName ("Horn in E",_) = horns
            partFromName ("Trumpet (a)",_) = (!! 0) $ divide 4 $ trumpets
            partFromName ("Trumpet (b)",_) = (!! 1) $ divide 4 $ trumpets
            partFromName ("Trumpet (c)",_) = (!! 2) $ divide 4 $ trumpets
            partFromName ("Trumpet (d)",_) = (!! 3) $ divide 4 $ trumpets
            partFromName ('T':'r':'u':'m':'p':'e':'t':_,_) = trumpets
            partFromName ("Trombone",_) = trombones
            partFromName ("Trombones",_) = trombones
            partFromName ("Timpani",_) = tutti timpani

            partFromName ("Harp",_)     = harp
            partFromName ("Harp (a)",_) = (!! 0) $ divide 2 harp
            partFromName ("Harp (b)",_) = (!! 1) $ divide 2 harp

            partFromName ("Strings (a)",_) = (!! 0) $ divide 8 violins
            partFromName ("Strings (b)",_) = (!! 0) $ divide 8 cellos
            partFromName ("Strings (c)",_) = (!! 1) $ divide 8 violins
            partFromName ("Strings (d)",_) = (!! 1) $ divide 8 cellos
            partFromName ("Strings (e)",_) = (!! 2) $ divide 8 violins
            partFromName ("Strings (f)",_) = (!! 2) $ divide 8 cellos
            partFromName ("Strings (g)",_) = (!! 3) $ divide 8 violins
            partFromName ("Strings (h)",_) = (!! 3) $ divide 8 cellos
            partFromName ("Strings (i)",_) = (!! 4) $ divide 8 violins
            partFromName ("Strings (j)",_) = (!! 4) $ divide 8 cellos
            partFromName ("Strings (k)",_) = (!! 5) $ divide 8 violins
            partFromName ("Strings (l)",_) = (!! 5) $ divide 8 cellos
            partFromName ("Strings (m)",_) = (!! 6) $ divide 8 violins
            partFromName ("Strings (n)",_) = (!! 6) $ divide 8 cellos
            partFromName ("Strings (o)",_) = (!! 7) $ divide 8 violins
            partFromName ("Strings (p)",_) = (!! 7) $ divide 8 cellos
            -- partFromName ("Strings (q)",_) = (!! 0) $ divide 2 violins
            
            partFromName ("Violin I",_) = violins1
            partFromName ("Violin II",_) = violins2
            partFromName ("Viola",_) = violas
            partFromName ("Violin",_) = violins
            partFromName ("Violoncello",_) = cellos
            partFromName ("Violoncello (a)",_) = (!! 0) $ divide 2 cellos
            partFromName ("Violoncello (b)",_) = (!! 1) $ divide 2 cellos
            partFromName ("Contrabass",_) = doubleBasses
            partFromName ("Double Bass",_) = doubleBasses
            partFromName ("Piano",_)       = tutti piano
            partFromName ("Piano (a)",_)       = tutti piano
            partFromName ("Piano (b)",_)       = tutti piano

            partFromName ("Soprano",_) = violins1
            partFromName ("Mezzo-Soprano",_) = violins2
            partFromName ("Mezzo-soprano",_) = violins2
            partFromName ("Alto",_) = violas
            partFromName ("Tenor",_) = (!! 0) $ divide 2 cellos
            partFromName ("Baritone",_) = (!! 1) $ divide 2 cellos
            partFromName ("Bass",_) = doubleBasses

            partFromName (n,_) = error $ "Unknown instrument: " ++ n
-- TODO move to Score.Meta.TimeSignature

barDuration :: TimeSignature -> Duration
barDuration (getTimeSignature -> (as,b)) =  realToFrac (sum as) / realToFrac b

fromSibeliusStaff :: IsSibelius a => Duration -> SibeliusStaff -> Score a
fromSibeliusStaff d (SibeliusStaff bars name shortName) =
    removeRests $ scat $ fmap (fromSibeliusBar d) bars
    -- 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 => Duration -> SibeliusBar -> Score (Maybe a)
fromSibeliusBar d (SibeliusBar elems) = 
    fmap Just (pcat $ fmap fromSibeliusChordElem chords) <> stretch d rest
    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]



-- In Sibelius, bar objects are either chords, tuplet or a "floating" object (i.e. one that has no duraion)
isChord :: SibeliusBarObject -> Bool
isChord (SibeliusBarObjectChord _) = True
isChord _                     = False

isTuplet :: SibeliusBarObject -> Bool
isTuplet (SibeliusBarObjectTuplet _) = True
isTuplet _                      = False

isFloating :: SibeliusBarObject -> Bool
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
        showVals = id
        -- 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, Tiable a) => SibeliusNote -> Score a
fromSibeliusNote (SibeliusNote pitch diatonicPitch acc tied style) =
    (if tied then fmap beginTie else id)
    $ fromPitch'' actualPitch
    -- TODO spell correctly if this is Common.Pitch (how to distinguish)
    where
      actualPitch = midiOrigin .+^ (d2^*fromIntegral diatonicPitch ^+^ _A1^*fromIntegral pitch)
      midiOrigin = octavesDown 5 Pitch.c -- As middle C is (60 = 5*12)
      
fromPitch'' :: IsPitch a => Music.Prelude.Pitch -> a
fromPitch'' x = let i = x .-. c in 
  fromPitch $ PitchL ((fromIntegral $ i^._steps) `mod` 7, Just (fromIntegral (i^._alteration)), fromIntegral $ octaves i)

-- |
-- This constraint includes all note types that can be constructed from a Sibelius representation.
--
type IsSibelius a = (
    HasPitches' a, 
    IsPitch a, 

    HasPart' a, 
    S.Part a ~ Part,

    HasArticulation' a,
    S.Articulation a ~ Articulation,

    HasDynamic' a,
    S.Dynamic a ~ Dynamics,
    
    HasText a, 
    HasTremolo a,
    Tiable a
    -- Num (Pitch a), 
    -- HasTremolo a, 
    -- HasText a,
    -- Tiable a
    )


-- Util

every :: (a -> b -> b) -> [a] -> b -> b
every f = flip (foldr f)

kTicksPerWholeNote = 1024 -- Always in Sibelius

-- Debug
#ifdef GHCI
openAudacity :: Score StandardNote -> IO ()    
openAudacity x = do
    void $ writeMidi "test.mid" $ x
    void $ System.Process.system "timidity -Ow test.mid"
    void $ System.Process.system "open -a Audacity test.wav"
#endif