content: {-# LANGUAGE DeriveGeneric   #-}
  {-# LANGUAGE RecordWildCards #-}
  {-# LANGUAGE QuasiQuotes     #-}
  
  module Dixi.Config ( Config (Config, port, storage, static, stylesheet)
                     , Renders (..)
                     , defaultConfig
                     , configToRenders
                     , defaultRenders
                     , EndoIO (..)
                     ) where
  
  import Control.Monad ((<=<))
  import Data.Aeson
  import Data.Aeson.Types
  import Data.Char (toLower)
  import Data.Default
  import Data.Maybe (mapMaybe, fromMaybe)
  import Data.Monoid
  import Data.Time (UTCTime, formatTime)
  import Data.Time.Locale.Compat
  import Data.Time.LocalTime.TimeZone.Olson
  import Data.Time.LocalTime.TimeZone.Series
  import GHC.Generics
  import Text.Hamlet
  
  import qualified Text.Pandoc       as P
  import qualified Text.Pandoc.Error as P
  
  import Dixi.Pandoc.Wikilinks
  
  newtype Format = Format String
                 deriving (Generic, Show)
  
  data TimeConfig = TimeConfig
                  { timezone :: String
                  , format   :: String
                  } deriving (Generic, Show)
  
  
  
  data MathMethod = Plain | LatexMathML | MathML | MathJax | Katex deriving (Generic, Show)
  
  data Config = Config
              { port         :: Int
              , storage      :: FilePath
              , static       :: Maybe FilePath
              , stylesheet   :: FilePath
              , time         :: TimeConfig
              , readerFormat :: Format
              , url          :: String
              , processors   :: [String]
              , math         :: MathMethod
              } deriving (Generic, Show)
  
  instance FromJSON Config     where
    parseJSON = genericParseJSON (defaultOptions {omitNothingFields = True})
  instance ToJSON   Config     where
    toJSON = genericToJSON (defaultOptions {omitNothingFields = True})
  instance FromJSON TimeConfig where -- generic
  instance ToJSON   TimeConfig where -- generic
  instance FromJSON Format     where -- generic
  instance ToJSON   Format     where -- generic
  instance FromJSON MathMethod where
    parseJSON = genericParseJSON (defaultOptions { constructorTagModifier = map toLower})
  instance ToJSON   MathMethod where
    toJSON = genericToJSON (defaultOptions { constructorTagModifier = map toLower })
  
  type PureReader = P.ReaderOptions -> String -> Either P.PandocError P.Pandoc
  
  newtype EndoIO x = EndoIO { runEndoIO :: x -> IO x }
  
  instance Monoid (EndoIO a) where
    mempty = EndoIO return
    EndoIO a `mappend` EndoIO b = EndoIO (a <=< b)
  
  data Renders = Renders
     { renderTime :: Last UTCTime -> String
     , pandocReader :: PureReader
     , pandocWriterOptions :: P.WriterOptions
     , pandocProcessors :: EndoIO P.Pandoc
     , headerBlock :: Html
     }
  
  defaultRenders :: Renders
  defaultRenders = Renders renderTime P.readOrg def mempty
                           [shamlet|<link rel="stylesheet" href="/static/stylesheet.css">|]
    where renderTime (Last Nothing)  = "(never)"
          renderTime (Last (Just t)) = show t
  
  defaultConfig :: Config
  defaultConfig = Config 8000 "state" (Just "static") "style.css"
                         (TimeConfig "Etc/UTC" "%T, %F")
                         (Format "org")
                         "http://localhost:8000"
                         ["wikilinks"]
                         Katex
  
  readers :: [(String, PureReader)]
  readers = [ ("native"       , const P.readNative)
            , ("json"         , P.readJSON )
            , ("commonmark"   , P.readCommonMark)
            , ("rst"          , P.readRST)
            , ("markdown"     , P.readMarkdown)
            , ("mediawiki"    , P.readMediaWiki)
            , ("docbook"      , P.readDocBook)
            , ("opml"         , P.readOPML)
            , ("org"          , P.readOrg)
            , ("textile"      , P.readTextile)
            , ("html"         , P.readHtml)
            , ("latex"        , P.readLaTeX)
            , ("haddock"      , P.readHaddock)
            , ("twiki"        , P.readTWiki)
            , ("t2t"          , P.readTxt2TagsNoMacros)
            ]
  
  allProcessors :: Config -> [(String, EndoIO P.Pandoc)]
  allProcessors Config {..}
                = [ ("wikilinks", EndoIO $ wikilinks url)
                  ]
  
  convertMathMethod :: MathMethod -> P.HTMLMathMethod
  convertMathMethod Plain = P.PlainMath
  convertMathMethod LatexMathML = P.LaTeXMathML Nothing
  convertMathMethod MathML = P.MathML Nothing
  convertMathMethod MathJax = P.MathJax ""
  convertMathMethod Katex = P.KaTeX "" ""
  
  headerForMathMethod :: MathMethod -> Html
  headerForMathMethod Plain = [shamlet||]
  headerForMathMethod LatexMathML = [shamlet|
       <script type="text/javascript" src="http://math.etsu.edu/LaTeXMathML/LaTeXMathML.js">
       <link rel="stylesheet" type="text/css" href="http://math.etsu.edu/LaTeXMathML/LaTeXMathML.standardarticle.css">
     |]
  headerForMathMethod MathML = [shamlet||]
  headerForMathMethod Katex = [shamlet|
       <link rel="stylesheet" href="//cdnjs.cloudflare.com/ajax/libs/KaTeX/0.5.1/katex.min.css">
       <script src="//cdnjs.cloudflare.com/ajax/libs/KaTeX/0.5.1/katex.min.js">
       <script src="//code.jquery.com/jquery-1.11.2.min.js"></script>
       <script> $(function () { $(".math").each(function (x) { katex.render($(this).text(), this); }); });
     |]
  headerForMathMethod MathJax = [shamlet|
       <script type="text/javascript" src="https://cdn.mathjax.org/mathjax/latest/MathJax.js?config=TeX-AMS-MML_HTMLorMML">
     |]
  
  configToRenders :: Config -> IO Renders
  configToRenders cfg@(Config {..}) = do
    olsonData <- getTimeZoneSeriesFromOlsonFile ("/usr/share/zoneinfo/" ++ timezone time)
    let renderTime (Last Nothing) = "(never)"
        renderTime (Last (Just t)) = formatTime defaultTimeLocale (format time) $ utcToLocalTime' olsonData t
        pandocReader | Format f <- readerFormat = fromMaybe P.readOrg (lookup f readers)
        pandocWriterOptions = def { P.writerSourceURL = Just url, P.writerHTMLMathMethod = convertMathMethod math }
        pandocProcessors = mconcat $ mapMaybe (flip lookup $ allProcessors cfg) processors
        stylesheetUrl = url ++ "/static/" ++ stylesheet
        headerBlock = [shamlet|
                         <link rel="stylesheet" href="#{stylesheetUrl}">
                         #{headerForMathMethod math}
                      |]
    return Renders {..}
  