Scott KarpandClaude Fable 5.1
5ff1b73d00
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>
500 lines
19 KiB
Haskell
500 lines
19 KiB
Haskell
{-# LANGUAGE OverloadedStrings #-}
|
||
|
||
-- | Shoresh Engine test suite.
|
||
--
|
||
-- Tests the three Step 7 verification requirements:
|
||
-- 1. Root activation through all 7 binyanim
|
||
-- 2. Te'amim parse tree construction
|
||
-- 3. Gematria computation
|
||
--
|
||
-- Plus structural tests for types, lexicon, ketiv/qere, graph.
|
||
module Main where
|
||
|
||
import Test.Hspec
|
||
import qualified Data.Map.Strict as Map
|
||
import Data.Text (Text)
|
||
import Data.Maybe (isJust, isNothing, mapMaybe)
|
||
|
||
import Shoresh.Types
|
||
import Shoresh.Gematria
|
||
import Shoresh.Binyanim
|
||
import Shoresh.Teamim
|
||
import Shoresh.KetivQere
|
||
import Shoresh.Lexicon
|
||
import Shoresh.Graph
|
||
import Shoresh.Roots
|
||
import Shoresh.KiTov
|
||
import Luchot.Firmware
|
||
|
||
main :: IO ()
|
||
main = hspec $ do
|
||
consonantSpec
|
||
shoreshSpec
|
||
binyanSpec
|
||
gematriaSpec
|
||
teamimSpec
|
||
ketivQereSpec
|
||
graphSpec
|
||
kiTovSpec
|
||
firmwareSpec
|
||
rootsSpec
|
||
|
||
consonantSpec :: Spec
|
||
consonantSpec = describe "Consonant" $ do
|
||
it "has exactly 22 consonants" $
|
||
length [minBound .. maxBound :: Consonant] `shouldBe` 22
|
||
|
||
it "round-trips through char conversion" $ do
|
||
mapM_ (\c ->
|
||
charToConsonant (consonantToChar c) `shouldBe` Just c
|
||
) [minBound .. maxBound :: Consonant]
|
||
|
||
it "handles final forms (sofit)" $ do
|
||
charToConsonant 'ך' `shouldBe` Just Kaf
|
||
charToConsonant 'ם' `shouldBe` Just Mem
|
||
charToConsonant 'ן' `shouldBe` Just Nun
|
||
charToConsonant 'ף' `shouldBe` Just Pe
|
||
charToConsonant 'ץ' `shouldBe` Just Tsade
|
||
|
||
it "rejects non-Hebrew characters" $ do
|
||
charToConsonant 'a' `shouldBe` Nothing
|
||
charToConsonant '1' `shouldBe` Nothing
|
||
|
||
|
||
shoreshSpec :: Spec
|
||
shoreshSpec = describe "Shoresh" $ do
|
||
it "constructs a triliteral root" $ do
|
||
let sh = triliteral Bet Resh Aleph
|
||
radicals sh `shouldBe` [Bet, Resh, Aleph]
|
||
|
||
it "renders as Hebrew text" $ do
|
||
shoreshToText (triliteral Bet Resh Aleph) `shouldBe` "ברא"
|
||
shoreshToText (triliteral Qof Dalet Shin) `shouldBe` "קדש"
|
||
|
||
it "parses from Hebrew text (3 consonants)" $ do
|
||
textToShoresh "ברא" `shouldBe` Just (triliteral Bet Resh Aleph)
|
||
textToShoresh "קדש" `shouldBe` Just (triliteral Qof Dalet Shin)
|
||
|
||
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 -- one letter is not a root
|
||
textToShoresh "abc" `shouldBe` Nothing
|
||
textToShoresh "בר1" `shouldBe` Nothing
|
||
|
||
|
||
binyanSpec :: Spec
|
||
binyanSpec = describe "Binyanim" $ do
|
||
it "has exactly 7 binyanim" $
|
||
length allBinyanim `shouldBe` 7
|
||
|
||
it "activates a root through all 7 binyanim" $ do
|
||
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 = triliteral Shin Mem Resh -- שמר = guard
|
||
let p = activate Qal Third Singular Masculine Perfect sh
|
||
root p `shouldBe` sh
|
||
binyan p `shouldBe` Qal
|
||
person p `shouldBe` Third
|
||
number p `shouldBe` Singular
|
||
gender p `shouldBe` Masculine
|
||
aspect p `shouldBe` Perfect
|
||
|
||
it "activateDefault uses 3ms perfect citation form" $ do
|
||
let sh = triliteral Kaf Tav Bet -- כתב = write
|
||
let p = activateDefault Qal sh
|
||
person p `shouldBe` Third
|
||
number p `shouldBe` Singular
|
||
gender p `shouldBe` Masculine
|
||
aspect p `shouldBe` Perfect
|
||
|
||
|
||
gematriaSpec :: Spec
|
||
gematriaSpec = describe "Gematria" $ do
|
||
it "assigns correct values to individual letters" $ do
|
||
letterValue Aleph `shouldBe` 1
|
||
letterValue Yod `shouldBe` 10
|
||
letterValue Qof `shouldBe` 100
|
||
letterValue Tav `shouldBe` 400
|
||
|
||
it "computes root gematria correctly" $ do
|
||
-- ברא = Bet(2) + Resh(200) + Aleph(1) = 203
|
||
gematriaRoot (triliteral Bet Resh Aleph) `shouldBe` 203
|
||
-- קדש = Qof(100) + Dalet(4) + Shin(300) = 404
|
||
gematriaRoot (triliteral Qof Dalet Shin) `shouldBe` 404
|
||
-- שלם = Shin(300) + Lamed(30) + Mem(40) = 370
|
||
gematriaRoot (triliteral Shin Lamed Mem) `shouldBe` 370
|
||
|
||
it "computes word gematria correctly" $ do
|
||
-- תורה = Tav(400) + Vav(6) + Resh(200) + He(5) = 611
|
||
gematriaWord "תורה" `shouldBe` 611
|
||
-- שלום = Shin(300) + Lamed(30) + Vav(6) + Mem(40) = 376
|
||
gematriaWord "שלום" `shouldBe` 376
|
||
|
||
it "ignores non-consonant characters in word gematria" $ do
|
||
-- Word with vowels and cantillation should give same value
|
||
-- as consonants only
|
||
gematriaWord "בְּרֵאשִׁ֖ית" `shouldBe` gematriaWord "בראשית"
|
||
|
||
it "finds gematria neighbors" $ do
|
||
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)
|
||
]
|
||
-- bara's neighbors at 203 should not include 'other' (206)
|
||
gematriaNeighbors 203 lex `shouldBe`
|
||
[ShoreshEntry bara Creation [] [] Map.empty]
|
||
|
||
|
||
teamimSpec :: Spec
|
||
teamimSpec = describe "Te'amim" $ do
|
||
it "classifies taam roles correctly" $ do
|
||
taamRole Etnachta `shouldBe` Melekh
|
||
taamRole SofPasuk `shouldBe` Melekh
|
||
taamRole Tipcha `shouldBe` Melekh
|
||
taamRole Munach `shouldBe` Mesharet
|
||
taamRole Mercha `shouldBe` Mesharet
|
||
|
||
it "parses taam names from L1 format" $ do
|
||
taamFromName "tipcha" `shouldBe` Just Tipcha
|
||
taamFromName "etnachta" `shouldBe` Just Etnachta
|
||
taamFromName "munach" `shouldBe` Just Munach
|
||
taamFromName "mercha" `shouldBe` Just Mercha
|
||
-- Build log correction #1: meteg_siluq
|
||
taamFromName "meteg_siluq" `shouldBe` Just MetegSiluq
|
||
|
||
it "ranks disjunctors by strength" $ do
|
||
taamRank SofPasuk `shouldSatisfy` (> taamRank Etnachta)
|
||
taamRank Etnachta `shouldSatisfy` (> taamRank ZakefKatan)
|
||
taamRank ZakefKatan `shouldSatisfy` (> taamRank Tipcha)
|
||
taamRank Tipcha `shouldSatisfy` (> taamRank Munach)
|
||
|
||
it "builds a parse tree from Bereishit 1:1 words" $ do
|
||
-- Bereishit 1:1: 7 words with these te'amim:
|
||
-- בראשית(tipcha) ברא(munach) אלהים(etnachta)
|
||
-- את(mercha) השמים(tipcha) ואת(mercha) הארץ(meteg_siluq)
|
||
let words =
|
||
[ AnnotatedWord "בְּרֵאשִׁ֖ית" Tipcha Melekh
|
||
, AnnotatedWord "בָּרָ֣א" Munach Mesharet
|
||
, AnnotatedWord "אֱלֹהִ֑ים" Etnachta Melekh
|
||
, AnnotatedWord "אֵ֥ת" Mercha Mesharet
|
||
, AnnotatedWord "הַשָּׁמַ֖יִם" Tipcha Melekh
|
||
, AnnotatedWord "וְאֵ֥ת" Mercha Mesharet
|
||
, AnnotatedWord "הָאָֽרֶץ" MetegSiluq Melekh
|
||
]
|
||
let tree = readTeamim words
|
||
-- The tree should exist and have branches
|
||
treeDepth tree `shouldSatisfy` (> 1)
|
||
|
||
it "finds primary division at etnachta" $ do
|
||
let words =
|
||
[ AnnotatedWord "בְּרֵאשִׁ֖ית" Tipcha Melekh
|
||
, AnnotatedWord "בָּרָ֣א" Munach Mesharet
|
||
, AnnotatedWord "אֱלֹהִ֑ים" Etnachta Melekh
|
||
, AnnotatedWord "אֵ֥ת" Mercha Mesharet
|
||
, AnnotatedWord "הַשָּׁמַ֖יִם" Tipcha Melekh
|
||
, AnnotatedWord "וְאֵ֥ת" Mercha Mesharet
|
||
, AnnotatedWord "הָאָֽרֶץ" MetegSiluq Melekh
|
||
]
|
||
let tree = readTeamim words
|
||
let (left, right) = primaryDivision tree
|
||
-- Left of etnachta should have: בראשית ברא אלהים
|
||
collectAllWords left `shouldBe`
|
||
["בְּרֵאשִׁ֖ית", "בָּרָ֣א", "אֱלֹהִ֑ים"]
|
||
-- Right of etnachta should have: את השמים ואת הארץ
|
||
collectAllWords right `shouldBe`
|
||
["אֵ֥ת", "הַשָּׁמַ֖יִם", "וְאֵ֥ת", "הָאָֽרֶץ"]
|
||
|
||
|
||
ketivQereSpec :: Spec
|
||
ketivQereSpec = describe "KetivQere" $ do
|
||
it "single reading returns same text for both" $ do
|
||
bothReadings (Single "שלום") `shouldBe` ("שלום", "שלום")
|
||
|
||
it "dual reading preserves both" $ do
|
||
let ref = Reference Bereishit 1 1
|
||
let dr = DualReading "הוא" "היא" ref
|
||
bothReadings (DualVal dr) `shouldBe` ("הוא", "היא")
|
||
|
||
it "isDual distinguishes correctly" $ do
|
||
isDual (Single "test") `shouldBe` False
|
||
isDual (DualVal (DualReading "a" "b" (Reference Bereishit 1 1))) `shouldBe` True
|
||
|
||
|
||
graphSpec :: Spec
|
||
graphSpec = describe "Graph" $ do
|
||
it "finds roots sharing 2 consonants" $ do
|
||
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)
|
||
, (garaEnt, ShoreshEntry garaEnt Movement [] [] Map.empty)
|
||
, (unrelated, ShoreshEntry unrelated Covenant [] [] Map.empty)
|
||
]
|
||
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 = triliteral Bet Resh Aleph
|
||
let sh2 = triliteral Bet Resh Kaf
|
||
sharedConsonants sh1 sh2 `shouldBe` 2
|
||
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 = 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 = triliteral Bet Resh Aleph
|
||
let entry = ShoreshEntry sh Creation [] [Reference Bereishit 1 1] Map.empty
|
||
let emptyLex = Map.empty
|
||
let result = ProcessedResult [] [entry]
|
||
case kiTov result emptyLex of
|
||
LoTov _ -> return ()
|
||
other -> expectationFailure $ "Expected LoTov, got " ++ show other
|
||
|
||
|
||
firmwareSpec :: Spec
|
||
firmwareSpec = describe "Firmware" $ do
|
||
it "has correct L1 hash" $
|
||
l1ExpectedHash `shouldBe`
|
||
"156b1d2724a4bf9999aa45c83ebd0794792f5aa4d524e8a7a898c871c1d8c9d5"
|
||
|
||
it "has correct counts" $ do
|
||
torahBookCount `shouldBe` 5
|
||
torahVerseCount `shouldBe` 5853
|
||
torahWordCount `shouldBe` 79982
|
||
uniqueRootCount `shouldBe` 1378
|
||
|
||
it "dibrot exist" $
|
||
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
|
||
-- ============================================================
|
||
|
||
treeDepth :: ParsedVerse -> Int
|
||
treeDepth (Leaf _) = 1
|
||
treeDepth (Branch _ l r) = 1 + max (treeDepth l) (treeDepth r)
|
||
|
||
collectAllWords :: ParsedVerse -> [Text]
|
||
collectAllWords (Leaf w) = [awWord w]
|
||
collectAllWords (Branch _ l r) = collectAllWords l ++ collectAllWords r
|