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

module Web.Informative where

import Control.Applicative
import Control.Arrow
import Control.Monad
import Data.Char
import Data.Monoid
import Data.Set (fromList)
import qualified Data.Text as T
import Data.Time.Clock
import Data.Time.Format
import Database.Persist
import Database.Persist.Sql
import GHC.Int
import Data.Time.Locale.Compat
import Text.Cassius
import Text.CSV
import Text.Hamlet
import Text.Highlighting.Kate
import Text.Highlighting.Kate.Format.HTML
import Text.Highlighting.Kate.Types
import qualified Text.Pandoc as P
import Web.Informative.Data
import Yesod hiding (languages)
import Yesod.Auth
import Yesod.Form

type WikiHandler a = forall master. (YesodWikiAuth master, YesodPersist master, YesodPersistBackend master ~ SqlBackend) => 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
Wikisugg
  page T.Text
  segment T.Text
  index Int
  caption T.Text
  UniqueSugg page segment
|]

readFmt Markdown = P.readMarkdown
readFmt MediaWiki = P.readMediaWiki
readFmt ReStructuredText = P.readRST
readFmt LaTeX = P.readLaTeX
readFmt Textile = P.readTextile
convFmt :: TextFormat -> String -> Html
convFmt Plain = toHtml
convFmt (Source lg ln) = toHtml . formatHtmlBlock defaultFormatOpts{numberLines=True,startNumber=ln,containerClasses=["sourceCode","source-"<>toClassname lg],codeClasses=["source-"<>toClassname lg]} . highlightAs (T.unpack lg)
convFmt fmt = preEscapedToMarkup . P.writeHtml P.def{P.writerHtml5=True,P.writerHighlight=True,P.writerListings=True} . readFmt fmt P.def{P.readerSmart=True,P.readerExtensions=fromList [P.Ext_literate_haskell,P.Ext_fenced_code_blocks,P.Ext_backtick_code_blocks,P.Ext_superscript,P.Ext_subscript,P.Ext_strikeout]}
convSect Table fmt = convTable fmt
convSect Mapping fmt = convTable fmt
convSect _ fmt = Left . convFmt fmt . remCR . T.unpack
convTable :: TextFormat -> T.Text -> Either Html [[Html]]
convTable fmt t = case parseCSV (T.unpack "wikipage") (remCR $ T.unpack t) of
  Left err -> Left $ toHtml $ show err
  Right csv -> Right $ map (map (convFmt fmt)) csv
source :: TextFormat -> T.Text -> Int -> TextFormat
source (Source _ _) lg ln = Source lg ln
source fmt _ _ = fmt
fmtNorm :: TextFormat -> TextFormat
fmtNorm (Source _ _) = Source "" 1
fmtNorm fmt = fmt
fmtLang (Source lg _) = lg
fmtLang _ = "haskell"
fmtLine (Source _ ln) = ln
fmtLine _ = 1
toClassname = filter isAlphaNum . T.unpack
remCR = filter (/=chr 13)

renderShowArticle :: YesodWikiAuth master => [Entity Wikisugg] -> Bool -> (AuthRoute -> Route master) -> (Route Informative -> Route master) -> AuthResult -> Maybe Html -> [(Int,(T.Text,Either Html [[Html]],TextKind))] -> [(T.Text,T.Text,UTCTime)] -> T.Text -> HandlerT Informative (HandlerT master IO) Html
renderShowArticle suggs loggedIn authR toParent mayEdit mmsg sects edits page = do
  seg <- liftM getSegment getYesod
  pref <- liftM getPrefix getYesod
  lift $ wikiLayout $ do
    setTitle $ toHtml page
    toWidget $(hamletFile "informative.htm")
    toWidget $(cassiusFile "informative.css")

renderEditArticle :: YesodWikiAuth master => [Entity Wikisugg] -> Bool -> (AuthRoute -> Route master) -> (Route Informative -> Route master) -> Route master -> Maybe Html -> Maybe (Either Html [[Html]]) -> TextKind -> PageContent (Route master) -> T.Text -> HandlerT Informative (HandlerT master IO) Html
renderEditArticle suggs loggedIn authR toParent submitR mmsg msect kind form page = do
  seg <- liftM getSegment getYesod
  pref <- liftM getPrefix getYesod
  lift $ wikiLayout $ do
    setTitle $ toHtml page
    toWidget $ pageHead form
    toWidget $(hamletFile "informative-edit.htm")
    toWidget $(cassiusFile "informative.css")

