
# LANGUAGE TypeOperators , OverloadedStrings ,  

-------------------------------------------------------------------------------------
-- |
  Copyright    : ( c )   2012
--
-- License     : BSD-style
--
  Maintainer   : 
-- Stability   : experimental
-- Portability : portable
--
  A  representation and parser for ABC notation . Based on the 2.1 standard .
--
-- For more information see <>.
--
-------------------------------------------------------------------------------------

-- TODO compare 

module Data.Music.Abc (

        ----------------------------------------------------------------------

        -- * Abc format
        -- ** Files
        AbcFile(..),

        -- *** File header
        FileHeader(..),
        Element(..),

        -- ** Tunes
        AbcTune(..),
        TuneHeader(..),
        TuneBody(..),

        ----------------------------------------------------------------------

        -- * Music
        Music(..),
        Chord(..),
        Barline(..),
        Annotation(..),
        ChordSymbol(..),
        Decoration(..),
        Dynamic(..),

        -- ** Time
        Duration(..),
        Meter(..),
        Tempo(..),

        -- ** Pitch
        PitchClass(..),
        Accidental(..),
        Octave(..),
        Pitch(..),
        Key(..),
        StemDirection(..),
        Clef(..),
        Mode(..),

        ----------------------------------------------------------------------

        -- * Information
        Information(..),
        Directive(..),
        VoiceProperties(..),

        ----------------------------------------------------------------------

        -- * Import and export
        readAbc,
        showAbc
  ) where

import Data.Maybe
import Data.Ratio
import Data.Char
import Data.Semigroup
import Data.List (intersperse)
import Text.Pretty hiding (Mode)

--------------------------------------------------------------------------------

-- File structure


  | A full ABC file ( 2.2 ) .
data AbcFile
    = AbcFile
        (Maybe String)
        (Maybe FileHeader)
        [Element]
    deriving (Eq, Ord, Show)

instance Pretty AbcFile where
    pretty (AbcFile version header elements) = mempty
        <> "%abc-" <> string (fromMaybe "2.1" version) <> "\n"
        <> pretty header <> "\n"
        <> sepBy "\n" (fmap pretty elements) <> "\n"
    
    
  | File header ( 2.2.2 ) .
data FileHeader
    = FileHeader
        [Information]
        [Directive]
    deriving (Eq, Ord, Show)

instance Pretty FileHeader where
    pretty (FileHeader info directives) = mempty
        <> sepBy "\n" (fmap pretty info) <> "\n"
        <> sepBy "\n" (fmap pretty directives)


  | Either a tune , free text or typeset text ( 2.2.3 ) .
data Element
    = Tune
        AbcTune                         -- ^ An Abc tune.
    | FreeText
  ^ Free text ( 2.2.3 ) .
    | TypesetText
  ^ Typeset text ( 2.2.3 ) .
    deriving (Eq, Ord, Show)

instance Pretty Element where
    pretty (Tune a)         = pretty a
    pretty (FreeText a)     = string a
    pretty (TypesetText a)  = string a


data AbcTune
    = AbcTune
        TuneHeader
        TuneBody
    deriving (Eq, Ord, Show)

instance Pretty AbcTune where
    pretty (AbcTune header elements) = mempty
        <> pretty header <> "\n"
        <> sepBy "\n" (fmap pretty elements) <> "\n"


data TuneHeader
    = TuneHeader
        [Information]
    deriving (Eq, Ord, Show)

instance Pretty TuneHeader where
    pretty (TuneHeader info) =
        sepBy "\n" (fmap pretty info)


-- | Lines of music code.
type TuneBody 
    = [Music]
  TODO voices , see 


--------------------------------------------------------------------------------

  Music


-- | One line of music code.
data Music
    = Chord Chord
    | Barline Barline
    | Tie Music
    | Slur Music
    | Beam Music
    | Grace Music
    | Tuplet Duration Music
    | Decorate Decoration Music
    | Annotate Annotation Music
    | ChordSymbol ChordSymbol Music
    | Sequence [Music] -- beam? music
    deriving (Eq, Ord, Show)

