module Music.Transposition
    exposing
        ( defaultKey
        , keyDistance
        , transposeNote
        , transposeTo
        )

{-| Tune transposition

You can transpose an ABC tune (in whatever key - perhaps in C) to (say) G# using:

    transposedResult = mapError (\_ -> "parse error") (parse source)
        |> andThen (\tune -> transposeTo ({pitchClass = G, accidental = Just Sharp, mode = Major},[]) tune)


The mode before and after transposition must be identical (that is: you cannot transpose minor to major and so on).
Chord symbols will be lost on transposition.

# Constants
@docs defaultKey


# Functions
@docs keyDistance
    , transposeNote
    , transposeTo


-}

{- A parse tree score contains implicit accidentals.  Very often, the source text will not mark them but assume that they
   are implicit in the key signature.  They also may appear 'locally' - i.e. earlier in the bar and thus inherited.
   In order for the transposition process to work, all accidentals must be made explicit during transposition and then
   made implicit when written out to text if they are defined earlier in the bar or are defined in the key signature.

   This means we have to thread state through the transposition and hence use folds rather than maps
-}

import Dict exposing (Dict, fromList, get)
import Maybe exposing (withDefault)
import Maybe.Extra exposing (isJust, or)
import Tuple exposing (first, second)
import Abc.ParseTree exposing (..)
import Music.Notation exposing (..)
import Music.Accidentals exposing (..)
import Debug exposing (..)


type alias TranspositionState =
    { keyDistance :
        Int
        -- semitone distance between keys - may be positive or negative
    , sourcemks :
        ModifiedKeySignature
        -- source key signature
    , sourceBarAccidentals :
        Accidentals
        -- any accidental defined locally to the current bar in the tune source
    , targetmks :
        ModifiedKeySignature
        -- target key signature
    , targetKeySet :
        KeySet
        -- the set of accidental keys in the target key signature
    , targetScale :
        DiatonicScale
        -- diatonic scale in the target key
    , targetBarAccidentals :
        Accidentals
        -- any accidental defined locally to the current bar in the tune target
    }



-- Exposed API


{-| The default Key - C Major.
-}
defaultKey : ModifiedKeySignature
defaultKey =
    ( { pitchClass = C, accidental = Nothing, mode = Major }, [] )


{-| Calculate the distance between the keys (target - source) measured in semitones.
   Keys must be in compatible modes.
-}
keyDistance : ModifiedKeySignature -> ModifiedKeySignature -> Result String Int
keyDistance targetmks srcmks =
    let
        target =
            first targetmks

        src =
            first srcmks
    in
        if (target.mode /= src.mode) then
            Err "incompatible modes"
        else
            Ok (transpositionDistance ( target.pitchClass, target.accidental ) ( src.pitchClass, src.accidental ))


{-| Transpose a note from its source key to its target.
-}
transposeNote : ModifiedKeySignature -> ModifiedKeySignature -> AbcNote -> Result String AbcNote
transposeNote targetmks srcKey note =
    let
        rdist =
            keyDistance targetmks srcKey
    in
        case rdist of
            Err e ->
                Err e

            Ok d ->
                let
                    transpositionState =
                        { keyDistance = d
                        , sourcemks = srcKey
                        , sourceBarAccidentals = Music.Accidentals.empty
                        , targetmks = targetmks
                        , targetKeySet = modifiedKeySet targetmks
                        , targetScale = diatonicScale (first targetmks)
                        , targetBarAccidentals = Music.Accidentals.empty
                        }

                    ( transposedNote, _ ) =
                        (transposeNoteBy transpositionState note)
                in
                    Ok transposedNote


{-| Transpose a tune to the target key.
-}
transposeTo : ModifiedKeySignature -> AbcTune -> Result String AbcTune
transposeTo targetmks t =
    let
        -- get the key signature from the tune if there is one, default to C Major
        mks =
            getKeySig t
                |> withDefault defaultKey

        -- find the distance between the keys
        rdistance =
            keyDistance targetmks mks
    in
        case rdistance of
            Err e ->
                Err e

            Ok d ->
                -- don't bother transposing if there's no distance between the keys
                if (d == 0) then
                    Ok t
                else
                    let
                        transpositionState =
                            { keyDistance = d
                            , sourcemks = mks
                            , sourceBarAccidentals = Music.Accidentals.empty
                            , targetmks = targetmks
                            , targetKeySet = modifiedKeySet targetmks
                            , targetScale = diatonicScale (first targetmks)
                            , targetBarAccidentals = Music.Accidentals.empty
                            }
                    in
                        Ok (transposeTune transpositionState t)



