-----------------------------------------------------------------------------
-- 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 Main.Tasks
   ( tasks
   , findTask
   , findTaskFuzzy
   , fullNetwork
   , taskNetwork
   ) where

import Ideas.Common.Id
import Recognize.Data.MathStoryProblem
import Task.AreaAndExpression
import Task.AreaOfATriangle
import Task.CarRental
import Task.MagicTrick.Recognizer
import Task.MakingASquare
import Task.Matryoshka.Recognizer
import Task.Pattern.Recognizer
import Task.RectangleArea
import Task.TheatreRate.Recognizer
import Task.VPattern.Recognizer
import Data.List
import Util.String ( normalize )

import Bayes.Network ( Network )
import qualified Task.Network.StudentModel as StudentModel

-- | The list of Advise-me exercises
tasks :: [Task]
tasks =
   [ Task areaAndExpression
   , Task areaOfATriangle
   , Task carRental
   , Task makingASquare
   , Task matryoshka
   , Task pattern
   , Task rectangleArea
   --, Task rectangleAreaOld
   , Task theatreRate
   , Task vPattern
   , Task magicTrick
   ]

findTask :: Monad m => Id -> m Task
findTask i =
   case find (\t -> i == getId t) tasks of
      Just t  -> return t
      Nothing -> fail $ "Could not find task " ++ show i

-- | Find task, being forgiving about capitalisation, whitespace and
-- interpunction.
findTaskFuzzy :: Monad m => String -> m Task
findTaskFuzzy i =
   case find (\t -> normalize i == normalize (showId t)) tasks of
      Just t  -> return t
      Nothing -> fail $ "Could not find task " ++ show i


-- | Combined network for all tasks.
fullNetwork :: Network ()
fullNetwork = mappend StudentModel.network taskNetwork

-- | Combined network for all tasks (without student model).
taskNetwork :: Network ()
taskNetwork = mconcat
            . map (\(Task t) -> singleNetwork t)
            $ tasks