getArticleIdR :: T.Text -> WikiHandler Html
getArticleIdR pageid = do
  seg <- liftM getSegment getYesod
  pref <- liftM getPrefix getYesod
  (edits,sects',page,suggs) <- lift $ runDB $ do
    let pid = read $ T.unpack pageid
    wp <- get pid
    (sects,page) <- case wp of
      Nothing -> return ([("/new/",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 k r) -> liftM (T.pack $ show k,) $ 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 k p) -> (T.pack $ show k, wikipageEditor p, wikipageTimestamp p)) hs
    suggs <- selectList [WikisuggSegment ==. seg] [Asc WikisuggIndex]
    return (es,sects,page,suggs)
  toParent <- getRouteToParent
  mayEdit <- lift $ isAuthorized (toParent $ ArticleR page) True
  authR <- lift getAuthR
  loggedIn <- lift isLoggedIn
  mmsg <- getMessage
  let sects = zip [1..] sects'
  renderShowArticle suggs loggedIn authR toParent mayEdit mmsg sects edits page

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

data SectionData = SectionData {
  sdKind :: TextKind,
  sdFormat :: TextFormat,
  sdLang :: T.Text,
  sdFirstLine :: Int,
  sdContent :: Textarea
  }

editSectionForm :: RenderMessage master FormMessage => Maybe SectionData -> Html -> MForm (HandlerT master IO) (FormResult SectionData, WidgetT master IO ())
editSectionForm mdata = renderDivs $ SectionData
                        <$> areq (selectFieldList kinds) "Kind:" (sdKind <$> mdata)
                        <*> areq (selectFieldList formats) "Format:" (sdFormat <$> mdata)
                        <*> areq textField "Language:" (sdLang <$> mdata)
                        <*> areq intField "First line:" (sdFirstLine <$> mdata)
                        <*> areq textareaField "Content:" (sdContent <$> mdata)
  where formats :: [(T.Text,TextFormat)]
        formats = [("Markdown",Markdown),("MediaWiki",MediaWiki),("ReStructuredText",ReStructuredText),("LaTeX",LaTeX),("Textile",Textile),("Source code",Source "" 1),("Plain text",Plain)]
        kinds = map (T.pack . show &&& id) [minBound..maxBound]

getEditR :: T.Text -> WikiHandler Html
getEditR rid = do
  seg <- liftM getSegment getYesod
  pref <- liftM getPrefix getYesod
  (msect, mprec, kind, fmt, suggs, page) <- lift $ runDB $ do
    suggs <- selectList [WikisuggSegment ==. seg] [Asc WikisuggIndex]
    rel <- get $ read $ T.unpack rid
    case rel of
      Nothing -> return (Nothing, Nothing, Error, Plain, suggs, "none")
      Just rel -> do
        msect <- get $ wikirelSection rel
        mpage <- get $ wikirelPage rel
        case (msect,mpage) of
          (Nothing,Nothing) -> return (Nothing, Nothing, Error, Plain, suggs, "none")
          (Just sect, Just page) ->
            return (Just $ convSect (wikisectionKind sect) (wikisectionFormat sect) (wikisectionContent sect), Just $ wikisectionContent sect, wikisectionKind sect, wikisectionFormat sect, suggs, wikipageTitle page)
  toParent <- getRouteToParent
  authR <- lift getAuthR
  loggedIn <- lift isLoggedIn
  mmsg <- getMessage
  (formw, enctype) <- lift $ generateFormPost $ editSectionForm $ liftM (\t -> SectionData kind (fmtNorm fmt) (fmtLang fmt) (fmtLine fmt) $ Textarea t) mprec
  form <- lift $ widgetToPageContent formw
  submitR <- return $ toParent $ EditR rid
  renderEditArticle suggs loggedIn authR toParent submitR mmsg msect kind form page

getInsertR :: T.Text -> WikiHandler Html
getInsertR rid = do
  seg <- liftM getSegment getYesod
  pref <- liftM getPrefix getYesod
  (suggs, page) <- lift $ runDB $ do
    suggs <- selectList [WikisuggSegment ==. seg] [Asc WikisuggIndex]
    rel <-  get $ read $ T.unpack rid
    case rel of
      Nothing -> return (suggs, "none")
      Just rel -> do
        mpage <- get $ wikirelPage rel
        case mpage of
          Nothing -> return (suggs, "none")
          Just page -> return (suggs, wikipageTitle page)
  toParent <- getRouteToParent
  authR <- lift getAuthR
  loggedIn <- lift isLoggedIn
  mmsg <- getMessage
  (formw, enctype) <- lift $ generateFormPost $ editSectionForm $ Just $ SectionData Article MediaWiki "haskell" 1 $ Textarea ""
  form <- lift $ widgetToPageContent formw
  submitR <- return $ toParent $ InsertR rid
  msect <- return (Nothing :: Maybe (Either Html [[Html]]))
  kind <- return Article
  renderEditArticle suggs loggedIn authR toParent submitR mmsg msect kind form page

getPrependR :: T.Text -> WikiHandler Html
getPrependR rid = do
  seg <- liftM getSegment getYesod
  pref <- liftM getPrefix getYesod
  (suggs, page) <- lift $ runDB $ do
    suggs <- selectList [WikisuggSegment ==. seg] [Asc WikisuggIndex]
    rel <- get $ read $ T.unpack rid
    case rel of
      Nothing -> return (suggs, "none")
      Just rel -> do
        mpage <- get $ wikirelPage rel
        case mpage of
          Nothing -> return (suggs, "none")
          Just page -> return (suggs, wikipageTitle page)
  toParent <- getRouteToParent
  authR <- lift getAuthR
  loggedIn <- lift isLoggedIn
  mmsg <- getMessage
  (formw, enctype) <- lift $ generateFormPost $ editSectionForm $ Just $ SectionData Article MediaWiki "haskell" 1 $ Textarea ""
  form <- lift $ widgetToPageContent formw
  submitR <- return $ toParent $ PrependR rid
  msect <- return (Nothing :: Maybe (Either Html [[Html]]))
  kind <- return Article
  renderEditArticle suggs loggedIn authR toParent submitR mmsg msect kind form page

getCreateR :: T.Text -> WikiHandler Html
getCreateR page = do
  seg <- liftM getSegment getYesod
  pref <- liftM getPrefix getYesod
  (suggs, exists) <- lift $ runDB $ do
    suggs <- selectList [WikisuggSegment ==. seg] [Asc WikisuggIndex]
    vs <- selectList [WikipageTitle ==. page] [LimitTo 1]
    return (suggs, not $ null vs)
  toParent <- getRouteToParent
  authR <- lift getAuthR
  loggedIn <- lift isLoggedIn
  mmsg <- getMessage
  (formw, enctype) <- lift $ generateFormPost $ editSectionForm $ Just $ SectionData Article MediaWiki "haskell" 1 $ Textarea ("= "<>page<>" =\n\nSome text about "<>page<>".")
  form <- lift $ widgetToPageContent (if exists then [whamlet|<div .error>Page does already exist.|] else formw)
  submitR <- return $ toParent $ CreateR page
  msect <- return (Nothing :: Maybe (Either Html [[Html]]))
  kind <- return Article
  renderEditArticle suggs loggedIn authR toParent submitR mmsg msect kind form page

postEditR :: T.Text -> WikiHandler Html
postEditR rid = do
  seg <- liftM getSegment getYesod
  pref <- liftM getPrefix getYesod
  let rid' = read $ T.unpack rid
  (msect, mprec, kind, fmt, suggs, page) <- lift $ runDB $ do
    suggs <- selectList [WikisuggSegment ==. seg] [Asc WikisuggIndex]
    rel <- get rid'
    case rel of
      Nothing -> return (Nothing, Nothing, Error, Plain, suggs, "none")
      Just rel -> do
        msect <- get $ wikirelSection rel
        mpage <- get $ wikirelPage rel
        case (msect,mpage) of
          (Nothing,Nothing) -> return (Nothing, Nothing, Error, Plain, suggs, "none")
          (Just sect, Just page) ->
            return (Just $ convSect (wikisectionKind sect) (wikisectionFormat sect) (wikisectionContent sect), Just $ wikisectionContent sect, wikisectionKind sect, wikisectionFormat sect, suggs, wikipageTitle page)
  toParent <- getRouteToParent
  authR <- lift getAuthR
  loggedIn <- lift isLoggedIn
  mmsg <- getMessage
  user <- lift getUserName
  now <- liftIO getCurrentTime
  ((result, widget),enctype) <- lift $ runFormPost $ editSectionForm $ liftM (\t -> SectionData kind (fmtNorm fmt) (fmtLang fmt) (fmtLine fmt) $ Textarea t) mprec
  action <- lift $ runInputPost $ id <$> ireq textField "action"
  submitR <- return $ toParent $ EditR rid
  case (result,action) of
    (FormSuccess (SectionData k f lg ln (Textarea c)),"save") -> do
      lift $ runDB $ do
        Right sid <- insertBy $ Wikisection c (source f lg ln) k
        Right pid <- insertBy $ Wikipage page seg user now
        prel <- get rid'
        case prel of
          Nothing -> return ()
          Just prel -> do
            rels <- selectList [WikirelPage ==. wikirelPage prel] [Asc WikirelIndex]
            let nrels = map (\(Entity ri r) -> Wikirel pid (if ri==rid' then sid else wikirelSection r) (wikirelIndex r)) rels
            forM_ nrels insertBy
      setMessage $ toHtml ("Page has been edited." :: T.Text)
      lift $ redirect $ toParent $ ArticleR page
    (FormSuccess (SectionData k f lg ln (Textarea c)),_) -> do
      kind <- return k
      msect <- return $ Just $ convSect k (source f lg ln) c
      mprec <- return $ Just c
      (widget,enctype) <- lift $ generateFormPost $ editSectionForm $ Just $ SectionData k f lg ln $ Textarea c
      form <- lift $ widgetToPageContent widget
      renderEditArticle suggs loggedIn authR toParent submitR mmsg msect kind form page 
    _ -> do
      form <- lift $ widgetToPageContent widget
      renderEditArticle suggs loggedIn authR toParent submitR mmsg msect kind form page

postInsertR :: T.Text -> WikiHandler Html
postInsertR rid = do
  seg <- liftM getSegment getYesod
  pref <- liftM getPrefix getYesod
  let rid' = read $ T.unpack rid
  (suggs, page) <- lift $ runDB $ do
    suggs <- selectList [WikisuggSegment ==. seg] [Asc WikisuggIndex]
    rel <- get rid'
    case rel of
      Nothing -> return (suggs, "none")
      Just rel -> do
        mpage <- get $ wikirelPage rel
        case mpage of
          Nothing -> return (suggs, "none")
          Just page ->
            return (suggs, wikipageTitle page)
  toParent <- getRouteToParent
  authR <- lift getAuthR
  loggedIn <- lift isLoggedIn
  mmsg <- getMessage
  user <- lift getUserName
  now <- liftIO getCurrentTime
  msect <- return (Nothing :: Maybe (Either Html [[Html]]))
  ((result, widget),enctype) <- lift $ runFormPost $ editSectionForm $ Just $ SectionData Article MediaWiki "haskell" 1 $ Textarea ""
  action <- lift $ runInputPost $ id <$> ireq textField "action"
  kind <- return Article
  submitR <- return $ toParent $ InsertR rid
  case (result,action) of
    (FormSuccess (SectionData k f lg ln (Textarea c)),"save") -> do
      lift $ runDB $ do
        sid <- insert $ Wikisection c (source f lg ln) k
        Right pid <- insertBy $ Wikipage page seg user now
        prel <- get rid'
        case prel of
          Nothing -> return ()
          Just prel -> do
            rels <- selectList [WikirelPage ==. wikirelPage prel] [Asc WikirelIndex]
            let nrels1 = map (\(Entity _ r) -> r) $ takeWhile (\(Entity ri _) -> ri /= rid') rels
                nrels2 = map (\(Entity _ r) -> r) $ drop (length nrels1) rels
                nrels3 = nrels1 ++ [head nrels2] ++ [Wikirel pid sid 0] ++ tail nrels2
                nrels = map (\(i,Wikirel _ s _) -> Wikirel pid s i) $ zip [1..] nrels3
            forM_ nrels insertBy
      setMessage $ toHtml ("Page has been edited." :: T.Text)
      lift $ redirect $ toParent $ ArticleR page
    (FormSuccess (SectionData k f lg ln (Textarea c)),_) -> do
      kind <- return k
      msect <- return $ Just $ convSect k (source f lg ln) c
      mprec <- return $ Just c
      (widget,enctype) <- lift $ generateFormPost $ editSectionForm $ Just $ SectionData k f lg ln $ Textarea c
      form <- lift $ widgetToPageContent widget
      renderEditArticle suggs loggedIn authR toParent submitR mmsg msect kind form page 
    _ -> do
      form <- lift $ widgetToPageContent widget
      renderEditArticle suggs loggedIn authR toParent submitR mmsg msect kind form page 

postPrependR :: T.Text -> WikiHandler Html
postPrependR rid = do
  seg <- liftM getSegment getYesod
  pref <- liftM getPrefix getYesod
  let rid' = read $ T.unpack rid
  (suggs, page) <- lift $ runDB $ do
    suggs <- selectList [WikisuggSegment ==. seg] [Asc WikisuggIndex]
    rel <- get rid'
    case rel of
      Nothing -> return (suggs, "none")
      Just rel -> do
        mpage <- get $ wikirelPage rel
        case mpage of
          Nothing -> return (suggs, "none")
          Just page ->
            return (suggs, wikipageTitle page)
  toParent <- getRouteToParent
  authR <- lift getAuthR
  loggedIn <- lift isLoggedIn
  mmsg <- getMessage
  user <- lift getUserName
  now <- liftIO getCurrentTime
  msect <- return (Nothing :: Maybe (Either Html [[Html]]))
  ((result, widget),enctype) <- lift $ runFormPost $ editSectionForm $ Just $ SectionData Article MediaWiki "haskell" 1 $ Textarea ""
  action <- lift $ runInputPost $ id <$> ireq textField "action"
  kind <- return Article
  submitR <- return $ toParent $ PrependR rid
  case (result,action) of
    (FormSuccess (SectionData k f lg ln (Textarea c)),"save") -> do
      lift $ runDB $ do
        sid <- insert $ Wikisection c (source f lg ln) k
        Right pid <- insertBy $ Wikipage page seg user now
        prel <- get rid'
        case prel of
          Nothing -> return ()
          Just prel -> do
            rels <- selectList [WikirelPage ==. wikirelPage prel] [Asc WikirelIndex]
            let nrels1 = map (\(Entity _ r) -> r) $ takeWhile (\(Entity ri _) -> ri /= rid') rels
                nrels2 = map (\(Entity _ r) -> r) $ drop (length nrels1) rels
                nrels3 = nrels1 ++ [Wikirel pid sid 0] ++ nrels2
                nrels = map (\(i,Wikirel _ s _) -> Wikirel pid s i) $ zip [1..] nrels3
            forM_ nrels insertBy
      setMessage $ toHtml ("Page has been edited." :: T.Text)
      lift $ redirect $ toParent $ ArticleR page
    (FormSuccess (SectionData k f lg ln (Textarea c)),_) -> do
      kind <- return k
      msect <- return $ Just $ convSect k (source f lg ln) c
      mprec <- return $ Just c
      (widget,enctype) <- lift $ generateFormPost $ editSectionForm $ Just $ SectionData k f lg ln $ Textarea c
      form <- lift $ widgetToPageContent widget
      renderEditArticle suggs loggedIn authR toParent submitR mmsg msect kind form page 
    _ -> do
      form <- lift $ widgetToPageContent widget
      renderEditArticle suggs loggedIn authR toParent submitR mmsg msect kind form page 

postCreateR :: T.Text -> WikiHandler Html
postCreateR page = do
  seg <- liftM getSegment getYesod
  pref <- liftM getPrefix getYesod
  (suggs, exists) <- lift $ runDB $ do
    suggs <- selectList [WikisuggSegment ==. seg] [Asc WikisuggIndex]
    vs <- selectList [WikipageTitle ==. page] [LimitTo 1]
    return (suggs, not $ null vs)
  toParent <- getRouteToParent
  authR <- lift getAuthR
  loggedIn <- lift isLoggedIn
  mmsg <- getMessage
  user <- lift getUserName
  now <- liftIO getCurrentTime
  msect <- return (Nothing :: Maybe (Either Html [[Html]]))
  ((result, widget),enctype) <- lift $ runFormPost $ editSectionForm $ Just $ SectionData Article MediaWiki "haskell" 1 $ Textarea ""
  action <- lift $ runInputPost $ id <$> ireq textField "action"
  kind <- return Article
  submitR <- return $ toParent $ CreateR page
  case (exists,result,action) of
    (False,FormSuccess (SectionData k f lg ln (Textarea c)),"save") -> do
      lift $ runDB $ do
        sid <- insert $ Wikisection c (source f lg ln) k
        Right pid <- insertBy $ Wikipage page seg user now
        insertBy $ Wikirel pid sid 1
      setMessage $ toHtml ("Page has been created." :: T.Text)
      lift $ redirect $ toParent $ ArticleR page
    (False,FormSuccess (SectionData k f lg ln (Textarea c)),_) -> do
      kind <- return k
      msect <- return $ Just $ convSect k (source f lg ln) c
      mprec <- return $ Just c
      (widget,enctype) <- lift $ generateFormPost $ editSectionForm $ Just $ SectionData k f lg ln $ Textarea c
      form <- lift $ widgetToPageContent widget
      renderEditArticle suggs loggedIn authR toParent submitR mmsg msect kind form page 
    _ -> do
      form <- lift $ widgetToPageContent widget
      renderEditArticle suggs loggedIn authR toParent submitR mmsg msect kind form page 

postDownR :: T.Text -> WikiHandler Html
postDownR rid = do
  seg <- liftM getSegment getYesod
  pref <- liftM getPrefix getYesod
  user <- lift getUserName
  now <- liftIO getCurrentTime
  toParent <- getRouteToParent
  let rid' = read $ T.unpack rid
  page <- lift $ runDB $ do
    rel <- get rid'
    case rel of
      Nothing -> return "none"
      Just rel -> do
        page <- get $ wikirelPage rel
        case page of
          Nothing -> return "none"
          Just page -> do
            Right pid <- insertBy $ Wikipage (wikipageTitle page) seg user now
            rels <- selectList [WikirelPage ==. wikirelPage rel] [Asc WikirelIndex]
            let swap [Entity _ r] = [r]
                swap [] = []
                swap (Entity ri1 r1:Entity _ r2:rs)
                  | ri1 == rid' = r1{wikirelIndex=wikirelIndex r2}:r2{wikirelIndex=wikirelIndex r1}:swap rs
                swap (Entity _ r:rs) = r:swap rs
            forM (swap rels) $ \r -> insertBy r{wikirelPage=pid}
            return $ wikipageTitle page
  lift $ redirect $ toParent $ ArticleR page

postUpR :: T.Text -> WikiHandler Html
postUpR rid = do
  seg <- liftM getSegment getYesod
  pref <- liftM getPrefix getYesod
  user <- lift getUserName
  now <- liftIO getCurrentTime
  toParent <- getRouteToParent
  let rid' = read $ T.unpack rid
  page <- lift $ runDB $ do
    rel <- get rid'
    case rel of
      Nothing -> return "none"
      Just rel -> do
        page <- get $ wikirelPage rel
        case page of
          Nothing -> return "none"
          Just page -> do
            Right pid <- insertBy $ Wikipage (wikipageTitle page) seg user now
            rels <- selectList [WikirelPage ==. wikirelPage rel] [Asc WikirelIndex]
            let swap [Entity _ r] = [r]
                swap [] = []
                swap (Entity _ r1:Entity ri2 r2:rs)
                  | ri2 == rid' = r1{wikirelIndex=wikirelIndex r2}:r2{wikirelIndex=wikirelIndex r1}:swap rs
                swap (Entity _ r:rs) = r:swap rs
            forM (swap rels) $ \r -> insertBy r{wikirelPage=pid}
            return $ wikipageTitle page
  lift $ redirect $ toParent $ ArticleR page

postDeleteR :: T.Text -> WikiHandler Html
postDeleteR rid = do
  seg <- liftM getSegment getYesod
  pref <- liftM getPrefix getYesod
  user <- lift getUserName
  now <- liftIO getCurrentTime
  toParent <- getRouteToParent
  let rid' = read $ T.unpack rid
  page <- lift $ runDB $ do
    rel <- get rid'
    case rel of
      Nothing -> return "none"
      Just rel -> do
        page <- get $ wikirelPage rel
        case page of
          Nothing -> return "none"
          Just page -> do
            Right pid <- insertBy $ Wikipage (wikipageTitle page) seg user now
            rels <- selectList [WikirelPage ==. wikirelPage rel] [Asc WikirelIndex]
            let nrels = map (\(Entity _ r) -> r) $ filter (\(Entity ri _) -> ri /=  rid') rels
            forM nrels $ \r -> insertBy r{wikirelPage=pid}
            return $ wikipageTitle page
  lift $ redirect $ toParent $ ArticleR page

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