module Abc.Canonical
    exposing
        ( fromTune
        , fromResult
        , abcNote
        , abcChord
        , tuplet
        )

{-| Module for converting an ABC Tune parse tree to a canonical ABC string,



# Functions
@docs fromTune, fromResult, abcNote, abcChord, tuplet

-}

import Abc.ParseTree exposing (..)
import Ratio exposing (Rational, numerator, denominator)
import Maybe exposing (withDefault)
import String exposing (fromChar, fromList, repeat, trimRight, toLower)
import Tuple exposing (first, second)


enquote : String -> String
enquote s =
    "\"" ++ s ++ "\""


mode : Mode -> String
mode m =
    case m of
        Major ->
            "major"

        Minor ->
            "minor"

        Ionian ->
            "ionian"

        Dorian ->
            "dorian"

        Phrygian ->
            "phrygian"

        Lydian ->
            "lydian"

        Mixolydian ->
            "mixolydian"

        Aeolian ->
            "aeolian"

        Locrian ->
            "locrian"


bar : Bar -> String
bar b =
    let
        it =
            withDefault "" (Maybe.map toString b.iteration)

        lines =
            case b.thickness of
                ThickThin ->
                    "[|"

                ThinThick ->
                    "|]"

                ThinThin ->
                    "||"

                _ ->
                    "|"
    in
        case b.repeat of
            Nothing ->
                lines ++ it

            Just Begin ->
                lines ++ ":"

            Just End ->
                ":" ++ lines ++ it

            Just BeginAndEnd ->
                ":" ++ lines ++ ":"


accidental : Accidental -> String
accidental a =
    case a of
        Sharp ->
            "^"

        Flat ->
            "_"

        DoubleSharp ->
            "^^"

        DoubleFlat ->
            "__"

        Natural ->
            "="


headerAccidental : Accidental -> String
headerAccidental a =
    case a of
        Sharp ->
            "#"

        Flat ->
            "b"

        _ ->
            ""


{-| Pretty-print a tuplet.
-}
tuplet : TupletSignature -> String
tuplet t =
    let
        ( p, q, r ) =
            t
    in
        case t of
            ( 2, 3, 2 ) ->
                "(2"

            ( 3, 2, 3 ) ->
                "(3"

            ( 4, 3, 4 ) ->
                "(4"

            _ ->
                "("
                    ++ (toString p)
                    ++ ":"
                    ++ (toString q)
                    ++ ":"
                    ++ (toString r)


tempo : TempoSignature -> String
tempo t =
    let
        text =
            withDefault "" (Maybe.map (\s -> " " ++ (enquote s)) t.marking)

        eq =
            if (List.length t.noteLengths == 0) then
                ""
            else
                "="
    in
        ratlist t.noteLengths
            ++ eq
            ++ toString t.bpm
            ++ text


rational : Rational -> String
rational r =
    toString (numerator r) ++ "/" ++ toString (denominator r)


ratlist : List Rational -> String
ratlist rs =
    let
        f r acc =
            (rational r) ++ " " ++ acc
    in
        List.foldr f "" rs
            |> trimRight


meter : Maybe MeterSignature -> String
meter ms =
    case ms of
        Nothing ->
            "none"

        Just m ->
            let
                ( n, d ) =
                    m
            in
                toString n ++ "/" ++ toString d


duration : NoteDuration -> String
duration nd =
    if (denominator nd == 1) && (numerator nd == 1) then
        ""
    else if (denominator nd == 2) && (numerator nd == 1) then
        "/"
    else if (denominator nd == 1) then
        toString (numerator nd)
    else
        rational nd


key : KeySignature -> String
key k =
    let
        acc =
            Maybe.map headerAccidental k.accidental
                |> withDefault ""
    in
        toString k.pitchClass ++ acc ++ toString k.mode


keyAccidental : KeyAccidental -> String
keyAccidental ka =
    let
        ( pc, acc ) =
            ka
    in
        accidental acc ++ toLower (toString pc)


keyAccidentals : List KeyAccidental -> String
keyAccidentals =
    String.concat
        << List.map (\a -> " " ++ keyAccidental a)


octave : Int -> String
octave i =
    let
        octaveAboveMiddleC =
            middlecOctave + 1
    in
        if ((i == middlecOctave) || (i == octaveAboveMiddleC)) then
            ""
        else if (i > octaveAboveMiddleC) then
            repeat (i - octaveAboveMiddleC) "'"
        else
            repeat (middlecOctave - i) ","


pitch : Int -> PitchClass -> String
pitch octave p =
    if (octave <= middlecOctave) then
        toString p
    else
        toLower (toString p)


