engine: a word's root is what L1 records for it (tablet 33)
The Shoresh Engine never opened L1 to find a root. extractRoots called every word of two or three letters a root and dropped every longer one: את → א-ת-ה (padded with a He the text never wrote), ואת → ו-א-ת, בכל → ב-כ-ל; ויאמר, ואהבת, אלהים → nothing. Handed all of Devarim 6:5 it found no א-ה-ב. Binyan was "Qal" for everything, nouns included. shoresh-engine: - Shoresh.Roots: an index over all of L1 (5853 verses, built once at server start, <1 s). A word resolves, in order: from the verse in scope (its own shoresh, with the binyan read from the verb's morphology; else its lemma's shoresh — לבבך → לבב); else the way Torah most often reads that surface form (its commonest lemma decides, so אשר the particle has no root); else a root the asker named, if Torah knows it. A word in the verse that L1 gives no root has none, whatever a homograph elsewhere carries. Unknown words yield nothing. - Roots are rendered as L1 records them: two letters stay two letters. - binyan is null unless a verb stands in the scoped verse. - L1 is found via L1_MOUNT_POINT, not the literal l1/ relative to cwd — which is why parse_tree was null on the pod. - Adds "surface" and "derivation" to each root (verse|lemma|torah| named_root). 22 new HSpec examples; 55 examples, 0 failures. vav_pipeline: - normalize_root places a lemma-derived root at the word it was heard from (L1 has no shoresh on לבבך to search by). - A binyan is printed only where there is one; "binyan unknown" on a noun claimed a question that does not exist. - test/tablet33_engine_roots_test.exs: the new shape through the router. - liveness_test: clear a halt leaked by halt_monitor_test (the seed 0/191243 flake, present since before tablet 30). 461 tests, 0 failures on seeds 0 42 191243. Verified before push with BOTH built images, the real engine binary and a local PostgreSQL 16 (SSL): Devarim 6:5 → א-ה-ב (Qal, word 1), י-ה-ו, א-ל-ה, כ-ל (words 5,7,9), ל-ב-ב, נ-פ-ש, מ-א-ד; 4 interpretations written to L3, 0 L3_WRITE_FAILED, health healthy. NOT repaired here: the quality of L1's own shoresh field, which the engine is now faithful to — ויהי is recorded as יהי, שמים as שמ, יהוה as יהו, הבאתי as בא. That is the quarry's tablet (scripts/build_l1.py) and it changes the L1 hash; a decision, not a patch. Co-Authored-By: Claude Fable 5.1 <noreply@anthropic.com>
This commit is contained in:
1 parent
83fa5ac46b
commit
6d3411fcfa
7 files changed
+682
-68
No files matched your search
@@ -28,6 +28,7 @@ library
|
|||||||
Shoresh.KetivQere
|
Shoresh.KetivQere
|
||||||
Shoresh.Smikhut
|
Shoresh.Smikhut
|
||||||
Shoresh.Lexicon
|
Shoresh.Lexicon
|
||||||
|
Shoresh.Roots
|
||||||
Shoresh.Graph
|
Shoresh.Graph
|
||||||
Shoresh.Havdalah
|
Shoresh.Havdalah
|
||||||
Shoresh.Kriah
|
Shoresh.Kriah
|
||||||
|
|||||||
@@ -0,0 +1,274 @@
|
|||||||
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
|
||||||
|
-- | Roots — hearing the shoresh of a word from L1.
|
||||||
|
--
|
||||||
|
-- Broken tablet 33 (2026-10-04). Until now the server's @extractRoots@
|
||||||
|
-- called every word of two or three letters a root and dropped every
|
||||||
|
-- longer word: את became א-ת-ה (padded with a He the text never wrote),
|
||||||
|
-- ואת became ו-א-ת, בכל became ב-כ-ל, and ויאמר, ואהבת, אלהים produced
|
||||||
|
-- nothing at all. Handed the whole of Devarim 6:5 it found no א-ה-ב.
|
||||||
|
-- It never opened L1.
|
||||||
|
--
|
||||||
|
-- "The lexicon is read from L1. It is not hardcoded. The system reads
|
||||||
|
-- Torah and learns what roots are there." (Shoresh.Lexicon) — so this
|
||||||
|
-- module does that. A word's root is what L1 records for that word:
|
||||||
|
--
|
||||||
|
-- 1. 'FromVerse' — the word stands in the verse in scope; L1's
|
||||||
|
-- @shoresh@ for that very word (and its binyan, if it
|
||||||
|
-- is a verb, from the morphology).
|
||||||
|
-- 2. 'FromLemma' — the word stands in L1 without a @shoresh@ of its
|
||||||
|
-- own (לבבך, נפשך), but shares its lemma with words
|
||||||
|
-- that have one (לבב, נפש).
|
||||||
|
-- 3. 'FromTorah' — the word is not in the verse in scope but appears
|
||||||
|
-- elsewhere in Torah; the root it most often carries.
|
||||||
|
-- 4. 'NamedRoot' — the asker wrote a root itself (ברא) and Torah
|
||||||
|
-- knows it as a root.
|
||||||
|
--
|
||||||
|
-- A word L1 does not know yields nothing. A particle L1 gives no root
|
||||||
|
-- (את) yields nothing. The engine does not invent a root to have
|
||||||
|
-- something to say.
|
||||||
|
--
|
||||||
|
-- What this does NOT repair: the quality of L1's own @shoresh@ field,
|
||||||
|
-- which is derived (ויהי is recorded as יהי, שמים as שמ). That is the
|
||||||
|
-- quarry's tablet, not the mason's; this module is faithful to L1.
|
||||||
|
module Shoresh.Roots
|
||||||
|
( RootIndex
|
||||||
|
, emptyIndex
|
||||||
|
, indexVerse
|
||||||
|
, buildIndex
|
||||||
|
, loadIndex
|
||||||
|
, indexStats
|
||||||
|
, Derivation(..)
|
||||||
|
, ResolvedRoot(..)
|
||||||
|
, resolveText
|
||||||
|
, tokenize
|
||||||
|
, binyanFromMorph
|
||||||
|
) where
|
||||||
|
|
||||||
|
import Control.Exception (SomeException, try)
|
||||||
|
import Control.Monad (foldM, guard)
|
||||||
|
import Data.Char (isDigit)
|
||||||
|
import Data.List (foldl', sort, sortOn)
|
||||||
|
import Data.Map.Strict (Map)
|
||||||
|
import qualified Data.Map.Strict as Map
|
||||||
|
import Data.Maybe (listToMaybe, mapMaybe)
|
||||||
|
import Data.Ord (Down(..))
|
||||||
|
import Data.Set (Set)
|
||||||
|
import qualified Data.Set as Set
|
||||||
|
import Data.Text (Text)
|
||||||
|
import qualified Data.Text as T
|
||||||
|
import System.Directory (doesDirectoryExist, listDirectory)
|
||||||
|
import System.FilePath ((</>), takeExtension)
|
||||||
|
import Text.Read (readMaybe)
|
||||||
|
|
||||||
|
import Shoresh.Lexicon (L1Verse(..), L1Word(..), loadL1Verse)
|
||||||
|
import Shoresh.Types (Binyan(..))
|
||||||
|
|
||||||
|
|
||||||
|
-- | What L1 teaches about its words, gathered once.
|
||||||
|
data RootIndex = RootIndex
|
||||||
|
{ riSurface :: !(Map (Text, Text) (Map Text Int))
|
||||||
|
-- ^ (consonants, lemma) → shoresh → count
|
||||||
|
, riSurfaceLemma :: !(Map Text (Map Text Int)) -- ^ consonants → lemma → count
|
||||||
|
, riLemma :: !(Map Text (Map Text Int)) -- ^ lemma → shoresh → count
|
||||||
|
, riRoots :: !(Set Text) -- ^ every shoresh L1 records
|
||||||
|
, riVerses :: !Int
|
||||||
|
}
|
||||||
|
|
||||||
|
emptyIndex :: RootIndex
|
||||||
|
emptyIndex = RootIndex Map.empty Map.empty Map.empty Set.empty 0
|
||||||
|
|
||||||
|
-- | (verses, distinct surface forms, distinct roots)
|
||||||
|
indexStats :: RootIndex -> (Int, Int, Int)
|
||||||
|
indexStats ix = (riVerses ix, Map.size (riSurfaceLemma ix), Set.size (riRoots ix))
|
||||||
|
|
||||||
|
bump :: Ord k => k -> Text -> Map k (Map Text Int) -> Map k (Map Text Int)
|
||||||
|
bump k v = Map.insertWith (Map.unionWith (+)) k (Map.singleton v 1)
|
||||||
|
|
||||||
|
-- | Add one verse's words to the index.
|
||||||
|
indexVerse :: RootIndex -> L1Verse -> RootIndex
|
||||||
|
indexVerse ix verse =
|
||||||
|
let ix' = foldl' addWord ix (l1vWords verse)
|
||||||
|
in ix' { riVerses = riVerses ix' + 1 }
|
||||||
|
where
|
||||||
|
addWord acc w =
|
||||||
|
let lemma = l1wLemma w
|
||||||
|
surfaces = splitMaqaf (l1wConsonants w)
|
||||||
|
withLemma a s = a { riSurfaceLemma = bump s lemma (riSurfaceLemma a) }
|
||||||
|
acc1 = foldl' withLemma acc surfaces
|
||||||
|
in case l1wShoresh w of
|
||||||
|
Nothing -> acc1
|
||||||
|
Just sh | T.null sh -> acc1
|
||||||
|
| otherwise ->
|
||||||
|
let withSurface a s = a { riSurface = bump (s, lemma) sh (riSurface a) }
|
||||||
|
acc2 = foldl' withSurface acc1 surfaces
|
||||||
|
in acc2 { riLemma = if realLemma lemma
|
||||||
|
then bump lemma sh (riLemma acc2)
|
||||||
|
else riLemma acc2
|
||||||
|
, riRoots = Set.insert sh (riRoots acc2)
|
||||||
|
}
|
||||||
|
|
||||||
|
buildIndex :: [L1Verse] -> RootIndex
|
||||||
|
buildIndex = foldl' indexVerse emptyIndex
|
||||||
|
|
||||||
|
-- | A lemma that names a lexeme (a Strong's number), as opposed to the
|
||||||
|
-- bare prefix letters L1 records for pronominal forms (@l@, @b@).
|
||||||
|
realLemma :: Text -> Bool
|
||||||
|
realLemma l = case T.uncons l of
|
||||||
|
Just (c, _) -> isDigit c
|
||||||
|
Nothing -> False
|
||||||
|
|
||||||
|
-- | Read every verse under @<l1root>/torah@ into an index. A missing or
|
||||||
|
-- unreadable L1 gives an empty index: the engine then finds no roots and
|
||||||
|
-- says so, rather than guessing.
|
||||||
|
loadIndex :: FilePath -> IO RootIndex
|
||||||
|
loadIndex l1root = do
|
||||||
|
let torah = l1root </> "torah"
|
||||||
|
ok <- doesDirectoryExist torah
|
||||||
|
if not ok then return emptyIndex else do
|
||||||
|
books <- sort <$> listDirectory torah
|
||||||
|
foldM (loadBook torah) emptyIndex books
|
||||||
|
where
|
||||||
|
loadBook torah ix book = do
|
||||||
|
let bdir = torah </> book
|
||||||
|
isDir <- doesDirectoryExist bdir
|
||||||
|
if not isDir then return ix else do
|
||||||
|
chapters <- numbered <$> listDirectory bdir
|
||||||
|
foldM (loadChapter bdir) ix chapters
|
||||||
|
|
||||||
|
loadChapter bdir ix ch = do
|
||||||
|
let cdir = bdir </> show ch
|
||||||
|
isDir <- doesDirectoryExist cdir
|
||||||
|
if not isDir then return ix else do
|
||||||
|
files <- listDirectory cdir
|
||||||
|
let verses = sort (mapMaybe verseNumber files)
|
||||||
|
foldM (loadVerse cdir) ix verses
|
||||||
|
|
||||||
|
loadVerse cdir ix v = do
|
||||||
|
r <- try (loadL1Verse (cdir </> (show v ++ ".json")))
|
||||||
|
:: IO (Either SomeException (Maybe L1Verse))
|
||||||
|
return $! case r of
|
||||||
|
Right (Just verse) -> indexVerse ix verse
|
||||||
|
_ -> ix
|
||||||
|
|
||||||
|
numbered :: [FilePath] -> [Int]
|
||||||
|
numbered = sort . mapMaybe readMaybe
|
||||||
|
|
||||||
|
verseNumber :: FilePath -> Maybe Int
|
||||||
|
verseNumber f
|
||||||
|
| takeExtension f == ".json" = readMaybe (takeWhile (/= '.') f)
|
||||||
|
| otherwise = Nothing
|
||||||
|
|
||||||
|
|
||||||
|
-- | How a root was heard.
|
||||||
|
data Derivation = FromVerse | FromLemma | FromTorah | NamedRoot
|
||||||
|
deriving (Eq, Show)
|
||||||
|
|
||||||
|
data ResolvedRoot = ResolvedRoot
|
||||||
|
{ rrShoresh :: !Text -- ^ exactly as L1 records it (2 or 3 letters)
|
||||||
|
, rrSurface :: !Text -- ^ the word it was heard from
|
||||||
|
, rrBinyan :: !(Maybe Binyan) -- ^ only for a verb standing in the scoped verse
|
||||||
|
, rrDerivation :: !Derivation
|
||||||
|
} deriving (Eq, Show)
|
||||||
|
|
||||||
|
|
||||||
|
-- | The Hebrew words of a text as bare consonants, in order.
|
||||||
|
-- Maqaf is split BEFORE the marks are stripped: it sits inside the
|
||||||
|
-- combining-mark range and would otherwise fuse two words (tablet 30a).
|
||||||
|
tokenize :: Text -> [Text]
|
||||||
|
tokenize =
|
||||||
|
filter (not . T.null)
|
||||||
|
. T.split (not . isHebrewLetter)
|
||||||
|
. T.filter (not . isMark)
|
||||||
|
. T.map (\c -> if c == '\x05BE' then ' ' else c)
|
||||||
|
where
|
||||||
|
isMark c = c >= '\x0591' && c <= '\x05C7'
|
||||||
|
|
||||||
|
isHebrewLetter :: Char -> Bool
|
||||||
|
isHebrewLetter c = c >= '\x05D0' && c <= '\x05EA'
|
||||||
|
|
||||||
|
splitMaqaf :: Text -> [Text]
|
||||||
|
splitMaqaf = filter (not . T.null) . T.splitOn "\x05BE"
|
||||||
|
|
||||||
|
|
||||||
|
-- | Resolve every Hebrew word of a text to its root, in order, each root
|
||||||
|
-- once. The verse in scope, when there is one, is consulted first.
|
||||||
|
resolveText :: RootIndex -> Maybe L1Verse -> Text -> [ResolvedRoot]
|
||||||
|
resolveText ix mverse =
|
||||||
|
dedupe . mapMaybe (resolveWord ix mverse) . tokenize
|
||||||
|
where
|
||||||
|
dedupe = go Set.empty
|
||||||
|
go _ [] = []
|
||||||
|
go seen (r:rs)
|
||||||
|
| rrShoresh r `Set.member` seen = go seen rs
|
||||||
|
| otherwise = r : go (Set.insert (rrShoresh r) seen) rs
|
||||||
|
|
||||||
|
resolveWord :: RootIndex -> Maybe L1Verse -> Text -> Maybe ResolvedRoot
|
||||||
|
resolveWord ix mverse w = case here of
|
||||||
|
(_:_) -> inVerse
|
||||||
|
[] -> case Map.lookup w (riSurfaceLemma ix) of
|
||||||
|
Just lemmas -> inTorah lemmas
|
||||||
|
Nothing -> named
|
||||||
|
where
|
||||||
|
verseWords = maybe [] l1vWords mverse
|
||||||
|
here = filter (\lw -> w `elem` splitMaqaf (l1wConsonants lw)) verseWords
|
||||||
|
|
||||||
|
-- The word stands in the verse in scope. What L1 says of it THERE is
|
||||||
|
-- the whole answer: its own shoresh, else its lemma's; and if L1 gives
|
||||||
|
-- it neither (את, אל, אשר), it has no root here — whatever a homograph
|
||||||
|
-- elsewhere in Torah may carry.
|
||||||
|
inVerse = firstJust
|
||||||
|
[ listToMaybe
|
||||||
|
[ ResolvedRoot sh w (binyanFromMorph (l1wMorph lw)) FromVerse
|
||||||
|
| lw <- here, Just sh <- [l1wShoresh lw], not (T.null sh) ]
|
||||||
|
, firstJust [ viaLemma (l1wLemma lw) | lw <- here ]
|
||||||
|
]
|
||||||
|
|
||||||
|
-- The word is not in the verse in scope but Torah has it. Read it
|
||||||
|
-- the way Torah most often does: its most common lemma decides.
|
||||||
|
-- אשר is the relative particle 1649 times and a name 14 times; the
|
||||||
|
-- particle wins, and a particle has no root.
|
||||||
|
inTorah lemmas = do
|
||||||
|
lemma <- mostCommon lemmas
|
||||||
|
firstJust
|
||||||
|
[ do sh <- mostCommon =<< Map.lookup (w, lemma) (riSurface ix)
|
||||||
|
return (ResolvedRoot sh w Nothing FromTorah)
|
||||||
|
, viaLemma lemma
|
||||||
|
]
|
||||||
|
|
||||||
|
-- No shoresh of its own, but a lemma whose other words have one.
|
||||||
|
viaLemma lemma = do
|
||||||
|
guard (realLemma lemma)
|
||||||
|
sh <- mostCommon =<< Map.lookup lemma (riLemma ix)
|
||||||
|
return (ResolvedRoot sh w Nothing FromLemma)
|
||||||
|
|
||||||
|
-- Torah has no such word, but knows it as a root: the asker named one.
|
||||||
|
named
|
||||||
|
| w `Set.member` riRoots ix = Just (ResolvedRoot w w Nothing NamedRoot)
|
||||||
|
| otherwise = Nothing
|
||||||
|
|
||||||
|
firstJust :: [Maybe a] -> Maybe a
|
||||||
|
firstJust = listToMaybe . mapMaybe id
|
||||||
|
|
||||||
|
-- | The key with the highest count; ties go to the lesser key, so the
|
||||||
|
-- answer does not depend on map traversal accidents.
|
||||||
|
mostCommon :: Map Text Int -> Maybe Text
|
||||||
|
mostCommon m = fmap fst . listToMaybe $ sortOn (\(k, n) -> (Down n, k)) (Map.toList m)
|
||||||
|
|
||||||
|
|
||||||
|
-- | The binyan a verb stands in, from its OSHB morphology code
|
||||||
|
-- (e.g. @HC/Vqw3ms@ → Qal, @HVhp1cs@ → Hifil). 'Nothing' for a word
|
||||||
|
-- that is not a verb, or a stem outside the seven.
|
||||||
|
binyanFromMorph :: Text -> Maybe Binyan
|
||||||
|
binyanFromMorph morph =
|
||||||
|
listToMaybe (mapMaybe stem (T.splitOn "/" (T.dropWhile (== 'H') morph)))
|
||||||
|
where
|
||||||
|
stem seg = case T.unpack (T.take 2 seg) of
|
||||||
|
['V', 'q'] -> Just Qal
|
||||||
|
['V', 'N'] -> Just Nifal
|
||||||
|
['V', 'p'] -> Just Piel
|
||||||
|
['V', 'P'] -> Just Pual
|
||||||
|
['V', 'h'] -> Just Hifil
|
||||||
|
['V', 'H'] -> Just Hofal
|
||||||
|
['V', 't'] -> Just Hitpael
|
||||||
|
_ -> Nothing
|
||||||
@@ -16,6 +16,8 @@
|
|||||||
module Shoresh.Server
|
module Shoresh.Server
|
||||||
( runServer
|
( runServer
|
||||||
, handleRequest
|
, handleRequest
|
||||||
|
, Env(..)
|
||||||
|
, loadEnv
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import qualified Data.ByteString.Char8 as BS8
|
import qualified Data.ByteString.Char8 as BS8
|
||||||
@@ -29,13 +31,15 @@ import Data.Maybe (mapMaybe)
|
|||||||
import System.IO (hSetBuffering, stdin, stdout, stderr,
|
import System.IO (hSetBuffering, stdin, stdout, stderr,
|
||||||
BufferMode(..), hFlush, hIsEOF)
|
BufferMode(..), hFlush, hIsEOF)
|
||||||
import System.Directory (doesFileExist)
|
import System.Directory (doesFileExist)
|
||||||
|
import System.Environment (lookupEnv)
|
||||||
|
import System.FilePath ((</>))
|
||||||
import Control.Exception (catch, SomeException)
|
import Control.Exception (catch, SomeException)
|
||||||
|
|
||||||
import Shoresh.Types
|
import Shoresh.Types
|
||||||
import Shoresh.Gematria
|
import Shoresh.Gematria
|
||||||
import Shoresh.Binyanim
|
|
||||||
import Shoresh.Teamim
|
import Shoresh.Teamim
|
||||||
import Shoresh.Lexicon
|
import Shoresh.Lexicon
|
||||||
|
import Shoresh.Roots
|
||||||
|
|
||||||
|
|
||||||
-- | Run the JSON-line server loop.
|
-- | Run the JSON-line server loop.
|
||||||
@@ -48,37 +52,59 @@ runServer = do
|
|||||||
hSetBuffering stdin LineBuffering
|
hSetBuffering stdin LineBuffering
|
||||||
hSetBuffering stdout LineBuffering
|
hSetBuffering stdout LineBuffering
|
||||||
hSetBuffering stderr LineBuffering
|
hSetBuffering stderr LineBuffering
|
||||||
serverLoop
|
env <- loadEnv
|
||||||
|
serverLoop env
|
||||||
|
|
||||||
|
|
||||||
|
-- | What the server holds for its whole life: where L1 is, and what L1
|
||||||
|
-- teaches about its words.
|
||||||
|
data Env = Env
|
||||||
|
{ envL1Root :: FilePath
|
||||||
|
, envRoots :: RootIndex
|
||||||
|
}
|
||||||
|
|
||||||
|
-- | Find L1 and read it once. The pipeline sets @L1_MOUNT_POINT@
|
||||||
|
-- (/mnt/torah on the pod); a bare checkout has @l1/@ beside it. Until
|
||||||
|
-- tablet 33 the path was the literal @l1/torah/…@ relative to the
|
||||||
|
-- working directory, which on the pod is not where the scroll is — so
|
||||||
|
-- @parse_tree@ was null there and nobody had noticed.
|
||||||
|
loadEnv :: IO Env
|
||||||
|
loadEnv = do
|
||||||
|
l1root <- maybe "l1" id <$> lookupEnv "L1_MOUNT_POINT"
|
||||||
|
ix <- loadIndex l1root
|
||||||
|
-- Force the index before the first request is read.
|
||||||
|
let (nVerses, nSurfaces, nRoots) = indexStats ix
|
||||||
|
nVerses `seq` nSurfaces `seq` nRoots `seq` return (Env l1root ix)
|
||||||
|
|
||||||
|
|
||||||
-- | Main server loop: read line, process, write line, repeat.
|
-- | Main server loop: read line, process, write line, repeat.
|
||||||
serverLoop :: IO ()
|
serverLoop :: Env -> IO ()
|
||||||
serverLoop = do
|
serverLoop env = do
|
||||||
eof <- hIsEOF stdin
|
eof <- hIsEOF stdin
|
||||||
if eof
|
if eof
|
||||||
then return ()
|
then return ()
|
||||||
else do
|
else do
|
||||||
line <- BL.fromStrict <$> BS8.getLine
|
line <- BL.fromStrict <$> BS8.getLine
|
||||||
response <- processLine line
|
response <- processLine env line
|
||||||
BLC.putStrLn (encode response)
|
BLC.putStrLn (encode response)
|
||||||
hFlush stdout
|
hFlush stdout
|
||||||
serverLoop
|
serverLoop env
|
||||||
|
|
||||||
|
|
||||||
-- | Process a single JSON line and return a response.
|
-- | Process a single JSON line and return a response.
|
||||||
processLine :: BL.ByteString -> IO Value
|
processLine :: Env -> BL.ByteString -> IO Value
|
||||||
processLine line = case eitherDecode line of
|
processLine env line = case eitherDecode line of
|
||||||
Left err -> return $ errorResponse "PARSE_ERROR" (T.pack err)
|
Left err -> return $ errorResponse "PARSE_ERROR" (T.pack err)
|
||||||
Right req -> handleRequest req
|
Right req -> handleRequest env req
|
||||||
`catch` \e -> return $ errorResponse "INTERNAL_ERROR"
|
`catch` \e -> return $ errorResponse "INTERNAL_ERROR"
|
||||||
(T.pack $ show (e :: SomeException))
|
(T.pack $ show (e :: SomeException))
|
||||||
|
|
||||||
|
|
||||||
-- | Handle a parsed request and produce a response.
|
-- | Handle a parsed request and produce a response.
|
||||||
handleRequest :: Value -> IO Value
|
handleRequest :: Env -> Value -> IO Value
|
||||||
handleRequest val = case parseOperation val of
|
handleRequest env val = case parseOperation val of
|
||||||
Nothing -> return $ errorResponse "INVALID_OPERATION" "Missing or invalid 'operation' field"
|
Nothing -> return $ errorResponse "INVALID_OPERATION" "Missing or invalid 'operation' field"
|
||||||
Just "process" -> handleProcess val
|
Just "process" -> handleProcess env val
|
||||||
Just "separate" -> handleSeparate val
|
Just "separate" -> handleSeparate val
|
||||||
Just "name" -> handleName val
|
Just "name" -> handleName val
|
||||||
Just "evaluate" -> handleEvaluate val
|
Just "evaluate" -> handleEvaluate val
|
||||||
@@ -103,36 +129,29 @@ parseOperation _ = Nothing
|
|||||||
-- | Handle "process" operation — root activation, te'amim parse, gematria.
|
-- | Handle "process" operation — root activation, te'amim parse, gematria.
|
||||||
-- Construction spec §3.1: Takes text + scope, returns roots_activated,
|
-- Construction spec §3.1: Takes text + scope, returns roots_activated,
|
||||||
-- parse_tree, dual_readings.
|
-- parse_tree, dual_readings.
|
||||||
handleProcess :: Value -> IO Value
|
handleProcess :: Env -> Value -> IO Value
|
||||||
handleProcess val = do
|
handleProcess env val = do
|
||||||
let reqText = extractText val
|
let reqText = extractText val
|
||||||
mscope = extractScope val
|
mscope = extractScope val
|
||||||
|
|
||||||
-- Parse roots from input text
|
-- The verse in scope, if one was named and L1 has it.
|
||||||
let roots = extractRoots reqText
|
mverse <- case mscope of
|
||||||
|
Nothing -> return Nothing
|
||||||
-- Build activated roots with gematria and binyanim
|
|
||||||
let activatedRoots = map activateRoot roots
|
|
||||||
|
|
||||||
-- If scope is provided, load verse from L1 and parse te'amim
|
|
||||||
(parseTree, dualReadings) <- case mscope of
|
|
||||||
Nothing -> return (Null, toJSON ([] :: [Value]))
|
|
||||||
Just (book, ch, vs) -> do
|
Just (book, ch, vs) -> do
|
||||||
let path = "l1/torah/" ++ T.unpack (bookToText book)
|
let path = envL1Root env </> "torah" </> T.unpack (bookToText book)
|
||||||
++ "/" ++ show ch ++ "/" ++ show vs ++ ".json"
|
</> show ch </> (show vs ++ ".json")
|
||||||
exists <- doesFileExist path
|
exists <- doesFileExist path
|
||||||
if not exists
|
if exists then loadL1Verse path else return Nothing
|
||||||
then return (Null, toJSON ([] :: [Value]))
|
|
||||||
else do
|
-- Each Hebrew word of the input, heard through L1 (Shoresh.Roots).
|
||||||
mverse <- loadL1Verse path
|
let activatedRoots = map activateRoot (resolveText (envRoots env) mverse reqText)
|
||||||
case mverse of
|
|
||||||
Nothing -> return (Null, toJSON ([] :: [Value]))
|
let (parseTree, dualReadings) = case mverse of
|
||||||
Just verse -> do
|
Nothing -> (Null, toJSON ([] :: [Value]))
|
||||||
|
Just verse ->
|
||||||
let annotated = mapMaybe annotateL1Word (l1vWords verse)
|
let annotated = mapMaybe annotateL1Word (l1vWords verse)
|
||||||
tree = readTeamim annotated
|
-- Phase 3: extract ketiv/qere
|
||||||
ptJson = treeToJson tree
|
in (treeToJson (readTeamim annotated), toJSON ([] :: [Value]))
|
||||||
drJson = toJSON ([] :: [Value]) -- Phase 3: extract ketiv/qere
|
|
||||||
return (ptJson, drJson)
|
|
||||||
|
|
||||||
return $ object
|
return $ object
|
||||||
[ "status" .= ("ok" :: Text)
|
[ "status" .= ("ok" :: Text)
|
||||||
@@ -226,41 +245,40 @@ extractScope (Object obj) = do
|
|||||||
extractScope _ = Nothing
|
extractScope _ = Nothing
|
||||||
|
|
||||||
|
|
||||||
-- | Extract Hebrew roots from input text.
|
-- | Render a root heard from L1 in the port's contract shape
|
||||||
extractRoots :: Text -> [Shoresh]
|
-- (Construction spec §3.1), plus where it was heard from.
|
||||||
extractRoots t =
|
--
|
||||||
let words' = T.words t
|
-- The shoresh is rendered exactly as L1 records it. A two-letter root
|
||||||
-- Try each word as a potential root
|
-- (כל, שמ) stays two letters: the old path padded it with He to fit the
|
||||||
candidates = mapMaybe textToShoresh words'
|
-- triliteral type and reported a root — and a gematria — the text does
|
||||||
-- Also try the whole text as a single root
|
-- not contain.
|
||||||
wholeRoot = textToShoresh (T.filter (\c -> c >= '\x05D0' && c <= '\x05EA') t)
|
--
|
||||||
in case candidates of
|
-- @binyan@ is the stem the verb actually stands in, read from the
|
||||||
[] -> case wholeRoot of
|
-- verse's morphology. It is null for a noun and for a word that is not
|
||||||
Just r -> [r]
|
-- in the verse in scope: the old path answered "Qal" for everything.
|
||||||
Nothing -> []
|
activateRoot :: ResolvedRoot -> Value
|
||||||
rs -> rs
|
activateRoot r =
|
||||||
|
let sh = rrShoresh r
|
||||||
|
|
||||||
-- | Activate a root: expand through binyanim, compute gematria, find neighbors.
|
|
||||||
activateRoot :: Shoresh -> Value
|
|
||||||
activateRoot sh =
|
|
||||||
let expanded = expand sh
|
|
||||||
gv = gematriaRoot sh
|
|
||||||
consonantNames = map consonantName [c1 sh, c2 sh, c3 sh]
|
|
||||||
defaultBinyan = case Map.lookup Qal expanded of
|
|
||||||
Just p -> T.pack (show (Shoresh.Types.binyan p))
|
|
||||||
Nothing -> "Qal"
|
|
||||||
in object
|
in object
|
||||||
[ "shoresh" .= consonantNames
|
[ "shoresh" .= mapMaybe (fmap consonantName . charToConsonant) (T.unpack sh)
|
||||||
, "shoresh_hebrew" .= shoreshToText sh
|
, "shoresh_hebrew" .= sh
|
||||||
, "binyan" .= defaultBinyan
|
, "binyan" .= fmap (T.pack . show) (rrBinyan r)
|
||||||
, "domain" .= ("unknown" :: Text) -- Phase 3: domain lookup
|
, "domain" .= ("unknown" :: Text) -- Phase 3: domain lookup
|
||||||
, "torah_refs" .= ([] :: [Value]) -- Phase 3: lexicon lookup
|
, "torah_refs" .= ([] :: [Value]) -- Phase 3: lexicon lookup
|
||||||
, "gematria_value" .= gv
|
, "gematria_value" .= gematriaWord sh
|
||||||
, "gematria_neighbors" .= ([] :: [Value]) -- Phase 3: lexicon needed
|
, "gematria_neighbors" .= ([] :: [Value]) -- Phase 3: lexicon needed
|
||||||
, "neighbors" .= ([] :: [Value]) -- Phase 3: lexicon needed
|
, "neighbors" .= ([] :: [Value]) -- Phase 3: lexicon needed
|
||||||
|
, "surface" .= rrSurface r
|
||||||
|
, "derivation" .= derivationName (rrDerivation r)
|
||||||
]
|
]
|
||||||
|
|
||||||
|
derivationName :: Derivation -> Text
|
||||||
|
derivationName d = case d of
|
||||||
|
FromVerse -> "verse"
|
||||||
|
FromLemma -> "lemma"
|
||||||
|
FromTorah -> "torah"
|
||||||
|
NamedRoot -> "named_root"
|
||||||
|
|
||||||
|
|
||||||
-- | Convert an L1 word to an AnnotatedWord for te'amim parsing.
|
-- | Convert an L1 word to an AnnotatedWord for te'amim parsing.
|
||||||
annotateL1Word :: L1Word -> Maybe AnnotatedWord
|
annotateL1Word :: L1Word -> Maybe AnnotatedWord
|
||||||
|
|||||||
@@ -22,6 +22,7 @@ import Shoresh.Teamim
|
|||||||
import Shoresh.KetivQere
|
import Shoresh.KetivQere
|
||||||
import Shoresh.Lexicon
|
import Shoresh.Lexicon
|
||||||
import Shoresh.Graph
|
import Shoresh.Graph
|
||||||
|
import Shoresh.Roots
|
||||||
import Shoresh.KiTov
|
import Shoresh.KiTov
|
||||||
import Luchot.Firmware
|
import Luchot.Firmware
|
||||||
|
|
||||||
@@ -36,6 +37,7 @@ main = hspec $ do
|
|||||||
graphSpec
|
graphSpec
|
||||||
kiTovSpec
|
kiTovSpec
|
||||||
firmwareSpec
|
firmwareSpec
|
||||||
|
rootsSpec
|
||||||
|
|
||||||
consonantSpec :: Spec
|
consonantSpec :: Spec
|
||||||
consonantSpec = describe "Consonant" $ do
|
consonantSpec = describe "Consonant" $ do
|
||||||
@@ -294,6 +296,166 @@ firmwareSpec = describe "Firmware" $ do
|
|||||||
dibrot `shouldBe` Dibrot () () () () () () () () () ()
|
dibrot `shouldBe` Dibrot () () () () () () () () () ()
|
||||||
|
|
||||||
|
|
||||||
|
-- ============================================================
|
||||||
|
-- Roots — tablet 33: a word's root is what L1 records for it
|
||||||
|
-- ============================================================
|
||||||
|
|
||||||
|
-- | An L1 word as build_l1.py writes it (position, text and te'amim are
|
||||||
|
-- irrelevant to root resolution).
|
||||||
|
l1w :: Text -> Text -> Text -> Maybe Text -> L1Word
|
||||||
|
l1w cons lemma morph sh = L1Word
|
||||||
|
{ l1wPosition = 0, l1wText = cons, l1wConsonants = cons, l1wLemma = lemma
|
||||||
|
, l1wMorph = morph, l1wTeamim = [], l1wPrefix = Nothing, l1wShoresh = sh }
|
||||||
|
|
||||||
|
l1v :: Text -> Int -> Int -> [L1Word] -> L1Verse
|
||||||
|
l1v book ch vs ws = L1Verse
|
||||||
|
{ l1vRef = "", l1vBook = book, l1vChapter = ch, l1vVerse = vs
|
||||||
|
, l1vTextHebrew = "", l1vWords = ws }
|
||||||
|
|
||||||
|
-- Devarim 6:5, as L1 holds it: three suffixed nouns carry no shoresh.
|
||||||
|
devarim65 :: L1Verse
|
||||||
|
devarim65 = l1v "devarim" 6 5
|
||||||
|
[ l1w "ואהבת" "157" "HC/Vqq2ms" (Just "אהב")
|
||||||
|
, l1w "את" "853" "HTo" Nothing
|
||||||
|
, l1w "יהוה" "3068" "HNp" (Just "יהו")
|
||||||
|
, l1w "אלהיך" "430" "HNcmpc/Sp2ms" Nothing
|
||||||
|
, l1w "בכל" "3605" "HR/Ncmsc" (Just "כל")
|
||||||
|
, l1w "לבבך" "3824" "HNcmsc/Sp2ms" Nothing
|
||||||
|
, l1w "ובכל" "3605" "HC/R/Ncmsc" (Just "כל")
|
||||||
|
, l1w "נפשך" "5315" "HNcbsc/Sp2ms" Nothing
|
||||||
|
]
|
||||||
|
|
||||||
|
-- Elsewhere in Torah: the same lemmas with a shoresh of their own.
|
||||||
|
elsewhere :: [L1Verse]
|
||||||
|
elsewhere =
|
||||||
|
[ l1v "bereishit" 1 1
|
||||||
|
[ l1w "בראשית" "7225" "HR/Ncfsa" (Just "ראש")
|
||||||
|
, l1w "ברא" "1254" "HVqp3ms" (Just "ברא")
|
||||||
|
, l1w "אלהים" "430" "HNcmpa" (Just "אלה")
|
||||||
|
, l1w "את" "853" "HTo" Nothing
|
||||||
|
]
|
||||||
|
, l1v "bereishit" 1 3
|
||||||
|
[ l1w "ויאמר" "559" "HC/Vqw3ms" (Just "אמר")
|
||||||
|
, l1w "אור" "216" "HNcbsa" (Just "אור")
|
||||||
|
, l1w "ויהי־אור" "1961" "HC/Vqw3ms" (Just "יהי")
|
||||||
|
]
|
||||||
|
, l1v "bereishit" 1 4
|
||||||
|
[ l1w "ויבדל" "914" "HC/Vhw3ms" (Just "בדל") ]
|
||||||
|
, l1v "devarim" 4 29
|
||||||
|
[ l1w "לבב" "3824" "HNcmsa" (Just "לבב")
|
||||||
|
, l1w "נפש" "5315" "HNcbsa" (Just "נפש")
|
||||||
|
]
|
||||||
|
-- Homographs. אשר: the relative particle twice, the name Asher once.
|
||||||
|
-- את: the object marker everywhere, but אתה yields the root את.
|
||||||
|
, l1v "shemot" 3 14
|
||||||
|
[ l1w "אשר" "834 a" "HTr" Nothing
|
||||||
|
, l1w "אהיה" "1961" "HVqi1cs" (Just "היה")
|
||||||
|
, l1w "אשר" "834 a" "HTr" Nothing
|
||||||
|
]
|
||||||
|
, l1v "bereishit" 30 13
|
||||||
|
[ l1w "אשר" "836" "HNp" (Just "אשר")
|
||||||
|
, l1w "אתה" "859 a" "HPp2ms" (Just "את")
|
||||||
|
]
|
||||||
|
]
|
||||||
|
|
||||||
|
testIndex :: RootIndex
|
||||||
|
testIndex = buildIndex (devarim65 : elsewhere)
|
||||||
|
|
||||||
|
shoreshim :: [ResolvedRoot] -> [Text]
|
||||||
|
shoreshim = map rrShoresh
|
||||||
|
|
||||||
|
rootsSpec :: Spec
|
||||||
|
rootsSpec = describe "Roots (tablet 33)" $ do
|
||||||
|
describe "what the old engine did, and must not do again" $ do
|
||||||
|
it "a particle is not a root — את yields nothing, never א-ת-ה" $
|
||||||
|
resolveText testIndex Nothing "את" `shouldBe` []
|
||||||
|
|
||||||
|
it "a three-letter word is not a root because it has three letters" $
|
||||||
|
-- בכל was reported as ב-כ-ל; L1 says its root is כל.
|
||||||
|
shoreshim (resolveText testIndex (Just devarim65) "בכל") `shouldBe` ["כל"]
|
||||||
|
|
||||||
|
it "a long word is not dropped — ויאמר is א-מ-ר" $
|
||||||
|
shoreshim (resolveText testIndex Nothing "ויאמר") `shouldBe` ["אמר"]
|
||||||
|
|
||||||
|
it "a word Torah does not contain yields nothing" $
|
||||||
|
resolveText testIndex Nothing "מחשב" `shouldBe` []
|
||||||
|
|
||||||
|
it "non-Hebrew input yields nothing" $
|
||||||
|
resolveText testIndex Nothing "Test query 1" `shouldBe` []
|
||||||
|
|
||||||
|
describe "the whole of Devarim 6:5" $ do
|
||||||
|
let roots = resolveText testIndex (Just devarim65)
|
||||||
|
"ואהבת את יהוה אלהיך בכל לבבך ובכל נפשך"
|
||||||
|
|
||||||
|
it "finds א-ה-ב, and the heart and the soul" $
|
||||||
|
shoreshim roots `shouldBe` ["אהב", "יהו", "אלה", "כל", "לבב", "נפש"]
|
||||||
|
|
||||||
|
it "a word in the verse with its own shoresh is heard from the verse" $
|
||||||
|
map rrDerivation (take 2 roots) `shouldBe` [FromVerse, FromVerse]
|
||||||
|
|
||||||
|
it "a suffixed noun with no shoresh is heard through its lemma" $
|
||||||
|
[ rrDerivation r | r <- roots, rrShoresh r `elem` ["לבב", "נפש", "אלה"] ]
|
||||||
|
`shouldBe` [FromLemma, FromLemma, FromLemma]
|
||||||
|
|
||||||
|
it "כל appears once though the verse says it twice" $
|
||||||
|
length (filter (== "כל") (shoreshim roots)) `shouldBe` 1
|
||||||
|
|
||||||
|
describe "binyan" $ do
|
||||||
|
it "is read from the verb's morphology in the verse" $ do
|
||||||
|
let v = elsewhere !! 2
|
||||||
|
map rrBinyan (resolveText testIndex (Just v) "ויבדל") `shouldBe` [Just Hifil]
|
||||||
|
map rrBinyan (resolveText testIndex (Just devarim65) "ואהבת") `shouldBe` [Just Qal]
|
||||||
|
|
||||||
|
it "is not claimed for a noun" $
|
||||||
|
map rrBinyan (resolveText testIndex (Just devarim65) "בכל") `shouldBe` [Nothing]
|
||||||
|
|
||||||
|
it "is not claimed for a word outside the verse in scope" $
|
||||||
|
map rrBinyan (resolveText testIndex (Just devarim65) "ויבדל") `shouldBe` [Nothing]
|
||||||
|
|
||||||
|
it "parses OSHB stems" $ do
|
||||||
|
binyanFromMorph "HC/Vqw3ms" `shouldBe` Just Qal
|
||||||
|
binyanFromMorph "HVhp1cs" `shouldBe` Just Hifil
|
||||||
|
binyanFromMorph "HVNp3ms" `shouldBe` Just Nifal
|
||||||
|
binyanFromMorph "HVtw3ms" `shouldBe` Just Hitpael
|
||||||
|
binyanFromMorph "HNcmsa" `shouldBe` Nothing
|
||||||
|
|
||||||
|
describe "homographs" $ do
|
||||||
|
it "a particle in the verse has no root, though Torah knows את as a root" $ do
|
||||||
|
resolveText testIndex (Just devarim65) "את" `shouldBe` []
|
||||||
|
resolveText testIndex Nothing "את" `shouldBe` []
|
||||||
|
|
||||||
|
it "out of scope, a word is read the way Torah most often reads it" $
|
||||||
|
-- אשר: particle ×2, the name ×1. The particle wins; no root.
|
||||||
|
resolveText testIndex Nothing "אשר" `shouldBe` []
|
||||||
|
|
||||||
|
it "in scope, the verse decides — אשר the particle in Shemot 3:14" $
|
||||||
|
shoreshim (resolveText testIndex (Just (elsewhere !! 4)) "אהיה אשר אהיה")
|
||||||
|
`shouldBe` ["היה"]
|
||||||
|
|
||||||
|
describe "other ways a root is heard" $ do
|
||||||
|
it "from elsewhere in Torah when the word is not in the verse in scope" $
|
||||||
|
map (\r -> (rrShoresh r, rrDerivation r))
|
||||||
|
(resolveText testIndex (Just devarim65) "ויאמר")
|
||||||
|
`shouldBe` [("אמר", FromTorah)]
|
||||||
|
|
||||||
|
it "a root the asker names, if Torah knows it as a root" $
|
||||||
|
map (\r -> (rrShoresh r, rrDerivation r)) (resolveText testIndex Nothing "אמר")
|
||||||
|
`shouldBe` [("אמר", NamedRoot)]
|
||||||
|
|
||||||
|
it "a three-letter string Torah does not know as a root is not one" $
|
||||||
|
resolveText testIndex Nothing "קטל" `shouldBe` []
|
||||||
|
|
||||||
|
describe "tokenize" $ do
|
||||||
|
it "strips nikud and te'amim" $
|
||||||
|
tokenize "וַיֹּ֥אמֶר אֱלֹהִ֖ים" `shouldBe` ["ויאמר", "אלהים"]
|
||||||
|
|
||||||
|
it "splits maqaf before stripping marks (tablet 30a)" $
|
||||||
|
tokenize "וַֽיְהִי־אֽוֹר ׃" `shouldBe` ["ויהי", "אור"]
|
||||||
|
|
||||||
|
it "indexes both halves of a maqaf-joined L1 word" $
|
||||||
|
shoreshim (resolveText testIndex Nothing "ויהי") `shouldBe` ["יהי"]
|
||||||
|
|
||||||
|
|
||||||
-- ============================================================
|
-- ============================================================
|
||||||
-- Helpers
|
-- Helpers
|
||||||
-- ============================================================
|
-- ============================================================
|
||||||
|
|||||||
@@ -365,7 +365,13 @@ defmodule VavPipeline.BereishitCycle do
|
|||||||
ps -> "word " <> Enum.join(Enum.map(ps, &to_string/1), ", ")
|
ps -> "word " <> Enum.join(Enum.map(ps, &to_string/1), ", ")
|
||||||
end
|
end
|
||||||
|
|
||||||
"#{hyphenate(r.shoresh)} (gematria #{r.gematria}, #{r.binyan || "binyan unknown"}, #{where})"
|
# A binyan is said only where the engine read one off a verb in
|
||||||
|
# this verse. A noun has none; saying "unknown" (or, before
|
||||||
|
# tablet 33, "Qal" for everything) claims a question that does
|
||||||
|
# not exist.
|
||||||
|
binyan = if r.binyan, do: "#{r.binyan}, ", else: ""
|
||||||
|
|
||||||
|
"#{hyphenate(r.shoresh)} (gematria #{r.gematria}, #{binyan}#{where})"
|
||||||
end)
|
end)
|
||||||
|
|
||||||
group_line =
|
group_line =
|
||||||
@@ -891,10 +897,20 @@ defmodule VavPipeline.BereishitCycle do
|
|||||||
Map.get(root, "shoresh_hebrew") ||
|
Map.get(root, "shoresh_hebrew") ||
|
||||||
letters_to_hebrew(Map.get(root, "shoresh"))
|
letters_to_hebrew(Map.get(root, "shoresh"))
|
||||||
|
|
||||||
|
# Where the root stands in the verse: every word L1 gives this
|
||||||
|
# shoresh, and — for a root the engine heard through a word's lemma
|
||||||
|
# (לבבך → לבב; L1 records no shoresh on the suffixed noun itself) —
|
||||||
|
# the word it was heard from (tablet 33).
|
||||||
positions =
|
positions =
|
||||||
case shoresh do
|
case shoresh do
|
||||||
nil -> []
|
nil ->
|
||||||
s -> verse_positions_for(s, context)
|
[]
|
||||||
|
|
||||||
|
s ->
|
||||||
|
(verse_positions_for(s, context) ++
|
||||||
|
surface_positions_for(Map.get(root, "surface"), context))
|
||||||
|
|> Enum.uniq()
|
||||||
|
|> Enum.sort()
|
||||||
end
|
end
|
||||||
|
|
||||||
given_position = Map.get(root, :position)
|
given_position = Map.get(root, :position)
|
||||||
@@ -906,7 +922,8 @@ defmodule VavPipeline.BereishitCycle do
|
|||||||
binyan: Map.get(root, :binyan) || Map.get(root, "binyan"),
|
binyan: Map.get(root, :binyan) || Map.get(root, "binyan"),
|
||||||
domain: Map.get(root, :domain) || Map.get(root, "domain"),
|
domain: Map.get(root, :domain) || Map.get(root, "domain"),
|
||||||
torah_refs: Map.get(root, :torah_refs) || Map.get(root, "torah_refs") || [],
|
torah_refs: Map.get(root, :torah_refs) || Map.get(root, "torah_refs") || [],
|
||||||
word: Map.get(root, :word),
|
word: Map.get(root, :word) || Map.get(root, "surface"),
|
||||||
|
derivation: Map.get(root, "derivation"),
|
||||||
morph: Map.get(root, :morph),
|
morph: Map.get(root, :morph),
|
||||||
positions: positions,
|
positions: positions,
|
||||||
position: given_position || List.first(positions),
|
position: given_position || List.first(positions),
|
||||||
@@ -924,6 +941,14 @@ defmodule VavPipeline.BereishitCycle do
|
|||||||
|> Enum.sort()
|
|> Enum.sort()
|
||||||
end
|
end
|
||||||
|
|
||||||
|
defp surface_positions_for(nil, _context), do: []
|
||||||
|
|
||||||
|
defp surface_positions_for(surface, context) do
|
||||||
|
(get_in(context, [:verse, :words]) || [])
|
||||||
|
|> Enum.filter(fn w -> w.consonants == surface end)
|
||||||
|
|> Enum.map(& &1.position)
|
||||||
|
end
|
||||||
|
|
||||||
# The engine's "shoresh" is a list of consonant NAMES ("bet","resh",
|
# The engine's "shoresh" is a list of consonant NAMES ("bet","resh",
|
||||||
# "aleph"). shoresh_hebrew is the authoritative Hebrew form and is
|
# "aleph"). shoresh_hebrew is the authoritative Hebrew form and is
|
||||||
# always present in practice; this is a last resort that never
|
# always present in practice; this is a last resort that never
|
||||||
|
|||||||
@@ -22,6 +22,9 @@ defmodule VavPipeline.LivenessTest do
|
|||||||
setup do
|
setup do
|
||||||
# Make sure no provision exists — the exact state of a fresh pod.
|
# Make sure no provision exists — the exact state of a fresh pod.
|
||||||
File.rm(VavPipeline.Manna.provision_file())
|
File.rm(VavPipeline.Manna.provision_file())
|
||||||
|
# ...and no halt. halt_monitor_test leaves the monitor halted on some
|
||||||
|
# seeds (0, 191243), and a fresh pod is not halted.
|
||||||
|
if HaltMonitor.halted?(), do: HaltMonitor.resolve("liveness test setup")
|
||||||
:ok
|
:ok
|
||||||
end
|
end
|
||||||
|
|
||||||
|
|||||||
@@ -0,0 +1,131 @@
|
|||||||
|
defmodule VavPipeline.Tablet33EngineRootsTest do
|
||||||
|
@moduledoc """
|
||||||
|
Tablet 33 (2026-10-04) — the Shoresh Engine now hears roots from L1
|
||||||
|
(shoresh-engine `Shoresh.Roots`), and its answers changed shape in three
|
||||||
|
ways the cycle must carry faithfully:
|
||||||
|
|
||||||
|
* a root may be two letters (`כל`), exactly as L1 records it — no
|
||||||
|
padded He;
|
||||||
|
* `binyan` is null for a noun, and for any word not in the verse;
|
||||||
|
* a root heard through a word's lemma (`לבבך` → `לבב`) arrives with the
|
||||||
|
`surface` word it was heard from, because L1 records no shoresh on
|
||||||
|
the suffixed noun and the verse cannot be searched by shoresh.
|
||||||
|
|
||||||
|
The engine's own behaviour is held by its HSpec suite (55 examples).
|
||||||
|
This file holds the pipeline's reading of it, with an engine-shaped
|
||||||
|
stand-in under the real port name answering as the rebuilt engine
|
||||||
|
answered for Devarim 6:5 on 2026-10-04.
|
||||||
|
"""
|
||||||
|
|
||||||
|
use ExUnit.Case, async: false
|
||||||
|
|
||||||
|
import Plug.Test
|
||||||
|
import Plug.Conn
|
||||||
|
|
||||||
|
alias VavPipeline.{HaltMonitor, MannaLedger}
|
||||||
|
alias VavPipeline.BigdeiKodesh.Router
|
||||||
|
|
||||||
|
@opts Router.init([])
|
||||||
|
|
||||||
|
defmodule EnginePort do
|
||||||
|
use GenServer
|
||||||
|
|
||||||
|
def start, do: GenServer.start(__MODULE__, :ok, name: VavPipeline.ShoreshEnginePort)
|
||||||
|
|
||||||
|
@impl true
|
||||||
|
def init(:ok), do: {:ok, :ok}
|
||||||
|
|
||||||
|
@impl true
|
||||||
|
def handle_call({:request, _json_line}, _from, s) do
|
||||||
|
roots = [
|
||||||
|
root(["aleph", "he", "bet"], "אהב", 8, "Qal", "ואהבת", "verse"),
|
||||||
|
root(["kaf", "lamed"], "כל", 50, nil, "בכל", "verse"),
|
||||||
|
root(["lamed", "bet", "bet"], "לבב", 34, nil, "לבבך", "lemma")
|
||||||
|
]
|
||||||
|
|
||||||
|
{:reply, {:ok, %{"roots_activated" => roots, "parse_tree" => nil, "dual_readings" => []}}, s}
|
||||||
|
end
|
||||||
|
|
||||||
|
defp root(letters, hebrew, gematria, binyan, surface, derivation) do
|
||||||
|
%{
|
||||||
|
"shoresh" => letters,
|
||||||
|
"shoresh_hebrew" => hebrew,
|
||||||
|
"gematria_value" => gematria,
|
||||||
|
"binyan" => binyan,
|
||||||
|
"domain" => "unknown",
|
||||||
|
"torah_refs" => [],
|
||||||
|
"neighbors" => [],
|
||||||
|
"gematria_neighbors" => [],
|
||||||
|
"surface" => surface,
|
||||||
|
"derivation" => derivation
|
||||||
|
}
|
||||||
|
end
|
||||||
|
end
|
||||||
|
|
||||||
|
setup do
|
||||||
|
if HaltMonitor.halted?(), do: HaltMonitor.resolve("tablet33 test setup")
|
||||||
|
write_provision(50)
|
||||||
|
|
||||||
|
assert Process.whereis(VavPipeline.ShoreshEnginePort) == nil
|
||||||
|
{:ok, pid} = EnginePort.start()
|
||||||
|
on_exit(fn -> if Process.alive?(pid), do: GenServer.stop(pid) end)
|
||||||
|
:ok
|
||||||
|
end
|
||||||
|
|
||||||
|
test "Devarim 6:5 — the engine's roots are placed in the verse and said plainly" do
|
||||||
|
conn = post_ask("devarim 6:5")
|
||||||
|
body = Jason.decode!(conn.resp_body)
|
||||||
|
answer = body["answer"]
|
||||||
|
|
||||||
|
assert conn.status == 200, "#{conn.status} #{conn.resp_body}"
|
||||||
|
|
||||||
|
# A verb in the verse: binyan and position.
|
||||||
|
assert answer =~ "א-ה-ב (gematria 8, Qal, word 1)"
|
||||||
|
|
||||||
|
# A two-letter root stays two letters, and stands where L1 says: בכל
|
||||||
|
# is word 5, ובכל words 7 and 9.
|
||||||
|
assert answer =~ "כ-ל (gematria 50, word 5, 7, 9)"
|
||||||
|
|
||||||
|
# Heard through the lemma; L1 gives לבבך no shoresh, so only the
|
||||||
|
# surface word can place it. Word 6 — not "not in this verse".
|
||||||
|
assert answer =~ "ל-ב-ב (gematria 34, word 6)"
|
||||||
|
|
||||||
|
refute answer =~ "not in this verse"
|
||||||
|
refute answer =~ "binyan unknown"
|
||||||
|
assert body["processing"]["roots_consulted"] == ["א-ה-ב", "כ-ל", "ל-ב-ב"]
|
||||||
|
end
|
||||||
|
|
||||||
|
defp write_provision(compute_units) do
|
||||||
|
MannaLedger.reset()
|
||||||
|
on_exit(fn -> MannaLedger.reset() end)
|
||||||
|
today = Date.utc_today() |> Date.to_iso8601()
|
||||||
|
expires = DateTime.utc_now() |> DateTime.add(6 * 3600) |> DateTime.to_iso8601()
|
||||||
|
|
||||||
|
provision = %{
|
||||||
|
"date" => today,
|
||||||
|
"provision" => %{
|
||||||
|
"compute_units" => compute_units,
|
||||||
|
"memory_mb" => 512,
|
||||||
|
"api_calls_external" => 5,
|
||||||
|
"storage_delta_mb" => 2,
|
||||||
|
"sanhedrin_panels_max" => 2
|
||||||
|
},
|
||||||
|
"type" => "regular",
|
||||||
|
"expires_at" => expires,
|
||||||
|
"written_by" => "tablet33_test",
|
||||||
|
"written_at" => DateTime.utc_now() |> DateTime.to_iso8601()
|
||||||
|
}
|
||||||
|
|
||||||
|
path = VavPipeline.Manna.provision_file()
|
||||||
|
File.mkdir_p!(Path.dirname(path))
|
||||||
|
File.write!(path, Jason.encode!(provision))
|
||||||
|
on_exit(fn -> File.rm(path) end)
|
||||||
|
path
|
||||||
|
end
|
||||||
|
|
||||||
|
defp post_ask(question) do
|
||||||
|
conn(:post, "/peah/ask", Jason.encode!(%{question: question}))
|
||||||
|
|> put_req_header("content-type", "application/json")
|
||||||
|
|> Router.call(@opts)
|
||||||
|
end
|
||||||
|
end
|
||||||
Reference in new issue
Block a user