instance Pretty Music where
    pretty = go
        where
            go (Chord a) = pretty a
            go (Sequence as) = sepBy " " $ fmap pretty as
  FIXME


data Annotation
    = AnnotateLeft String
    | AnnotateRight String
    | AnnotateAbove String
    | AnnotateBelow String
    | AnnotateUnspecified String
    deriving (Eq, Ord, Show)
    
  TODO clefs and transposition ( 4.6 )
  TODO redifinable symbols ( 4.16 )
  TODO symbol lines ( 4.15 )
-- TODO symbol lyrics

  Note ( 4.20 )
newtype Chord = Chord_ { getChord :: (
        [Pitch],
        (Maybe Duration)
    ) }
    deriving (Eq, Ord, Show)

instance Pretty Chord where
  TODO skip duration if zero
    pretty (Chord_ ([], dur))       = ""
    pretty (Chord_ ([pitch], dur))  =
        pretty pitch <> pretty dur
    pretty (Chord_ (pitches, dur))  =
        brackets (sepBy "" (fmap pretty pitches)) <> pretty dur


type ChordSymbol 
    = String

-- | Barline, including special barlines and repeats.
data Barline
    = SingleBarline
    | DoubleBarline Bool Bool           -- thick? thick?
    | Repeat Int Bool Bool              -- times end? begin?
    | DottedBarline Barline
    | InvisibleBarline Barline
    deriving (Eq, Ord, Show)

  TODO first and second repeats ( 4.9 )
  TODO variant endings ( 4.10 )


  | Decorations ( 4.14 )
data Decoration
    = Trill                   -- "tr" (trill mark)
    | TrillBegin              -- start of an extended trill
    | TrillEnd                -- end of an extended trill
    | Lowermordent            -- short squiggle with a vertical line through it
    | Uppermordent            -- short squiggle
  a roll mark ( arc ) as used in Irish music
    | Turn                    -- a turn mark (also known as gruppetto)
    | Turnx                   -- a turn mark with a line through it
    | Invertedturn            -- an inverted turn mark
    | Invertedturnx           -- an inverted turn mark with a line through it
    | Arpeggio                -- vertical squiggle
    | Accent                  -- accent mark
    | Fermata Bool            -- fermata or hold (arc above dot), inverted?
    | Tenuto                  -- horizontal line to indicate holding note for full duration
    | Fingering Int           -- fingerings
  left - hand pizzicato , or rasp for French horns
    | Snap                    -- snap-pizzicato mark, visually similar to !thumb!
    | Slide                   -- slide up to a note, visually similar to a half slur
    | Wedge                   -- small filled-in wedge mark
    | Upbow                   -- V mark
    | Downbow                 -- squared n mark
    | Open                    -- small circle above note indicating open string or harmonic
    | Thumb                   -- cello thumb symbol
    | Breath                  -- a breath mark (apostrophe-like) after note
    | Dynamic Dynamic         -- Dynamics
    | Crescendo               -- start of a crescendo mark
    | EndCrescendo            -- end of a crescendo mark, placed after the last note
    | Diminuendo              -- start of a diminuendo mark
    | EndDiminuendo           -- end of a diminuendo mark, placed after the last note
    | Segno                   -- ornate s-like symbols separated by a diagonal line
    | Coda                    -- a ring with a cross in it
  the letters D.S. (= Da Segno )
  the letters D.C. (= either   or   )
  the word " Da " followed by a Coda sign
    | Fine                    -- the word "fine"
    | Shortphrase             -- vertical line on the upper part of the staff
    | Mediumphrase            -- same, but extending down to the centre line
  same , but extending 3/4 of the way down
    deriving (Eq, Ord, Show)

data Dynamic
    = PPPP
    | PPP
    | PP
    | P_
    | MP
    | MF
    | F_
    | FF
    | FFF
    | FFFF
    | SFZ
    deriving (Eq, Ord, Show)


--------------------------------------------------------------------------------

-- Information


  | An information field ( 3 ) .
