-- |
-- Module      : Harmonic.Rules.Import.Transform
-- Description : YCACL data transformation into cadence structures
--
-- Transforms raw CSV corpus records into 'Harmonic.Rules.Types.Harmony.Cadence' structures suitable for
-- Neo4j graph storage: fundamental extraction, triad generation via
-- "Harmonic.Rules.Constraints.Overtone", and dissonance scoring.
--
-- == BEFORE RE-INGESTING THE CORPUS, READ THIS ==
--
-- The LIVE database's node keys (@show@ = movement + functionality) carry
-- functionality names produced under LEGACY naming rules — e.g. zero form
-- @[0,3,8]@ is stored as @maj_1stInv@, @[0,2,7]@ as @sus4_1stInv@,
-- @[0,5,10]@ as @sus4_2ndInv@. The CURRENT namers in this pipeline
-- ('H.toTriad' via 'H.toCadence' below) deliberately diverge from those
-- rules (@min#5@, @sus2@, @7sus4@ for the same forms). Every read-side
-- fetch key is therefore built through 'H.corpusFunctionality', whose
-- 55-form @corpusNameTable@ ("Harmonic.Rules.Types.Harmony") was
-- transcribed verbatim from the live database (2026-08-19).
--
-- Consequence: running this ingestion pipeline as-is would create a graph
-- whose keyspace DIVERGES from @corpusNameTable@ — every fetch would miss
-- and generation would silently drop to fallback-only. Any re-ingestion
-- must do one of:
--
--   (a) route write-side naming through 'H.corpusFunctionality' so the
--       new keyspace is identical to the table (preferred — keeps read
--       and write sides on one contract), or
--   (b) re-ingest with the current namers and then REGENERATE
--       @corpusNameTable@ from the fresh database:
--       @MATCH (c:Cadence) RETURN DISTINCT c.chord, c.show@.
--
-- Either way, verify afterwards with an online @gen'@ run: graph counts
-- (@[nG/...]@) must stay nonzero across steps that select inversion forms.

module Harmonic.Rules.Import.Transform (
    -- * Cadence construction
    buildCadences, buildCadencesPerPiece,

    -- * Helpers
    fundamentals,
) where

import           Harmonic.Rules.Import.Types
import qualified Data.Vector as V
import qualified Data.List as L
import           Data.List (sortOn)

-- Phase B modules
import qualified Harmonic.Rules.Types.Harmony as H
import qualified Harmonic.Evaluation.Scoring.Dissonance as D
import qualified Harmonic.Rules.Constraints.Overtone as O

-- | Extract the fundamental bass note of each chord: the lowest pitch present.
-- Empty chords yield @0@.
fundamentals :: V.Vector [Int] -> [Int]
fundamentals :: Vector [Int] -> [Int]
fundamentals Vector [Int]
v = Vector Int -> [Int]
forall a. Vector a -> [a]
V.toList (Vector Int -> [Int]) -> Vector Int -> [Int]
forall a b. (a -> b) -> a -> b
$ ([Int] -> Int) -> Vector [Int] -> Vector Int
forall a b. (a -> b) -> Vector a -> Vector b
V.map [Int] -> Int
fundamental Vector [Int]
v
  where
    fundamental :: [Int] -> Int
    fundamental :: [Int] -> Int
fundamental []  = Int
0
    fundamental [Int]
xs  = [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [Int]
xs

-- |Convert a sequence of chord slices into a cadence list that reflects every
-- reasonable triad interpretation. Instead of picking a single "best" triad, we
-- duplicate the top three options (3\/2\/1 copies) and cross-multiply adjacent
-- slices so the Markov model can learn from alternate paths without fractional
-- weights.
buildCadences :: [ChordSlice] -> [H.Cadence]
buildCadences :: [ChordSlice] -> [Cadence]
buildCadences [ChordSlice]
slices =
  let triadOptions :: [[Chord]]
triadOptions = (ChordSlice -> [Chord]) -> [ChordSlice] -> [[Chord]]
forall a b. (a -> b) -> [a] -> [b]
map ChordSlice -> [Chord]
sliceTriads [ChordSlice]
slices
      transitions :: [([Chord], [Chord])]
transitions  = [[Chord]] -> [[Chord]] -> [([Chord], [Chord])]
forall a b. [a] -> [b] -> [(a, b)]
zip [[Chord]]
triadOptions (Int -> [[Chord]] -> [[Chord]]
forall a. Int -> [a] -> [a]
drop Int
1 [[Chord]]
triadOptions)
   in (([Chord], [Chord]) -> [Cadence])
-> [([Chord], [Chord])] -> [Cadence]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([Chord], [Chord]) -> [Cadence]
expand [([Chord], [Chord])]
transitions
  where
    expand :: ([Chord], [Chord]) -> [Cadence]
expand ([Chord]
fromChoices, [Chord]
toChoices) =
      -- NODE-KEY DECISION POINT: 'H.toCadence' stamps the functionality
      -- that becomes the graph node's @show@ key. See the module-header
      -- warning — the live DB's keys were stamped under legacy naming,
      -- which the current 'H.toTriad'-derived names diverge from. Do not
      -- re-ingest without resolving that (route through
      -- 'H.corpusFunctionality', or rebuild @corpusNameTable@ after).
      [ (Chord, Chord) -> Cadence
H.toCadence (Chord
fromChord, Chord
toChord)
      | Chord
fromChord <- [Chord]
fromChoices
      , Chord
toChord   <- [Chord]
toChoices
      ]

    sliceTriads :: ChordSlice -> [Chord]
sliceTriads ChordSlice
slice =
      -- Fall back to a single flat triad if the ranking step fails (e.g.,
      -- exporter filtered the slice down to fewer than three unique pitch
      -- classes). This keeps the cadence stream contiguous.
      let ranked :: [Chord]
ranked = ChordSlice -> [Chord]
rankedTriads ChordSlice
slice
       in if [Chord] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Chord]
ranked
            then [[Int] -> Chord
H.flatTriad (ChordSlice -> [Int]
slicePitches ChordSlice
slice)]
            else [Chord]
ranked

    rankedTriads :: ChordSlice -> [Chord]
rankedTriads ChordSlice
slice =
      let fundamental :: Int
fundamental = ChordSlice -> Int
sliceFundamental ChordSlice
slice
          uniquePcs :: [Int]
uniquePcs   = [Int] -> [Int]
forall a. Eq a => [a] -> [a]
L.nub (ChordSlice -> [Int]
slicePitches ChordSlice
slice)
          overtones :: [Int]
overtones   = (Int -> Bool) -> [Int] -> [Int]
forall a. (a -> Bool) -> [a] -> [a]
filter (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
fundamental) [Int]
uniquePcs
          candidates :: [[Int]]
candidates  = (Int, [Int]) -> [[Int]]
forall a. (Integral a, Num a) => (a, [a]) -> [[a]]
O.possibleTriads'' (Int
fundamental, [Int]
overtones)
          scored :: [(Integer, Chord)]
scored      = ([Int] -> (Integer, Chord)) -> [[Int]] -> [(Integer, Chord)]
forall a b. (a -> b) -> [a] -> [b]
map [Int] -> (Integer, Chord)
score [[Int]]
candidates
          top :: [(Integer, Chord)]
top         = Int -> [(Integer, Chord)] -> [(Integer, Chord)]
forall a. Int -> [a] -> [a]
take Int
3 (((Integer, Chord) -> Integer)
-> [(Integer, Chord)] -> [(Integer, Chord)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (Integer, Chord) -> Integer
forall a b. (a, b) -> a
fst [(Integer, Chord)]
scored)
          weights :: [Int]
weights     = [Int
3,Int
2,Int
1]
       in [[Chord]] -> [Chord]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Chord]] -> [Chord]) -> [[Chord]] -> [Chord]
