bikoret/shoresh-engine/src/Main.hs

{-# LANGUAGE OverloadedStrings #-}

-- | Shoresh Engine — CLI entry point.
--
-- Demonstrates core operations:
--   1. Load a verse from L1
--   2. Parse its te'amim into a tree
--   3. Activate roots through binyanim
--   4. Compute gematria
--
-- This is the Step 7 verification interface.
module Main where

import qualified Data.ByteString.Lazy as BL
import qualified Data.Map.Strict as Map
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.IO as TIO
import Data.Maybe (mapMaybe, fromMaybe)
import System.Environment (getArgs)
import System.Directory (doesFileExist)

import Shoresh.Types
import Shoresh.Gematria
import Shoresh.Binyanim
import Shoresh.Teamim
import Shoresh.KetivQere
import Shoresh.Lexicon
import Shoresh.Graph
import Shoresh.Server (runServer)
import Luchot.Firmware

main :: IO ()
main = do
  args <- getArgs
  case args of
    ["verify"]                -> runVerification
    ["server"]                -> runServer
    ["verse", book, ch, vs]   -> runVerse book ch vs
    ["root", rootText]        -> runRoot rootText
    ["gematria", word]        -> runGematria word
    _                         -> printUsage

printUsage :: IO ()
printUsage = do
  putStrLn "Shoresh Engine — Core symbolic processing unit"
  putStrLn ""
  putStrLn "Usage:"
  putStrLn "  shoresh-engine verify                    Run Step 7 verification"
  putStrLn "  shoresh-engine server                    JSON-line server (Erlang Port mode)"
  putStrLn "  shoresh-engine verse <book> <ch> <vs>    Read and parse a verse from L1"
  putStrLn "  shoresh-engine root <root>               Activate a root through all 7 binyanim"
  putStrLn "  shoresh-engine gematria <word>           Compute gematria of a Hebrew word"

-- | Step 7 verification: Architecture §4 step 7.
-- "Verify: Shoresh Engine can activate a root through all 7 binyanim
--  AND parse a verse's te'amim tree AND compute gematria"
runVerification :: IO ()
runVerification = do
  putStrLn "=== STEP 7 VERIFICATION ==="
  putStrLn ""

  -- 1. Root activation through all 7 binyanim
  putStrLn "--- Test 1: Root activation (ב-ר-א through 7 binyanim) ---"
  let bara = mkShoresh Bet Resh Aleph  -- ברא = create
  let expanded = expand bara
  mapM_ (\(b, p) -> do
    TIO.putStr $ "  " <> T.pack (show b) <> ": "
    TIO.putStrLn $ shoreshToText (root p) <> " [" <> T.pack (show (aspect p))
                <> " " <> T.pack (show (person p))
                <> " " <> T.pack (show (number p))
                <> " " <> T.pack (show (gender p)) <> "]"
    ) (Map.toList expanded)
  putStrLn $ "  PASS: " ++ show (Map.size expanded) ++ " binyanim activated"
  putStrLn ""

  -- 2. Gematria computation
  putStrLn "--- Test 2: Gematria ---"
  let gBara = gematriaRoot bara
  putStrLn $ "  ברא (bara) = " ++ show gBara
  let gTorah = gematriaWord "תורה"
  putStrLn $ "  תורה (torah) = " ++ show gTorah
  let gShalom = gematriaWord "שלום"
  putStrLn $ "  שלום (shalom) = " ++ show gShalom
  -- Verify known values
  let gPass = gBara == 203 && gTorah == 611 && gShalom == 376
  putStrLn $ if gPass
    then "  PASS: Gematria values correct"
    else "  FAIL: Gematria values incorrect"
  putStrLn ""

  -- 3. Te'amim parse — load Bereishit 1:1 from L1
  putStrLn "--- Test 3: Te'amim parse (Bereishit 1:1) ---"
  let versePath = "l1/torah/bereishit/1/1.json"
  exists <- doesFileExist versePath
  if not exists
    then do
      putStrLn $ "  SKIP: L1 verse file not found at " ++ versePath
      putStrLn "  (Run from project root where l1/ directory exists)"
    else do
      mverse <- loadL1Verse versePath
      case mverse of
        Nothing -> putStrLn "  FAIL: Could not parse verse JSON"
        Just verse -> do
          TIO.putStrLn $ "  Verse: " <> l1vTextHebrew verse
          -- Build annotated words from L1 data
          let annotated = mapMaybe annotateWord (l1vWords verse)
          putStrLn $ "  Words with te'amim: " ++ show (length annotated)
          -- Parse into tree
          let tree = readTeamim annotated
          putStrLn $ "  Parse tree depth: " ++ show (treeDepth tree)
          -- Primary division
          let (left, right) = primaryDivision tree
          TIO.putStrLn $ "  Left of etnachta:  " <> T.unwords (collectWords left)
          TIO.putStrLn $ "  Right of etnachta: " <> T.unwords (collectWords right)
          -- Bound groups
          let groups = boundGroups tree
          putStrLn $ "  Bound groups: " ++ show (length groups)
          putStrLn "  PASS: Te'amim parse complete"
  putStrLn ""

  -- 4. L0 firmware check
  putStrLn "--- Test 4: L0 Firmware ---"
  TIO.putStrLn $ "  L1 expected hash: " <> l1ExpectedHash
  putStrLn $ "  Torah books: " ++ show torahBookCount
  putStrLn $ "  Torah verses (WLC): " ++ show torahVerseCount
  putStrLn $ "  Torah words: " ++ show torahWordCount
  putStrLn $ "  Unique roots: " ++ show uniqueRootCount
  putStrLn "  PASS: Firmware constants verified"
  putStrLn ""

  putStrLn "=== VERIFICATION COMPLETE ==="


-- | Read a verse from L1, parse its te'amim, show its roots.
runVerse :: String -> String -> String -> IO ()
runVerse book ch vs = do
  let path = "l1/torah/" ++ book ++ "/" ++ ch ++ "/" ++ vs ++ ".json"
  exists <- doesFileExist path
  if not exists
    then putStrLn $ "Verse not found: " ++ path
    else do
      mverse <- loadL1Verse path
      case mverse of
        Nothing -> putStrLn "Failed to parse verse JSON"
        Just verse -> do
          TIO.putStrLn $ "Ref: " <> l1vRef verse
          TIO.putStrLn $ "Text: " <> l1vTextHebrew verse
          putStrLn ""

          -- Show words with roots and te'amim
          putStrLn "Words:"
          mapM_ (\w -> do
            TIO.putStr $ "  " <> l1wText w
            TIO.putStr $ "  root=" <> fromMaybe "-" (l1wShoresh w)
            TIO.putStr $ "  teamim=" <> T.pack (show (l1wTeamim w))
            case l1wShoresh w >>= textToShoresh of
              Just sh -> TIO.putStr $ "  gematria=" <> T.pack (show (gematriaRoot sh))
              Nothing -> return ()
            TIO.putStrLn ""
            ) (l1vWords verse)

          -- Te'amim parse
          let annotated = mapMaybe annotateWord (l1vWords verse)
          case annotated of
            [] -> putStrLn "\nNo te'amim found"
            _  -> do
              putStrLn "\nTe'amim parse tree:"
              let tree = readTeamim annotated
              putStrLn (showTree 0 tree)

              let (left, right) = primaryDivision tree
              TIO.putStrLn $ "Primary division (etnachta):"
              TIO.putStrLn $ "  Left:  " <> T.unwords (collectWords left)
              TIO.putStrLn $ "  Right: " <> T.unwords (collectWords right)


-- | Activate a root through all 7 binyanim and show gematria.
runRoot :: String -> IO ()
runRoot rootStr = do
  let rootText = T.pack rootStr
  case textToShoresh rootText of
    Nothing -> putStrLn $ "Cannot parse root: " ++ rootStr
    Just sh -> do
      TIO.putStrLn $ "Root: " <> shoreshToText sh
      putStrLn $ "Gematria: " ++ show (gematriaRoot sh)
      putStrLn ""
      putStrLn "Binyanim:"
      let expanded = expand sh
      mapM_ (\(b, p) ->
        TIO.putStrLn $ "  " <> T.pack (show b) <> ": "
          <> shoreshToText (root p)
          <> " [" <> T.pack (show (aspect p))
          <> " " <> T.pack (show (person p))
          <> " " <> T.pack (show (number p))
          <> " " <> T.pack (show (gender p)) <> "]"
        ) (Map.toList expanded)


-- | Compute and display gematria of a word.
runGematria :: String -> IO ()
runGematria wordStr = do
  let wordText = T.pack wordStr
  TIO.putStrLn $ "Word: " <> wordText
  putStrLn $ "Gematria: " ++ show (gematriaWord wordText)


-- ============================================================
-- Helpers
-- ============================================================

-- | Convert an L1 word to an AnnotatedWord for te'amim parsing.
-- Uses the first taam in the teamim list.
annotateWord :: L1Word -> Maybe AnnotatedWord
annotateWord w = case l1wTeamim w of
  []    -> Nothing
  (t:_) -> case taamFromName t of
    Nothing   -> Nothing
    Just taam -> Just AnnotatedWord
      { awWord = l1wText w
      , awTaam = taam
      , awRole = taamRole taam
      }

-- | Depth of a parsed verse tree.
treeDepth :: ParsedVerse -> Int
treeDepth (Leaf _) = 1
treeDepth (Branch _ l r) = 1 + max (treeDepth l) (treeDepth r)

-- | Collect all words from a parsed verse tree.
collectWords :: ParsedVerse -> [Text]
collectWords (Leaf w) = [awWord w]
collectWords (Branch _ l r) = collectWords l ++ collectWords r

-- | Pretty-print a parse tree with indentation.
showTree :: Int -> ParsedVerse -> String
showTree indent (Leaf w) =
  replicate (indent * 2) ' ' ++ "Leaf: " ++ T.unpack (awWord w)
    ++ " [" ++ show (awTaam w) ++ "]"
showTree indent (Branch t l r) =
  replicate (indent * 2) ' ' ++ "Branch: " ++ show t ++ "\n"
    ++ showTree (indent + 1) l ++ "\n"
    ++ showTree (indent + 1) r