data Information
    = Area String
    | Book String
    | Composer String
    | Discography String
    | FileUrl String
    | Group String
    | History String
    | Instruction Directive
    | Key Key
    | UnitNoteLength Duration
    | Meter Meter            
  ^ Macro ( not supported )
    | Notes String                      -- ^ Notes
    | Origin String                     -- ^ Origin of tune.
    | Parts
    | Tempo Tempo                       -- ^ Tempo of tune.
    | Rhythm String                     -- ^ Rhythm type of tune.
    | Remark                            -- ^ Remarks (not supported)
    | Source String                     -- ^ Source material.
    | SymbolLine
    | Title String                      -- ^ Title of tune.
    | UserDefined                       -- ^ User defined (not supported)
    | Voice VoiceProperties
    | Words String
    | ReferenceNumber Integer
    | Transcription String
    deriving (Eq, Ord, Show)

instance Pretty Information where
    pretty a = string $ fieldName a ++ ": " ++ showField a


fieldName :: Information -> String
fieldName = go
    where
        go (Area _)                 = "A"
        go (Book _)                 = "B"
        go (Composer _)             = "C"
        go (Discography _)          = "D"
        go (FileUrl _)              = "F"
        go (Group _)                = "G"
        go (History _)              = "H"
        go (Instruction _)          = "I"
        go (Key _)                  = "K"
        go (UnitNoteLength _)       = "L"
        go (Meter _)                = "M"
        go Macro                    = "m"
        go (Notes _)                = "N"
        go (Origin _)               = "O"
        go Parts                    = "O"
        go (Tempo _)                = "Q"
        go (Rhythm _)               = "R"
        go Remark                   = "r"
        go (Source _)               = "S"
        go SymbolLine               = "s"
        go (Title _)                = "T"
        go UserDefined              = "U"
        go (Voice _)                = "V"
        go (Words _)                = "W"
        go (ReferenceNumber _)      = "X"
        go (Transcription _)        = "Z"

-- (file header, tune header, tune body, inline)
fieldAllowed :: Information -> (Bool, Bool, Bool, Bool)
fieldAllowed = go
    where
        go (Area _)                 = (True, True, False, False)
        go (Book _)                 = (True, True, False, False)
        go (Composer _)             = (True, True, False, False)
        go (Discography _)          = (True, True, False, False)
        go (FileUrl _)              = (True, True, False, False)
        go (Group _)                = (True, True, False, False)
        go (History _)              = (True, True, False, False)
        
        go (Instruction _)          = (True, True, True, True)
        go (Key _)                  = (False, True{-last-}, True, True)
        go (UnitNoteLength _)       = (True, True, True, True)
        go (Meter _)                = (True, True, True, True)
        go Macro                    = (True, True, True, True)
        go (Notes _)                = (True, True, True, True)
        
        go (Origin _)               = (True, True, False, False)
        go Parts                    = (False, True, True, True)
        go (Tempo _)                = (False, True, True, True)
        go (Rhythm _)               = (True, True, True, True)
        go Remark                   = (True, True, True, True)
        
        go (Source _)               = (True, True, False, False)
        go SymbolLine               = (False, False, True, False)
second
        
        go UserDefined              = (True, True, True, True)
        go (Voice _)                = (False, True, True, True)
        go (Words _)                = (False, True, True, False)
first
        go (Transcription _)        = (True, True, False, False)

fieldAllowedInFileHeader a = r where (r,_,_,_) = fieldAllowed a
fieldAllowedInTuneHeader a = r where (_,r,_,_) = fieldAllowed a
fieldAllowedInTuneBody   a = r where (_,_,r,_) = fieldAllowed a
fieldAllowedInline       a = r where (_,_,_,r) = fieldAllowed a

showField :: Information -> String
showField = go
    where
        go (Area a)                 = a
        go (Book a)                 = a
        go (Composer a)             = a
        go (Discography a)          = a
        go (FileUrl a)              = a
        go (Group a)                = a
        go (History a)              = a
        go (Instruction a)          = show $ pretty a
        go (Key a)                  = show $ pretty a
        go (UnitNoteLength a)       = show $ pretty a
        go (Meter a)                = show $ pretty a
        go Macro                    = ""
        go (Notes a)                = a
        go (Origin a)               = a
  TODO
        go (Tempo a)                = show $ pretty a
        go (Rhythm a)               = a
  TODO
        go (Source a)               = a
  TODO
        go (Title a)                = a
  TODO
        go (Voice a)                = show $ pretty a
        go (Words a)                = a
        go (ReferenceNumber a)      = show a
        go (Transcription a)        = a
        