-- Implementation


transposeTune : TranspositionState -> AbcTune -> AbcTune
transposeTune state t =
    let
        ( headers, body ) =
            t

        newHeaders =
            replaceKeyHeader state.targetmks headers
    in
        ( newHeaders, (transposeTuneBody state body) )



{- transpose the tune body.  We need to thread state through the tune in case there's an inline
   information header which changes key part way through the tune
-}


transposeTuneBody : TranspositionState -> TuneBody -> TuneBody
transposeTuneBody state body =
    let
        f n acc =
            let
                ( bs, s0 ) =
                    acc

                ( b1, s1 ) =
                    transposeBodyPart s0 n
            in
                ( b1 :: bs, s1 )
    in
        let
            ( tb, news ) =
                List.foldl f ( [], state ) body
        in
            List.reverse tb


processHeader : TranspositionState -> Header -> ( Header, TranspositionState )
processHeader state h =
    case h of
        Key mks ->
            let
                newmks =
                    transposeKeySignatureBy state.keyDistance mks

                -- newmks = log "\r\nkey change\r\n" (transposeKeySignatureBy state.keyDistance mks)
            in
                ( Key newmks
                , { state
                    | sourcemks = mks
                    , sourceBarAccidentals = Music.Accidentals.empty
                    , targetmks = newmks
                    , targetKeySet = modifiedKeySet newmks
                    , targetScale = diatonicScale (first newmks)
                    , targetBarAccidentals = Music.Accidentals.empty
                  }
                )

        _ ->
            ( h, state )


transposeBodyPart : TranspositionState -> BodyPart -> ( BodyPart, TranspositionState )
transposeBodyPart state bp =
    case bp of
        -- just transpose the score
        Score ms ->
            let
                ( ms1, s1 ) =
                    transposeMusicList state ms
            in
                ( Score ms1, s1 )

        -- transpose any Key header found inline
        BodyInfo h ->
            let
                ( h1, state1 ) =
                    processHeader state h
            in
                ( BodyInfo h1, state1 )


transposeMusic : TranspositionState -> Music -> ( Music, TranspositionState )
transposeMusic state m =
    case m of
        Note n ->
            let
                ( tn1, s1 ) =
                    transposeNoteBy state n
            in
                ( Note tn1, s1 )

        BrokenRhythmPair n1 b n2 ->
            let
                ( tn1, s1 ) =
                    transposeNoteBy state n1

                ( tn2, s2 ) =
                    transposeNoteBy s1 n2
            in
                ( BrokenRhythmPair tn1 b tn2, s2 )

        Tuplet ts ns ->
            let
                ( ns1, s1 ) =
                    transposeNoteList state ns
            in
                ( Tuplet ts ns1, s1 )

        GraceNote b ns ->
            let
                ( m1, s1 ) =
                    transposeNoteList state ns
            in
                ( GraceNote b m1, s1 )

        Chord c ->
            let
                ( tc, s1 ) =
                    transposeChord state c
            in
                ( Chord tc, s1 )

        -- we won't attempt to transpose chord symbols - just quietly drop them
        ChordSymbol s ->
            ( Ignore, state )

        -- new bar, initialise accidentals list
        Barline b ->
            ( Barline b, { state | sourceBarAccidentals = Music.Accidentals.empty, targetBarAccidentals = Music.Accidentals.empty } )

        -- an inline header
        Inline h ->
            let
                ( h1, state1 ) =
                    processHeader state h
            in
                ( Inline h1, state1 )

        _ ->
            ( m, state )


transposeMusicList : TranspositionState -> List Music -> ( List Music, TranspositionState )
transposeMusicList state ms =
    let
        f n acc =
            let
                ( ns, s0 ) =
                    acc

                ( n1, s1 ) =
                    transposeMusic s0 n
            in
                ( n1 :: ns, s1 )
    in
        let
            ( tns, news ) =
                List.foldl f ( [], state ) ms
        in
            ( List.reverse tns, news )


