specs §3.1 + engine + Doorpost: a root is the consonants L1 records — two, three, or more

Architecture §3.1 typed a root as exactly three consonants (`Shoresh {c1,c2,c3}`) and listed data/roots.json and data/torah_refs.json in the engine's file tree. L1 has 115 roots that are not three letters (32 of two, 83 of four or more), and the engine has no data directory: the roots are in L1. The code had followed the spec's type and paid for it. textToShoresh padded a two-letter root with He — בן became בנה, כל became כלה — and returned Nothing for anything longer, so Lexicon.buildLexiconFromVerses either falsified those roots or dropped them. Shoresh.Roots (tablet 33) had stepped around the type by carrying roots as Text. Spec: - §3.1 data structures: `newtype Shoresh = Shoresh { radicals :: [Consonant] }` — two or more, never padded or truncated; `mkShoresh`, `triliteral`. - relatedRoots / neighbors: same length, differing in exactly one consonant (for a root of three, the old "sharing 2 consonants"). - File tree: Roots.hs and Server.hs added; data/ removed, with a line saying where the roots are; cabal.project.freeze listed; aeson's purpose corrected. Engine: - Types: the newtype, mkShoresh :: [Consonant] -> Maybe Shoresh, triliteral, textToShoresh without padding. - Gematria: sum over the radicals. Graph: neighbors among roots of the same length; neighborsByPosition labels the shared positions ("c1c2" for a triliteral, as before). - Server: consonant names through the type. - Spec.hs: בן stays two letters (gematria 52, not 57); שמאל is held whole; the graph compares only roots of equal length. 59 examples. Doorpost @expected_hash 094b8164… → f653ef05…, in this commit, with the witnessed file that moved it (architecture). Read before committing: Haskell 59/0; Elixir 474/0 on seeds 0 7 42; both images built and run together with the real binary — Shemot 3:14 answers ב-ן (two letters), Bereishit 48:13 answers ש-מ-א-ל (four), Devarim 6:5 unchanged; local specification_identity verified f653ef05…; no engine errors or fallbacks. Not touched: §3.1's dependency list omits bytestring, filepath and directory, which the cabal file has. Co-Authored-By: Claude Fable 5.1 <noreply@anthropic.com>
2026-10-04 18:42:52 +00:00
1 parent 4f1879d7ce
commit 5ff1b73d00
@@ -64,32 +64,39 @@ consonantSpec = describe "Consonant" $ do
 shoreshSpec :: Spec
 shoreshSpec = describe "Shoresh" $ do
  it "constructs a triliteral root" $ do
-    let sh = mkShoresh Bet Resh Aleph
-    c1 sh `shouldBe` Bet
-    c2 sh `shouldBe` Resh
-    c3 sh `shouldBe` Aleph
+    let sh = triliteral Bet Resh Aleph
+    radicals sh `shouldBe` [Bet, Resh, Aleph]

  it "renders as Hebrew text" $ do
-    shoreshToText (mkShoresh Bet Resh Aleph) `shouldBe` "ברא"
-    shoreshToText (mkShoresh Qof Dalet Shin) `shouldBe` "קדש"
+    shoreshToText (triliteral Bet Resh Aleph) `shouldBe` "ברא"
+    shoreshToText (triliteral Qof Dalet Shin) `shouldBe` "קדש"

  it "parses from Hebrew text (3 consonants)" $ do
-    textToShoresh "ברא" `shouldBe` Just (mkShoresh Bet Resh Aleph)
-    textToShoresh "קדש" `shouldBe` Just (mkShoresh Qof Dalet Shin)
+    textToShoresh "ברא" `shouldBe` Just (triliteral Bet Resh Aleph)
+    textToShoresh "קדש" `shouldBe` Just (triliteral Qof Dalet Shin)

