-- |
-- Module      : Harmonic.Interface.Tidal.ChordscaleT
-- Description : REPL report for the chordscale key-area analysis
--
-- Pretty-printer over "Harmonic.Evaluation.Analysis.KeyArea": one row per
-- bar with the chord, the detected key area, the realised scale form, the
-- mode on the bar's root, the assigned pentatonic, and the flags
-- (@\<@ key boundary, @!@ override mode, @?@ gap bar, @*@ out-of-key
-- pentatonic). Mirrors 'Harmonic.Interface.Tidal.OctatripentatonicT.genPReport'
-- \/ 'Harmonic.Interface.Tidal.PolytonalT.genEReport' for the gen \/ genJ
-- families.
module Harmonic.Interface.Tidal.ChordscaleT
  ( renderChordscaleReport
  , chordscaleReport
  ) where

import           Data.Foldable (toList)
import           Data.Maybe (fromMaybe)

import           Harmonic.Evaluation.Analysis.KeyArea
import qualified Harmonic.Rules.Types.Harmony as H
import qualified Harmonic.Rules.Types.Pitch as Pt
import qualified Harmonic.Rules.Types.Progression as Pr
import qualified Harmonic.Rules.Types.ProgressionContext as PC
import qualified Harmonic.Rules.Types.Scale as Sc

-- |Render the per-bar key-area analysis of a gen \/ genJ (or hand-built)
-- context. Returns 'Nothing' for 'PC.FStrata' \/ 'PC.FPoly' contexts,
-- whose layers carry their own semantics and their own reports.
renderChordscaleReport :: PC.ProgressionContext -> Maybe String
renderChordscaleReport :: ProgressionContext -> Maybe String
renderChordscaleReport ProgressionContext
pc
  | ProgressionContext -> Family
PC.pcFamily ProgressionContext
pc Family -> [Family] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Family
PC.FStrata, Family
PC.FPoly] = Maybe String
forall a. Maybe a
Nothing
  | Bool
otherwise =
      let bars :: [CadenceState]
bars = Seq CadenceState -> [CadenceState]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Progression -> Seq CadenceState
Pr.unProgression (ProgressionContext -> Progression
PC.triadLayer ProgressionContext
pc))
          anns :: [BarAnalysis]
anns = Progression -> [BarAnalysis]
analyzeProgression (ProgressionContext -> Progression
PC.triadLayer ProgressionContext
pc)
          hdr :: String
hdr  = String
"bar  chord           key    form  mode           penta   flags"
          sep :: String
sep  = Int -> Char -> String
forall a. Int -> a -> [a]
replicate (String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
hdr) Char
'-'
          rows :: [String]
rows = (Int -> CadenceState -> BarAnalysis -> String)
-> [Int] -> [CadenceState] -> [BarAnalysis] -> [String]
forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3 Int -> CadenceState -> BarAnalysis -> String
forall {a}. Show a => a -> CadenceState -> BarAnalysis -> String
renderBar [Int
1 :: Int ..] [CadenceState]
bars [BarAnalysis]
anns
      in if [CadenceState] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [CadenceState]
bars then Maybe String
forall a. Maybe a
Nothing else String -> Maybe String
forall a. a -> Maybe a
Just ([String] -> String
unlines (String
hdr String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String
sep String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
rows))
  where
    renderBar :: a -> CadenceState -> BarAnalysis -> String
renderBar a
i CadenceState
cs BarAnalysis
a =
      let -- The grid's display seam, so slash structures print in chart
          -- convention here exactly as they do in the grid.
          chord :: String
chord = (PitchClass -> NoteName) -> CadenceState -> String
Pr.showHarmony (EnharmonicSpelling -> PitchClass -> NoteName
H.enharmonicFunc (CadenceState -> EnharmonicSpelling
H.stateSpelling CadenceState
cs)) CadenceState
cs
          form :: String
form  = case BarAnalysis -> KeyForm
baForm BarAnalysis
a of
                    KeyForm
MajForm  -> String
"maj"
                    KeyForm
NatForm  -> String
"nat"
                    KeyForm
HarmForm -> String
"harm"
                    KeyForm
MelForm  -> String
"mel"
          mode :: String
mode  = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"(unclassified)"
                    ((Mode -> String) -> Maybe Mode -> Maybe String
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ModeQuality -> String
Sc.showModeQuality (ModeQuality -> String) -> (Mode -> ModeQuality) -> Mode -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mode -> ModeQuality
Sc.modeQuality) (BarAnalysis -> Maybe Mode
baMode BarAnalysis
a))
          penta :: String
penta = NoteName -> String
forall a. Show a => a -> String
show (PitchClass -> NoteName
Pt.flat (Int -> PitchClass
Pt.mkPitchClass (BarAnalysis -> Int
baPentaRoot BarAnalysis
a))) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" pent"
          flags :: String
flags = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
            [ if BarAnalysis -> Bool
baBoundary BarAnalysis
a then String
"<" else String
""
            , case BarAnalysis -> ModeTier
baTier BarAnalysis
a of
                ModeTier
TierForm   -> String
""
                ModeTier
TierSeed   -> String
"!"
                ModeTier
TierSearch -> String
"!"
                ModeTier
TierGap    -> String
"?"
            , if BarAnalysis -> Bool
baPentaInKey BarAnalysis
a then String
"" else String
"*"
            ]
      in Int -> String -> String
pad Int
5 (a -> String
forall a. Show a => a -> String
show a
i) String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String -> String
pad Int
16 String
chord String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String -> String
pad Int
7 (KeyArea -> String
showKeyArea (BarAnalysis -> KeyArea
baKey BarAnalysis
a))
           String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String -> String
pad Int
6 String
form String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String -> String
pad Int
15 String
mode String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String -> String
pad Int
8 String
penta String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
flags
    pad :: Int -> String -> String
pad Int
n String
s = String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s)) Char
' '

-- |Live-coding helper: print the chordscale report for a gen \/ genJ
-- result alongside the standard 'Show' output.
chordscaleReport :: PC.ProgressionContext -> IO ()
chordscaleReport :: ProgressionContext -> IO ()
chordscaleReport ProgressionContext
pc = do
  String -> IO ()
putStrLn String
""
  case ProgressionContext -> Maybe String
renderChordscaleReport ProgressionContext
pc of
    Just String
report -> String -> IO ()
putStr String
report
    Maybe String
Nothing     -> String -> IO ()
putStrLn String
"[chordscaleReport applies to gen / genJ / hand-built contexts — genP has genPReport, genE has genEReport]"
  String -> IO ()
putStrLn String
""
  ProgressionContext -> IO ()
forall a. Show a => a -> IO ()
print ProgressionContext
pc