transposeNoteList : TranspositionState -> List AbcNote -> ( List AbcNote, TranspositionState )
transposeNoteList state ns =
    let
        f n acc =
            let
                ( ns, s0 ) =
                    acc

                ( n1, s1 ) =
                    transposeNoteBy s0 n
            in
                ( n1 :: ns, s1 )
    in
        let
            ( tns, news ) =
                List.foldl f ( [], state ) ns
        in
            ( List.reverse tns, news )


transposeChord : TranspositionState -> AbcChord -> ( AbcChord, TranspositionState )
transposeChord state c =
    let
        ( ns, newstate ) =
            transposeNoteList state c.notes
    in
        ( { c | notes = ns }, newstate )


{-| transpose a note by the required distance which may be positive or negative
    transposition distance and source and target keys are taken from the state.  This is the heart of the module.

    The strategy is:
      * does the source note have an explicit accidental?
      * if not, does it have an implicit accidental?  i.e. implied firstly by an earlier explicit in the bar or secondly by the key signature
      * move the note to the target by the required distance between the keys, using either form of accidental if present
      * use a convention for the target note that if it has an explicit accidental, the accidental in the full note is represented as Just Acc - otherwise None
      * to decide on whether an explicit accidental is present, first look up the exact note in the target bar accidentals, then do so for just the pitch
        (i.e. there is an accidental for the pitch but it's a different one) and finally look up the note in the target scale for the key in question
      * if there is an explicit accidental, save the source note in the source bar accidentals, ditto for the target, keep in the state
-}
transposeNoteBy : TranspositionState -> AbcNote -> ( AbcNote, TranspositionState )
transposeNoteBy state note =
    let
        -- make any implicit accidental explicit in the source note to be transposed if it's not marked as an accidental
        inSourceKeyAccidental =
            accidentalImplicitInKey note.pitchClass (state.sourcemks)

        inSourceBarAccidental =
            lookup note.pitchClass state.sourceBarAccidentals

        -- we must do the lookup of the source accidental in this order - local bar overrides key
        implicitSourceAccidental =
            firstOneOf [ inSourceBarAccidental, inSourceKeyAccidental ]

        explicitSourceNote =
            if (isJust note.accidental) then
                note
            else
                { note | accidental = implicitSourceAccidental }

        srcNum =
            noteNumber explicitSourceNote

        ( targetNum, octaveIncrement ) =
            noteIndex srcNum (state.keyDistance)

        ka =
            pitchFromInt (first state.targetmks) targetNum

        ( pc, acc ) =
            sharpenFlatEnharmonic ka

        targetAcc =
            -- is it present in the local target bar accidentals
            if (Music.Accidentals.member ( pc, acc ) state.targetBarAccidentals) then
                Nothing
                -- is it present in the local target bar accidentals but with a different value
            else if (isJust (Music.Accidentals.lookup pc state.targetBarAccidentals)) then
                Just acc
                -- is it in the set of keys in the target diatonic scale
            else if (inScale ( pc, acc ) state.targetScale) then
                Nothing
            else
                Just acc

        transposedNote =
            { note | pitchClass = pc, accidental = targetAcc, octave = note.octave + octaveIncrement }

        {-
           _ = log "\r\nsource note" note
           _ = log "source note made explicit" explicitSourceNote
           _ = log "source accidentals" state.sourceBarAccidentals
           _ = log "target keyset" state.targetKeySet
           _ = log "target key sig " state.targetmks
           _ = log "target accidentals" state.targetBarAccidentals
           _ = log "target scale" state.targetScale
           _ = log "transposed note" transposedNote
           _ = log "accidentalised target note" (pc, acc)
           _ = log "is transposed note a member of target accs" (Music.Accidentals.member (pc, acc) state.targetBarAccidentals)
        -}
        -- save any accidental nature of the original untransposed note
        newSourceAccs =
            addBarAccidental note.pitchClass note.accidental state.sourceBarAccidentals

        -- if the target, after all this, has an explicit accidental, we need to save it in the target bar accidental state
        newTargetAccs =
            if (isJust targetAcc) then
                -- we use the explicit form of the target
                addBarAccidental pc (Just acc) state.targetBarAccidentals
            else
                state.targetBarAccidentals

        -- update the state with both the source an target bar accidentals
        newState =
            { state | sourceBarAccidentals = newSourceAccs, targetBarAccidentals = newTargetAccs }
    in
        ( transposedNote, newState )


{-| enharmonic equivalence for flattened accidentals
   We'll (for the moment) use the convention that most flat accidentals
   are presented in sharpened form
-}
sharpenFlatEnharmonic : KeyAccidental -> KeyAccidental
sharpenFlatEnharmonic ka =
    case ka of
        ( G, Flat ) ->
            ( F, Sharp )

        ( D, Flat ) ->
            ( C, Sharp )

        _ ->
            ka



{- we need to take note of any accidentals so far in the bar because these may influence
   later notes in that bar.  If the note uses an accidental, add it to the accidental set.
-}


addBarAccidental : PitchClass -> Maybe Accidental -> Accidentals -> Accidentals
addBarAccidental pc ma accs =
    case ma of
        Just acc ->
            Music.Accidentals.add pc acc accs

        _ ->
            accs



{- create a list of pairs which should match every possible
   note pitch  (pitch class and accidental) with its offset into
   its 12-note chromatic scale
-}


noteNumbers : List ( ( PitchClass, Accidental ), Int )
noteNumbers =
    [ ( ( C, Flat ), 11 )
    , ( ( C, Natural ), 0 )
    , ( ( C, Sharp ), 1 )
    , ( ( C, DoubleSharp ), 2 )
    , ( ( D, DoubleFlat ), 0 )
    , ( ( D, Flat ), 1 )
    , ( ( D, Natural ), 2 )
    , ( ( D, Sharp ), 3 )
    , ( ( D, DoubleSharp ), 4 )
    , ( ( E, DoubleFlat ), 2 )
    , ( ( E, Flat ), 3 )
    , ( ( E, Natural ), 4 )
    , ( ( E, Sharp ), 5 )
    , ( ( E, DoubleSharp ), 6 )
    , ( ( F, Flat ), 4 )
    , ( ( F, Natural ), 5 )
    , ( ( F, Sharp ), 6 )
    , ( ( F, DoubleSharp ), 7 )
    , ( ( G, DoubleFlat ), 5 )
    , ( ( G, Flat ), 6 )
    , ( ( G, Natural ), 7 )
    , ( ( G, Sharp ), 8 )
    , ( ( G, DoubleSharp ), 9 )
    , ( ( A, DoubleFlat ), 7 )
    , ( ( A, Flat ), 8 )
    , ( ( A, Natural ), 9 )
    , ( ( A, Sharp ), 10 )
    , ( ( A, DoubleSharp ), 11 )
    , ( ( B, DoubleFlat ), 9 )
    , ( ( B, Flat ), 10 )
    , ( ( B, Natural ), 11 )
    , ( ( B, Sharp ), 0 )
    , ( ( B, DoubleSharp ), 1 )
    ]



{- note pairs for the black and white notes of a piano,
   designating black notes with the Sharp accidental
-}


sharpNoteNumbers : List ( ( PitchClass, Accidental ), Int )
sharpNoteNumbers =
    let
        f nn =
            let
                ( ( pc, a ), i ) =
                    nn
            in
                ((a == Sharp) && (pc /= E && pc /= B))
                    || (a == Natural)
    in
        List.filter f noteNumbers



{- note pairs for the black and white notes of a piano,
   designating black notes with the Flat accidental
-}


flatNoteNumbers : List ( ( PitchClass, Accidental ), Int )
flatNoteNumbers =
    let
        f nn =
            let
                ( ( pc, a ), i ) =
                    nn
            in
                ((a == Flat) && (pc /= F && pc /= C))
                    || (a == Natural)
    in
        List.filter f noteNumbers



{- given a key signature and an integer (0 <= n < notesInChromaticScale)
   return the pitch of the note within that signature
-}


pitchFromInt : KeySignature -> Int -> KeyAccidental
pitchFromInt ks i =
    let
        dict =
            if (isCOrSharpKey ks) then
                sharpNotedNumbers
            else
                flatNotedNumbers
    in
        Dict.get i dict
            |> withDefault ( C, Natural )



{- the inverted lookup for sharp chromatic scales.  This dictionaary
   allows you to enter a number (0 <= n < notesInChromaticScale) and return
   a (pitchClass, Accidental) pair which is the note's pitch
-}


sharpNotedNumbers : Dict Int ( PitchClass, Accidental )
sharpNotedNumbers =
    let
        invert ( a, b ) =
            ( b, a )
    in
        List.map invert sharpNoteNumbers
            |> Dict.fromList



{- the inverted lookup for flat chromatic scales.  This dictionaary
   allows you to enter a number (0 <= n < notesInChromaticScale) and return
   a (pitchClass, Accidental) pair which is the note's pitch
-}


flatNotedNumbers : Dict Int ( PitchClass, Accidental )
flatNotedNumbers =
    let
        invert ( a, b ) =
            ( b, a )
    in
        List.map invert flatNoteNumbers
            |> Dict.fromList



{- make a note's pitch comparable by translating to a string
   so it can be used in dictionaries
-}


comparableNote : ( PitchClass, Accidental ) -> String
comparableNote n =
    let
        ( pc, acc ) =
            n

        accStr =
            case acc of
                Natural ->
                    ""

                Sharp ->
                    "#"

                Flat ->
                    "b"

                DoubleSharp ->
                    "##"

                DoubleFlat ->
                    "bb"
    in
        toString pc ++ accStr



{- noteNumbers with the notes converted to comparable strings for use in dictionaries -}


comparableNoteNumbers : List ( String, Int )
comparableNoteNumbers =
    let
        f notePair =
            ( comparableNote (first notePair), (second notePair) )
    in
        List.map f noteNumbers



{- a dictionary of comparable note -> note number -}


chromaticScaleDict : Dict String Int
chromaticScaleDict =
    Dict.fromList comparableNoteNumbers


lookupChromatic : Dict String Int -> String -> Int
lookupChromatic dict target =
    Dict.get target dict
        |> withDefault 0



{- look up the pitch and return a number in the range 0 <= n < notesInChromaticScale  (0 is C Natural) -}


pitchNumber : ( PitchClass, Accidental ) -> Int
pitchNumber pa =
    lookupChromatic chromaticScaleDict (comparableNote pa)



{- look up the note and return the number of its pitch in the range 0 <= n < notesInChromaticScale (0 is C Natural) -}


noteNumber : AbcNote -> Int
noteNumber n =
    let
        acc =
            n.accidental
                |> withDefault Natural
    in
        pitchNumber ( n.pitchClass, acc )



{- inspect the current note index and the amount it is to be incremented by.
   produce a new note index in the range (0 <= n < notesInChromaticScale)
   and associate with this a number (-1,0,1) which indicates an increment to the octave
-}


noteIndex : Int -> Int -> ( Int, Int )
noteIndex from increment =
    let
        -- _ = log "note index from" from
        -- _ = log "note index by" increment
        to =
            (from + increment)
    in
        if to < 0 then
            ( (notesInChromaticScale + to), -1 )
        else if (to >= notesInChromaticScale) then
            ( (to - notesInChromaticScale), 1 )
        else
            ( to, 0 )



{- work out the minimum transposition distance (target - source) or (source - target) measured in semitones -}


transpositionDistance : ( PitchClass, Maybe Accidental ) -> ( PitchClass, Maybe Accidental ) -> Int
transpositionDistance target src =
    let
        ( spc, smacc ) =
            src

        ( tpc, tmacc ) =
            target

        sacc =
            smacc |> withDefault Natural

        tacc =
            tmacc |> withDefault Natural

        distance =
            (pitchNumber ( tpc, tacc ) - pitchNumber ( spc, sacc ))
    in
        -- +5 is a shorter distance than -7 etc
        if (distance <= -7) then
            (notesInChromaticScale + distance) % notesInChromaticScale
        else
            distance



{- replace a Key header (if it exists) -}


replaceKeyHeader : ModifiedKeySignature -> TuneHeaders -> TuneHeaders
replaceKeyHeader newmks hs =
    let
        f h =
            case h of
                Key mks ->
                    False

                _ ->
                    True

        newhs =
            List.filter f hs
    in
        newhs ++ [ Key newmks ]


{-| Pick the first `Maybe` that actually has a value
-}
firstOneOf : List (Maybe a) -> Maybe a
firstOneOf =
    List.foldr or Nothing