{-# LANGUAGE TemplateHaskell, QuasiQuotes, FlexibleInstances, MultiParamTypeClasses, FlexibleContexts, RankNTypes, TypeFamilies, GADTs, GeneralizedNewtypeDeriving, OverloadedStrings, TupleSections #-}

module Web.Informative where

import Control.Monad
import qualified Data.Text as T
import Data.Time.Clock
import Data.Time.Format
import Database.Persist.Sql
import System.Locale
import Text.Cassius
import Text.CSV
import Text.Hamlet
import qualified Text.Pandoc as P
import Web.Informative.Data
import Yesod
import Yesod.Auth

type WikiHandler a = forall master. (Yesod master, YesodWikiAuth master, YesodPersist master, YesodPersistBackend master ~ SqlPersistT) => HandlerT Informative (HandlerT master IO) a

class (Yesod master, RenderMessage master FormMessage) => YesodWikiAuth master where
  getAuthR :: HandlerT master IO (AuthRoute -> Route master)
  getUserName :: HandlerT master IO T.Text
  isLoggedIn :: HandlerT master IO Bool
  wikiLayout :: WidgetT master IO () -> HandlerT master IO Html

share [mkPersist sqlSettings, mkMigrate "migrateWiki"] [persistLowerCase|
Wikipage
  title T.Text
  segment T.Text
  editor T.Text
  timestamp UTCTime
  UniquePage title segment timestamp
Wikisection
  content T.Text
  format TextFormat
  kind TextKind
Wikirel
  page WikipageId
  section WikisectionId
  index Int
  UniqueRel page section
|]

readFmt Markdown = P.readMarkdown
readFmt MediaWiki = P.readMediaWiki
readFmt ReStructuredText = P.readRST
readFmt LaTeX = P.readLaTeX
convFmt Plain = toHtml
convFmt fmt = preEscapedToMarkup . P.writeHtml P.def . readFmt fmt P.def
convSect Table fmt = convTable fmt
convSect Mapping fmt = convTable fmt
convSect _ fmt = Left . convFmt fmt . T.unpack
convTable :: TextFormat -> T.Text -> Either Html [[Html]]
convTable fmt t = case parseCSV (T.unpack "wikipage") (T.unpack t) of
  Left err -> Left $ toHtml $ show err
  Right csv -> Right $ map (map (convFmt fmt)) csv

getArticleIdR :: Int -> WikiHandler Html
getArticleIdR pageid = do
  seg <- liftM getSegment getYesod
  pref <- liftM getPrefix getYesod
  (edits,sects',page) <- lift $ runDB $ do
    let pid = Key (PersistInt64 $ fromIntegral pageid) :: WikipageId
    wp <- get pid
    (sects,page) <- case wp of
      Nothing -> return ([(-1,Left $ convFmt LaTeX "\\section{404 Not Found} We're sorry, but that article doesn't exist in our database.", Error)],"none")
      Just p -> do
        rels <- selectList [WikirelPage ==. pid] [Asc WikirelIndex]
        sects <- forM rels $ \(Entity (Key (PersistInt64 rid)) r) -> liftM (rid,) $ get $ wikirelSection r
        let s' = map (\(rid,Just  s) -> (rid,convSect (wikisectionKind s) (wikisectionFormat s) (wikisectionContent s), wikisectionKind s)) sects
        return (s', wikipageTitle p)
    hs <- selectList [WikipageTitle ==. page, WikipageSegment ==. seg] [Desc WikipageTimestamp, LimitTo 10]
    let es = map (\(Entity (Key (PersistInt64 pid)) p) -> (pid, wikipageEditor p, wikipageTimestamp p)) hs
    return (es,sects,page)
  toParent <- getRouteToParent
  mayEdit <- lift $ isAuthorized (toParent $ ArticleR page) True
  authR <- lift getAuthR
  loggedIn <- lift isLoggedIn
  mmsg <- getMessage
  let sects = zip [1..] sects'
  lift $ wikiLayout $ do
    setTitle $ toHtml page
    toWidget $(hamletFile "informative.htm")
    toWidget $(cassiusFile "informative.css")

getArticleR :: T.Text -> WikiHandler Html
getArticleR page = do
  seg <- liftM getSegment getYesod
  pref <- liftM getPrefix getYesod
  (edits,sects') <- lift $ runDB $ do
    wp <- selectList [WikipageTitle ==. page, WikipageSegment ==. seg] [Desc WikipageTimestamp, LimitTo 10]
    case wp of
      [] -> return ([], [(-1,Left $ convFmt LaTeX "\\section{404 Not Found} We're sorry, but that article doesn't exist in our database.", Error)])
      hs@((Entity pid p):_) -> do
        rels <- selectList [WikirelPage ==. pid] [Asc WikirelIndex]
        sects <- forM rels $ \(Entity (Key (PersistInt64 rid)) r) -> liftM (rid,) $ get $ wikirelSection r
        let s' = map (\(rid,Just  s) -> (rid,convSect (wikisectionKind s) (wikisectionFormat s) (wikisectionContent s), wikisectionKind s)) sects
            es = map (\(Entity (Key (PersistInt64 pid)) p) -> (pid, wikipageEditor p, wikipageTimestamp p)) hs
        return (es, s')
  toParent <- getRouteToParent
  mayEdit <- lift $ isAuthorized (toParent $ ArticleR page) True
  authR <- lift getAuthR
  loggedIn <- lift isLoggedIn
  mmsg <- getMessage
  let sects = zip [1..] sects'
  lift $ wikiLayout $ do
    setTitle $ toHtml page
    toWidget $(hamletFile "informative.htm")
    toWidget $(cassiusFile "informative.css")

getEditR :: T.Text -> Int -> WikiHandler Html
getEditR page sect = do
  lift $ defaultLayout [whamlet| Woohoo, we are editing this!|]

instance (YesodWikiAuth master, YesodPersist master, YesodPersistBackend master ~ SqlPersistT) => YesodSubDispatch Informative (HandlerT master IO) where
  yesodSubDispatch = $(mkYesodSubDispatch resourcesInformative)