--------------------------------------------------------------------------------

-- Base types

  | Pitch ( 4.1 , 4.2 ) .
newtype Pitch = Pitch { getPitch :: (PitchClass, Maybe Accidental, Octave) }
    deriving (Eq, Ord, Show)

instance Pretty Pitch where
    pretty (Pitch (cl, acc, oct)) = pretty acc <> (string $
        (if oct <= 0 then id else fmap toLower) (show cl)
        ++ replicate (negate (fromIntegral oct) `max` 0) ','
        ++ replicate (fromIntegral (oct - 1) `max` 0) '\'')

  | Pitch class ( 4.1 ) .
data PitchClass = C | D | E | F | G | A | B
    deriving (Eq, Ord, Show, Enum, Bounded)

  | Accidentals ( 4.2 ) .
data Accidental = DoubleFlat | Flat | Natural | Sharp | DoubleSharp
    deriving (Eq, Ord, Show, Enum, Bounded)

instance Pretty Accidental where
    pretty = go
        where
            go DoubleFlat   = "__"
            go Flat         = "_"
            go Natural      = "="
            go Sharp        = "^"
            go DoubleSharp  = "^^"

  | Octaves ( 4.1 ) .
newtype Octave = Octave { getOctave :: Int }
    deriving (Eq, Ord, Show, Enum, Num, Real, Integral)






  | Duration ( 4.3 ) .
newtype Duration = Duration { getDuration :: Rational }
    deriving (Eq, Ord, Show, Enum, Num, Real, Fractional, RealFrac)

instance Pretty Duration where
    pretty = string . showRatio . getDuration

            
data Meter
    = NoMeter
    | Common
    | Cut
    | Simple Rational
    | Compound [Integer] Integer
    deriving (Eq, Ord, Show)

instance Pretty Meter where
    pretty = go
        where
            go Common           = "C"
            go Cut              = "C|"
            go (Simple a)       = string $ showRatio a
            go (Compound as a)  = sepBy "+" (fmap integer as) <> "/" <> integer a








newtype Key = Key_ (Integer, Mode)
    deriving (Eq, Ord, Show)

instance Pretty Key where
    pretty (Key_ (tonic, mode)) = prettyTonic tonic <+> pretty mode
        where
            prettyTonic a = case a of
                0 -> "C"

data Mode
    = Major
    | Minor
    | Ionian
    | Dorian
    | Phrygian
    | Lydian
    | Mixolydian
    | Aeolian
    | Locrian
    deriving (Eq, Ord, Show)

instance Pretty Mode where
    pretty = go
        where
            go Major        = ""
            go Minor        = "minor"
            go Ionian       = "ionian"
            go Dorian       = "dorian"
            go Phrygian     = "phrygian"
            go Lydian       = "lydian"
            go Mixolydian   = "mixolydian"
            go Aeolian      = "aeolian"
            go Locrian      = "locrian"




-- | Optional string, numerators, frequency (3.1.8)
newtype Tempo = Tempo_ { getTempo :: (Maybe String, [Duration], Duration) }
    deriving (Eq, Ord, Show)

instance Pretty Tempo where
    pretty (Tempo_ (str, durs, bpm)) = 
        pretty str <+> (hsep (fmap pretty durs) <> "=" <> pretty bpm)

data VoiceProperties
    = VoiceProperties
        (Maybe String)
        (Maybe String)
        (Maybe StemDirection)
        (Maybe Clef)
    deriving (Eq, Ord, Show)

instance Pretty VoiceProperties where
    pretty _ = "{VoiceProperties}"
  FIXME

data StemDirection = Up | Down
    deriving (Eq, Ord, Show, Enum, Bounded)

data Clef = NoClef | Treble | Alto | Tenor | Bass | Perc
    deriving (Eq, Ord, Show, Enum, Bounded)


