#!/usr/bin/env bash
# check-boot.sh — typecheck BootTidal.hs WITHOUT booting anything.
#
# Why this exists (2026-07-27, mid-rehearsal):
# a DJF "fix" shipped to BootTidal.hs as  (# lpf .. # hpf ..)  — a right
# section containing another operator of the same fixity, which is a hard
# Haskell PARSE ERROR (`#` is infixl 9). One bad line took the whole `let`
# block down, i.e. EVERY g* helper. And nothing surfaced it: the running
# ghci still held the old definitions, so the rig kept making sound while
# the file on disk was unloadable. The bug would only have detonated at the
# next boot — on stage.
#
# The lesson is the rig's recurring one: a definition that lives only in a
# running process is not verified. Prove it structurally, cheaply, cold.
#
# Method: extract the big helper `let` block, dedent it into a real module,
# stub the few stream-bound names (p, setI) it closes over, and run
# `ghc -fno-code`. Types only — no code generated, no stream started, no
# port 6010 grabbed. Safe to run mid-set.
set -euo pipefail

ROOT="$(cd "$(dirname "${BASH_SOURCE[0]}")/.." && pwd)"
BOOT="${1:-$ROOT/BootTidal.hs}"
WORK="$(mktemp -d)"
trap 'rm -rf "$WORK"' EXIT

# Locate the helper block: the `:{ let ...` that defines the g* helpers,
# found by content rather than hardcoded line numbers so edits don't rot it.
START="$(grep -n '^let -- DPV specific parameters' "$BOOT" | cut -d: -f1)"
if [ -z "$START" ]; then
  echo "check-boot: FAIL — could not locate the helper let-block in $BOOT" >&2
  exit 2
fi
END="$(awk -v s="$START" 'NR>s && /^:\}/ {print NR-1; exit}' "$BOOT")"
if [ -z "$END" ]; then
  echo "check-boot: FAIL — no closing :} after line $START" >&2
  exit 2
fi

{
  echo '{-# LANGUAGE OverloadedStrings #-}'
  echo '{-# OPTIONS_GHC -Wno-missing-signatures -Wno-name-shadowing #-}'
  echo 'module BootCheck where'
  echo 'import Sound.Tidal.Context'
  echo 'import Data.Char (toLower)'
  # Names the block closes over from earlier :{ :} blocks (stream-bound).
  echo 'p :: Int -> ControlPattern -> IO ()'
  echo 'p = undefined'
  echo 'setI :: String -> Pattern Int -> IO ()'
  echo 'setI = undefined'
  sed -n "${START},${END}p" "$BOOT" | sed -e '1s/^let //' -e 's/^    //'
} > "$WORK/BootCheck.hs"

echo "check-boot: typechecking $BOOT lines $START-$END ..."
# NB: run ghc ONCE and capture, rather than piping into `grep -q`. Under
# `set -o pipefail` a failing ghc makes the whole pipeline non-zero no matter
# what grep decides, which silently inverts the test — this guard shipped
# broken exactly that way and only its own negative test caught it.
set +e
OUT="$(ghc -fno-code -package tidal "$WORK/BootCheck.hs" 2>&1)"
RC=$?
set -e
if [ "$RC" -ne 0 ]; then
  echo "" >&2
  printf '%s\n' "$OUT" | sed "s#$WORK/BootCheck.hs#<let-block>#" >&2
  echo "" >&2
  echo "check-boot: FAIL — BootTidal.hs would NOT load. Do not boot." >&2
  exit 1
fi
echo "check-boot: OK — helper block typechecks against tidal-1.9.5."

