-- Copyright (C) 2008 Eric Kow
-- This is to be BSD3 licensed

{-# OPTIONS_GHC -Wall -fno-warn-orphans #-}
module NLP.ToyEarley ( go, goS, parse, showChart
                     , toyConfig, axioms, mkItem
                     , module NLP.ToyDottedCky ) where

import qualified Data.DList as DL

import NLP.ChartParser
import NLP.CfgStuff (Cfg(..), CfgRule(..))
import qualified NLP.ToyDottedCky as DottedCky
import NLP.ToyDottedCky
 (WordMap, toWordMap,
  ToyItem(..), parseTrees, completed,
 )
import NLP.Tree (showBrackets)

go :: Cfg -> String -> String
go cfg s = unlines . map showBrackets . parseTrees cfg wmap
         $ parse cfg s
 where
  wmap = toWordMap . words $ s

goS :: Cfg -> String -> Bool
goS cfg s = successful config $ parse cfg s
 where
  config = toyConfig cfg wmap
  wmap = toWordMap . words $ s

showChart :: SimpleStatus ToyItem -> String
showChart = unlines . map show . chart

-- ----------------------------------------------------------------------
-- configuration of NLP.ChartParser
-- ----------------------------------------------------------------------

parse :: Cfg -> String -> SimpleStatus ToyItem
parse cfg s = chartParse (toyConfig cfg wmap) initialSt
 where
  initialSt = Status { agenda = axioms cfg
                     , chart  = [] }
  wmap = toWordMap . words $ s

toyConfig :: Cfg -> WordMap -> SimpleConfig ToyItem
toyConfig gram wmap =
 (DottedCky.toyConfig gram wmap) { inferenceRules = ckyInferenceRules gram wmap }

-- ----------------------------------------------------------------------
-- axioms
-- ----------------------------------------------------------------------

axioms :: Cfg -> [ToyItem]
axioms cfg = map mkItem (rules cfg)

mkItem :: CfgRule -> ToyItem
mkItem = DottedCky.mkItem 0

-- ----------------------------------------------------------------------
-- inference rules
-- ----------------------------------------------------------------------

ckyInferenceRules :: Cfg -> WordMap -> [ToyItem] -> ToyItem -> [ToyItem]
ckyInferenceRules cfg wmap chrt ti =
  DottedCky.ckyInferenceRules wmap chrt ti
  ++ predictR cfg ti

-- | we ignore the chart item for this inference rule
predictR :: Cfg -> ToyItem -> [ToyItem]
predictR _ (ToyItem { afterDot = [] }) = []
predictR cfg (ToyItem { right    = tright
                      , afterDot = (tc:_)
                      }) =
  map toItem $ filter (\x -> lhs x == tc) (rules cfg)
 where
  toItem (CfgRule c cs) =
    ToyItem { symbol    = c
            , beforeDot = DL.empty
            , afterDot  = cs
            , left      = tright
            , right     = tright }