-----------------------------------------------------------------------------
-- Copyright 2019, Advise-Me project team. This file is distributed under 
-- the terms of the Apache License 2.0. For more information, see the files
-- "LICENSE.txt" and "NOTICE.txt", which are included in the distribution.
-----------------------------------------------------------------------------
-- |
-- Maintainer  :  bastiaan.heeren@ou.nl
-- Stability   :  provisional
-- Portability :  portable (depends on ghc)
--
-----------------------------------------------------------------------------

module Recognize.Data.MathParserOutput where

import Data.Monoid ( (<>) )
import Ideas.Text.HTML                         hiding (table, ul)
import Ideas.Text.HTML.W3CSS                   hiding (input)
import Ideas.Text.XML                          hiding (tag)
import Recognize.Data.Math
import Recognize.Data.MathParserOptions
import Recognize.Parsing.MathParser
import Util.Monad
import qualified Text.PrettyPrint.Leijen as PP

data MathParserOutput = MathParserOutput { mathParserOutput :: [Math], hasChainedEquations :: Bool}
 deriving Eq

instance Show MathParserOutput where
   show = show . PP.pretty

instance PP.Pretty MathParserOutput where
   pretty a = PP.vcat $
      map (PP.string . show) (mathParserOutput a) ++
      [ PP.string $ "Chained equations: " ++ show (hasChainedEquations a) ]

instance ToHTML MathParserOutput where
   toHTML m =
      toHTML (mathParserOutput m)
          <> mWhen (hasChainedEquations m) ((tag . background Orange . string) "chained")

instance ToXML MathParserOutput where
 toXML mpo = makeXML "mathparseroutput" $ mconcat
    [ element "mathparseroutput" (map builderXML (mathParserOutput mpo))
    , element "hasChainedEquations" [string (show (hasChainedEquations mpo))]
    ]

mathParser :: MathParserOptions -> [String] -> MathParserOutput
mathParser opts ss = MathParserOutput
               { mathParserOutput = fs
               , hasChainedEquations = or chainedEqs
               }
 where
  (chainedEqs,eqs) = unzip (map (parseMath opts) ss)
  fs = concat eqs