forall a b. (a -> b) -> a -> b
$ (Int -> Chord -> [Chord]) -> [Int] -> [Chord] -> [[Chord]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> Chord -> [Chord]
forall a. Int -> a -> [a]
replicate [Int]
weights (((Integer, Chord) -> Chord) -> [(Integer, Chord)] -> [Chord]
forall a b. (a -> b) -> [a] -> [b]
map (Integer, Chord) -> Chord
forall a b. (a, b) -> b
snd [(Integer, Chord)]
top)

    score :: [Int] -> (Integer, Chord)
score [Int]
triad =
      -- Hindemith dissonance from Dissonance module gives us ordinal ranking;
      -- lower values are more consonant, so we sort ascending before duplicating.
      let pcs :: [Int]
pcs    = (Int -> Int) -> [Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
12) [Int]
triad
          chord :: Chord
chord  = [Int] -> Chord
H.flatTriad [Int]
pcs
          (Integer
diss, [Int]
_) = [Int] -> (Integer, [Int])
D.dissonanceLevel [Int]
pcs
       in (Integer
diss, Chord
chord)

-- | Build cadences piece by piece, then concatenate. Keeping pieces separate
-- matters: it stops a transition being invented across the boundary between
-- the last chord of one piece and the first of the next.
buildCadencesPerPiece :: [[ChordSlice]] -> [H.Cadence]
buildCadencesPerPiece :: [[ChordSlice]] -> [Cadence]
buildCadencesPerPiece [[ChordSlice]]
pieces = ([ChordSlice] -> [Cadence]) -> [[ChordSlice]] -> [Cadence]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap [ChordSlice] -> [Cadence]
buildCadences [[ChordSlice]]
pieces