-  it "parses from Hebrew text (2 consonants — biconsonantal)" $ do
-    -- Build log: some roots in L1 are 2-consonant (e.g. "שמ")
-    let result = textToShoresh "שמ"
-    result `shouldSatisfy` isJust
-    -- Bicons pad with He
-    case result of
-      Just sh -> c3 sh `shouldBe` He
-      Nothing -> expectationFailure "Should have parsed"
+  it "a two-letter root stays two letters — nothing is added" $ do
+    -- L1 has roots of two consonants (בן, יד). This type once held
+    -- exactly three and padded these with He: בן became בנה.
+    fmap radicals (textToShoresh "בן") `shouldBe` Just [Bet, Nun]
+    fmap shoreshToText (textToShoresh "בן") `shouldBe` Just "בנ"
+    fmap gematriaRoot (textToShoresh "בן") `shouldBe` Just 52
+
+  it "a root of four or more is held whole" $ do
+    -- שמאל — once rejected as "too long".
+    fmap radicals (textToShoresh "שמאל") `shouldBe` Just [Shin, Mem, Aleph, Lamed]
+    fmap gematriaRoot (textToShoresh "שמאל") `shouldBe` Just 371
+
+  it "mkShoresh needs at least two consonants" $ do
+    mkShoresh [] `shouldBe` Nothing
+    mkShoresh [Aleph] `shouldBe` Nothing
+    mkShoresh [Bet, Nun] `shouldSatisfy` isJust

  it "rejects invalid input" $ do
    textToShoresh "" `shouldBe` Nothing
-    textToShoresh "א" `shouldBe` Nothing  -- too short
-    textToShoresh "אבגד" `shouldBe` Nothing  -- too long
+    textToShoresh "א" `shouldBe` Nothing  -- one letter is not a root
+    textToShoresh "abc" `shouldBe` Nothing
+    textToShoresh "בר1" `shouldBe` Nothing


 binyanSpec :: Spec
@@ -98,14 +105,14 @@ binyanSpec = describe "Binyanim" $ do
    length allBinyanim `shouldBe` 7

  it "activates a root through all 7 binyanim" $ do
-    let sh = mkShoresh Bet Resh Aleph
+    let sh = triliteral Bet Resh Aleph
    let expanded = expand sh
    Map.size expanded `shouldBe` 7
    -- Each binyan should produce a peulah with the same root
    mapM_ (\(b, p) -> root p `shouldBe` sh) (Map.toList expanded)

  it "activate produces correct grammatical features" $ do
-    let sh = mkShoresh Shin Mem Resh  -- שמר = guard
+    let sh = triliteral Shin Mem Resh  -- שמר = guard
    let p = activate Qal Third Singular Masculine Perfect sh
    root p `shouldBe` sh
    binyan p `shouldBe` Qal
@@ -115,7 +122,7 @@ binyanSpec = describe "Binyanim" $ do
    aspect p `shouldBe` Perfect

  it "activateDefault uses 3ms perfect citation form" $ do
-    let sh = mkShoresh Kaf Tav Bet  -- כתב = write
+    let sh = triliteral Kaf Tav Bet  -- כתב = write
    let p = activateDefault Qal sh
    person p `shouldBe` Third
    number p `shouldBe` Singular
@@ -133,11 +140,11 @@ gematriaSpec = describe "Gematria" $ do

  it "computes root gematria correctly" $ do
    -- ברא = Bet(2) + Resh(200) + Aleph(1) = 203
-    gematriaRoot (mkShoresh Bet Resh Aleph) `shouldBe` 203
+    gematriaRoot (triliteral Bet Resh Aleph) `shouldBe` 203
    -- קדש = Qof(100) + Dalet(4) + Shin(300) = 404
-    gematriaRoot (mkShoresh Qof Dalet Shin) `shouldBe` 404
+    gematriaRoot (triliteral Qof Dalet Shin) `shouldBe` 404
    -- שלם = Shin(300) + Lamed(30) + Mem(40) = 370
-    gematriaRoot (mkShoresh Shin Lamed Mem) `shouldBe` 370
+    gematriaRoot (triliteral Shin Lamed Mem) `shouldBe` 370

  it "computes word gematria correctly" $ do
    -- תורה = Tav(400) + Vav(6) + Resh(200) + He(5) = 611
@@ -151,8 +158,8 @@ gematriaSpec = describe "Gematria" $ do
    gematriaWord "בְּרֵאשִׁ֖ית" `shouldBe` gematriaWord "בראשית"

  it "finds gematria neighbors" $ do
