-----------------------------------------------------------------------------
-- 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.Solution
   ( Solution(..), UserId, GroupId
   , Language(..), Source
   , Input(..), InputId, inputToString, defaultSolution
   ) where

import Control.Monad ( (>=>) )
import Data.Semigroup
import Ideas.Common.Library hiding (recognize, right)
import Ideas.Text.MathML
import Ideas.Text.HTML
import Ideas.Text.HTML.W3CSS hiding (content, tag)
import Ideas.Text.XML

-- | An incoming request is parsed to a solution
data Solution = Solution
   { userId   :: UserId
   , groupId  :: GroupId
   , language :: Maybe Language
   , inputs   :: [Input]
   }
 deriving Show

instance ToXML Solution where
   toXML sol = makeXML "solution" $ mconcat $
      maybe mempty ("userid" .=.) (userId sol) :
      maybe mempty ("groupid" .=.) (groupId sol) :
      maybe mempty ("language" .=.) (show <$> language sol) :
      map builderXML (inputs sol)

instance InXML Solution where
   fromXML xml = do
      let uid = findAttribute "userid"   xml
          gid = findAttribute "groupid"  xml
          lan = findAttribute "language" xml >>= readM
      xs <- mapM fromXML (findChildren "input" xml)
      return (Solution uid gid lan xs)

type Source  = Maybe String
type UserId  = Maybe String
type GroupId = Maybe String

data Language = EN | FR | DE | NL
 deriving (Show, Read)

type InputId = Id

data Input = Input { getInputId :: InputId, getInput :: [Either MathML String] }
 deriving Show

-- | Since the current mixed content representation cannot support two
-- consecutive strings, we make sure that it does not contain two consecutive
-- @Right@ values.
collapseRights :: (b -> b -> b) -> [Either a b] -> [Either a b]
collapseRights combine (Right x:Right y:xs) = Right (combine x y) : collapseRights combine xs
collapseRights combine (x:xs) = x : collapseRights combine xs
collapseRights _       [] = []

--collapseLefts :: (a -> a -> a) -> [Either a b] -> [Either a b]
--collapseLefts f = let swap = either Right Left in swap . collapseRights f . swap

-- Reconsider xml representation for Input: the current mixed content representation cannot
-- support two consecutive String parts
instance ToXML Input where
 toXML inp = makeXML "input" $
    "id".=. show (getInputId inp) <> mconcat (map f (collapseRights (++) $ getInput inp))
  where
   f :: Either MathML String -> XMLBuilder
   f = either (builder . toXML) string

instance InXML Input where
   fromXML xml =
      Input <$> (newId <$> findAttribute "id" xml) <*> mapM f (content xml)
    where
      f :: Monad m => Either String XML -> m (Either MathML String)
      f = either (return . Right) (fromXML >=> return . Left)


instance ToHTML Input where
   toHTML inp = mconcat
      [ panel $ barPos CenterLeft body
      ]
    where
      body = if null xs then space else spaced xs
      xs   = map (either text toHTML) (getInput inp)

defaultSolution :: [Input] -> Solution
defaultSolution inps = Solution
   { userId   = Nothing
   , groupId  = Nothing
   , language = Nothing
   , inputs   = inps
   }

instance HasId Input where
   getId = getInputId
   changeId f inp = inp { getInputId = f (getInputId inp) }

inputToString :: [Either MathML String] -> String
inputToString = unwords . map (either ppMathML id)

ppMathML :: MathML -> String
ppMathML = rec
 where
  rec :: MathML -> String
  rec math =
     case math of
        MRow ms           -> concatMap rec ms
        MId s             -> s
        MNumber s         -> s
        MOperator s       -> s
        MString s         -> s
        MText s           -> s
        MSqrt m           -> "sqrt (" ++ rec m ++ ")"
        MRoot m1 m2       -> "root (" ++ rec m1 ++ ") (" ++ rec m2 ++ ")"
        MSup m1 m2        -> ""++ rec m1 ++"^(" ++ rec m2 ++ ")"
        MSub m1 m2        -> rec m1 ++ rec m2
        MSubSup m1 m2 m3  -> ""++ rec m1 ++ rec m2 ++"^(" ++ rec m3 ++ ")"
        MFrac m1 m2       -> ""++ rec m1 ++"/(" ++ rec m2 ++ ")"
        MFenced s1 s2 m   -> s1 ++ rec m ++ s2
        MSpace            -> " "
        MStyle            -> ""
        MPadded           -> ""
        MPhantom          -> ""
        MError            -> ""
        MEnclose          -> ""
        MUnder            -> ""
        MOver             -> ""
        MUnderOver        -> ""
        MTable            -> ""
        MTableRow         -> ""
        MLabeledTableRow  -> ""
        MTableData        -> ""