{-# LANGUAGE ScopedTypeVariables, FlexibleContexts #-}
module Parsing.TestProgram where

import System.IO ( stdin, hGetContents )
import System.Environment ( getArgs, getProgName )

import GHC.Exts
import Control.Monad
import Control.Applicative (pure)
import Parsing.Chart hiding (fingerprint,mkTree)
import Data.Matrix.Quad
import Data.Pair
import Algebra.RingUtils

type Verbosity = Int

putStrV :: Verbosity -> String -> IO ()
putStrV v s = if v > 1 then putStrLn s else return ()


mainTest :: forall category token. 
            (RingP [(category,Any)], Eq category) =>
         ((category,Any) -> String) ->
         (Bool -> token -> Pair [(category,Any)]) ->
         (String -> [token]) ->
         (token -> (Int,Int)) -> 
         (category -> String) -> 
         (category -> [category]) ->
         IO ()
mainTest showAst cnfToksToCat myLLexer getTokPos describe follows = 
  do args <- getArgs
     case args of
       [] -> hGetContents stdin >>= run 2
       "-s":fs -> mapM_ (runFile 0) fs
       fs -> mapM_ (runFile 2) fs
       
 where 
  neighbors a b = b `elem` follows a
  showResults :: [(category,Any)] -> IO ()
  showResults x = do
        putStrLn $ show (length x) ++ " results"
        forM_ x $ \(cat,ast) -> do
          putStrLn $ describe cat        
          putStrLn $ showAst (cat,ast)
  
  runFile v f = putStrLn f >> readFile f >>= run v
  run v s = 
    do case rs of
         [(_,x,_)] -> showResults x
         _ -> do let errs = pairs rs
                     best = minimum $ map quality errs                     
                 mapM_ (putStrLn . showErr ts) $ filter (\x -> quality x == best) errs
       writeFile "cnf.xpm" (genXPM $ fingerprint chart)
    where ts = myLLexer s
          chart = mkTree $ zipWith cnfToksToCat (cycle [False,True]) ts 
          rs = results chart
  
  showTokPos :: (Int,Int) -> String
  showTokPos (l,c) = show l ++ "," ++ show (c-1)

  showPos :: [token] -> Int -> String
  showPos ts x = showTokPos (getTokPos $ ts !! x)
  
  showErr ts ((_,x',p),(_,y',_)) = 
     showPos ts p ++ ": cannot combine " ++ showBestCat x' ++ " with " ++ showBestCat y'

  quality (a@(_,x',p),b@(_,y',_)) = (or [ neighbors x y | x <- map fst x', y <- map fst y'],
                                     (resSz a) Prelude.+ (resSz b))
     

  showBestCat ((x,_):_) = describe x

pairs (x:y:xs) = (x,y):pairs (y:xs)
pairs _ = []

resSz (i,_,j) = j-i