{-# LANGUAGE OverloadedStrings #-}
{-
Module: TestMaker
Copyright: (c) Chris Godbout
License: GPLv3
Maintainer: Chris Godbout <chris@mathologist.net>
Stability: experimental
Portability: portable

-}

module TestMaker ( fileToDB
                 , shuffleQList
                 , getQuestions
                 , getDatabase
                 , getQuestionsByTag
                 , renumber
                 , freeze
                 , genExamsFromYaml
                 , writeExamsFromYaml
                 , writeExamsFromConfig) where

import qualified Data.ByteString       as B
import qualified Data.Text             as T
import           Data.Text.Encoding    (encodeUtf8)
import qualified Data.Text.IO
import           Data.Yaml             (FromJSON (..), (.!=), (.:), (.:?))
import qualified Data.Yaml             as Y
import           System.FilePath
import           System.Random.Shuffle
import           TestMaker.Database
import           TestMaker.Problems
import           TestMaker.SageTex
import           TestMaker.Test
import           TestMaker.Types

-- Generate exams from yaml files

data QGroup = QGroup { qgSA      :: Bool
                     , qgIntro   :: T.Text
                     , qgList    :: [Int]
                     , qgShuffle :: Bool
                     , qgPerPage :: Int
                     , qgDB      :: Maybe FilePath} deriving (Eq, Show)

instance FromJSON QGroup where
  parseJSON (Y.Object v) =
    QGroup <$>
    v .:? "short-answer" .!= False <*>
    v .:? "intro" .!= "" <*>
    v .:? "ids" .!= [] <*>
    v .:? "shuffle" .!= False <*>
    v .:? "per-page" .!= 0 <*>
    v .:? "database"

data Exam = Exam { eDBname    :: FilePath
                 , eGroups    :: [QGroup]
                 , eNameSpace :: Bool
                 , eTitle     :: T.Text
                 , eKey       :: Bool
                 , eOutFile   :: Maybe [FilePath]} deriving (Eq, Show)

instance FromJSON Exam where
  parseJSON (Y.Object v) =
    Exam <$>
    v .: "database" <*>
    v .:? "questions" .!= [] <*>
    v .:? "name-space" .!= False <*>
    v .:? "title" .!= "" <*>
    v .:? "answer-key" .!= True <*>
    v .:? "output-file"

writeExams :: Maybe [FilePath] -> [T.Text] -> IO ()
writeExams (Just []) _ = pure ()
writeExams _ [] = pure ()
writeExams Nothing (exam:_) = Data.Text.IO.putStrLn exam
writeExams (Just (fp:fps)) (exam:exams) = (B.writeFile fp $ encodeUtf8 exam) >> writeExams (Just fps) exams

unrelative :: FilePath -> FilePath -> FilePath
unrelative dir fp = if isRelative fp
                    then dir </> fp
                    else fp

qgroupToQuestionGroup :: FilePath -> QuestionDB -> QGroup ->  IO QuestionGroup
qgroupToQuestionGroup dir _ (QGroup sa intro ids shuffle n (Just db)) = do
  db' <- fileToDB $ unrelative dir db
  qgroupToQuestionGroup dir db' (QGroup sa intro ids shuffle n Nothing)
qgroupToQuestionGroup _ db (QGroup sa intro ids shuffle n Nothing ) = do
  qs' <- if shuffle
         then (shuffleQList $ getQuestions db ids) >>= shuffleM
         else shuffleQList $ getQuestions db ids
  pure $ QG qs' sa intro n

groupsToBody ::FilePath -> QuestionDB -> [QGroup] -> IO (T.Text, T.Text)
groupsToBody dir db qgs =
    fmap makeGroups $ sequence $ map (qgroupToQuestionGroup dir db) qgs

decodeYaml :: B.ByteString -> Either String Exam
decodeYaml = Y.decodeEither

genExamsFromYaml' :: FilePath ->  Exam -> IO [T.Text]
genExamsFromYaml' dir (Exam dbfp qgs ns title key output) = do
  db <- fileToDB $ unrelative dir dbfp
  (bdy, answerKey) <- groupsToBody dir db qgs
  let answerKey' = if key
                   then T.concat ["\\pagebreak \n \\begin{center}\n  \\textbf{Answer Key}\n\\end{center}\n\\begin{enumerate}\n"
                                 , answerKey
                                 , "\n\\end{enumerate}\n"]
                   else ""
      preamble = "\\documentclass{article}\n\\usepackage{testmaker}\n"
      sageInit = "\\begin{sagesilent}\n  import random\n  x,y,z = var('x','y','z')\n\\end{sagesilent}"
      header = if ns
               then T.concat [ "\\hfill Name:\\underline{\\hspace{2in}}\n\\begin{center}\n  "
                             , title
                             , "\n\\end{center}"]
               else T.concat [ "\\begin{center}\n  "
                             , title
                             , "\n\\end{center}"]
      exam =T.intercalate "\n" [ preamble
                               , "\\begin{document}"
                               , header
                               , sageInit
                               , bdy
                               , answerKey'
                               , "\\end{document}"]
  case output of
    Nothing -> pure [exam]
    Just [] -> pure []
    Just (fp:fps) -> (exam:) <$> genExamsFromYaml' dir (Exam dbfp qgs ns title key (Just fps))
--      pure $ exam : rest
genExamsFromYaml :: Maybe FilePath -> FilePath -> B.ByteString -> IO [T.Text]
genExamsFromYaml db dir yaml = do
  case decodeYaml yaml of
    Left s -> pure [T.pack s]
    Right exam -> genExamsFromYaml' dir $ changeDB db  exam


splitYaml :: B.ByteString -> [B.ByteString]
splitYaml y = h : if B.null t then [] else splitYaml (B.drop 5 t)
  where (h,t) = B.breakSubstring "\n---\n" y

changeDB :: Maybe FilePath -> Exam -> Exam
changeDB fp e@(Exam _ g n t k o) =
  case fp of
    Nothing -> e
    Just fp' -> Exam fp' g n t k o

writeExamsFromYaml :: Maybe FilePath -> FilePath -> [B.ByteString] -> IO ()
writeExamsFromYaml db dir [] = pure ()
writeExamsFromYaml db dir (yaml:yamls) = do
  exams <- genExamsFromYaml db dir yaml
  f (decodeYaml yaml) exams
  writeExamsFromYaml db dir yamls
    where f (Left _) _ = pure ()
          f (Right x) y = writeExams (eOutFile x) y
-- examFromYaml = undefined


writeExamsFromConfig :: Maybe FilePath -> FilePath -> IO ()
writeExamsFromConfig db yamlFile = do
    config <- B.readFile yamlFile
    writeExamsFromYaml db (takeDirectory yamlFile) $ filter (not . B.null) $ splitYaml config