-- | Abc directive.
newtype Directive = Directive { getDirective :: (String, String) }
    deriving (Eq, Ord, Show)

instance Pretty Directive where
    pretty _ = "{Directive}"
  FIXME



--------------------------------------------------------------------------------

-- Utility

readAbc :: String -> AbcFile
readAbc = error "Not impl"

showAbc :: AbcFile -> String
showAbc = error "Not impl"


showRatio :: (Integral a, Show a) => Ratio a -> String
showRatio x
    | denominator x == 1  = show (numerator x)
    | otherwise           = (show $ numerator x) ++ "/" ++ (show $ denominator x)


-----------------------------------------------------------------------------------
 |

 License     : BSD-style

 Stability   : experimental
 Portability : portable


 For more information see <>.

-----------------------------------------------------------------------------------
 TODO compare 
--------------------------------------------------------------------
 * Abc format
 ** Files
 *** File header
 ** Tunes
--------------------------------------------------------------------
 * Music
 ** Time
 ** Pitch
--------------------------------------------------------------------
 * Information
--------------------------------------------------------------------
 * Import and export
------------------------------------------------------------------------------
 File structure
 ^ An Abc tune.
 | Lines of music code.
------------------------------------------------------------------------------
 | One line of music code.
 beam? music
 TODO symbol lyrics
 | Barline, including special barlines and repeats.
 thick? thick?
 times end? begin?
 "tr" (trill mark)
 start of an extended trill
 end of an extended trill
 short squiggle with a vertical line through it
 short squiggle
 a turn mark (also known as gruppetto)
 a turn mark with a line through it
 an inverted turn mark
 an inverted turn mark with a line through it
 vertical squiggle
 accent mark
 fermata or hold (arc above dot), inverted?
 horizontal line to indicate holding note for full duration
 fingerings
 snap-pizzicato mark, visually similar to !thumb!
 slide up to a note, visually similar to a half slur
 small filled-in wedge mark
 V mark
 squared n mark
 small circle above note indicating open string or harmonic
 cello thumb symbol
 a breath mark (apostrophe-like) after note
 Dynamics
 start of a crescendo mark
 end of a crescendo mark, placed after the last note
 start of a diminuendo mark
 end of a diminuendo mark, placed after the last note
 ornate s-like symbols separated by a diagonal line
 a ring with a cross in it
 the word "fine"
 vertical line on the upper part of the staff
 same, but extending down to the centre line
------------------------------------------------------------------------------
 Information
 ^ Notes
 ^ Origin of tune.
 ^ Tempo of tune.
 ^ Rhythm type of tune.
 ^ Remarks (not supported)
 ^ Source material.
 ^ Title of tune.
 ^ User defined (not supported)
 (file header, tune header, tune body, inline)
last
------------------------------------------------------------------------------
 Base types
 | Optional string, numerators, frequency (3.1.8)
 | Abc directive.
------------------------------------------------------------------------------
 Utility

# LANGUAGE TypeOperators , OverloadedStrings ,  

  Copyright    : ( c )   2012
  Maintainer   : 
  A  representation and parser for ABC notation . Based on the 2.1 standard .


module Data.Music.Abc (


        AbcFile(..),

        FileHeader(..),
        Element(..),

        AbcTune(..),
        TuneHeader(..),
        TuneBody(..),


        Music(..),
        Chord(..),
        Barline(..),
        Annotation(..),
        ChordSymbol(..),
        Decoration(..),
        Dynamic(..),

        Duration(..),
        Meter(..),
        Tempo(..),

        PitchClass(..),
        Accidental(..),
        Octave(..),
        Pitch(..),
        Key(..),
        StemDirection(..),
        Clef(..),
        Mode(..),


        Information(..),
        Directive(..),
        VoiceProperties(..),


        readAbc,
        showAbc
  ) where

import Data.Maybe
import Data.Ratio
import Data.Char
import Data.Semigroup
import Data.List (intersperse)
import Text.Pretty hiding (Mode)




  | A full ABC file ( 2.2 ) .
