
module Igor2.RuleDevelopment (

    advanceRule
    
    )where 

import Prelude hiding ((<$>))

import Igor2.RuleDevelopment.Partition
import Igor2.RuleDevelopment.Subfunction
import Igor2.RuleDevelopment.Matching
import Igor2.RuleDevelopment.Cata
import Igor2.RuleDevelopment.Accumulator (accumIntro)
import Igor2.Data.IOData
import Igor2.Data.IgorMonad
import Igor2.Logging
import Igor2.Ppr
import Control.Monad
import Data.Maybe (catMaybes)
import Data.Either (rights)

advanceRule :: Hypo -> CovrRule -> IM Hypos
advanceRule h r = do

  logNO $ linebreak <> text "Advancing" <^> pretty r <$>
             text "of" <+> pretty h

  (fs,ns,ms,ps,cs,as) <- compSucs h r
                      
  fhs <- developAll r h fs
  nhs <- developAll r h ns 
  mhs <- developAll r h ms 
  phs <- developAll r h ps   
  chs <- developAll r h cs
  ahs <- developAll r h as
  let all = concat $ map rights  [fhs, nhs, mhs, phs, chs, ahs]
  waypointS $ text "Summary"
  logNO $ linebreak <>
                  text "Advancing" <^> pretty r <$>
                  text "of" <+> pretty h <$> text "resulted in" <+>
                  int (length all) <+> text "new hypotheses." <> linebreak <$>
                  text "OP1a: FOLD" <^> text "Advancements:" <$> pretty fs <^>
                  text "Hypotheses  :" <$> pretty fhs <$>
                  text "OP1b: NAIVE_MAP" <^> text "Advancements:" <$> pretty ns <^>
                  text "Hypotheses  :" <$> pretty nhs <$>
                  text "OP2: MTCH" <^> text "Advancements:" <$> pretty ms <^>
                  text "Hypotheses  :" <$> pretty mhs <$>
                  text "OP3: PART" <^> text "Advancements:" <$> pretty ps <^>
                  text "Hypotheses  :" <$> pretty phs <$>
                  text "OP4: CALL" <^> text "Advancements:" <$> pretty cs <^>
                  text "Hypotheses  :" <$> pretty chs <$>
                  text "OP5: ACCUM" <^> text "Advancements:" <$> pretty as <^>
                  text "Hypotheses  :" <$> pretty ahs
  
  return all
    where
    developAll :: (CovrRule -> Hypo -> [(CovrRules,[Call])] -> IM [Either String Hypo])
    developAll r h = mapM (applyC . (developH r h))
    compSucs h r = do
        fs <- ifIsSet inEnhanced (tyMorphIntro r) []  
        if not $ null fs then return (fs,[],[],[],[],[])
          else liftM5 ((,,,,,)[])
                      (return []) -- (naiveMap r) 
                      (introduceMatchings (callings h) r)
                      (partition r)
                      (callSubfunction r)
                      (ifIsSet introduceAccums (accumIntro r) [])
