{-# LANGUAGE OverloadedStrings #-}

-- | Graph — root connectivity.
--
-- Architecture §3.1:
--   neighbors :: Shoresh -> ShoreshLexicon -> [ShoreshEntry]
--   "Find all roots sharing 2 consonants (semantic neighborhood)"
--
-- Two roots are neighbors if they share 2 of 3 consonants
-- in the same positions. This captures the Hebrew linguistic
-- phenomenon where related roots share consonants.
module Shoresh.Graph
  ( neighbors
  , sharedConsonants
  , neighborsByPosition
  ) where

import Shoresh.Types
import Shoresh.Lexicon (ShoreshLexicon, allRoots, lookupRoot)
import Data.Maybe (mapMaybe)

-- | Count shared consonants between two roots (position-sensitive).
sharedConsonants :: Shoresh -> Shoresh -> Int
sharedConsonants (Shoresh a1 b1 c1') (Shoresh a2 b2 c2') =
  (if a1 == a2 then 1 else 0) +
  (if b1 == b2 then 1 else 0) +
  (if c1' == c2' then 1 else 0)

-- | Find all roots sharing exactly 2 consonants in the same positions.
neighbors :: Shoresh -> ShoreshLexicon -> [ShoreshEntry]
neighbors sh lexicon =
  mapMaybe (\sh' ->
    if sh' /= sh && sharedConsonants sh sh' >= 2
    then lookupRoot sh' lexicon
    else Nothing
  ) (allRoots lexicon)

-- | Find neighbors that share consonants at specific positions.
-- Returns (position_shared, neighbor_entry) pairs.
neighborsByPosition :: Shoresh -> ShoreshLexicon -> [(String, ShoreshEntry)]
neighborsByPosition sh@(Shoresh a b d) lexicon =
  concatMap checkNeighbor (allRoots lexicon)
  where
    checkNeighbor sh'@(Shoresh a' b' d')
      | sh' == sh = []
      | a == a' && b == b' = maybe [] (\e -> [("c1c2", e)]) (lookupRoot sh' lexicon)
      | a == a' && d == d' = maybe [] (\e -> [("c1c3", e)]) (lookupRoot sh' lexicon)
      | b == b' && d == d' = maybe [] (\e -> [("c2c3", e)]) (lookupRoot sh' lexicon)
      | otherwise = []