This is an alternative site for discovering Elm packages. You may be looking for the official Elm package site instead.
1.0.0

Abc.Canonical

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

Functions

fromTune : AbcTune -> String

Translate an ABC Tune parse tree to a canonical ABC String.

fromResult : Result String AbcTune -> Result String String

Translate a parse Result containing an ABC Tune parse tree to a Result containing a canonical ABC String.

abcNote : AbcNote -> String

Pretty-print a note.

abcChord : AbcChord -> String

Pretty-print a chord.

tuplet : TupletSignature -> String

Pretty-print a tuplet.

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