-    let bara = mkShoresh Bet Resh Aleph  -- 203
-    let other = mkShoresh Resh Gimel Gimel  -- 200+3+3 = 206, not 203
+    let bara = triliteral Bet Resh Aleph  -- 203
+    let other = triliteral Resh Gimel Gimel  -- 200+3+3 = 206, not 203
    let lex = Map.fromList
                [ (bara, ShoreshEntry bara Creation [] [] Map.empty)
                , (other, ShoreshEntry other Creation [] [] Map.empty)
@@ -240,10 +247,10 @@ ketivQereSpec = describe "KetivQere" $ do
 graphSpec :: Spec
 graphSpec = describe "Graph" $ do
  it "finds roots sharing 2 consonants" $ do
-    let bara = mkShoresh Bet Resh Aleph    -- ברא
-    let barak = mkShoresh Bet Resh Kaf     -- ברך (shares ב,ר)
-    let garaEnt = mkShoresh Gimel Resh Aleph -- גרא (shares ר,א)
-    let unrelated = mkShoresh Shin Lamed Mem -- שלם (shares nothing)
+    let bara = triliteral Bet Resh Aleph    -- ברא
+    let barak = triliteral Bet Resh Kaf     -- ברך (shares ב,ר)
+    let garaEnt = triliteral Gimel Resh Aleph -- גרא (shares ר,א)
+    let unrelated = triliteral Shin Lamed Mem -- שלם (shares nothing)
    let lex = Map.fromList
                [ (bara, ShoreshEntry bara Creation [] [] Map.empty)
                , (barak, ShoreshEntry barak Blessing [] [] Map.empty)
@@ -253,25 +260,48 @@ graphSpec = describe "Graph" $ do
    let ns = neighbors bara lex
    length ns `shouldBe` 2  -- barak and gara, not unrelated

+  it "compares only roots of the same length" $ do
+    let Just ben = textToShoresh "בן"
+    let Just bat = textToShoresh "בת"
+    let bana = triliteral Bet Nun He
+    sharedConsonants ben bat `shouldBe` 1
+    sharedConsonants ben bana `shouldBe` 0
+    let lex = Map.fromList
+                [ (ben, ShoreshEntry ben Creation [] [] Map.empty)
+                , (bat, ShoreshEntry bat Creation [] [] Map.empty)
+                , (bana, ShoreshEntry bana Creation [] [] Map.empty)
+                ]
+    map seShoresh (neighbors ben lex) `shouldBe` [bat]
+    map fst (neighborsByPosition ben lex) `shouldBe` ["c1"]
+
+  it "labels a triliteral neighbor by the positions it shares" $ do
+    let bara = triliteral Bet Resh Aleph
+    let barak = triliteral Bet Resh Kaf
+    let lex = Map.fromList
+                [ (bara, ShoreshEntry bara Creation [] [] Map.empty)
+                , (barak, ShoreshEntry barak Blessing [] [] Map.empty)
+                ]
+    map fst (neighborsByPosition bara lex) `shouldBe` ["c1c2"]
+
  it "counts shared consonants correctly" $ do
-    let sh1 = mkShoresh Bet Resh Aleph
-    let sh2 = mkShoresh Bet Resh Kaf
+    let sh1 = triliteral Bet Resh Aleph
+    let sh2 = triliteral Bet Resh Kaf
    sharedConsonants sh1 sh2 `shouldBe` 2
-    let sh3 = mkShoresh Shin Lamed Mem
+    let sh3 = triliteral Shin Lamed Mem
    sharedConsonants sh1 sh3 `shouldBe` 0


 kiTovSpec :: Spec
 kiTovSpec = describe "KiTov" $ do
  it "returns Tov when all roots exist in lexicon" $ do
-    let sh = mkShoresh Bet Resh Aleph
+    let sh = triliteral Bet Resh Aleph
    let entry = ShoreshEntry sh Creation [] [Reference Bereishit 1 1] Map.empty
    let lex = Map.fromList [(sh, entry)]
    let result = ProcessedResult [] [entry]
    kiTov result lex `shouldBe` Tov

  it "returns LoTov when roots are missing" $ do
-    let sh = mkShoresh Bet Resh Aleph
+    let sh = triliteral Bet Resh Aleph
    let entry = ShoreshEntry sh Creation [] [Reference Bereishit 1 1] Map.empty
    let emptyLex = Map.empty
    let result = ProcessedResult [] [entry]