data AbcFile
    = AbcFile
        (Maybe String)
        (Maybe FileHeader)
        [Element]
    deriving (Eq, Ord, Show)

instance Pretty AbcFile where
    pretty (AbcFile version header elements) = mempty
        <> "%abc-" <> string (fromMaybe "2.1" version) <> "\n"
        <> pretty header <> "\n"
        <> sepBy "\n" (fmap pretty elements) <> "\n"
    
    
  | File header ( 2.2.2 ) .
data FileHeader
    = FileHeader
        [Information]
        [Directive]
    deriving (Eq, Ord, Show)

instance Pretty FileHeader where
    pretty (FileHeader info directives) = mempty
        <> sepBy "\n" (fmap pretty info) <> "\n"
        <> sepBy "\n" (fmap pretty directives)


  | Either a tune , free text or typeset text ( 2.2.3 ) .
data Element
    = Tune
    | FreeText
  ^ Free text ( 2.2.3 ) .
    | TypesetText
  ^ Typeset text ( 2.2.3 ) .
    deriving (Eq, Ord, Show)

instance Pretty Element where
    pretty (Tune a)         = pretty a
    pretty (FreeText a)     = string a
    pretty (TypesetText a)  = string a


data AbcTune
    = AbcTune
        TuneHeader
        TuneBody
    deriving (Eq, Ord, Show)

instance Pretty AbcTune where
    pretty (AbcTune header elements) = mempty
        <> pretty header <> "\n"
        <> sepBy "\n" (fmap pretty elements) <> "\n"


data TuneHeader
    = TuneHeader
        [Information]
    deriving (Eq, Ord, Show)

instance Pretty TuneHeader where
    pretty (TuneHeader info) =
        sepBy "\n" (fmap pretty info)


type TuneBody 
    = [Music]
  TODO voices , see 



  Music


data Music
    = Chord Chord
    | Barline Barline
    | Tie Music
    | Slur Music
    | Beam Music
    | Grace Music
    | Tuplet Duration Music
    | Decorate Decoration Music
    | Annotate Annotation Music
    | ChordSymbol ChordSymbol Music
    deriving (Eq, Ord, Show)

instance Pretty Music where
    pretty = go
        where
            go (Chord a) = pretty a
            go (Sequence as) = sepBy " " $ fmap pretty as
  FIXME


data Annotation
    = AnnotateLeft String
    | AnnotateRight String
    | AnnotateAbove String
    | AnnotateBelow String
    | AnnotateUnspecified String
    deriving (Eq, Ord, Show)
    
  TODO clefs and transposition ( 4.6 )
  TODO redifinable symbols ( 4.16 )
  TODO symbol lines ( 4.15 )

  Note ( 4.20 )
newtype Chord = Chord_ { getChord :: (
        [Pitch],
        (Maybe Duration)
    ) }
    deriving (Eq, Ord, Show)

instance Pretty Chord where
  TODO skip duration if zero
    pretty (Chord_ ([], dur))       = ""
    pretty (Chord_ ([pitch], dur))  =
        pretty pitch <> pretty dur
    pretty (Chord_ (pitches, dur))  =
        brackets (sepBy "" (fmap pretty pitches)) <> pretty dur


type ChordSymbol 
    = String

data Barline
    = SingleBarline
    | DottedBarline Barline
    | InvisibleBarline Barline
    deriving (Eq, Ord, Show)

  TODO first and second repeats ( 4.9 )
  TODO variant endings ( 4.10 )


  | Decorations ( 4.14 )
data Decoration
  a roll mark ( arc ) as used in Irish music
  left - hand pizzicato , or rasp for French horns
  the letters D.S. (= Da Segno )
  the letters D.C. (= either   or   )
  the word " Da " followed by a Coda sign
  same , but extending 3/4 of the way down
    deriving (Eq, Ord, Show)

data Dynamic
    = PPPP
    | PPP
    | PP
    | P_
    | MP
    | MF
    | F_
    | FF
    | FFF
    | FFFF
    | SFZ
    deriving (Eq, Ord, Show)





  | An information field ( 3 ) .
