{-# LANGUAGE FlexibleInstances #-}
-----------------------------------------------------------------------------
-- 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.Step where

import Data.List
import Data.Semigroup
import Domain.Math.Expr
import Recognize.Data.Math
import Recognize.Data.Attribute
import Ideas.Common.Id
import Ideas.Text.HTML
import Ideas.Text.HTML.W3CSS
import Ideas.Text.XML hiding (Attribute)
import Util.W3CSSHTML

-- | A step is a small step, which describes some action by the math and attributes it carries
-- or it is a big step which is a grouping of other steps.
data Step = Step Id (Math, [Attribute]) [Step]
 deriving Eq

instance ToHTML (Step) where
 toHTML = text

instance Show Step where
 show (Step i a []) = show i ++ ": "++ show a
 show (Step i a ss) = show i ++ ": "++ show a ++ "\n" ++ unlines (map ('\t':) (lines (intercalate "\n" $ map show ss)))

instance HasId Step where
 getId (Step i _ _) = i
 changeId f (Step i b as) = Step (f i) b as

instance ToXML (Math, [Attribute]) where
 toXML (m,ats) = makeXML "stepcontent" $ mconcat [builderXML m, element "attributes" (map builderXML ats)]

instance ToXML Step where
 toXML (Step stepId stepValue steps) = makeXML "step" $ mconcat ("id".=. show stepId : builderXML stepValue : map builderXML steps)

smallStep :: Id -> (Math, [Attribute]) -> Step
smallStep i a = Step i a []

bigStep :: Id -> (Math, [Attribute]) -> [Step] -> Step
bigStep = Step

getValue :: Step -> (Math, [Attribute])
getValue (Step _ a _) = a

addAttribute :: Attribute -> Step -> Step
addAttribute a (Step i (m, attr) xs) = Step i (m, attr ++ [a]) xs

addAttributes :: [Attribute] -> Step -> Step
addAttributes xs s = foldl (flip addAttribute) s xs

hasMistakes :: Step -> Bool
hasMistakes = any isMistake . snd . getValue

makeFAStep :: Expr -> Step
makeFAStep e = smallStep (newId "final answer") (makeMath e, [FinalAnswer e])

getMath :: Step -> Math
getMath = fst . getValue

getMaths :: [Step] -> [Math]
getMaths = map getMath

getAttributes :: Step -> [Attribute]
getAttributes = snd . getValue

mergeSteps :: [Step] -> Maybe Step
mergeSteps [] = Nothing
mergeSteps (x:xs) = Just $ case mergeSteps xs of
  Nothing -> x
  Just y -> addAttributes (getAttributes x) y

stepsToHTML :: [Step] -> HTMLBuilder
stepsToHTML xs = tableAll $ mconcat (header : map (stepToHTML 0) xs)
 where
   header = tr (map (th . string) ["id", "attributes", "math"])

stepToHTML :: Int -> Step -> HTMLBuilder
stepToHTML indent (Step i (m,ats) xs) =
  tr (map td [ ( if null xs then id else bold) (string (replicate indent '-' ++ show i))
             , string (intercalate "," (map show ats))
             , toHTML m])
  <> mconcat (map (stepToHTML (indent + 1)) xs) -- indent