App.hs

{-# LANGUAGE OverloadedStrings #-}
{-|
Module      : $Header$
Description : Connector from IO to logic
Copyright   : (c) Justus Adam, 2015
License     : LGPL-3
Maintainer  : development@justusadam.com
Stability   : experimental
Portability : POSIX

Sort of the Main script for all the common operations, independant of the
program instance (webservice, command line)
-}
module SchedulePlanner.App
  ( reportAndPrint
  , reportAndExecute
  , serverCalculation
  ) where


import           Control.Arrow              ((&&&))
import           Control.Monad.Writer       (Writer, runWriter, tell, when)
import           Data.Aeson                 (eitherDecode, encode)
import           Data.ByteString.Lazy       as LBS (ByteString, toStrict)
import qualified Data.Map                   as Map (elems, keys)
import           Data.String                (fromString)
import           Data.Text                  as T (Text, append, pack)
import qualified Data.Text.Encoding         (decodeUtf8)
import           Data.Text.IO               as TIO (putStrLn, writeFile)
import           SchedulePlanner.Calculator (MappedSchedule(..), MappedLessons(..), calcFromMap,
                                             mapToSubject, weigh)
import           SchedulePlanner.Serialize  (DataFile (DataFile),
                                             formatSchedule, scheduleToJson,
                                             shortSubject)


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


{-|
  Calculation on internal data structures.
-}
calculate :: DataFile -> Maybe [MappedSchedule Text]
calculate (DataFile rules lessons) =
  calcFromMap $ mapToSubject $ weigh rules lessons


{-|
  Calculation wrapped into server I/O compatible data structures.
-}
serverCalculation :: ByteString -> ByteString
serverCalculation =
  either
    (fromString . ("Error:" ++) . show)
    (maybe
      "\"No schedule could be calculated\""
      (encode . map scheduleToJson)
    . calculate)
  . eitherDecode


{-|
  Evaluates the transformed json, compiles (useful) error messages, runs the algorithm
  and returns a writer of any output created.
-}
reportAndExecute :: Text -> Bool -> DataFile -> Writer Text ()
reportAndExecute outputFormat debugMode (DataFile rules lessons)  =
  maybe
    (tell "Calculation failed, no valid schedule possible")

    (\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 . pack . show . (shortSubject &&& id) ) (Map.keys mlRaw)


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

        "json" -> do
          tell $ Data.Text.Encoding.decodeUtf8 $ toStrict $ encode $ concatMap (Map.elems . unMapSchedule) calculated
          return ()

        _ -> tell "invalid output format")

    (calcFromMap mappedLessons)

  where
    weighted      = weigh rules lessons
    mappedLessons@(MappedLessons mlRaw) = mapToSubject weighted
    pc            = mapM (tell . append "\n\n" . formatSchedule)


{-|
  perform the calculation and print the result to the command line
-}
reportAndPrint :: Text -> Bool -> Maybe String -> ByteString -> IO()
reportAndPrint outputFormat debugMode outFile =
  maybe TIO.putStrLn TIO.writeFile outFile . either
    (pack . ("Stopped execution due to a severe problem with the input data:" ++) . show)
    (snd . runWriter . reportAndExecute outputFormat debugMode)
     . eitherDecode