data Information
    = Area String
    | Book String
    | Composer String
    | Discography String
    | FileUrl String
    | Group String
    | History String
    | Instruction Directive
    | Key Key
    | UnitNoteLength Duration
    | Meter Meter            
  ^ Macro ( not supported )
    | Parts
    | SymbolLine
    | Voice VoiceProperties
    | Words String
    | ReferenceNumber Integer
    | Transcription String
    deriving (Eq, Ord, Show)

instance Pretty Information where
    pretty a = string $ fieldName a ++ ": " ++ showField a


fieldName :: Information -> String
fieldName = go
    where
        go (Area _)                 = "A"
        go (Book _)                 = "B"
        go (Composer _)             = "C"
        go (Discography _)          = "D"
        go (FileUrl _)              = "F"
        go (Group _)                = "G"
        go (History _)              = "H"
        go (Instruction _)          = "I"
        go (Key _)                  = "K"
        go (UnitNoteLength _)       = "L"
        go (Meter _)                = "M"
        go Macro                    = "m"
        go (Notes _)                = "N"
        go (Origin _)               = "O"
        go Parts                    = "O"
        go (Tempo _)                = "Q"
        go (Rhythm _)               = "R"
        go Remark                   = "r"
        go (Source _)               = "S"
        go SymbolLine               = "s"
        go (Title _)                = "T"
        go UserDefined              = "U"
        go (Voice _)                = "V"
        go (Words _)                = "W"
        go (ReferenceNumber _)      = "X"
        go (Transcription _)        = "Z"

fieldAllowed :: Information -> (Bool, Bool, Bool, Bool)
fieldAllowed = go
    where
        go (Area _)                 = (True, True, False, False)
        go (Book _)                 = (True, True, False, False)
        go (Composer _)             = (True, True, False, False)
        go (Discography _)          = (True, True, False, False)
        go (FileUrl _)              = (True, True, False, False)
        go (Group _)                = (True, True, False, False)
        go (History _)              = (True, True, False, False)
        
        go (Instruction _)          = (True, True, True, True)
        go (UnitNoteLength _)       = (True, True, True, True)
        go (Meter _)                = (True, True, True, True)
        go Macro                    = (True, True, True, True)
        go (Notes _)                = (True, True, True, True)
        
        go (Origin _)               = (True, True, False, False)
        go Parts                    = (False, True, True, True)
        go (Tempo _)                = (False, True, True, True)
        go (Rhythm _)               = (True, True, True, True)
        go Remark                   = (True, True, True, True)
        
        go (Source _)               = (True, True, False, False)
        go SymbolLine               = (False, False, True, False)
second
        
        go UserDefined              = (True, True, True, True)
        go (Voice _)                = (False, True, True, True)
        go (Words _)                = (False, True, True, False)
first
        go (Transcription _)        = (True, True, False, False)

fieldAllowedInFileHeader a = r where (r,_,_,_) = fieldAllowed a
fieldAllowedInTuneHeader a = r where (_,r,_,_) = fieldAllowed a
fieldAllowedInTuneBody   a = r where (_,_,r,_) = fieldAllowed a
fieldAllowedInline       a = r where (_,_,_,r) = fieldAllowed a

showField :: Information -> String
showField = go
    where
        go (Area a)                 = a
        go (Book a)                 = a
        go (Composer a)             = a
        go (Discography a)          = a
        go (FileUrl a)              = a
        go (Group a)                = a
        go (History a)              = a
        go (Instruction a)          = show $ pretty a
        go (Key a)                  = show $ pretty a
        go (UnitNoteLength a)       = show $ pretty a
        go (Meter a)                = show $ pretty a
        go Macro                    = ""
        go (Notes a)                = a
        go (Origin a)               = a
  TODO
        go (Tempo a)                = show $ pretty a
        go (Rhythm a)               = a
  TODO
        go (Source a)               = a
  TODO
        go (Title a)                = a
  TODO
        go (Voice a)                = show $ pretty a
        go (Words a)                = a
        go (ReferenceNumber a)      = show a
        go (Transcription a)        = a
        



  | Pitch ( 4.1 , 4.2 ) .
