App.hs

module SchedulePlanner.App (
  reportAndPrint,
  reportAndExecute
  ) where


import           Control.Applicative        (pure, (<*>))
import           Control.Monad.Writer
import qualified Data.List                  as List (take)
import qualified Data.Map                   as Map (keys)
import           Data.Maybe                 (fromMaybe)
import           SchedulePlanner.Calculator
import           SchedulePlanner.Serialize
import           System.IO                  (hPutStrLn, stderr)
import           Text.JSON                  as JSON (Result (..))



-- |Print a line to stdout
putErrorLine :: String -> IO()
putErrorLine = hPutStrLn stderr


-- |Print a string if debug is enabled
printDebug :: Show a => Bool -> a -> Writer String ()
printDebug debugMode = when debugMode . tell . show


{-|
  Evaluates the transformed json, compiles (useful) error messages, prints them
  and then runs the algorithm or, if the errors are too severe, aborts.
-}
reportAndExecute :: String -> Bool -> Result ([Result Rule], [Result (Lesson String)]) -> Writer String ()
reportAndExecute _ _ (Error s)    =
  tell $ "Stopped execution due to a severe problem with the input data:" ++ show s
reportAndExecute outputFormat debugMode (Ok (r, l))  = do
  rules   <- reportOrReturn r
  lessons <- reportOrReturn l

  let weighted      = weigh rules lessons

  let mappedLessons = mapToSubject weighted

  let result        = calcFromMap mappedLessons

  case result of
    Nothing ->
      tell "Calculation failed, no valid schedule possible"
    Just calculated ->

      case outputFormat of

        "print" -> do

          tell "\n"
          _       <- mapM (printDebug debugMode) rules
          tell "\n"

          tell "\n"
          _       <- mapM (printDebug debugMode) weighted
          tell "\n"

          tell "Legend:"
          _       <- mapM (tell . show . (pure (,) <*> shortSubject <*> id) ) (Map.keys mappedLessons)


          tell "\n"
          _       <- pc calculated
          return ()

        "json" -> do
          tell $  serialize calculated
          return ()

  where
    pc = mapM (tell.("\n\n" ++).formatSchedule)

    reportOrReturn :: [Result a] -> Writer String [a]
    reportOrReturn []     = return []
    reportOrReturn (x:xs) =
      case x of
        Error s -> do
          tell "Some data was unusable:"
          tell s
          reportOrReturn xs
        Ok v    -> liftM (v:) (reportOrReturn xs)


reportAndPrint :: String -> Bool -> String -> IO()
reportAndPrint outputFormat debugMode rawInput =
  putStrLn $ snd $ runWriter $ reportAndExecute outputFormat debugMode (deSerialize rawInput)