{-| Pretty-print a note.
-}
abcNote : AbcNote -> String
abcNote a =
    let
        acc =
            Maybe.map accidental a.accidental
                |> withDefault ""

        tie =
            case a.tied of
                True ->
                    "-"

                _ ->
                    ""
    in
        acc
            ++ pitch a.octave a.pitchClass
            ++ octave a.octave
            ++ duration a.duration
            ++ tie


{-| Pretty-print a chord.
-}
abcChord : AbcChord -> String
abcChord a =
    "["
        ++ (notes a.notes)
        ++ "]"
        ++ duration a.duration


notes : List AbcNote -> String
notes ns =
    let
        f a acc =
            (abcNote a) ++ acc
    in
        List.foldr f "" ns


rest : NoteDuration -> String
rest n =
    "z" ++ (duration n)


decorate : String -> String
decorate s =
    if (String.length s == 1) then
        s
    else
        "!" ++ s ++ "!"


musics : List Music -> String
musics ms =
    let
        f m acc =
            (music m) ++ acc
    in
        List.foldr f "" ms


broken : Broken -> String
broken b =
    case b of
        LeftArrow i ->
            String.repeat i "<"

        RightArrow i ->
            String.repeat i ">"


music : Music -> String
music m =
    case m of
        Barline b ->
            bar b

        Note a ->
            abcNote a

        BrokenRhythmPair a1 b a2 ->
            abcNote a1 ++ (broken b) ++ abcNote a2

        Rest r ->
            rest r

        Tuplet tup ns ->
            tuplet tup ++ notes ns

        Decoration s ->
            decorate s

        GraceNote isAcciaccatura ns ->
            "{" ++ notes ns ++ "}"

        Slur c ->
            String.fromChar c

        Annotation placement s ->
            toString placement ++ ":" ++ s

        ChordSymbol s ->
            enquote s

        Chord a ->
            abcChord a

        Inline h ->
            "[" ++ header h ++ "]"

        Spacer i ->
            " "

        Ignore ->
            ""

        Continuation ->
            "\\"


header : Header -> String
header h =
    case h of
        Area s ->
            "A: " ++ s

        Book s ->
            "B: " ++ s

        Composer s ->
            "C: " ++ s

        Discography s ->
            "D: " ++ s

        FileUrl s ->
            "F: " ++ s

        Group s ->
            "G: " ++ s

        History s ->
            "H: " ++ s

        Instruction s ->
            "I: " ++ s

        Key ( k, kacc ) ->
            "K: " ++ (key k) ++ (keyAccidentals kacc)

        UnitNoteLength d ->
            "L: " ++ (duration d)

        Meter m ->
            "M: " ++ (meter m)

        Macro s ->
            "m: " ++ s

        Notes s ->
            "N: " ++ s

        Origin s ->
            "O: " ++ s

        Parts s ->
            "P: " ++ s

        Rhythm s ->
            "R: " ++ s

        Remark s ->
            "r: " ++ s

        Source s ->
            "S: " ++ s

        Title s ->
            "T: " ++ s

        Tempo t ->
            "Q: " ++ (tempo t)

        UserDefined s ->
            "U: " ++ s

        Voice s ->
            "V: " ++ s

        WordsAfter s ->
            "W: " ++ s

        WordsAligned s ->
            "w: " ++ s

        ReferenceNumber i ->
            "X: " ++ (toString i)

        Transcription s ->
            "Z: " ++ s

        FieldContinuation s ->
            "+: " ++ s

        Comment s ->
            "%" ++ s

        _ ->
            ""


tuneHeaders : List Header -> String
tuneHeaders hs =
    let
        f h acc =
            (header h) ++ "\x0D\n" ++ acc
    in
        List.foldr f "" hs


bodyPart : BodyPart -> String
bodyPart bp =
    case bp of
        Score ml ->
            musics ml

        BodyInfo h ->
            header h


continuation : Bool -> String
continuation c =
    if c then
        "\\"
    else
        ""


tuneBody : TuneBody -> String
tuneBody b =
    let
        f bp acc =
            (bodyPart bp) ++ "\x0D\n" ++ acc
    in
        List.foldr f "" b



-- Main Exported Functions


{-| Translate an ABC Tune parse tree to a canonical ABC String.
-}
fromTune : AbcTune -> String
fromTune t =
    tuneHeaders (first t) ++ tuneBody (second t)


{-| Translate a parse Result containing an ABC Tune parse tree to a Result containing a canonical ABC String.
-}
fromResult : Result String AbcTune -> Result String String
fromResult r =
    Result.map fromTune r