newtype Pitch = Pitch { getPitch :: (PitchClass, Maybe Accidental, Octave) }
    deriving (Eq, Ord, Show)

instance Pretty Pitch where
    pretty (Pitch (cl, acc, oct)) = pretty acc <> (string $
        (if oct <= 0 then id else fmap toLower) (show cl)
        ++ replicate (negate (fromIntegral oct) `max` 0) ','
        ++ replicate (fromIntegral (oct - 1) `max` 0) '\'')

  | Pitch class ( 4.1 ) .
data PitchClass = C | D | E | F | G | A | B
    deriving (Eq, Ord, Show, Enum, Bounded)

  | Accidentals ( 4.2 ) .
data Accidental = DoubleFlat | Flat | Natural | Sharp | DoubleSharp
    deriving (Eq, Ord, Show, Enum, Bounded)

instance Pretty Accidental where
    pretty = go
        where
            go DoubleFlat   = "__"
            go Flat         = "_"
            go Natural      = "="
            go Sharp        = "^"
            go DoubleSharp  = "^^"

  | Octaves ( 4.1 ) .
newtype Octave = Octave { getOctave :: Int }
    deriving (Eq, Ord, Show, Enum, Num, Real, Integral)






  | Duration ( 4.3 ) .
newtype Duration = Duration { getDuration :: Rational }
    deriving (Eq, Ord, Show, Enum, Num, Real, Fractional, RealFrac)

instance Pretty Duration where
    pretty = string . showRatio . getDuration

            
data Meter
    = NoMeter
    | Common
    | Cut
    | Simple Rational
    | Compound [Integer] Integer
    deriving (Eq, Ord, Show)

instance Pretty Meter where
    pretty = go
        where
            go Common           = "C"
            go Cut              = "C|"
            go (Simple a)       = string $ showRatio a
            go (Compound as a)  = sepBy "+" (fmap integer as) <> "/" <> integer a








newtype Key = Key_ (Integer, Mode)
    deriving (Eq, Ord, Show)

instance Pretty Key where
    pretty (Key_ (tonic, mode)) = prettyTonic tonic <+> pretty mode
        where
            prettyTonic a = case a of
                0 -> "C"

data Mode
    = Major
    | Minor
    | Ionian
    | Dorian
    | Phrygian
    | Lydian
    | Mixolydian
    | Aeolian
    | Locrian
    deriving (Eq, Ord, Show)

instance Pretty Mode where
    pretty = go
        where
            go Major        = ""
            go Minor        = "minor"
            go Ionian       = "ionian"
            go Dorian       = "dorian"
            go Phrygian     = "phrygian"
            go Lydian       = "lydian"
            go Mixolydian   = "mixolydian"
            go Aeolian      = "aeolian"
            go Locrian      = "locrian"




newtype Tempo = Tempo_ { getTempo :: (Maybe String, [Duration], Duration) }
    deriving (Eq, Ord, Show)

instance Pretty Tempo where
    pretty (Tempo_ (str, durs, bpm)) = 
        pretty str <+> (hsep (fmap pretty durs) <> "=" <> pretty bpm)

data VoiceProperties
    = VoiceProperties
        (Maybe String)
        (Maybe String)
        (Maybe StemDirection)
        (Maybe Clef)
    deriving (Eq, Ord, Show)

instance Pretty VoiceProperties where
    pretty _ = "{VoiceProperties}"
  FIXME

data StemDirection = Up | Down
    deriving (Eq, Ord, Show, Enum, Bounded)

data Clef = NoClef | Treble | Alto | Tenor | Bass | Perc
    deriving (Eq, Ord, Show, Enum, Bounded)


newtype Directive = Directive { getDirective :: (String, String) }
    deriving (Eq, Ord, Show)

instance Pretty Directive where
    pretty _ = "{Directive}"
  FIXME





readAbc :: String -> AbcFile
readAbc = error "Not impl"

showAbc :: AbcFile -> String
showAbc = error "Not impl"


showRatio :: (Integral a, Show a) => Ratio a -> String
showRatio x
    | denominator x == 1  = show (numerator x)
    | otherwise           = (show $ numerator x) ++ "/" ++ (show $ denominator x)