# --- Pass 2: the #55 control-seed block ---------------------------------
# Seeding runs at boot and silences nothing if it fails, but a type error in
# it aborts the rest of the boot file. Check the seed list's shape and the
# streamSetF signature it depends on.
SEED_START="$(grep -n '^let _seed = concat' "$BOOT" | cut -d: -f1)"
if [ -n "$SEED_START" ]; then
  SEED_END="$(awk -v s="$SEED_START" 'NR>=s && /\] :: \[\(String, Double\)\]/ {print NR; exit}' "$BOOT")"
  {
    echo 'module SeedCheck where'
    echo 'import Sound.Tidal.Context'
    # Pin the exact signature the seed block calls through `setF`.
    echo 'sigF :: Stream -> String -> Pattern Double -> IO ()'
    echo 'sigF = streamSetF'
    sed -n "${SEED_START},${SEED_END}p" "$BOOT" | sed '1s/^let //'
    echo 'useSeed :: Stream -> IO ()'
    echo 'useSeed t = mapM_ (\(k, v) -> streamSetF t k (pure v)) _seed'
  } > "$WORK/SeedCheck.hs"
  set +e
  SOUT="$(ghc -fno-code -package tidal "$WORK/SeedCheck.hs" 2>&1)"
  SRC=$?
  set -e
  if [ "$SRC" -ne 0 ]; then
    echo "" >&2
    printf '%s\n' "$SOUT" | sed "s#$WORK/SeedCheck.hs#<seed-block>#" >&2
    echo "check-boot: FAIL — the #55 control-seed block does not typecheck." >&2
    exit 1
  fi
  echo "check-boot: OK — #55 control-seed block typechecks."

  # --- Pass 3: RUN the helpers against an EMPTY control map (#55) ----------
  # The regression test that tonight's bug needed and nobody had. Typechecking
  # cannot catch it: `gF1 $ sound "bd"` is perfectly well-typed while emitting
  # ZERO events, because an untouched "^NN" yields nothing and `#` cannot emit
  # without a right-hand value. The only mechanical check is to QUERY the
  # pattern with no controls set and assert events come out.
  #
  # This is a real execution, not a typecheck — but it is pure pattern
  # evaluation: no stream, no scsynth, no MIDI, no ports. Safe mid-set.
  {
    echo '{-# LANGUAGE OverloadedStrings #-}'
    echo '{-# OPTIONS_GHC -Wno-missing-signatures -Wno-name-shadowing -Wno-type-defaults #-}'
    echo 'module Main where'
    echo 'import Sound.Tidal.Context'
    echo 'import qualified Data.Map.Strict as M'
    echo 'import System.Exit (exitFailure)'
    echo 'import Data.IORef'
    echo 'p :: Int -> ControlPattern -> IO ()'
    echo 'p = undefined'
    echo 'setI :: String -> Pattern Int -> IO ()'
    echo 'setI = undefined'
    sed -n "${START},${END}p" "$BOOT" | sed -e '1s/^let //' -e 's/^    //'
    cat <<'HS'

-- Query with a DELIBERATELY EMPTY controls map: the state of a fresh boot
-- before any knob has been moved.
audible :: String -> ControlPattern -> IORef Bool -> IO ()
audible label pat failed = do
  let evs = query pat (State (Arc 0 1) M.empty)
  if null evs
    then do putStrLn ("  FAIL " ++ label ++ " -> SILENT with an empty control map")
            writeIORef failed True
    else putStrLn ("  ok   " ++ label ++ " -> " ++ show (length evs) ++ " event(s)")

main :: IO ()
main = do
  failed <- newIORef False
  putStrLn "  (untouched-control audibility, #55)"
  mapM_ (\(l, f) -> audible l (f (sound "bd")) failed)
    [ ("gF1   ", gF1), ("gF2   ", gF2), ("gF3   ", gF3)
    , ("gMask ", gMask)
    , ("gMute1", gMute1), ("gMute2", gMute2), ("gMute3", gMute3)
    , ("gM1   ", gM1), ("gM2   ", gM2), ("gM3   ", gM3)
    , ("gPanic", gPanic)
    ]
  -- Gain paths: silent here means the global fader zeroes the whole rig.
  audible "midiGdef" (sound "bd" # midiGdef) failed
  -- A composed stack is the realistic shape a track actually uses.
  audible "gF1.gM2 " (gF1 (gM2 (sound "bd"))) failed
  bad <- readIORef failed
  if bad then exitFailure else return ()
HS
  } > "$WORK/RunCheck.hs"
  set +e
  ROUT="$(ghc -package tidal -package containers -o "$WORK/runcheck" \
            -outputdir "$WORK/out" "$WORK/RunCheck.hs" 2>&1)"
  RRC=$?
  set -e
  if [ "$RRC" -ne 0 ]; then
    echo "" >&2
    printf '%s\n' "$ROUT" | sed "s#$WORK/RunCheck.hs#<run-check>#" >&2
    echo "check-boot: FAIL — could not build the untouched-control test." >&2
    exit 1
  fi
  set +e
  "$WORK/runcheck"
  RUNRC=$?
  set -e
  if [ "$RUNRC" -ne 0 ]; then
    echo "check-boot: FAIL — helpers go SILENT with an untouched controller." >&2
    echo "            This is the #55 mute-bomb. Streams will have no sound on" >&2
    echo "            a fresh boot until every knob is physically moved." >&2
    exit 1
  fi
  echo "check-boot: OK — all g* helpers audible with an untouched controller."
else
  echo "check-boot: WARN — no #55 control-seed block found (untouched knobs" >&2
  echo "            will silence their streams; see BootTidal.hs history)." >&2
fi

# --- Pass 4: does each block PARSE THE WAY PULSAR SENDS IT? (#79) ----------
# Passes 1-3 all prove things about the Haskell. None of them can see the bug
# that actually silenced the rig: Pulsar chunks this file on BLANK LINES and
# wraps each chunk in its own `:{ ... :}`, which holds exactly ONE statement.
# The #55 seed put `let _seed`, `mapM_` and `putStrLn` in one chunk, so it was
# a parse error on every boot for two days and the seed never ran — while every
# check above stayed green. Verified code that never executes is this rig's
# signature failure; this pass tests the SEAM.
if [ -x "$ROOT/tools/check-boot-blocks.py" ]; then
  if ! python3 "$ROOT/tools/check-boot-blocks.py" "$BOOT"; then
    echo "check-boot: FAIL — a block will not parse as Pulsar sends it." >&2
    exit 1
  fi
fi

# --- Pass 5: does the default dN transition leave a GHOST? (2026-07-29) ------
# The bug PLN chased for a whole afternoon, in one sentence: Tidal's `xfadeIn`
# turns the OUTGOING pattern down but never off, so it emits events forever at
# gain 0 — and a gain-0 event still broadcasts its cut group (SuperDirt
# DirtEvent.sc:182-189 fires the cut in playSynths BEFORE amp is read, with
# cutAllSamples=1 for a positive cut). The ghost therefore keeps releasing the
# INCOMING pattern's voice on every hit, forever. Symptom: "ctrl+enter i hear
# sth, which fades" on every orbit that owns a `# cut`, cured only by `hush`
# (which prepends silence to the pattern history) or a reboot (which leaves one
# pattern in history, and xfadeIn returns a lone pattern untouched).
#
# Passes 1-4 cannot see this: it typechecks, it parses, and it emits events. The
# only way to catch it is to COUNT ONSETS FROM THE OUTGOING PATTERN AFTER THE
# FADE. This pass lifts the real `xfadeCutIn` out of BootTidal.hs verbatim and
# asserts that count is zero.
GHOSTCHK="$WORK/GhostCheck.hs"
if python3 - "$BOOT" "$GHOSTCHK" <<'PYEOF'
import pathlib, sys
boot, out = pathlib.Path(sys.argv[1]), pathlib.Path(sys.argv[2])
src = boot.read_text().splitlines()
try:
    start = next(i for i, l in enumerate(src) if l.strip().startswith("xfadeCutIn t now pats"))
    end = next(i for i, l in enumerate(src) if i > start and l.strip().startswith("xfade i ="))
except StopIteration:
    sys.exit(3)  # binding absent -> nothing to check (reported by the caller)
body = [l[4:] if l.startswith("    ") else l for l in src[start:end]]
out.write_text("\n".join([
    "import Sound.Tidal.Context",
    "import qualified Data.Map as Map",
    "xfadeCutIn :: Time -> Time -> [ControlPattern] -> ControlPattern",
    *body,
    'nm e = case Map.lookup "s" (value e) of { Just (VS x) -> x ; _ -> "?" }',
    "outgoing c = length [() | e <- queryArc",
    '  (xfadeCutIn 4 0 [s (pure "NEW") # cut (pure 5), s (pure "OLD") # cut (pure 5)])',
    '  (Arc c (c+1)), eventHasOnset e, nm e == "OLD"]',
    "main = do",
    "  let ghosts = sum (map outgoing [4,5,8,16,64,256])",
    '  putStrLn ("  outgoing onsets after a 4-cycle fade: " ++ show ghosts)',
    "  if ghosts == 0 then putStrLn \"  ok   the outgoing pattern STOPS\"",
    "    else do { putStrLn \"  FAIL the outgoing pattern is a ghost that keeps cutting\" ; ioError (userError \"ghost\") }",
]) + "\n")
PYEOF
then
  if ghc -package tidal -package containers -o "$WORK/ghostchk" \
         -outputdir "$WORK/ghosto" "$GHOSTCHK" >"$WORK/ghost.log" 2>&1; then
    echo "check-boot: transition ghost check (the outgoing pattern must stop) ..."
    if "$WORK/ghostchk"; then
      echo "check-boot: OK — no cut-stealing ghost after a transition."
    else
      echo "check-boot: FAIL — the default dN transition leaves a ghost." >&2
      exit 1
    fi
  else
    echo "check-boot: WARN — ghost check did not build:" >&2
    tail -5 "$WORK/ghost.log" >&2
  fi
else
  echo "check-boot: WARN — no xfadeCutIn binding in BootTidal.hs; the default" >&2
  echo "            transition is Tidal's leaky xfadeIn (see Pass 5 comment)." >&2
fi
