{-# LANGUAGE FlexibleInstances    #-}
{-# LANGUAGE OverloadedStrings    #-}
{-# LANGUAGE QuasiQuotes          #-}
{-# LANGUAGE ScopedTypeVariables  #-}
{-# LANGUAGE TypeSynonymInstances #-}

module Celtchar.Novel where

import           Control.Monad.Reader
import           Control.Monad.State.Strict
import           Data.String
import           Data.Text                    (Text, pack, unpack)
import qualified Data.Text.IO                 as T
import           System.FilePath
import           Text.Pandoc.Class
import           Text.Pandoc.Options
import           Text.Pandoc.Readers.Markdown
import           Text.Pandoc.Writers.LaTeX
import           Text.Shakespeare.Text

import           Celtchar.Metadata
import           Celtchar.Novel.Ogmarkup
import           Celtchar.Novel.Structure

type Builder = StateT Text (ReaderT Language IO)

getLanguage :: Builder Language
getLanguage = lift ask

append :: Text -> Builder ()
append str = do st <- get
                put (st `mappend` str)

appendLn :: Text -> Builder ()
appendLn str = do append str
                  append "\n"

stringify :: Language -> Builder () -> IO Text
stringify lang builder = runReaderT (execStateT builder "") lang

class Novelify a where
    novelify :: a -> Builder ()

instance (Novelify a) => Novelify [a] where
    novelify (a:r) = do novelify a
                        novelify r
    novelify [] = return ()

instance Novelify Document where
    novelify (Document path) = do
      lang <- getLanguage
      f <- liftIO $ T.readFile path
      case parseMetadata path f of
        Right (metadata :: Maybe Text, txt) ->
          appendLn $ case takeExtension path of
                        ".up"  -> parseDoc lang txt
                        ".tex" -> txt
                        ".md"  -> parseMd f txt
                        _      -> verbatim txt
        Left _                ->
          appendLn $ "error while parsing " `mappend` (fromString path :: Text)
      where
        verbatim txt = [st|\begin{verbatim}
#{txt}
\end{verbatim}|]

instance Novelify Chapter where
    novelify c = do
      appendLn $ [st|\chapter{#{maybe "" id $ chapterTitle c}}|]
      novelify $ documents c

instance Novelify Part where
    novelify p = do
      appendLn $ [st|\part{#{partTitle p}}|]
      novelify $ chapters p

instance Novelify Manuscript where
    novelify (WithParts p) = do
      append "\\mainmatter\n"
      novelify p
    novelify (WithChapters c) = do
      append "\\mainmatter\n"
      novelify c

instance Novelify Novel where
    novelify n = do
      appendLn [st|\documentclass[b5paper,12pt]{memoir}
\usepackage[#{show $ language n}]{babel}
\usepackage[T1]{fontenc}
\usepackage[utf8]{inputenc}
\usepackage[nf]{coelacanth}
\usepackage{microtype}
\usepackage[#{show $ language n}]{ogma}
\sloppy
\title{#{novelTitle n}}
\author{#{author n}}
\begin{document}
\frontmatter
\maketitle|]
      putFrontmatter $ frontmatter n
      novelify $ manuscript n
      putAppendix $ appendix n
      append "\\end{document}"
       where
         putFrontmatter Nothing =
           appendLn "% No frontmatter field in configuration file"
         putFrontmatter (Just fm) =
           novelify fm

         putAppendix Nothing =
           appendLn "% No appendix field in configuration file"
         putAppendix (Just app) =
           novelify app


parseMd :: Text
        -> Text
        -> Text
parseMd file txt = let val = runPure $ readMarkdown ropts txt >>= writeLaTeX wopts
                   in case val of
                        Right x -> x
                        Left _  -> [st|error while compiling #{file}|]
    where ropts :: ReaderOptions
          ropts = def

          wopts :: WriterOptions
          wopts = def