    {-# LANGUAGE ScopedTypeVariables #-}
    {-# LANGUAGE OverloadedStrings #-}
    {-
    Copyright (C) 2008-9 John MacFarlane <jgm@berkeley.edu>

    This program is free software; you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation; either version 2 of the License, or
    (at your option) any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this program; if not, write to the Free Software
    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
    -}

    {- Handlers for wiki functions.
    -}

    module Network.Gitit.Handlers (
                            handleAny
                          , debugHandler
                          , randomPage
                          , discussPage
                          , createPage
                          , showActivity
                          , goToPage
                          , searchResults
                          , uploadForm
                          , uploadFile
                          , indexPage
                          , categoryPage
                          , categoryListPage
                          , preview
                          , showRawPage
                          , showFileAsText
                          , showPageHistory
                          , showFileHistory
                          , showPage
                          , showPageDiff
                          , showFileDiff
                          , updatePage
                          , editPage
                          , deletePage
                          , confirmDelete
                          , showHighlightedSource
                          , expireCache
                          , feedHandler
                          )
    where
    import Safe
    import Network.Gitit.Server
    import Network.Gitit.Framework
    import Network.Gitit.Layout
    import Network.Gitit.Types
    import Network.Gitit.Feed (filestoreToXmlFeed, FeedConfig(..))
    import Network.Gitit.Util (orIfNull)
    import Network.Gitit.Cache (expireCachedFile, lookupCache, cacheContents)
    import Network.Gitit.ContentTransformer (showRawPage, showFileAsText, showPage,
            showHighlightedSource, preview, applyPreCommitPlugins)
    import Network.Gitit.Page (readCategories)
    import qualified Control.Exception as E
    import System.FilePath
    import Network.Gitit.State
    import Data.List (intercalate, intersperse, delete, nub, sortBy, find, isPrefixOf, inits, sort, (\\))
    import Data.List.Split (wordsBy)
    import Data.Maybe (fromMaybe, mapMaybe, isJust, catMaybes)
    import Data.Ord (comparing)
    import Data.Char (toLower, isSpace)
    import Control.Monad
    import Control.Monad.Reader
    import qualified Data.ByteString.Lazy as B
    import qualified Data.ByteString as S
    import Network.HTTP (urlEncodeVars)
    import Data.Time (getCurrentTime, addUTCTime)
    import Data.Time.Clock (diffUTCTime, UTCTime(..))
    import Data.FileStore
    import System.Log.Logger (logM, Priority(..))
    import Text.Blaze.Html.Renderer.String as Blaze ( renderHtml )
    import Text.Blaze.Html5 hiding (b, search, u, s, contents, source, html, title, map)
    import Text.Blaze.Html5.Attributes hiding (span, id)
    import qualified Text.Blaze.Html5 as Html5 hiding (search)
    import qualified Text.Blaze.Html5.Attributes as Html5.Attr hiding (span)
    import Data.String (IsString(fromString))
    import Prelude hiding (span)

    handleAny :: Handler
    handleAny :: Handler
    handleAny = (Params -> Handler) -> Handler
    forall (m :: * -> *) a r.
    (HasRqData m, FromData a, MonadPlus m, ServerMonad m) =>
    (a -> m r) -> m r
    withData ((Params -> Handler) -> Handler) -> (Params -> Handler) -> Handler
    forall a b. (a -> b) -> a -> b
    $ \(Params
    params :: Params) -> ([Char] -> Handler) -> Handler
    forall (m :: * -> *) a. ServerMonad m => ([Char] -> m a) -> m a
    uriRest (([Char] -> Handler) -> Handler) -> ([Char] -> Handler) -> Handler
    forall a b. (a -> b) -> a -> b
    $ \[Char]
    uri ->
      let path' :: [Char]
    path' = [Char] -> [Char]
    uriPath [Char]
    uri
      in  do fs <- GititServerPart FileStore
    getFileStore
             let rev = Params -> Maybe [Char]
    pRevision Params
    params
             mimetype <- getMimeTypeForExtension
                          (takeExtension path')
             res <- liftIO $ E.try
                    (retrieve fs path' rev :: IO B.ByteString)
             case res of
                    Right ByteString
    contents -> ServerPartT (ReaderT WikiState IO) ()
    forall a (m :: * -> *). FilterMonad a m => m ()
    ignoreFilters ServerPartT (ReaderT WikiState IO) () -> Handler -> Handler
    forall a b.
    ServerPartT (ReaderT WikiState IO) a
    -> ServerPartT (ReaderT WikiState IO) b
    -> ServerPartT (ReaderT WikiState IO) b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >>  -- don't compress
                                      (Response -> Handler
    forall (m :: * -> *) a. FilterMonad Response m => a -> m a
    ok (Response -> Handler) -> Response -> Handler
    forall a b. (a -> b) -> a -> b
    $ [Char] -> Response -> Response
    setContentType [Char]
    mimetype (Response -> Response) -> Response -> Response
    forall a b. (a -> b) -> a -> b
    $
                                        ([Char] -> Response
    forall a. ToMessage a => a -> Response
    toResponse (Html -> [Char]
    renderHtml Html
    forall a. Monoid a => a
    mempty)) {rsBody = contents})
                                        -- ugly hack
                    Left FileStoreError
    NotFound  -> Handler
    forall a. ServerPartT (ReaderT WikiState IO) a
    forall (m :: * -> *) a. MonadPlus m => m a
    mzero
                    Left FileStoreError
    e         -> [Char] -> Handler
    forall a. HasCallStack => [Char] -> a
    error (FileStoreError -> [Char]
    forall a. Show a => a -> [Char]
    show FileStoreError
    e)

    debugHandler :: Handler
    debugHandler :: Handler
    debugHandler = (Params -> Handler) -> Handler
    forall (m :: * -> *) a r.
    (HasRqData m, FromData a, MonadPlus m, ServerMonad m) =>
    (a -> m r) -> m r
    withData ((Params -> Handler) -> Handler) -> (Params -> Handler) -> Handler
    forall a b. (a -> b) -> a -> b
    $ \(Params
    params :: Params) -> do
      req <- ServerPartT (ReaderT WikiState IO) Request
    forall (m :: * -> *). ServerMonad m => m Request
    askRq
      liftIO $ logM "gitit" DEBUG (show req)
      page <- getPage
      liftIO $ logM "gitit" DEBUG $ "Page = '" ++ page ++ "'\n" ++
                  show params
      mzero

    randomPage :: Handler
    randomPage :: Handler
    randomPage = do
      fs <- GititServerPart FileStore
    getFileStore
      base' <- getWikiBase
      prunedFiles <- liftIO (index fs) >>= filterM isPageFile >>= filterM isNotDiscussPageFile
      let pages = ([Char] -> [Char]) -> [[Char]] -> [[Char]]
    forall a b. (a -> b) -> [a] -> [b]
    map [Char] -> [Char]
    dropExtension [[Char]]
    prunedFiles
      if null pages
         then error "No pages found!"
         else do
           secs <- liftIO (fmap utctDayTime getCurrentTime)
           let newPage = [[Char]]
    pages [[Char]] -> Int -> [Char]
    forall a. HasCallStack => [a] -> Int -> a
    !!
                         (DiffTime -> Int
    forall b. Integral b => DiffTime -> b
    forall a b. (RealFrac a, Integral b) => a -> b
    truncate (DiffTime
    secs DiffTime -> DiffTime -> DiffTime
    forall a. Num a => a -> a -> a
    * DiffTime
    1000000) Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `mod` [[Char]] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [[Char]]
    pages)
           seeOther (base' ++ urlForPage newPage) $ toResponse $
             renderHtml $ p $ "Redirecting to a random page"

    discussPage :: Handler
    discussPage :: Handler
    discussPage = do
      page <- GititServerPart [Char]
    getPage
      base' <- getWikiBase
      seeOther (base' ++ urlForPage (if isDiscussPage page then page else ('@':page))) $
                         toResponse ("Redirecting to discussion page" :: String)

    createPage :: Handler
    createPage :: Handler
    createPage = do
      page <- GititServerPart [Char]
    getPage
      base' <- getWikiBase
      case page of
           (Char
    '_':[Char]
    _) -> Handler
    forall a. ServerPartT (ReaderT WikiState IO) a
    forall (m :: * -> *) a. MonadPlus m => m a
    mzero   -- don't allow creation of _index, etc.
           [Char]
    _       -> PageLayout -> Html -> Handler
    formattedPage PageLayout
    defaultPageLayout{
                                          pgPageName = page
                                        , pgTabs = []
                                        , pgTitle = "Create " ++ page ++ "?"
                                        }
                        (Html -> Handler) -> Html -> Handler
    forall a b. (a -> b) -> a -> b
    $ Html -> Html
    p (Html -> Html) -> Html -> Html
    forall a b. (a -> b) -> a -> b
    $ [Html] -> Html
    forall a. Monoid a => [a] -> a
    mconcat
                          [ [Char] -> Html
    forall a. IsString a => [Char] -> a
    fromString
                              ([Char] -> Html) -> [Char] -> Html
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "There is no page named '" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    page [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "'. You can:"
                          , (Html -> Html
    ul (Html -> Html) -> Html -> Html
    forall a b. (a -> b) -> a -> b
    $ [Html] -> Html
    forall a. Monoid a => [a] -> a
    mconcat
                              [ Html -> Html
    li (Html -> Html) -> Html -> Html
    forall a b. (a -> b) -> a -> b
    $ Html -> Html
    a (Html -> Html) -> Attribute -> Html -> Html
    forall h. Attributable h => h -> Attribute -> h
    !
                                    AttributeValue -> Attribute
    href ([Char] -> AttributeValue
    forall a. IsString a => [Char] -> a
    fromString ([Char] -> AttributeValue) -> [Char] -> AttributeValue
    forall a b. (a -> b) -> a -> b
    $ [Char]
    base' [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "/_edit" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char] -> [Char]
    urlForPage [Char]
    page)
                                      (Html -> Html) -> Html -> Html
    forall a b. (a -> b) -> a -> b
    $ [Char] -> Html
    forall a. IsString a => [Char] -> a
    fromString ([Char]
    "Create the page '" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    page [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "'")
                              , Html -> Html
    li (Html -> Html) -> Html -> Html
    forall a b. (a -> b) -> a -> b
    $ Html -> Html
    a (Html -> Html) -> Attribute -> Html -> Html
    forall h. Attributable h => h -> Attribute -> h
    !
                                    AttributeValue -> Attribute
    href ([Char] -> AttributeValue
    forall a. IsString a => [Char] -> a
    fromString ([Char] -> AttributeValue) -> [Char] -> AttributeValue
    forall a b. (a -> b) -> a -> b
    $ [Char]
    base' [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "/_search?" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++
                                        ([([Char], [Char])] -> [Char]
    urlEncodeVars [([Char]
    "patterns", [Char]
    page)]))
                                      (Html -> Html) -> Html -> Html
    forall a b. (a -> b) -> a -> b
    $ [Char] -> Html
    forall a. IsString a => [Char] -> a
    fromString ([Char]
    "Search for pages containing the text '" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++
                                        [Char]
    page [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "'")])
                          ]

    fileInput :: AttributeValue -> AttributeValue -> Html
    fileInput :: AttributeValue -> AttributeValue -> Html
    fileInput AttributeValue
    nameAndId AttributeValue
    val =  Html
    input Html -> Attribute -> Html
    forall h. Attributable h => h -> Attribute -> h
    ! AttributeValue -> Attribute
    type_ AttributeValue
    "file" Html -> Attribute -> Html
    forall h. Attributable h => h -> Attribute -> h
    ! AttributeValue -> Attribute
    Html5.Attr.id AttributeValue
    nameAndId Html -> Attribute -> Html
    forall h. Attributable h => h -> Attribute -> h
    ! AttributeValue -> Attribute
    name AttributeValue
    nameAndId Html -> Attribute -> Html
    forall h. Attributable h => h -> Attribute -> h
    ! AttributeValue -> Attribute
    value AttributeValue
    val
    textfieldInput :: AttributeValue -> AttributeValue -> Html
    textfieldInput :: AttributeValue -> AttributeValue -> Html
    textfieldInput AttributeValue
    nameAndId AttributeValue
    val = Html
    input Html -> Attribute -> Html
    forall h. Attributable h => h -> Attribute -> h
    ! AttributeValue -> Attribute
    type_ AttributeValue
    "text" Html -> Attribute -> Html
    forall h. Attributable h => h -> Attribute -> h
    ! AttributeValue -> Attribute
    Html5.Attr.id AttributeValue
    nameAndId Html -> Attribute -> Html
    forall h. Attributable h => h -> Attribute -> h
    ! AttributeValue -> Attribute
    name AttributeValue
    nameAndId Html -> Attribute -> Html
    forall h. Attributable h => h -> Attribute -> h
    ! AttributeValue -> Attribute
    value AttributeValue
    val
    checkboxInput :: AttributeValue -> AttributeValue -> Html
    checkboxInput :: AttributeValue -> AttributeValue -> Html
    checkboxInput AttributeValue
    nameAndId AttributeValue
    val = Html
    input Html -> Attribute -> Html
    forall h. Attributable h => h -> Attribute -> h
    ! AttributeValue -> Attribute
    type_ AttributeValue
    "checkbox" Html -> Attribute -> Html
    forall h. Attributable h => h -> Attribute -> h
    ! AttributeValue -> Attribute
    Html5.Attr.id AttributeValue
    nameAndId Html -> Attribute -> Html
    forall h. Attributable h => h -> Attribute -> h
    ! AttributeValue -> Attribute
    name AttributeValue
    nameAndId Html -> Attribute -> Html
    forall h. Attributable h => h -> Attribute -> h
    ! AttributeValue -> Attribute
    value AttributeValue
    val
    submitInput :: AttributeValue -> AttributeValue -> Html
    submitInput :: AttributeValue -> AttributeValue -> Html
    submitInput AttributeValue
    nameAndId AttributeValue
    val = Html
    input Html -> Attribute -> Html
    forall h. Attributable h => h -> Attribute -> h
    ! AttributeValue -> Attribute
    type_ AttributeValue
    "submit" Html -> Attribute -> Html
    forall h. Attributable h => h -> Attribute -> h
    ! AttributeValue -> Attribute
    Html5.Attr.id AttributeValue
    nameAndId Html -> Attribute -> Html
    forall h. Attributable h => h -> Attribute -> h
    ! AttributeValue -> Attribute
    name AttributeValue
    nameAndId Html -> Attribute -> Html
    forall h. Attributable h => h -> Attribute -> h
    ! AttributeValue -> Attribute
    value AttributeValue
    val

    uploadForm :: Handler
    uploadForm :: Handler
    uploadForm = (Params -> Handler) -> Handler
    forall (m :: * -> *) a r.
    (HasRqData m, FromData a, MonadPlus m, ServerMonad m) =>
    (a -> m r) -> m r
    withData ((Params -> Handler) -> Handler) -> (Params -> Handler) -> Handler
    forall a b. (a -> b) -> a -> b
    $ \(Params
    params :: Params) -> do
      let origPath :: [Char]
    origPath = Params -> [Char]
    pFilename Params
    params
      let wikiname :: [Char]
    wikiname = Params -> [Char]
    pWikiname Params
    params [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    `orIfNull` [Char] -> [Char]
    takeFileName [Char]
    origPath
      let logMsg :: [Char]
    logMsg = Params -> [Char]
    pLogMsg Params
    params
      let upForm :: Html
    upForm = Html -> Html
    Html5.form (Html -> Html) -> Attribute -> Html -> Html
    forall h. Attributable h => h -> Attribute -> h
    ! AttributeValue -> Attribute
    Html5.Attr.method AttributeValue
    "post" (Html -> Html) -> Attribute -> Html -> Html
    forall h. Attributable h => h -> Attribute -> h
    ! AttributeValue -> Attribute
    enctype AttributeValue
    "multipart/form-data"
           (Html -> Html) -> Html -> Html
    forall a b. (a -> b) -> a -> b
    $ Html -> Html
    fieldset (Html -> Html) -> Html -> Html
    forall a b. (a -> b) -> a -> b
    $ [Html] -> Html
    forall a. Monoid a => [a] -> a
    mconcat
           [ Html -> Html
    p (Html -> Html) -> Html -> Html
    forall a b. (a -> b) -> a -> b
    $ [Html] -> Html
    forall a. Monoid a => [a] -> a
    mconcat
                  [ Html -> Html
    Html5.label (Html -> Html) -> Attribute -> Html -> Html
    forall h. Attributable h => h -> Attribute -> h
    ! AttributeValue -> Attribute
    for AttributeValue
    "file" (Html -> Html) -> Html -> Html
    forall a b. (a -> b) -> a -> b
    $ Html
    "File to upload:"
                  , Html
    br
                  , AttributeValue -> AttributeValue -> Html
    fileInput AttributeValue
    "file" ([Char] -> AttributeValue
    forall a. IsString a => [Char] -> a
    fromString [Char]
    origPath) ]
           , Html -> Html
    p (Html -> Html) -> Html -> Html
    forall a b. (a -> b) -> a -> b
    $ [Html] -> Html
    forall a. Monoid a => [a] -> a
    mconcat
                  [ Html -> Html
    Html5.label (Html -> Html) -> Attribute -> Html -> Html
    forall h. Attributable h => h -> Attribute -> h
    ! AttributeValue -> Attribute
    for AttributeValue
    "wikiname" (Html -> Html) -> Html -> Html
    forall a b. (a -> b) -> a -> b
    $ Html
    "Name on wiki, including extension"
                  , Html -> Html
    noscript (Html -> Html) -> Html -> Html
    forall a b. (a -> b) -> a -> b
    $ Html
    " (leave blank to use the same filename)"
                  , Html
    ":"
                  , Html
    br
                  , AttributeValue -> AttributeValue -> Html
    textfieldInput AttributeValue
    "wikiname" ([Char] -> AttributeValue
    forall a. IsString a => [Char] -> a
    fromString [Char]
    wikiname)
                  , [Char] -> Html
    preEscapedString [Char]
    "&nbsp;"
                  , AttributeValue -> AttributeValue -> Html
    checkboxInput AttributeValue
    "overwrite" AttributeValue
    "yes"
                  , Html -> Html
    Html5.label (Html -> Html) -> Attribute -> Html -> Html
    forall h. Attributable h => h -> Attribute -> h
    ! AttributeValue -> Attribute
    for AttributeValue
    "overwrite" (Html -> Html) -> Html -> Html
    forall a b. (a -> b) -> a -> b
    $ Html
    "Overwrite existing file"
                  ]
           , Html -> Html
    p (Html -> Html) -> Html -> Html
    forall a b. (a -> b) -> a -> b
    $ [Html] -> Html
    forall a. Monoid a => [a] -> a
    mconcat
                  [ Html -> Html
    Html5.label (Html -> Html) -> Attribute -> Html -> Html
    forall h. Attributable h => h -> Attribute -> h
    ! AttributeValue -> Attribute
    for AttributeValue
    "logMsg" (Html -> Html) -> Html -> Html
    forall a b. (a -> b) -> a -> b
    $ Html
    "Description of content or changes:"
                  , Html
    br
                  , AttributeValue -> AttributeValue -> Html
    textfieldInput AttributeValue
    "logMsg" ([Char] -> AttributeValue
    forall a. IsString a => [Char] -> a
    fromString [Char]
    logMsg) Html -> Attribute -> Html
    forall h. Attributable h => h -> Attribute -> h
    ! AttributeValue -> Attribute
    size AttributeValue
    "60"
                  , AttributeValue -> AttributeValue -> Html
    submitInput AttributeValue
    "upload" AttributeValue
    "Upload" ]
           ]
      PageLayout -> Html -> Handler
    formattedPage PageLayout
    defaultPageLayout{
                       pgMessages = pMessages params,
                       pgScripts = ["uploadForm.js"],
                       pgShowPageTools = False,
                       pgTabs = [],
                       pgTitle = "Upload a file"} Html
    upForm

    uploadFile :: Handler
    uploadFile :: Handler
    uploadFile = (Params -> Handler) -> Handler
    forall (m :: * -> *) a r.
    (HasRqData m, FromData a, MonadPlus m, ServerMonad m) =>
    (a -> m r) -> m r
    withData ((Params -> Handler) -> Handler) -> (Params -> Handler) -> Handler
    forall a b. (a -> b) -> a -> b
    $ \(Params
    params :: Params) -> do
      let origPath :: [Char]
    origPath = Params -> [Char]
    pFilename Params
    params
      let filePath :: [Char]
    filePath = Params -> [Char]
    pFilePath Params
    params
      let wikiname :: [Char]
    wikiname = [Char] -> [Char]
    normalise
                     ([Char] -> [Char]) -> [Char] -> [Char]
    forall a b. (a -> b) -> a -> b
    $ (Char -> Bool) -> [Char] -> [Char]
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    ==Char
    '/')
                     ([Char] -> [Char]) -> [Char] -> [Char]
    forall a b. (a -> b) -> a -> b
    $ Params -> [Char]
    pWikiname Params
    params [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    `orIfNull` [Char] -> [Char]
    takeFileName [Char]
    origPath
      let logMsg :: [Char]
    logMsg = Params -> [Char]
    pLogMsg Params
    params
      cfg <- GititServerPart Config
    getConfig
      wPF <- isPageFile wikiname
      mbUser <- getLoggedInUser
      (user, email) <- case mbUser of
                            Maybe User
    Nothing -> ([Char], [Char])
    -> ServerPartT (ReaderT WikiState IO) ([Char], [Char])
    forall a. a -> ServerPartT (ReaderT WikiState IO) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([Char]
    "Anonymous", [Char]
    "")
                            Just User
    u  -> ([Char], [Char])
    -> ServerPartT (ReaderT WikiState IO) ([Char], [Char])
    forall a. a -> ServerPartT (ReaderT WikiState IO) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (User -> [Char]
    uUsername User
    u, User -> [Char]
    uEmail User
    u)
      let overwrite = Params -> Bool
    pOverwrite Params
    params
      fs <- getFileStore
      exists <- liftIO $ E.catch (latest fs wikiname >> return True) $ \FileStoreError
    e ->
                          if FileStoreError
    e FileStoreError -> FileStoreError -> Bool
    forall a. Eq a => a -> a -> Bool
    == FileStoreError
    NotFound
                             then Bool -> IO Bool
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    False
                             else FileStoreError -> IO (ZonkAny 0)
    forall e a. (HasCallStack, Exception e) => e -> IO a
    E.throwIO FileStoreError
    e IO (ZonkAny 0) -> IO Bool -> IO Bool
    forall a b. IO a -> IO b -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Bool -> IO Bool
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    True
      let inStaticDir = Config -> [Char]
    staticDir Config
    cfg [Char] -> [Char] -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isPrefixOf` (Config -> [Char]
    repositoryPath Config
    cfg [Char] -> [Char] -> [Char]
    </> [Char]
    wikiname)
      let inTemplatesDir = Config -> [Char]
    templatesDir Config
    cfg [Char] -> [Char] -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isPrefixOf` (Config -> [Char]
    repositoryPath Config
    cfg [Char] -> [Char] -> [Char]
    </> [Char]
    wikiname)
      let dirs' = [Char] -> [[Char]]
    splitDirectories ([Char] -> [[Char]]) -> [Char] -> [[Char]]
    forall a b. (a -> b) -> a -> b
    $ [Char] -> [Char]
    takeDirectory [Char]
    wikiname
      let imageExtensions = [[Char]
    ".png", [Char]
    ".jpg", [Char]
    ".gif"]
      let errors = [(Bool, [Char])] -> [[Char]]
    validate
                     [ ([Char] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null ([Char] -> Bool) -> ([Char] -> [Char]) -> [Char] -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Char -> Bool) -> [Char] -> [Char]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Bool -> Bool
    not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Char -> Bool
    isSpace) ([Char] -> Bool) -> [Char] -> Bool
    forall a b. (a -> b) -> a -> b
    $ [Char]
    logMsg,
                        [Char]
    "Description cannot be empty.")
                     , ([Char]
    ".." [Char] -> [[Char]] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [[Char]]
    dirs', [Char]
    "Wikiname cannot contain '..'")
                     , ([Char] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Char]
    origPath, [Char]
    "File not found.")
                     , (Bool
    inStaticDir,  [Char]
    "Destination is inside static directory.")
                     , (Bool
    inTemplatesDir,  [Char]
    "Destination is inside templates directory.")
                     , (Bool -> Bool
    not Bool
    overwrite Bool -> Bool -> Bool
    && Bool
    exists, [Char]
    "A file named '" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    wikiname [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++
                        [Char]
    "' already exists in the repository: choose a new name " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++
                        [Char]
    "or check the box to overwrite the existing file.")
                     , (Bool
    wPF,
                        [Char]
    "This file extension is reserved for wiki pages.")
                     ]
      if null errors
         then do
           expireCachedFile wikiname `mplus` return ()
           fileContents <- liftIO $ B.readFile filePath
           let len = ByteString -> Int64
    B.length ByteString
    fileContents
           liftIO $ save fs wikiname (Author user email) logMsg fileContents
           let contents = Html -> Html
    Html5.div (Html -> Html) -> Html -> Html
    forall a b. (a -> b) -> a -> b
    $ [Html] -> Html
    forall a. Monoid a => [a] -> a
    mconcat
                 [ Html -> Html
    h2 (Html -> Html) -> Html -> Html
    forall a b. (a -> b) -> a -> b
    $ [Char] -> Html
    forall a. IsString a => [Char] -> a
    fromString ([Char]
    "Uploaded " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Int64 -> [Char]
    forall a. Show a => a -> [Char]
    show Int64
    len [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    " bytes")
                 , if [Char] -> [Char]
    takeExtension [Char]
    wikiname [Char] -> [[Char]] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [[Char]]
    imageExtensions
                      then (Html -> Html
    p (Html -> Html) -> Html -> Html
    forall a b. (a -> b) -> a -> b
    $ Html
    "To add this image to a page, use:") Html -> Html -> Html
    forall a. Semigroup a => a -> a -> a
    <>
                           (Html -> Html
    pre (Html -> Html) -> Html -> Html
    forall a b. (a -> b) -> a -> b
    $ [Char] -> Html
    forall a. IsString a => [Char] -> a
    fromString ([Char]
    "![alt text](/" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    wikiname [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    ")"))
                      else (Html -> Html
    p (Html -> Html) -> Html -> Html
    forall a b. (a -> b) -> a -> b
    $ Html
    "To link to this resource from a page, use:") Html -> Html -> Html
    forall a. Semigroup a => a -> a -> a
    <>
                           (Html -> Html
    pre (Html -> Html) -> Html -> Html
    forall a b. (a -> b) -> a -> b
    $ [Char] -> Html
    forall a. IsString a => [Char] -> a
    fromString ([Char]
    "[link label](/" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    wikiname [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    ")")) ]
           formattedPage defaultPageLayout{
                           pgMessages = pMessages params,
                           pgShowPageTools = False,
                           pgTabs = [],
                           pgTitle = "Upload successful"}
                         contents
         else withMessages errors uploadForm

    goToPage :: Handler
    goToPage :: Handler
    goToPage = (Params -> Handler) -> Handler
    forall (m :: * -> *) a r.
    (HasRqData m, FromData a, MonadPlus m, ServerMonad m) =>
    (a -> m r) -> m r
    withData ((Params -> Handler) -> Handler) -> (Params -> Handler) -> Handler
    forall a b. (a -> b) -> a -> b
    $ \(Params
    params :: Params) -> do
      let gotopage :: [Char]
    gotopage = Params -> [Char]
    pGotoPage Params
    params
      fs <- GititServerPart FileStore
    getFileStore
      pruned_files <- liftIO (index fs) >>= filterM isPageFile
      let allPageNames = ([Char] -> [Char]) -> [[Char]] -> [[Char]]
    forall a b. (a -> b) -> [a] -> [b]
    map [Char] -> [Char]
    dropExtension [[Char]]
    pruned_files
      let findPage [Char] -> Bool
    f = ([Char] -> Bool) -> [[Char]] -> Maybe [Char]
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
    find [Char] -> Bool
    f [[Char]]
    allPageNames
      let exactMatch [Char]
    f = [Char]
    gotopage [Char] -> [Char] -> Bool
    forall a. Eq a => a -> a -> Bool
    == [Char]
    f
      let insensitiveMatch [Char]
    f = ((Char -> Char) -> [Char] -> [Char]
    forall a b. (a -> b) -> [a] -> [b]
    map Char -> Char
    toLower [Char]
    gotopage) [Char] -> [Char] -> Bool
    forall a. Eq a => a -> a -> Bool
    == ((Char -> Char) -> [Char] -> [Char]
    forall a b. (a -> b) -> [a] -> [b]
    map Char -> Char
    toLower [Char]
    f)
      let prefixMatch [Char]
    f = ((Char -> Char) -> [Char] -> [Char]
    forall a b. (a -> b) -> [a] -> [b]
    map Char -> Char
    toLower [Char]
    gotopage) [Char] -> [Char] -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isPrefixOf` ((Char -> Char) -> [Char] -> [Char]
    forall a b. (a -> b) -> [a] -> [b]
    map Char -> Char
    toLower [Char]
    f)
      base' <- getWikiBase
      case findPage exactMatch of
           Just [Char]
    m  -> [Char] -> Response -> Handler
    forall (m :: * -> *) uri res.
    (FilterMonad Response m, ToSURI uri) =>
    uri -> res -> m res
    seeOther ([Char]
    base' [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char] -> [Char]
    urlForPage [Char]
    m) (Response -> Handler) -> Response -> Handler
    forall a b. (a -> b) -> a -> b
    $ [Char] -> Response
    forall a. ToMessage a => a -> Response
    toResponse
                         ([Char]
    "Redirecting to exact match" :: String)
           Maybe [Char]
    Nothing -> case ([Char] -> Bool) -> Maybe [Char]
    findPage [Char] -> Bool
    insensitiveMatch of
                           Just [Char]
    m  -> [Char] -> Response -> Handler
    forall (m :: * -> *) uri res.
    (FilterMonad Response m, ToSURI uri) =>
    uri -> res -> m res
    seeOther ([Char]
    base' [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char] -> [Char]
    urlForPage [Char]
    m) (Response -> Handler) -> Response -> Handler
    forall a b. (a -> b) -> a -> b
    $ [Char] -> Response
    forall a. ToMessage a => a -> Response
    toResponse
                                        ([Char]
    "Redirecting to case-insensitive match" :: String)
                           Maybe [Char]
    Nothing -> case ([Char] -> Bool) -> Maybe [Char]
    findPage [Char] -> Bool
    prefixMatch of
                                           Just [Char]
    m  -> [Char] -> Response -> Handler
    forall (m :: * -> *) uri res.
    (FilterMonad Response m, ToSURI uri) =>
    uri -> res -> m res
    seeOther ([Char]
    base' [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char] -> [Char]
    urlForPage [Char]
    m) (Response -> Handler) -> Response -> Handler
    forall a b. (a -> b) -> a -> b
    $
                                                      [Char] -> Response
    forall a. ToMessage a => a -> Response
    toResponse ([Char] -> Response) -> [Char] -> Response
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "Redirecting" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++
                                                        [Char]
    " to partial match"
                                           Maybe [Char]
    Nothing -> Handler
    searchResults

    searchResults :: Handler
    searchResults :: Handler
    searchResults = (Params -> Handler) -> Handler
    forall (m :: * -> *) a r.
    (HasRqData m, FromData a, MonadPlus m, ServerMonad m) =>
    (a -> m r) -> m r
    withData ((Params -> Handler) -> Handler) -> (Params -> Handler) -> Handler
    forall a b. (a -> b) -> a -> b
    $ \(Params
    params :: Params) -> do
      let patterns :: [[Char]]
    patterns = Params -> [[Char]]
    pPatterns Params
    params [[Char]] -> [[Char]] -> [[Char]]
    forall a. [a] -> [a] -> [a]
    `orIfNull` [Params -> [Char]
    pGotoPage Params
    params]
      fs <- GititServerPart FileStore
    getFileStore
      matchLines <- if null patterns
                       then return []
                       else liftIO $ E.catch (search fs SearchQuery{
                                                      queryPatterns = patterns
                                                    , queryWholeWords = True
                                                    , queryMatchAll = True
                                                    , queryIgnoreCase = True })
                                           -- catch error, because newer versions of git
                                           -- return 1 on no match, and filestore <=0.3.3
                                           -- doesn't handle this properly:
                                           (\(FileStoreError
    _ :: FileStoreError)  -> [SearchMatch] -> IO [SearchMatch]
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [])
      let contentMatches = (SearchMatch -> [Char]) -> [SearchMatch] -> [[Char]]
    forall a b. (a -> b) -> [a] -> [b]
    map SearchMatch -> [Char]
    matchResourceName [SearchMatch]
    matchLines
      allPages <- liftIO (index fs) >>= filterM isPageFile
      let slashToSpace = (Char -> Char) -> [Char] -> [Char]
    forall a b. (a -> b) -> [a] -> [b]
    map (\Char
    c -> if Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '/' then Char
    ' ' else Char
    c)
      let inPageName [Char]
    pageName' [Char]
    x = [Char]
    x [Char] -> [[Char]] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` ([Char] -> [[Char]]
    words ([Char] -> [[Char]]) -> [Char] -> [[Char]]
    forall a b. (a -> b) -> a -> b
    $ [Char] -> [Char]
    slashToSpace ([Char] -> [Char]) -> [Char] -> [Char]
    forall a b. (a -> b) -> a -> b
    $ [Char] -> [Char]
    dropExtension [Char]
    pageName')
      let matchesPatterns [Char]
    pageName' = Bool -> Bool
    not ([[Char]] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [[Char]]
    patterns) Bool -> Bool -> Bool
    &&
           ([Char] -> Bool) -> [[Char]] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all ([Char] -> [Char] -> Bool
    inPageName ((Char -> Char) -> [Char] -> [Char]
    forall a b. (a -> b) -> [a] -> [b]
    map Char -> Char
    toLower [Char]
    pageName')) (([Char] -> [Char]) -> [[Char]] -> [[Char]]
    forall a b. (a -> b) -> [a] -> [b]
    map ((Char -> Char) -> [Char] -> [Char]
    forall a b. (a -> b) -> [a] -> [b]
    map Char -> Char
    toLower) [[Char]]
    patterns)
      let pageNameMatches = ([Char] -> Bool) -> [[Char]] -> [[Char]]
    forall a. (a -> Bool) -> [a] -> [a]
    filter [Char] -> Bool
    matchesPatterns [[Char]]
    allPages
      prunedFiles <- filterM isPageFile (contentMatches ++ pageNameMatches)
      let allMatchedFiles = [[Char]] -> [[Char]]
    forall a. Eq a => [a] -> [a]
    nub ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
    forall a b. (a -> b) -> a -> b
    $ [[Char]]
    prunedFiles
      let matchesInFile [Char]
    f =  (SearchMatch -> Maybe [Char]) -> [SearchMatch] -> [[Char]]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe (\SearchMatch
    x -> if SearchMatch -> [Char]
    matchResourceName SearchMatch
    x [Char] -> [Char] -> Bool
    forall a. Eq a => a -> a -> Bool
    == [Char]
    f
                                                then [Char] -> Maybe [Char]
    forall a. a -> Maybe a
    Just (SearchMatch -> [Char]
    matchLine SearchMatch
    x)
                                                else Maybe [Char]
    forall a. Maybe a
    Nothing) [SearchMatch]
    matchLines
      let matches = ([Char] -> ([Char], [[Char]])) -> [[Char]] -> [([Char], [[Char]])]
    forall a b. (a -> b) -> [a] -> [b]
    map (\[Char]
    f -> ([Char]
    f, [Char] -> [[Char]]
    matchesInFile [Char]
    f)) [[Char]]
    allMatchedFiles
      let relevance ([Char]
    f, t a
    ms) = t a -> Int
    forall a. t a -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length t a
    ms Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + if [Char]
    f [Char] -> [[Char]] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [[Char]]
    pageNameMatches
                                             then Int
    100
                                             else Int
    0
      let preamble = if [[Char]] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [[Char]]
    patterns
                        then Html -> Html
    h3 (Html -> Html) -> Html -> Html
    forall a b. (a -> b) -> a -> b
    $ Html
    "Please enter a search term."
                        else Html -> Html
    h3 (Html -> Html) -> Html -> Html
    forall a b. (a -> b) -> a -> b
    $ [Html] -> Html
    forall a. Monoid a => [a] -> a
    mconcat
                                [ [Char] -> Html
    forall a. IsString a => [Char] -> a
    fromString (Int -> [Char]
    forall a. Show a => a -> [Char]
    show ([([Char], [[Char]])] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [([Char], [[Char]])]
    matches) [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    " matches found for ")
                                , Html -> Html
    Html5.span (Html -> Html) -> Attribute -> Html -> Html
    forall h. Attributable h => h -> Attribute -> h
    ! AttributeValue -> Attribute
    Html5.Attr.id AttributeValue
    "pattern" (Html -> Html) -> Html -> Html
    forall a b. (a -> b) -> a -> b
    $ [Char] -> Html
    forall a. IsString a => [Char] -> a
    fromString ([Char] -> Html) -> [Char] -> Html
    forall a b. (a -> b) -> a -> b
    $ [[Char]] -> [Char]
    unwords [[Char]]
    patterns ]
      base' <- getWikiBase
      let toMatchListItem ([Char]
    file, [[Char]]
    contents) = Html -> Html
    li (Html -> Html) -> Html -> Html
    forall a b. (a -> b) -> a -> b
    $ [Html] -> Html
    forall a. Monoid a => [a] -> a
    mconcat
            [ Html -> Html
    a (Html -> Html) -> Attribute -> Html -> Html
    forall h. Attributable h => h -> Attribute -> h
    ! AttributeValue -> Attribute
    href ([Char] -> AttributeValue
    forall a. IsString a => [Char] -> a
    fromString ([Char] -> AttributeValue) -> [Char] -> AttributeValue
    forall a b. (a -> b) -> a -> b
    $ [Char]
    base' [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char] -> [Char]
    urlForPage ([Char] -> [Char]
    dropExtension [Char]
    file)) (Html -> Html) -> Html -> Html
    forall a b. (a -> b) -> a -> b
    $ [Char] -> Html
    forall a. IsString a => [Char] -> a
    fromString ([Char] -> Html) -> [Char] -> Html
    forall a b. (a -> b) -> a -> b
    $ [Char] -> [Char]
    dropExtension [Char]
    file
            , [Char] -> Html
    forall a. IsString a => [Char] -> a
    fromString ([Char]
    " (" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Int -> [Char]
    forall a. Show a => a -> [Char]
    show ([[Char]] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [[Char]]
    contents) [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    " matching lines)")
            , Html
    " "
            , Html -> Html
    a (Html -> Html) -> Attribute -> Html -> Html
    forall h. Attributable h => h -> Attribute -> h
    ! AttributeValue -> Attribute
    href AttributeValue
    "#" (Html -> Html) -> Attribute -> Html -> Html
    forall h. Attributable h => h -> Attribute -> h
    ! AttributeValue -> Attribute
    class_ AttributeValue
    "showmatch" (Html -> Html) -> Attribute -> Html -> Html
    forall h. Attributable h => h -> Attribute -> h
    !
                        AttributeValue -> Attribute
    Html5.Attr.style AttributeValue
    "display: none;" (Html -> Html) -> Html -> Html
    forall a b. (a -> b) -> a -> b
    $ if [[Char]] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [[Char]]
    contents Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    0
                                                         then Html
    "[show matches]"
                                                         else Html
    ""
            , Html -> Html
    pre (Html -> Html) -> Attribute -> Html -> Html
    forall h. Attributable h => h -> Attribute -> h
    ! AttributeValue -> Attribute
    class_ AttributeValue
    "matches" (Html -> Html) -> Html -> Html
    forall a b. (a -> b) -> a -> b
    $ [Char] -> Html
    forall a. IsString a => [Char] -> a
    fromString ([Char] -> Html) -> [Char] -> Html
    forall a b. (a -> b) -> a -> b
    $ [[Char]] -> [Char]
    unlines [[Char]]
    contents]
      let htmlMatches = Html
    preamble Html -> Html -> Html
    forall a. Semigroup a => a -> a -> a
    <>
                        (Html -> Html
    ol (Html -> Html) -> Html -> Html
    forall a b. (a -> b) -> a -> b
    $ (([Char], [[Char]]) -> Html) -> [([Char], [[Char]])] -> Html
    forall m a. Monoid m => (a -> m) -> [a] -> m
    forall (t :: * -> *) m a.
    (Foldable t, Monoid m) =>
    (a -> m) -> t a -> m
    foldMap ([Char], [[Char]]) -> Html
    toMatchListItem
                                 ([([Char], [[Char]])] -> [([Char], [[Char]])]
    forall a. [a] -> [a]
    reverse ([([Char], [[Char]])] -> [([Char], [[Char]])])
    -> [([Char], [[Char]])] -> [([Char], [[Char]])]
    forall a b. (a -> b) -> a -> b
    $ (([Char], [[Char]]) -> ([Char], [[Char]]) -> Ordering)
    -> [([Char], [[Char]])] -> [([Char], [[Char]])]
    forall a. (a -> a -> Ordering) -> [a] -> [a]
    sortBy ((([Char], [[Char]]) -> Int)
    -> ([Char], [[Char]]) -> ([Char], [[Char]]) -> Ordering
    forall a b. Ord a => (b -> a) -> b -> b -> Ordering
    comparing ([Char], [[Char]]) -> Int
    forall {t :: * -> *} {a}. Foldable t => ([Char], t a) -> Int
    relevance) [([Char], [[Char]])]
    matches))
      formattedPage defaultPageLayout{
                      pgMessages = pMessages params,
                      pgShowPageTools = False,
                      pgTabs = [],
                      pgScripts = ["search.js"],
                      pgTitle = "Search results"}
                    htmlMatches

    showPageHistory :: Handler
    showPageHistory :: Handler
    showPageHistory = (Params -> Handler) -> Handler
    forall (m :: * -> *) a r.
    (HasRqData m, FromData a, MonadPlus m, ServerMonad m) =>
    (a -> m r) -> m r
    withData ((Params -> Handler) -> Handler) -> (Params -> Handler) -> Handler
    forall a b. (a -> b) -> a -> b
    $ \(Params
    params :: Params) -> do
      page <- GititServerPart [Char]
    getPage
      cfg <- getConfig
      showHistory (pathForPage page $ defaultExtension cfg) page params

    showFileHistory :: Handler
    showFileHistory :: Handler
    showFileHistory = (Params -> Handler) -> Handler
    forall (m :: * -> *) a r.
    (HasRqData m, FromData a, MonadPlus m, ServerMonad m) =>
    (a -> m r) -> m r
    withData ((Params -> Handler) -> Handler) -> (Params -> Handler) -> Handler
    forall a b. (a -> b) -> a -> b
    $ \(Params
    params :: Params) -> do
      file <- GititServerPart [Char]
    getPage
      showHistory file file params

    intDataAttribute :: Tag -> Int -> Attribute
    intDataAttribute :: Tag -> Int -> Attribute
    intDataAttribute Tag
    tag = Tag -> AttributeValue -> Attribute
    dataAttribute Tag
    tag (AttributeValue -> Attribute)
    -> (Int -> AttributeValue) -> Int -> Attribute
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Char] -> AttributeValue
    forall a. IsString a => [Char] -> a
    fromString ([Char] -> AttributeValue)
    -> (Int -> [Char]) -> Int -> AttributeValue
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> [Char]
    forall a. Show a => a -> [Char]
    show

    showHistory :: String -> String -> Params -> Handler
    showHistory :: [Char] -> [Char] -> Params -> Handler
    showHistory [Char]
    file [Char]
    page Params
    params =  do
      fs <- GititServerPart FileStore
    getFileStore
      hist <- liftIO $ history fs [file] (TimeRange Nothing Nothing)
                (Just $ pLimit params)
      base' <- getWikiBase
      let versionToHtml Revision
    rev Int
    pos = Html -> Html
    li (Html -> Html) -> Attribute -> Html -> Html
    forall h. Attributable h => h -> Attribute -> h
    ! AttributeValue -> Attribute
    class_ AttributeValue
    "difflink" (Html -> Html) -> Attribute -> Html -> Html
    forall h. Attributable h => h -> Attribute -> h
    ! Tag -> Int -> Attribute
    intDataAttribute Tag
    "order" Int
    pos (Html -> Html) -> Attribute -> Html -> Html
    forall h. Attributable h => h -> Attribute -> h
    !
                                        Tag -> AttributeValue -> Attribute
    dataAttribute Tag
    "revision" ([Char] -> AttributeValue
    forall a. IsString a => [Char] -> a
    fromString ([Char] -> AttributeValue) -> [Char] -> AttributeValue
    forall a b. (a -> b) -> a -> b
    $ Revision -> [Char]
    revId Revision
    rev) (Html -> Html) -> Attribute -> Html -> Html
    forall h. Attributable h => h -> Attribute -> h
    !
                                        Tag -> AttributeValue -> Attribute
    dataAttribute Tag
    "diffurl" ([Char] -> AttributeValue
    forall a. IsString a => [Char] -> a
    fromString ([Char] -> AttributeValue) -> [Char] -> AttributeValue
    forall a b. (a -> b) -> a -> b
    $ [Char]
    base' [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "/_diff/" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    page)
            (Html -> Html) -> Html -> Html
    forall a b. (a -> b) -> a -> b
    $ [Html] -> Html
    forall a. Monoid a => [a] -> a
    mconcat
            [ Html -> Html
    span (Html -> Html) -> Attribute -> Html -> Html
    forall h. Attributable h => h -> Attribute -> h
    ! AttributeValue -> Attribute
    class_ AttributeValue
    "date" (Html -> Html) -> Html -> Html
    forall a b. (a -> b) -> a -> b
    $ ([Char] -> Html
    forall a. IsString a => [Char] -> a
    fromString ([Char] -> Html) -> [Char] -> Html
    forall a b. (a -> b) -> a -> b
    $ UTCTime -> [Char]
    forall a. Show a => a -> [Char]
    show (UTCTime -> [Char]) -> UTCTime -> [Char]
    forall a b. (a -> b) -> a -> b
    $ Revision -> UTCTime
    revDateTime Revision
    rev)
            , Html
    " ("
            , Html -> Html
    span (Html -> Html) -> Attribute -> Html -> Html
    forall h. Attributable h => h -> Attribute -> h
    ! AttributeValue -> Attribute
    class_ AttributeValue
    "author" (Html -> Html) -> Html -> Html
    forall a b. (a -> b) -> a -> b
    $ Html -> Html
    a (Html -> Html) -> Attribute -> Html -> Html
    forall h. Attributable h => h -> Attribute -> h
    ! AttributeValue -> Attribute
    href ([Char] -> AttributeValue
    forall a. IsString a => [Char] -> a
    fromString ([Char] -> AttributeValue) -> [Char] -> AttributeValue
    forall a b. (a -> b) -> a -> b
    $ [Char]
    base' [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "/_activity?" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++
                [([Char], [Char])] -> [Char]
    urlEncodeVars [([Char]
    "forUser", Author -> [Char]
    authorName (Author -> [Char]) -> Author -> [Char]
    forall a b. (a -> b) -> a -> b
    $ Revision -> Author
    revAuthor Revision
    rev)]) (Html -> Html) -> Html -> Html
    forall a b. (a -> b) -> a -> b
    $
                  [Char] -> Html
    forall a. IsString a => [Char] -> a
    fromString (Author -> [Char]
    authorName (Author -> [Char]) -> Author -> [Char]
    forall a b. (a -> b) -> a -> b
    $ Revision -> Author
    revAuthor Revision
    rev)
            , Html
    "): "
            , Html -> Html
    a (Html -> Html) -> Attribute -> Html -> Html
    forall h. Attributable h => h -> Attribute -> h
    ! AttributeValue -> Attribute
    href ([Char] -> AttributeValue
    forall a. IsString a => [Char] -> a
    fromString ([Char] -> AttributeValue) -> [Char] -> AttributeValue
    forall a b. (a -> b) -> a -> b
    $ [Char]
    base' [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char] -> [Char]
    urlForPage [Char]
    page [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "?revision=" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Revision -> [Char]
    revId Revision
    rev) (Html -> Html) -> Html -> Html
    forall a b. (a -> b) -> a -> b
    $
               Html -> Html
    span (Html -> Html) -> Attribute -> Html -> Html
    forall h. Attributable h => h -> Attribute -> h
    ! AttributeValue -> Attribute
    class_ AttributeValue
    "subject" (Html -> Html) -> Html -> Html
    forall a b. (a -> b) -> a -> b
    $ [Char] -> Html
    forall a. IsString a => [Char] -> a
    fromString ([Char] -> Html) -> [Char] -> Html
    forall a b. (a -> b) -> a -> b
    $ Revision -> [Char]
    revDescription Revision
    rev
            , Html -> Html
    noscript (Html -> Html) -> Html -> Html
    forall a b. (a -> b) -> a -> b
    $ [Html] -> Html
    forall a. Monoid a => [a] -> a
    mconcat
                ([ Html
    " [compare with "
                 , Html -> Html
    a (Html -> Html) -> Attribute -> Html -> Html
    forall h. Attributable h => h -> Attribute -> h
    ! AttributeValue -> Attribute
    href ([Char] -> AttributeValue
    forall a. IsString a => [Char] -> a
    fromString ([Char] -> AttributeValue) -> [Char] -> AttributeValue
    forall a b. (a -> b) -> a -> b
    $ [Char]
    base' [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "/_diff" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char] -> [Char]
    urlForPage [Char]
    page [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "?to=" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Revision -> [Char]
    revId Revision
    rev) (Html -> Html) -> Html -> Html
    forall a b. (a -> b) -> a -> b
    $
                      Html
    "previous" ] [Html] -> [Html] -> [Html]
    forall a. [a] -> [a] -> [a]
    ++
                 (if Int
    pos Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Int
    1
                      then [ [Char] -> Html
    preEscapedString [Char]
    "&nbsp;"
                           , [Char] -> Html
    preEscapedString [Char]
    "&bull;"
                           , [Char] -> Html
    preEscapedString [Char]
    "&nbsp;"
                           , Html -> Html
    a (Html -> Html) -> Attribute -> Html -> Html
    forall h. Attributable h => h -> Attribute -> h
    ! AttributeValue -> Attribute
    href ([Char] -> AttributeValue
    forall a. IsString a => [Char] -> a
    fromString ([Char] -> AttributeValue) -> [Char] -> AttributeValue
    forall a b. (a -> b) -> a -> b
    $ [Char]
    base' [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "/_diff" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char] -> [Char]
    urlForPage [Char]
    page [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "?from=" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++
                                      Revision -> [Char]
    revId Revision
    rev) (Html -> Html) -> Html -> Html
    forall a b. (a -> b) -> a -> b
    $ Html
    "current"
                           ]
                      else []) [Html] -> [Html] -> [Html]
    forall a. [a] -> [a] -> [a]
    ++
                 [Html
    "]"])
            ]
      let contents = if [Revision] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Revision]
    hist
                        then Html
    forall a. Monoid a => a
    mempty
                        else Html -> Html
    ul (Html -> Html) -> Attribute -> Html -> Html
    forall h. Attributable h => h -> Attribute -> h
    ! AttributeValue -> Attribute
    class_ AttributeValue
    "history" (Html -> Html) -> Html -> Html
    forall a b. (a -> b) -> a -> b
    $ [Html] -> Html
    forall a. Monoid a => [a] -> a
    mconcat ([Html] -> Html) -> [Html] -> Html
    forall a b. (a -> b) -> a -> b
    $
                               (Revision -> Int -> Html) -> [Revision] -> [Int] -> [Html]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith Revision -> Int -> Html
    versionToHtml [Revision]
    hist
                               [[Revision] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Revision]
    hist, ([Revision] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Revision]
    hist Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1)..Int
    1]
      let more = if [Revision] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Revision]
    hist Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Params -> Int
    pLimit Params
    params
                    then Html -> Html
    a (Html -> Html) -> Attribute -> Html -> Html
    forall h. Attributable h => h -> Attribute -> h
    ! AttributeValue -> Attribute
    href ([Char] -> AttributeValue
    forall a. IsString a => [Char] -> a
    fromString ([Char] -> AttributeValue) -> [Char] -> AttributeValue
    forall a b. (a -> b) -> a -> b
    $ [Char]
    base' [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "/_history" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char] -> [Char]
    urlForPage [Char]
    page
                                     [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "?limit=" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Int -> [Char]
    forall a. Show a => a -> [Char]
    show (Params -> Int
    pLimit Params
    params Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    100)) (Html -> Html) -> Html -> Html
    forall a b. (a -> b) -> a -> b
    $
                                     Html
    "Show more..."
                    else Html
    forall a. Monoid a => a
    mempty
      let tabs = if [Char]
    file [Char] -> [Char] -> Bool
    forall a. Eq a => a -> a -> Bool
    == [Char]
    page  -- source file, not wiki page
                    then [Tab
    ViewTab,Tab
    HistoryTab]
                    else PageLayout -> [Tab]
    pgTabs PageLayout
    defaultPageLayout
      formattedPage defaultPageLayout{
                       pgPageName = page,
                       pgMessages = pMessages params,
                       pgScripts = ["dragdiff.js"],
                       pgTabs = tabs,
                       pgSelectedTab = HistoryTab,
                       pgTitle = ("Changes to " ++ page)
                       } $ contents <> more

    showActivity :: Handler
    showActivity :: Handler
    showActivity = (Params -> Handler) -> Handler
    forall (m :: * -> *) a r.
    (HasRqData m, FromData a, MonadPlus m, ServerMonad m) =>
    (a -> m r) -> m r
    withData ((Params -> Handler) -> Handler) -> (Params -> Handler) -> Handler
    forall a b. (a -> b) -> a -> b
    $ \(Params
    params :: Params) -> do
      cfg <- GititServerPart Config
    getConfig
      currTime <- liftIO getCurrentTime
      let defaultDaysAgo = Int -> NominalDiffTime
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Config -> Int
    recentActivityDays Config
    cfg)
      let daysAgo = NominalDiffTime -> UTCTime -> UTCTime
    addUTCTime (NominalDiffTime
    defaultDaysAgo NominalDiffTime -> NominalDiffTime -> NominalDiffTime
    forall a. Num a => a -> a -> a
    * (-NominalDiffTime
    60) NominalDiffTime -> NominalDiffTime -> NominalDiffTime
    forall a. Num a => a -> a -> a
    * NominalDiffTime
    60 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
    forall a. Num a => a -> a -> a
    * NominalDiffTime
    24) UTCTime
    currTime
      let since = case Params -> Maybe UTCTime
    pSince Params
    params of
                       Maybe UTCTime
    Nothing -> UTCTime -> Maybe UTCTime
    forall a. a -> Maybe a
    Just UTCTime
    daysAgo
                       Just UTCTime
    t  -> UTCTime -> Maybe UTCTime
    forall a. a -> Maybe a
    Just UTCTime
    t
      let forUser = Params -> Maybe [Char]
    pForUser Params
    params
      fs <- getFileStore
      hist <- liftIO $ history fs [] (TimeRange since Nothing)
                         (Just $ pLimit params)
      let hist' = case Maybe [Char]
    forUser of
                       Maybe [Char]
    Nothing -> [Revision]
    hist
                       Just [Char]
    u  -> (Revision -> Bool) -> [Revision] -> [Revision]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (\Revision
    r -> Author -> [Char]
    authorName (Revision -> Author
    revAuthor Revision
    r) [Char] -> [Char] -> Bool
    forall a. Eq a => a -> a -> Bool
    == [Char]
    u) [Revision]
    hist
      let fileFromChange (Added [Char]
    f)    = [Char]
    f
          fileFromChange (Modified [Char]
    f) = [Char]
    f
          fileFromChange (Deleted [Char]
    f)  = [Char]
    f
      base' <- getWikiBase
      let fileAnchor [Char]
    revis [Char]
    file = if [Char] -> [Char]
    takeExtension [Char]
    file [Char] -> [Char] -> Bool
    forall a. Eq a => a -> a -> Bool
    == [Char]
    "." [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ (Config -> [Char]
    defaultExtension Config
    cfg)
            then Html -> Html
    a (Html -> Html) -> Attribute -> Html -> Html
    forall h. Attributable h => h -> Attribute -> h
    ! AttributeValue -> Attribute
    href ([Char] -> AttributeValue
    forall a. IsString a => [Char] -> a
    fromString ([Char] -> AttributeValue) -> [Char] -> AttributeValue
    forall a b. (a -> b) -> a -> b
    $ [Char]
    base' [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "/_diff" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char] -> [Char]
    urlForPage ([Char] -> [Char]
    dropExtension [Char]
    file) [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "?to=" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    revis) (Html -> Html) -> Html -> Html
    forall a b. (a -> b) -> a -> b
    $ [Char] -> Html
    forall a. IsString a => [Char] -> a
    fromString ([Char] -> Html) -> [Char] -> Html
    forall a b. (a -> b) -> a -> b
    $ [Char] -> [Char]
    dropExtension [Char]
    file
            else Html -> Html
    a (Html -> Html) -> Attribute -> Html -> Html
    forall h. Attributable h => h -> Attribute -> h
    ! AttributeValue -> Attribute
    href ([Char] -> AttributeValue
    forall a. IsString a => [Char] -> a
    fromString ([Char] -> AttributeValue) -> [Char] -> AttributeValue
    forall a b. (a -> b) -> a -> b
    $ [Char]
    base' [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char] -> [Char]
    urlForPage [Char]
    file [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "?revision=" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    revis) (Html -> Html) -> Html -> Html
    forall a b. (a -> b) -> a -> b
    $ [Char] -> Html
    forall a. IsString a => [Char] -> a
    fromString [Char]
    file
      let filesFor [Change]
    changes [Char]
    revis = Html -> [Html] -> [Html]
    forall a. a -> [a] -> [a]
    intersperse Html
    " " ([Html] -> [Html]) -> [Html] -> [Html]
    forall a b. (a -> b) -> a -> b
    $
            (Change -> Html) -> [Change] -> [Html]
    forall a b. (a -> b) -> [a] -> [b]
    map ([Char] -> [Char] -> Html
    fileAnchor [Char]
    revis ([Char] -> Html) -> (Change -> [Char]) -> Change -> Html
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Change -> [Char]
    fileFromChange) [Change]
    changes
      let heading = Html -> Html
    h1 (Html -> Html) -> Html -> Html
    forall a b. (a -> b) -> a -> b
    $ [Char] -> Html
    forall a. IsString a => [Char] -> a
    fromString ([Char]
    "Recent changes by " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char] -> Maybe [Char] -> [Char]
    forall a. a -> Maybe a -> a
    fromMaybe [Char]
    "all users" Maybe [Char]
    forUser)
      let revToListItem Revision
    rev = Html -> Html
    li (Html -> Html) -> Html -> Html
    forall a b. (a -> b) -> a -> b
    $ [Html] -> Html
    forall a. Monoid a => [a] -> a
    mconcat
            [ Html -> Html
    span (Html -> Html) -> Attribute -> Html -> Html
    forall h. Attributable h => h -> Attribute -> h
    ! AttributeValue -> Attribute
    class_ AttributeValue
    "date" (Html -> Html) -> Html -> Html
    forall a b. (a -> b) -> a -> b
    $ [Char] -> Html
    forall a. IsString a => [Char] -> a
    fromString ([Char] -> Html) -> [Char] -> Html
    forall a b. (a -> b) -> a -> b
    $ (UTCTime -> [Char]
    forall a. Show a => a -> [Char]
    show (UTCTime -> [Char]) -> UTCTime -> [Char]
    forall a b. (a -> b) -> a -> b
    $ Revision -> UTCTime
    revDateTime Revision
    rev)
            , Html
    " ("
            , Html -> Html
    span (Html -> Html) -> Attribute -> Html -> Html
    forall h. Attributable h => h -> Attribute -> h
    ! AttributeValue -> Attribute
    class_ AttributeValue
    "author" (Html -> Html) -> Html -> Html
    forall a b. (a -> b) -> a -> b
    $
                Html -> Html
    a (Html -> Html) -> Attribute -> Html -> Html
    forall h. Attributable h => h -> Attribute -> h
    ! AttributeValue -> Attribute
    href ([Char] -> AttributeValue
    forall a. IsString a => [Char] -> a
    fromString ([Char] -> AttributeValue) -> [Char] -> AttributeValue
    forall a b. (a -> b) -> a -> b
    $ [Char]
    base' [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "/_activity?" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++
                  [([Char], [Char])] -> [Char]
    urlEncodeVars [([Char]
    "forUser", Author -> [Char]
    authorName (Author -> [Char]) -> Author -> [Char]
    forall a b. (a -> b) -> a -> b
    $ Revision -> Author
    revAuthor Revision
    rev)]) (Html -> Html) -> Html -> Html
    forall a b. (a -> b) -> a -> b
    $
                    [Char] -> Html
    forall a. IsString a => [Char] -> a
    fromString (Author -> [Char]
    authorName (Author -> [Char]) -> Author -> [Char]
    forall a b. (a -> b) -> a -> b
    $ Revision -> Author
    revAuthor Revision
    rev)
            , Html
    "): "
            , Html -> Html
    span (Html -> Html) -> Attribute -> Html -> Html
    forall h. Attributable h => h -> Attribute -> h
    ! AttributeValue -> Attribute
    class_ AttributeValue
    "subject" (Html -> Html) -> Html -> Html
    forall a b. (a -> b) -> a -> b
    $ [Char] -> Html
    forall a. IsString a => [Char] -> a
    fromString ([Char] -> Html) -> [Char] -> Html
    forall a b. (a -> b) -> a -> b
    $ Revision -> [Char]
    revDescription Revision
    rev
            , Html
    " ("
            , Html -> Html
    span (Html -> Html) -> Attribute -> Html -> Html
    forall h. Attributable h => h -> Attribute -> h
    ! AttributeValue -> Attribute
    class_ AttributeValue
    "files" (Html -> Html) -> Html -> Html
    forall a b. (a -> b) -> a -> b
    $ [Html] -> Html
    forall a. Monoid a => [a] -> a
    mconcat ([Html] -> Html) -> [Html] -> Html
    forall a b. (a -> b) -> a -> b
    $ [Change] -> [Char] -> [Html]
    filesFor (Revision -> [Change]
    revChanges Revision
    rev) (Revision -> [Char]
    revId Revision
    rev)
            , Html
    ")"
            ]
      let contents = Html -> Html
    ul (Html -> Html) -> Attribute -> Html -> Html
    forall h. Attributable h => h -> Attribute -> h
    ! AttributeValue -> Attribute
    class_ AttributeValue
    "history" (Html -> Html) -> Html -> Html
    forall a b. (a -> b) -> a -> b
    $ (Revision -> Html) -> [Revision] -> Html
    forall m a. Monoid m => (a -> m) -> [a] -> m
    forall (t :: * -> *) m a.
    (Foldable t, Monoid m) =>
    (a -> m) -> t a -> m
    foldMap Revision -> Html
    revToListItem [Revision]
    hist'
      formattedPage defaultPageLayout{
                      pgMessages = pMessages params,
                      pgShowPageTools = False,
                      pgTabs = [],
                      pgTitle = "Recent changes"
                      } (heading <> contents)

    showPageDiff :: Handler
    showPageDiff :: Handler
    showPageDiff = (Params -> Handler) -> Handler
    forall (m :: * -> *) a r.
    (HasRqData m, FromData a, MonadPlus m, ServerMonad m) =>
    (a -> m r) -> m r
    withData ((Params -> Handler) -> Handler) -> (Params -> Handler) -> Handler
    forall a b. (a -> b) -> a -> b
    $ \(Params
    params :: Params) -> do
      page <- GititServerPart [Char]
    getPage
      cfg <- getConfig
      showDiff (pathForPage page $ defaultExtension cfg) page params

    showFileDiff :: Handler
    showFileDiff :: Handler
    showFileDiff = (Params -> Handler) -> Handler
    forall (m :: * -> *) a r.
    (HasRqData m, FromData a, MonadPlus m, ServerMonad m) =>
    (a -> m r) -> m r
    withData ((Params -> Handler) -> Handler) -> (Params -> Handler) -> Handler
    forall a b. (a -> b) -> a -> b
    $ \(Params
    params :: Params) -> do
      page <- GititServerPart [Char]
    getPage
      showDiff page page params

    showDiff :: String -> String -> Params -> Handler
    showDiff :: [Char] -> [Char] -> Params -> Handler
    showDiff [Char]
    file [Char]
    page Params
    params = do
      let from :: Maybe [Char]
    from = Params -> Maybe [Char]
    pFrom Params
    params
      let to :: Maybe [Char]
    to = Params -> Maybe [Char]
    pTo Params
    params
      -- 'to' or 'from' must be given
      Bool
    -> ServerPartT (ReaderT WikiState IO) ()
    -> ServerPartT (ReaderT WikiState IO) ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Maybe [Char]
    from Maybe [Char] -> Maybe [Char] -> Bool
    forall a. Eq a => a -> a -> Bool
    == Maybe [Char]
    forall a. Maybe a
    Nothing Bool -> Bool -> Bool
    && Maybe [Char]
    to Maybe [Char] -> Maybe [Char] -> Bool
    forall a. Eq a => a -> a -> Bool
    == Maybe [Char]
    forall a. Maybe a
    Nothing) ServerPartT (ReaderT WikiState IO) ()
    forall a. ServerPartT (ReaderT WikiState IO) a
    forall (m :: * -> *) a. MonadPlus m => m a
    mzero
      fs <- GititServerPart FileStore
    getFileStore
      -- if 'to' is not specified, defaults to current revision
      -- if 'from' is not specified, defaults to revision immediately before 'to'
      from' <- case (from, to) of
                  (Just [Char]
    _, Maybe [Char]
    _)        -> Maybe [Char] -> ServerPartT (ReaderT WikiState IO) (Maybe [Char])
    forall a. a -> ServerPartT (ReaderT WikiState IO) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe [Char]
    from
                  (Maybe [Char]
    Nothing, Maybe [Char]
    Nothing) -> Maybe [Char] -> ServerPartT (ReaderT WikiState IO) (Maybe [Char])
    forall a. a -> ServerPartT (ReaderT WikiState IO) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe [Char]
    from
                  (Maybe [Char]
    Nothing, Just [Char]
    t)  -> do
                    pageHist <- IO [Revision] -> ServerPartT (ReaderT WikiState IO) [Revision]
    forall a. IO a -> ServerPartT (ReaderT WikiState IO) a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO [Revision] -> ServerPartT (ReaderT WikiState IO) [Revision])
    -> IO [Revision] -> ServerPartT (ReaderT WikiState IO) [Revision]
    forall a b. (a -> b) -> a -> b
    $ FileStore -> [[Char]] -> TimeRange -> Maybe Int -> IO [Revision]
    history FileStore
    fs [[Char]
    file]
                                         (Maybe UTCTime -> Maybe UTCTime -> TimeRange
    TimeRange Maybe UTCTime
    forall a. Maybe a
    Nothing Maybe UTCTime
    forall a. Maybe a
    Nothing)
                                         Maybe Int
    forall a. Maybe a
    Nothing
                    let (_, upto) = break (\Revision
    r -> FileStore -> [Char] -> [Char] -> Bool
    idsMatch FileStore
    fs (Revision -> [Char]
    revId Revision
    r) [Char]
    t)
                                      pageHist
                    return $ if length upto >= 2
                                -- immediately preceding revision
                                then Just $ revId $ upto !! 1
                                else Nothing
      result' <- liftIO $ E.try $ getDiff fs file from' to
      case result' of
           Left FileStoreError
    NotFound  -> Handler
    forall a. ServerPartT (ReaderT WikiState IO) a
    forall (m :: * -> *) a. MonadPlus m => m a
    mzero
           Left FileStoreError
    e         -> IO Response -> Handler
    forall a. IO a -> ServerPartT (ReaderT WikiState IO) a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO Response -> Handler) -> IO Response -> Handler
    forall a b. (a -> b) -> a -> b
    $ FileStoreError -> IO Response
    forall e a. (HasCallStack, Exception e) => e -> IO a
    E.throwIO FileStoreError
    e
           Right Html
    htmlDiff -> PageLayout -> Html -> Handler
    formattedPage PageLayout
    defaultPageLayout{
                                              pgPageName = page,
                                              pgRevision = from' `mplus` to,
                                              pgMessages = pMessages params,
                                              pgTabs = DiffTab :
                                                       pgTabs defaultPageLayout,
                                              pgSelectedTab = DiffTab,
                                              pgTitle = page
                                              }
                                           Html
    htmlDiff

    getDiff :: FileStore -> FilePath -> Maybe RevisionId -> Maybe RevisionId
            -> IO Html
    getDiff :: FileStore -> [Char] -> Maybe [Char] -> Maybe [Char] -> IO Html
    getDiff FileStore
    fs [Char]
    file Maybe [Char]
    from Maybe [Char]
    to = do
      rawDiff <- FileStore
    -> [Char] -> Maybe [Char] -> Maybe [Char] -> IO [Diff [[Char]]]
    diff FileStore
    fs [Char]
    file Maybe [Char]
    from Maybe [Char]
    to
      let diffLineToHtml (Both [[Char]]
    xs [[Char]]
    _) = Html -> Html
    span (Html -> Html) -> Html -> Html
    forall a b. (a -> b) -> a -> b
    $ [Char] -> Html
    forall a. IsString a => [Char] -> a
    fromString ([Char] -> Html) -> [Char] -> Html
    forall a b. (a -> b) -> a -> b
    $ [[Char]] -> [Char]
    unlines [[Char]]
    xs
          diffLineToHtml (First [[Char]]
    xs) = Html -> Html
    span (Html -> Html) -> Attribute -> Html -> Html
    forall h. Attributable h => h -> Attribute -> h
    ! AttributeValue -> Attribute
    class_ AttributeValue
    "deleted" (Html -> Html) -> Html -> Html
    forall a b. (a -> b) -> a -> b
    $ [Char] -> Html
    forall a. IsString a => [Char] -> a
    fromString ([Char] -> Html) -> [Char] -> Html
    forall a b. (a -> b) -> a -> b
    $ [[Char]] -> [Char]
    unlines [[Char]]
    xs
          diffLineToHtml (Second [[Char]]
    xs) = Html -> Html
    span (Html -> Html) -> Attribute -> Html -> Html
    forall h. Attributable h => h -> Attribute -> h
    ! AttributeValue -> Attribute
    class_ AttributeValue
    "added"  (Html -> Html) -> Html -> Html
    forall a b. (a -> b) -> a -> b
    $ [Char] -> Html
    forall a. IsString a => [Char] -> a
    fromString ([Char] -> Html) -> [Char] -> Html
    forall a b. (a -> b) -> a -> b
    $ [[Char]] -> [Char]
    unlines [[Char]]
    xs
      return $ h2 ! class_ "revision" $
                (fromString $ "Changes from " ++ fromMaybe "beginning" from ++
                  " to " ++ fromMaybe "current" to) <>
               (pre ! class_ "diff" $ foldMap diffLineToHtml rawDiff)

    editPage :: Handler
    editPage :: Handler
    editPage = (Params -> Handler) -> Handler
    forall (m :: * -> *) a r.
    (HasRqData m, FromData a, MonadPlus m, ServerMonad m) =>
    (a -> m r) -> m r
    withData Params -> Handler
    editPage'

    gui :: AttributeValue -> Html -> Html
    gui :: AttributeValue -> Html -> Html
    gui AttributeValue
    act = Html -> Html
    Html5.form (Html -> Html) -> Attribute -> Html -> Html
    forall h. Attributable h => h -> Attribute -> h
    ! AttributeValue -> Attribute
    action AttributeValue
    act (Html -> Html) -> Attribute -> Html -> Html
    forall h. Attributable h => h -> Attribute -> h
    ! AttributeValue -> Attribute
    Html5.Attr.method AttributeValue
    "post"

    editPage' :: Params -> Handler
    editPage' :: Params -> Handler
    editPage' Params
    params = do
      let rev :: Maybe [Char]
    rev = Params -> Maybe [Char]
    pRevision Params
    params  -- if this is set, we're doing a revert
      fs <- GititServerPart FileStore
    getFileStore
      page <- getPage
      cfg <- getConfig
      let getRevisionAndText = IO (Maybe [Char], [Char])
    -> (FileStoreError -> IO (Maybe [Char], [Char]))
    -> IO (Maybe [Char], [Char])
    forall e a. Exception e => IO a -> (e -> IO a) -> IO a
    E.catch
            (do c <- IO [Char] -> IO [Char]
    forall a. IO a -> IO a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO [Char] -> IO [Char]) -> IO [Char] -> IO [Char]
    forall a b. (a -> b) -> a -> b
    $ FileStore -> forall a. Contents a => [Char] -> Maybe [Char] -> IO a
    retrieve FileStore
    fs ([Char] -> [Char] -> [Char]
    pathForPage [Char]
    page ([Char] -> [Char]) -> [Char] -> [Char]
    forall a b. (a -> b) -> a -> b
    $ Config -> [Char]
    defaultExtension Config
    cfg) Maybe [Char]
    rev
                -- even if pRevision is set, we return revId of latest
                -- saved version (because we're doing a revert and
                -- we don't want gitit to merge the changes with the
                -- latest version)
                r <- liftIO $ latest fs (pathForPage page $ defaultExtension cfg) >>= revision fs
                return (Just $ revId r, c))
            (\FileStoreError
    e -> if FileStoreError
    e FileStoreError -> FileStoreError -> Bool
    forall a. Eq a => a -> a -> Bool
    == FileStoreError
    NotFound
                      then (Maybe [Char], [Char]) -> IO (Maybe [Char], [Char])
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe [Char]
    forall a. Maybe a
    Nothing, [Char]
    "")
                      else FileStoreError -> IO (Maybe [Char], [Char])
    forall e a. (HasCallStack, Exception e) => e -> IO a
    E.throwIO FileStoreError
    e)
      (mbRev, raw) <- case pEditedText params of
                             Maybe [Char]
    Nothing -> IO (Maybe [Char], [Char])
    -> ServerPartT (ReaderT WikiState IO) (Maybe [Char], [Char])
    forall a. IO a -> ServerPartT (ReaderT WikiState IO) a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO IO (Maybe [Char], [Char])
    getRevisionAndText
                             Just [Char]
    t  -> let r :: Maybe [Char]
    r = if [Char] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null (Params -> [Char]
    pSHA1 Params
    params)
                                                   then Maybe [Char]
    forall a. Maybe a
    Nothing
                                                   else [Char] -> Maybe [Char]
    forall a. a -> Maybe a
    Just (Params -> [Char]
    pSHA1 Params
    params)
                                        in (Maybe [Char], [Char])
    -> ServerPartT (ReaderT WikiState IO) (Maybe [Char], [Char])
    forall a. a -> ServerPartT (ReaderT WikiState IO) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe [Char]
    r, [Char]
    t)
      let messages = Params -> [[Char]]
    pMessages Params
    params
      let logMsg = Params -> [Char]
    pLogMsg Params
    params
      let sha1Box = case Maybe [Char]
    mbRev of
                     Just [Char]
    r  -> AttributeValue -> AttributeValue -> Html
    textfieldInput AttributeValue
    "sha1" ([Char] -> AttributeValue
    forall a. IsString a => [Char] -> a
    fromString [Char]
    r) Html -> Attribute -> Html
    forall h. Attributable h => h -> Attribute -> h
    ! AttributeValue -> Attribute
    Html5.Attr.style AttributeValue
    "display: none"
                     Maybe [Char]
    Nothing -> Html
    forall a. Monoid a => a
    mempty
      let readonly' = if Maybe [Char] -> Bool
    forall a. Maybe a -> Bool
    isJust (Params -> Maybe [Char]
    pRevision Params
    params)
                        -- disable editing of text box if it's a revert
                        then (AttributeValue -> Attribute
    Html5.Attr.readonly AttributeValue
    "readonly")
                              Attribute -> Attribute -> Attribute
    forall a. Semigroup a => a -> a -> a
    <> AttributeValue -> Attribute
    Html5.Attr.style AttributeValue
    "color: gray"
                        else Attribute
    forall a. Monoid a => a
    mempty
      base' <- getWikiBase
      let editForm = AttributeValue -> Html -> Html
    gui ([Char] -> AttributeValue
    forall a. IsString a => [Char] -> a
    fromString ([Char] -> AttributeValue) -> [Char] -> AttributeValue
    forall a b. (a -> b) -> a -> b
    $ [Char]
    base' [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char] -> [Char]
    urlForPage [Char]
    page) (Html -> Html) -> Attribute -> Html -> Html
    forall h. Attributable h => h -> Attribute -> h
    ! AttributeValue -> Attribute
    Html5.Attr.id AttributeValue
    "editform"
                       (Html -> Html) -> Html -> Html
    forall a b. (a -> b) -> a -> b
    $ [Html] -> Html
    forall a. Monoid a => [a] -> a
    mconcat
                       [ Html
    sha1Box
                       , Html -> Html
    textarea (Html -> Html) -> Attribute -> Html -> Html
    forall h. Attributable h => h -> Attribute -> h
    ! Attribute
    readonly' (Html -> Html) -> Attribute -> Html -> Html
    forall h. Attributable h => h -> Attribute -> h
    ! AttributeValue -> Attribute
    cols AttributeValue
    "80" (Html -> Html) -> Attribute -> Html -> Html
    forall h. Attributable h => h -> Attribute -> h
    ! AttributeValue -> Attribute
    name AttributeValue
    "editedText" (Html -> Html) -> Attribute -> Html -> Html
    forall h. Attributable h => h -> Attribute -> h
    !
                                      AttributeValue -> Attribute
    Html5.Attr.id AttributeValue
    "editedText" (Html -> Html) -> Html -> Html
    forall a b. (a -> b) -> a -> b
    $ [Char] -> Html
    forall a. IsString a => [Char] -> a
    fromString [Char]
    raw
                       , Html
    br
                       , Html -> Html
    Html5.label (Html -> Html) -> Attribute -> Html -> Html
    forall h. Attributable h => h -> Attribute -> h
    ! AttributeValue -> Attribute
    for AttributeValue
    "logMsg" (Html -> Html) -> Html -> Html
    forall a b. (a -> b) -> a -> b
    $ Html
    "Description of changes:"
                       , Html
    br
                       , AttributeValue -> AttributeValue -> Html
    textfieldInput AttributeValue
    "logMsg"  ([Char] -> AttributeValue
    forall a. IsString a => [Char] -> a
    fromString ([Char] -> AttributeValue) -> [Char] -> AttributeValue
    forall a b. (a -> b) -> a -> b
    $ [Char]
    logMsg [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    `orIfNull` Config -> [Char]
    defaultSummary Config
    cfg) Html -> Attribute -> Html
    forall h. Attributable h => h -> Attribute -> h
    ! Attribute
    readonly'
                       , AttributeValue -> AttributeValue -> Html
    submitInput AttributeValue
    "update" AttributeValue
    "Save"
                       , [Char] -> Html
    preEscapedString [Char]
    "&nbsp;"
                       , AttributeValue -> AttributeValue -> Html
    submitInput AttributeValue
    "cancel" AttributeValue
    "Discard"
                       , [Char] -> Html
    preEscapedString [Char]
    "&nbsp;"
                       , Html
    input Html -> Attribute -> Html
    forall h. Attributable h => h -> Attribute -> h
    ! AttributeValue -> Attribute
    type_ AttributeValue
    "button" Html -> Attribute -> Html
    forall h. Attributable h => h -> Attribute -> h
    ! AttributeValue -> Attribute
    class_ AttributeValue
    "editButton"
                               Html -> Attribute -> Html
    forall h. Attributable h => h -> Attribute -> h
    ! AttributeValue -> Attribute
    Html5.Attr.id AttributeValue
    "previewButton"
                               Html -> Attribute -> Html
    forall h. Attributable h => h -> Attribute -> h
    ! AttributeValue -> Attribute
    onclick AttributeValue
    "updatePreviewPane();"
                               Html -> Attribute -> Html
    forall h. Attributable h => h -> Attribute -> h
    ! AttributeValue -> Attribute
    Html5.Attr.style AttributeValue
    "display: none;"
                               Html -> Attribute -> Html
    forall h. Attributable h => h -> Attribute -> h
    ! AttributeValue -> Attribute
    value AttributeValue
    "Preview"
                       , Html -> Html
    Html5.div (Html -> Html) -> Attribute -> Html -> Html
    forall h. Attributable h => h -> Attribute -> h
    ! AttributeValue -> Attribute
    Html5.Attr.id AttributeValue
    "previewpane" (Html -> Html) -> Html -> Html
    forall a b. (a -> b) -> a -> b
    $ Html
    forall a. Monoid a => a
    mempty
                       ]
      let pgScripts' = [[Char]
    "preview.js"]
      let pgScripts'' = case Config -> MathMethod
    mathMethod Config
    cfg of
           MathJax [Char]
    url  -> [Char]
    url [Char] -> [[Char]] -> [[Char]]
    forall a. a -> [a] -> [a]
    : [[Char]]
    pgScripts'
           MathMethod
    _            -> [[Char]]
    pgScripts'
      formattedPage defaultPageLayout{
                      pgPageName = page,
                      pgMessages = messages,
                      pgRevision = rev,
                      pgShowPageTools = False,
                      pgShowSiteNav = False,
                      pgMarkupHelp = Just $ markupHelp cfg,
                      pgSelectedTab = EditTab,
                      pgScripts = pgScripts'',
                      pgTitle = ("Editing " ++ page)
                      } editForm

    confirmDelete :: Handler
    confirmDelete :: Handler
    confirmDelete = do
      page <- GititServerPart [Char]
    getPage
      fs <- getFileStore
      cfg <- getConfig
      -- determine whether there is a corresponding page, and if not whether there
      -- is a corresponding file
      pageTest <- liftIO $ E.try $ latest fs (pathForPage page $ defaultExtension cfg)
      fileToDelete <- case pageTest of
                           Right [Char]
    _        -> [Char] -> GititServerPart [Char]
    forall a. a -> ServerPartT (ReaderT WikiState IO) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([Char] -> GititServerPart [Char])
    -> [Char] -> GititServerPart [Char]
    forall a b. (a -> b) -> a -> b
    $ [Char] -> [Char] -> [Char]
    pathForPage [Char]
    page ([Char] -> [Char]) -> [Char] -> [Char]
    forall a b. (a -> b) -> a -> b
    $ Config -> [Char]
    defaultExtension Config
    cfg -- a page
                           Left  FileStoreError
    NotFound -> do
                             fileTest <- IO (Either FileStoreError [Char])
    -> ServerPartT
         (ReaderT WikiState IO) (Either FileStoreError [Char])
    forall a. IO a -> ServerPartT (ReaderT WikiState IO) a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO (Either FileStoreError [Char])
     -> ServerPartT
          (ReaderT WikiState IO) (Either FileStoreError [Char]))
    -> IO (Either FileStoreError [Char])
    -> ServerPartT
         (ReaderT WikiState IO) (Either FileStoreError [Char])
    forall a b. (a -> b) -> a -> b
    $ IO [Char] -> IO (Either FileStoreError [Char])
    forall e a. Exception e => IO a -> IO (Either e a)
    E.try (IO [Char] -> IO (Either FileStoreError [Char]))
    -> IO [Char] -> IO (Either FileStoreError [Char])
    forall a b. (a -> b) -> a -> b
    $ FileStore -> [Char] -> IO [Char]
    latest FileStore
    fs [Char]
    page
                             case fileTest of
                                  Right [Char]
    _       -> [Char] -> GititServerPart [Char]
    forall a. a -> ServerPartT (ReaderT WikiState IO) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [Char]
    page  -- a source file
                                  Left FileStoreError
    NotFound -> [Char] -> GititServerPart [Char]
    forall a. a -> ServerPartT (ReaderT WikiState IO) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [Char]
    ""
                                  Left FileStoreError
    e        -> [Char] -> GititServerPart [Char]
    forall a. [Char] -> ServerPartT (ReaderT WikiState IO) a
    forall (m :: * -> *) a. MonadFail m => [Char] -> m a
    fail (FileStoreError -> [Char]
    forall a. Show a => a -> [Char]
    show FileStoreError
    e)
                           Left FileStoreError
    e        -> [Char] -> GititServerPart [Char]
    forall a. [Char] -> ServerPartT (ReaderT WikiState IO) a
    forall (m :: * -> *) a. MonadFail m => [Char] -> m a
    fail (FileStoreError -> [Char]
    forall a. Show a => a -> [Char]
    show FileStoreError
    e)
      let confirmForm = AttributeValue -> Html -> Html
    gui AttributeValue
    "" (Html -> Html) -> Html -> Html
    forall a b. (a -> b) -> a -> b
    $ [Html] -> Html
    forall a. Monoid a => [a] -> a
    mconcat
            [ Html -> Html
    p (Html -> Html) -> Html -> Html
    forall a b. (a -> b) -> a -> b
    $ Html
    "Are you sure you want to delete this page?"
            , Html
    input Html -> Attribute -> Html
    forall h. Attributable h => h -> Attribute -> h
    ! AttributeValue -> Attribute
    type_ AttributeValue
    "text" Html -> Attribute -> Html
    forall h. Attributable h => h -> Attribute -> h
    ! AttributeValue -> Attribute
    name AttributeValue
    "filetodelete"
                    Html -> Attribute -> Html
    forall h. Attributable h => h -> Attribute -> h
    ! AttributeValue -> Attribute
    Html5.Attr.style AttributeValue
    "display: none;" Html -> Attribute -> Html
    forall h. Attributable h => h -> Attribute -> h
    ! AttributeValue -> Attribute
    value ([Char] -> AttributeValue
    forall a. IsString a => [Char] -> a
    fromString [Char]
    fileToDelete)
            , AttributeValue -> AttributeValue -> Html
    submitInput AttributeValue
    "confirm" AttributeValue
    "Yes, delete it!"
            , Html
    " "
            , AttributeValue -> AttributeValue -> Html
    submitInput AttributeValue
    "cancel" AttributeValue
    "No, keep it!"
            , Html
    br ]
      formattedPage defaultPageLayout{ pgTitle = "Delete " ++ page ++ "?" } $
        if null fileToDelete
           then ul ! class_ "messages" $ li $
                "There is no file or page by that name."
           else confirmForm

    deletePage :: Handler
    deletePage :: Handler
    deletePage = (Params -> Handler) -> Handler
    forall (m :: * -> *) a r.
    (HasRqData m, FromData a, MonadPlus m, ServerMonad m) =>
    (a -> m r) -> m r
    withData ((Params -> Handler) -> Handler) -> (Params -> Handler) -> Handler
    forall a b. (a -> b) -> a -> b
    $ \(Params
    params :: Params) -> do
      page <- GititServerPart [Char]
    getPage
      cfg <- getConfig
      let file = Params -> [Char]
    pFileToDelete Params
    params
      mbUser <- getLoggedInUser
      (user, email) <- case mbUser of
                            Maybe User
    Nothing -> ([Char], [Char])
    -> ServerPartT (ReaderT WikiState IO) ([Char], [Char])
    forall a. a -> ServerPartT (ReaderT WikiState IO) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([Char]
    "Anonymous", [Char]
    "")
                            Just User
    u  -> ([Char], [Char])
    -> ServerPartT (ReaderT WikiState IO) ([Char], [Char])
    forall a. a -> ServerPartT (ReaderT WikiState IO) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (User -> [Char]
    uUsername User
    u, User -> [Char]
    uEmail User
    u)
      let author = [Char] -> [Char] -> Author
    Author [Char]
    user [Char]
    email
      let descrip = Config -> [Char]
    deleteSummary Config
    cfg
      base' <- getWikiBase
      if pConfirm params && (file == page || file == page <.> (defaultExtension cfg))
         then do
           fs <- getFileStore
           liftIO $ Data.FileStore.delete fs file author descrip
           seeOther (base' ++ "/") $ toResponse $ p $ "File deleted"
         else seeOther (base' ++ urlForPage page) $ toResponse $ p $ "Not deleted"

    updatePage :: Handler
    updatePage :: Handler
    updatePage = (Params -> Handler) -> Handler
    forall (m :: * -> *) a r.
    (HasRqData m, FromData a, MonadPlus m, ServerMonad m) =>
    (a -> m r) -> m r
    withData ((Params -> Handler) -> Handler) -> (Params -> Handler) -> Handler
    forall a b. (a -> b) -> a -> b
    $ \(Params
    params :: Params) -> do
      page <- GititServerPart [Char]
    getPage
      cfg <- getConfig
      mbUser <- getLoggedInUser
      (user, email) <- case mbUser of
                            Maybe User
    Nothing -> ([Char], [Char])
    -> ServerPartT (ReaderT WikiState IO) ([Char], [Char])
    forall a. a -> ServerPartT (ReaderT WikiState IO) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([Char]
    "Anonymous", [Char]
    "")
                            Just User
    u  -> ([Char], [Char])
    -> ServerPartT (ReaderT WikiState IO) ([Char], [Char])
    forall a. a -> ServerPartT (ReaderT WikiState IO) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (User -> [Char]
    uUsername User
    u, User -> [Char]
    uEmail User
    u)
      editedText <- case pEditedText params of
                         Maybe [Char]
    Nothing -> [Char] -> GititServerPart [Char]
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "No body text in POST request"
                         Just [Char]
    b  -> [Char] -> GititServerPart [Char]
    applyPreCommitPlugins [Char]
    b
      let logMsg = Params -> [Char]
    pLogMsg Params
    params [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    `orIfNull` Config -> [Char]
    defaultSummary Config
    cfg
      let oldSHA1 = Params -> [Char]
    pSHA1 Params
    params
      fs <- getFileStore
      base' <- getWikiBase
      if null . filter (not . isSpace) $ logMsg
         then withMessages ["Description cannot be empty."] editPage
         else do
           when (length editedText > fromIntegral (maxPageSize cfg)) $
              error "Page exceeds maximum size."
           -- check SHA1 in case page has been modified, merge
           modifyRes <- if null oldSHA1
                           then liftIO $ create fs (pathForPage page $ defaultExtension cfg)
                                           (Author user email) logMsg editedText >>
                                         return (Right ())
                           else do
                             expireCachedFile (pathForPage page $ defaultExtension cfg) `mplus` return ()
                             liftIO $ E.catch (modify fs (pathForPage page $ defaultExtension cfg)
                                                oldSHA1 (Author user email) logMsg
                                                editedText)
                                         (\FileStoreError
    e -> if FileStoreError
    e FileStoreError -> FileStoreError -> Bool
    forall a. Eq a => a -> a -> Bool
    == FileStoreError
    Unchanged
                                                   then Either MergeInfo () -> IO (Either MergeInfo ())
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (() -> Either MergeInfo ()
    forall a b. b -> Either a b
    Right ())
                                                   else FileStoreError -> IO (Either MergeInfo ())
    forall e a. (HasCallStack, Exception e) => e -> IO a
    E.throwIO FileStoreError
    e)
           case modifyRes of
                Right () -> [Char] -> Response -> Handler
    forall (m :: * -> *) uri res.
    (FilterMonad Response m, ToSURI uri) =>
    uri -> res -> m res
    seeOther ([Char]
    base' [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char] -> [Char]
    urlForPage [Char]
    page) (Response -> Handler) -> Response -> Handler
    forall a b. (a -> b) -> a -> b
    $ Html -> Response
    forall a. ToMessage a => a -> Response
    toResponse (Html -> Response) -> Html -> Response
    forall a b. (a -> b) -> a -> b
    $ Html -> Html
    p (Html -> Html) -> Html -> Html
    forall a b. (a -> b) -> a -> b
    $ Html
    "Page updated"
                Left (MergeInfo Revision
    mergedWithRev Bool
    conflicts [Char]
    mergedText) -> do
                   let mergeMsg :: [Char]
    mergeMsg = [Char]
    "The page has been edited since you checked it out. " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++
                          [Char]
    "Changes from revision " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Revision -> [Char]
    revId Revision
    mergedWithRev [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++
                          [Char]
    " have been merged into your edits below. " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++
                          if Bool
    conflicts
                             then [Char]
    "Please resolve conflicts and Save."
                             else [Char]
    "Please review and Save."
                   Params -> Handler
    editPage' (Params -> Handler) -> Params -> Handler
    forall a b. (a -> b) -> a -> b
    $
                     Params
    params{ pEditedText = Just mergedText,
                             pSHA1       = revId mergedWithRev,
                             pMessages   = [mergeMsg] }

    indexPage :: Handler
    indexPage :: Handler
    indexPage = do
      path' <- GititServerPart [Char]
    forall (m :: * -> *). ServerMonad m => m [Char]
    getPath
      base' <- getWikiBase
      cfg <- getConfig
      let ext = Config -> [Char]
    defaultExtension Config
    cfg
      let prefix' = if [Char] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Char]
    path' then [Char]
    "" else [Char]
    path' [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "/"
      fs <- getFileStore
      listing <- liftIO $ directory fs prefix'
      let isNotDiscussionPage (FSFile [Char]
    f) = [Char] -> ServerPartT (ReaderT WikiState IO) Bool
    isNotDiscussPageFile [Char]
    f
          isNotDiscussionPage (FSDirectory [Char]
    _) = Bool -> ServerPartT (ReaderT WikiState IO) Bool
    forall a. a -> ServerPartT (ReaderT WikiState IO) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    True
      prunedListing <- filterM isNotDiscussionPage listing
      let htmlIndex = [Char] -> [Char] -> [Char] -> [Resource] -> Html
    fileListToHtml [Char]
    base' [Char]
    prefix' [Char]
    ext [Resource]
    prunedListing
      formattedPage defaultPageLayout{
                      pgPageName = prefix',
                      pgShowPageTools = False,
                      pgTabs = [],
                      pgScripts = [],
                      pgTitle = "Contents"} htmlIndex

    fileListToHtml :: String -> String -> String -> [Resource] -> Html
    fileListToHtml :: [Char] -> [Char] -> [Char] -> [Resource] -> Html
    fileListToHtml [Char]
    base' [Char]
    prefix [Char]
    ext [Resource]
    files =
      let fileLink :: Resource -> Html
    fileLink (FSFile [Char]
    f) | [Char] -> [Char]
    takeExtension [Char]
    f [Char] -> [Char] -> Bool
    forall a. Eq a => a -> a -> Bool
    == [Char]
    "." [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    ext =
            Html -> Html
    li (Html -> Html) -> Attribute -> Html -> Html
    forall h. Attributable h => h -> Attribute -> h
    ! AttributeValue -> Attribute
    class_ AttributeValue
    "page" (Html -> Html) -> Html -> Html
    forall a b. (a -> b) -> a -> b
    $
              Html -> Html
    a (Html -> Html) -> Attribute -> Html -> Html
    forall h. Attributable h => h -> Attribute -> h
    ! AttributeValue -> Attribute
    href ([Char] -> AttributeValue
    forall a. IsString a => [Char] -> a
    fromString ([Char] -> AttributeValue) -> [Char] -> AttributeValue
    forall a b. (a -> b) -> a -> b
    $ [Char]
    base' [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char] -> [Char]
    urlForPage ([Char]
    prefix [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char] -> [Char]
    dropExtension [Char]
    f)) (Html -> Html) -> Html -> Html
    forall a b. (a -> b) -> a -> b
    $
                [Char] -> Html
    forall a. IsString a => [Char] -> a
    fromString ([Char] -> Html) -> [Char] -> Html
    forall a b. (a -> b) -> a -> b
    $ [Char] -> [Char]
    dropExtension [Char]
    f
          fileLink (FSFile [Char]
    f) = Html -> Html
    li (Html -> Html) -> Attribute -> Html -> Html
    forall h. Attributable h => h -> Attribute -> h
    ! AttributeValue -> Attribute
    class_ AttributeValue
    "upload" (Html -> Html) -> Html -> Html
    forall a b. (a -> b) -> a -> b
    $ [Html] -> Html
    forall a. Monoid a => [a] -> a
    mconcat
            [ Html -> Html
    a (Html -> Html) -> Attribute -> Html -> Html
    forall h. Attributable h => h -> Attribute -> h
    ! AttributeValue -> Attribute
    href ([Char] -> AttributeValue
    forall a. IsString a => [Char] -> a
    fromString ([Char] -> AttributeValue) -> [Char] -> AttributeValue
    forall a b. (a -> b) -> a -> b
    $ [Char]
    base' [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char] -> [Char]
    urlForPage ([Char]
    prefix [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    f)) (Html -> Html) -> Html -> Html
    forall a b. (a -> b) -> a -> b
    $ [Char] -> Html
    forall a. IsString a => [Char] -> a
    fromString [Char]
    f
            , Html -> Html
    a (Html -> Html) -> Attribute -> Html -> Html
    forall h. Attributable h => h -> Attribute -> h
    ! AttributeValue -> Attribute
    href ([Char] -> AttributeValue
    forall a. IsString a => [Char] -> a
    fromString ([Char] -> AttributeValue) -> [Char] -> AttributeValue
    forall a b. (a -> b) -> a -> b
    $ [Char]
    base' [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "_delete" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char] -> [Char]
    urlForPage ([Char]
    prefix [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    f)) (Html -> Html) -> Html -> Html
    forall a b. (a -> b) -> a -> b
    $ Html
    "(delete)"
            ]
          fileLink (FSDirectory [Char]
    f) =
            Html -> Html
    li (Html -> Html) -> Attribute -> Html -> Html
    forall h. Attributable h => h -> Attribute -> h
    ! AttributeValue -> Attribute
    class_ AttributeValue
    "folder" (Html -> Html) -> Html -> Html
    forall a b. (a -> b) -> a -> b
    $
              Html -> Html
    a (Html -> Html) -> Attribute -> Html -> Html
    forall h. Attributable h => h -> Attribute -> h
    ! AttributeValue -> Attribute
    href ([Char] -> AttributeValue
    forall a. IsString a => [Char] -> a
    fromString ([Char] -> AttributeValue) -> [Char] -> AttributeValue
    forall a b. (a -> b) -> a -> b
    $ [Char]
    base' [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char] -> [Char]
    urlForPage ([Char]
    prefix [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    f) [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "/") (Html -> Html) -> Html -> Html
    forall a b. (a -> b) -> a -> b
    $ [Char] -> Html
    forall a. IsString a => [Char] -> a
    fromString [Char]
    f
          updirs :: [[[Char]]]
    updirs = Int -> [[[Char]]] -> [[[Char]]]
    forall a. Int -> [a] -> [a]
    drop Int
    1 ([[[Char]]] -> [[[Char]]]) -> [[[Char]]] -> [[[Char]]]
    forall a b. (a -> b) -> a -> b
    $ [[Char]] -> [[[Char]]]
    forall a. [a] -> [[a]]
    inits ([[Char]] -> [[[Char]]]) -> [[Char]] -> [[[Char]]]
    forall a b. (a -> b) -> a -> b
    $ [Char] -> [[Char]]
    splitPath ([Char] -> [[Char]]) -> [Char] -> [[Char]]
    forall a b. (a -> b) -> a -> b
    $ Char
    '/' Char -> [Char] -> [Char]
    forall a. a -> [a] -> [a]
    : [Char]
    prefix
          uplink :: Html
    uplink = ([[Char]] -> Html -> Html) -> Html -> [[[Char]]] -> Html
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr (\[[Char]]
    d Html
    accum ->
                      [Html] -> Html
    forall a. Monoid a => [a] -> a
    mconcat [ Html -> Html
    a (Html -> Html) -> Attribute -> Html -> Html
    forall h. Attributable h => h -> Attribute -> h
    ! AttributeValue -> Attribute
    class_ AttributeValue
    "updir" (Html -> Html) -> Attribute -> Html -> Html
    forall h. Attributable h => h -> Attribute -> h
    !
                                             AttributeValue -> Attribute
    href ([Char] -> AttributeValue
    forall a. IsString a => [Char] -> a
    fromString ([Char] -> AttributeValue) -> [Char] -> AttributeValue
    forall a b. (a -> b) -> a -> b
    $ if [[Char]] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [[Char]]
    d Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    1
                                                       then [Char]
    base' [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "/_index"
                                                       else [Char]
    base' [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++
                                                            [Char] -> [Char]
    urlForPage ([[Char]] -> [Char]
    joinPath ([[Char]] -> [Char]) -> [[Char]] -> [Char]
    forall a b. (a -> b) -> a -> b
    $ Int -> [[Char]] -> [[Char]]
    forall a. Int -> [a] -> [a]
    drop Int
    1 [[Char]]
    d)) (Html -> Html) -> Html -> Html
    forall a b. (a -> b) -> a -> b
    $
                      [Char] -> Html
    forall a. IsString a => [Char] -> a
    fromString ([Char] -> Html) -> [Char] -> Html
    forall a b. (a -> b) -> a -> b
    $ [Char] -> [[Char]] -> [Char]
    forall a. HasCallStack => [Char] -> [a] -> a
    lastNote [Char]
    "fileListToHtml" [[Char]]
    d, Html
    accum]) Html
    forall a. Monoid a => a
    mempty [[[Char]]]
    updirs
      in Html
    uplink Html -> Html -> Html
    forall a. Semigroup a => a -> a -> a
    <> (Html -> Html
    ul (Html -> Html) -> Attribute -> Html -> Html
    forall h. Attributable h => h -> Attribute -> h
    ! AttributeValue -> Attribute
    class_ AttributeValue
    "index" (Html -> Html) -> Html -> Html
    forall a b. (a -> b) -> a -> b
    $ (Resource -> Html) -> [Resource] -> Html
    forall m a. Monoid m => (a -> m) -> [a] -> m
    forall (t :: * -> *) m a.
    (Foldable t, Monoid m) =>
    (a -> m) -> t a -> m
    foldMap Resource -> Html
    fileLink [Resource]
    files)

    -- NOTE:  The current implementation of categoryPage does not go via the
    -- filestore abstraction.  That is bad, but can only be fixed if we add
    -- more sophisticated searching options to filestore.
    categoryPage :: Handler
    categoryPage :: Handler
    categoryPage = do
      path' <- GititServerPart [Char]
    forall (m :: * -> *). ServerMonad m => m [Char]
    getPath
      cfg <- getConfig
      let pcategories = (Char -> Bool) -> [Char] -> [[Char]]
    forall a. (a -> Bool) -> [a] -> [[a]]
    wordsBy (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    ==Char
    ',') [Char]
    path'
      let repoPath = Config -> [Char]
    repositoryPath Config
    cfg
      let categoryDescription = [Char]
    "Category: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ ([Char] -> [[Char]] -> [Char]
    forall a. [a] -> [[a]] -> [a]
    intercalate [Char]
    " + " [[Char]]
    pcategories)
      fs <- getFileStore
      pages <- liftIO (index fs) >>= filterM isPageFile >>= filterM isNotDiscussPageFile
      matches <- liftM catMaybes $
                 forM pages $ \[Char]
    f -> do
                   categories <- IO [[Char]] -> ServerPartT (ReaderT WikiState IO) [[Char]]
    forall a. IO a -> ServerPartT (ReaderT WikiState IO) a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO [[Char]] -> ServerPartT (ReaderT WikiState IO) [[Char]])
    -> IO [[Char]] -> ServerPartT (ReaderT WikiState IO) [[Char]]
    forall a b. (a -> b) -> a -> b
    $ [Char] -> IO [[Char]]
    readCategories ([Char] -> IO [[Char]]) -> [Char] -> IO [[Char]]
    forall a b. (a -> b) -> a -> b
    $ [Char]
    repoPath [Char] -> [Char] -> [Char]
    </> [Char]
    f
                   return $ if all ( `elem` categories) pcategories
                               then Just (f, categories \\ pcategories)
                               else Nothing
      base' <- getWikiBase
      let toMatchListItem [Char]
    file = Html -> Html
    li (Html -> Html) -> Html -> Html
    forall a b. (a -> b) -> a -> b
    $
            Html -> Html
    a (Html -> Html) -> Attribute -> Html -> Html
    forall h. Attributable h => h -> Attribute -> h
    ! AttributeValue -> Attribute
    href ([Char] -> AttributeValue
    forall a. IsString a => [Char] -> a
    fromString ([Char] -> AttributeValue) -> [Char] -> AttributeValue
    forall a b. (a -> b) -> a -> b
    $ [Char]
    base' [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char] -> [Char]
    urlForPage ([Char] -> [Char]
    dropExtension [Char]
    file)) (Html -> Html) -> Html -> Html
    forall a b. (a -> b) -> a -> b
    $ [Char] -> Html
    forall a. IsString a => [Char] -> a
    fromString ([Char] -> Html) -> [Char] -> Html
    forall a b. (a -> b) -> a -> b
    $ [Char] -> [Char]
    dropExtension [Char]
    file
      let toRemoveListItem [Char]
    cat = Html -> Html
    li (Html -> Html) -> Html -> Html
    forall a b. (a -> b) -> a -> b
    $
            Html -> Html
    a (Html -> Html) -> Attribute -> Html -> Html
    forall h. Attributable h => h -> Attribute -> h
    ! AttributeValue -> Attribute
    href ([Char] -> AttributeValue
    forall a. IsString a => [Char] -> a
    fromString ([Char] -> AttributeValue) -> [Char] -> AttributeValue
    forall a b. (a -> b) -> a -> b
    $ [Char]
    base' [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++
            (if [[Char]] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null ([[Char]] -> [[Char]]
    forall a. HasCallStack => [a] -> [a]
    tail [[Char]]
    pcategories)
             then [Char]
    "/_categories"
             else [Char]
    "/_category" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char] -> [Char]
    urlForPage ([Char] -> [[Char]] -> [Char]
    forall a. [a] -> [[a]] -> [a]
    intercalate [Char]
    "," ([[Char]] -> [Char]) -> [[Char]] -> [Char]
    forall a b. (a -> b) -> a -> b
    $ [Char] -> [[Char]] -> [[Char]]
    forall a. Eq a => a -> [a] -> [a]
    Data.List.delete [Char]
    cat [[Char]]
    pcategories)))
            (Html -> Html) -> Html -> Html
    forall a b. (a -> b) -> a -> b
    $ [Char] -> Html
    forall a. IsString a => [Char] -> a
    fromString ([Char]
    "-" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    cat)
      let toAddListItem [Char]
    cat = Html -> Html
    li (Html -> Html) -> Html -> Html
    forall a b. (a -> b) -> a -> b
    $
            Html -> Html
    a (Html -> Html) -> Attribute -> Html -> Html
    forall h. Attributable h => h -> Attribute -> h
    ! AttributeValue -> Attribute
    href ([Char] -> AttributeValue
    forall a. IsString a => [Char] -> a
    fromString ([Char] -> AttributeValue) -> [Char] -> AttributeValue
    forall a b. (a -> b) -> a -> b
    $ [Char]
    base' [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++
              [Char]
    "/_category" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char] -> [Char]
    urlForPage ([Char]
    path' [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "," [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    cat))
            (Html -> Html) -> Html -> Html
    forall a b. (a -> b) -> a -> b
    $ [Char] -> Html
    forall a. IsString a => [Char] -> a
    fromString ([Char]
    "+" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    cat)
      let matchList = Html -> Html
    ul (Html -> Html) -> Html -> Html
    forall a b. (a -> b) -> a -> b
    $ ([Char] -> Html) -> [[Char]] -> Html
    forall m a. Monoid m => (a -> m) -> [a] -> m
    forall (t :: * -> *) m a.
    (Foldable t, Monoid m) =>
    (a -> m) -> t a -> m
    foldMap [Char] -> Html
    toMatchListItem (([[Char]], [[[Char]]]) -> [[Char]]
    forall a b. (a, b) -> a
    fst (([[Char]], [[[Char]]]) -> [[Char]])
    -> ([[Char]], [[[Char]]]) -> [[Char]]
    forall a b. (a -> b) -> a -> b
    $ [([Char], [[Char]])] -> ([[Char]], [[[Char]]])
    forall a b. [(a, b)] -> ([a], [b])
    unzip [([Char], [[Char]])]
    matches) Html -> Html -> Html
    forall a. Semigroup a => a -> a -> a
    <>
                      (Html -> Html
    Html5.div (Html -> Html) -> Attribute -> Html -> Html
    forall h. Attributable h => h -> Attribute -> h
    ! AttributeValue -> Attribute
    Html5.Attr.id AttributeValue
    "categoryList" (Html -> Html) -> Html -> Html
    forall a b. (a -> b) -> a -> b
    $
                      Html -> Html
    ul (Html -> Html) -> Html -> Html
    forall a b. (a -> b) -> a -> b
    $ [Html] -> Html
    forall a. Monoid a => [a] -> a
    mconcat ([Html] -> Html) -> [Html] -> Html
    forall a b. (a -> b) -> a -> b
    $ [Html] -> [Html] -> [Html]
    forall a. [a] -> [a] -> [a]
    (++) (([Char] -> Html) -> [[Char]] -> [Html]
    forall a b. (a -> b) -> [a] -> [b]
    map [Char] -> Html
    toAddListItem ([[Char]] -> [[Char]]
    forall a. Eq a => [a] -> [a]
    nub ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
    forall a b. (a -> b) -> a -> b
    $ [[[Char]]] -> [[Char]]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat ([[[Char]]] -> [[Char]]) -> [[[Char]]] -> [[Char]]
    forall a b. (a -> b) -> a -> b
    $ ([[Char]], [[[Char]]]) -> [[[Char]]]
    forall a b. (a, b) -> b
    snd (([[Char]], [[[Char]]]) -> [[[Char]]])
    -> ([[Char]], [[[Char]]]) -> [[[Char]]]
    forall a b. (a -> b) -> a -> b
    $ [([Char], [[Char]])] -> ([[Char]], [[[Char]]])
    forall a b. [(a, b)] -> ([a], [b])
    unzip [([Char], [[Char]])]
    matches))
                                    (([Char] -> Html) -> [[Char]] -> [Html]
    forall a b. (a -> b) -> [a] -> [b]
    map [Char] -> Html
    toRemoveListItem [[Char]]
    pcategories))
      formattedPage defaultPageLayout{
                      pgPageName = categoryDescription,
                      pgShowPageTools = False,
                      pgTabs = [],
                      pgScripts = ["search.js"],
                      pgTitle = categoryDescription }
                    matchList

    categoryListPage :: Handler
    categoryListPage :: Handler
    categoryListPage = do
      cfg <- GititServerPart Config
    getConfig
      let repoPath = Config -> [Char]
    repositoryPath Config
    cfg
      fs <- getFileStore
      pages <- liftIO (index fs) >>= filterM isPageFile >>= filterM isNotDiscussPageFile
      categories <- liftIO $ liftM (nub . sort . concat) $ forM pages $ \[Char]
    f ->
                      [Char] -> IO [[Char]]
    readCategories ([Char]
    repoPath [Char] -> [Char] -> [Char]
    </> [Char]
    f)
      base' <- getWikiBase
      let toCatLink [Char]
    ctg = Html -> Html
    li (Html -> Html) -> Html -> Html
    forall a b. (a -> b) -> a -> b
    $
            Html -> Html
    a (Html -> Html) -> Attribute -> Html -> Html
    forall h. Attributable h => h -> Attribute -> h
    ! AttributeValue -> Attribute
    href ([Char] -> AttributeValue
    forall a. IsString a => [Char] -> a
    fromString ([Char] -> AttributeValue) -> [Char] -> AttributeValue
    forall a b. (a -> b) -> a -> b
    $ [Char]
    base' [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "/_category" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char] -> [Char]
    urlForPage [Char]
    ctg) (Html -> Html) -> Html -> Html
    forall a b. (a -> b) -> a -> b
    $ ([Char] -> Html
    forall a. IsString a => [Char] -> a
    fromString [Char]
    ctg)
      let htmlMatches = Html -> Html
    ul (Html -> Html) -> Html -> Html
    forall a b. (a -> b) -> a -> b
    $ ([Char] -> Html) -> [[Char]] -> Html
    forall m a. Monoid m => (a -> m) -> [a] -> m
    forall (t :: * -> *) m a.
    (Foldable t, Monoid m) =>
    (a -> m) -> t a -> m
    foldMap [Char] -> Html
    toCatLink [[Char]]
    categories
      formattedPage defaultPageLayout{
                      pgPageName = "Categories",
                      pgShowPageTools = False,
                      pgTabs = [],
                      pgScripts = ["search.js"],
                      pgTitle = "Categories" } htmlMatches

    expireCache :: Handler
    expireCache :: Handler
    expireCache = do
      page <- GititServerPart [Char]
    getPage
      cfg <- getConfig
      -- try it as a page first, then as an uploaded file
      expireCachedFile (pathForPage page $ defaultExtension cfg)
      expireCachedFile page
      ok $ toResponse ()

    feedHandler :: Handler
    feedHandler :: Handler
    feedHandler = do
      cfg <- GititServerPart Config
    getConfig
      when (not $ useFeed cfg) mzero
      base' <- getWikiBase
      feedBase <- if null (baseUrl cfg)  -- if baseUrl blank, try to get it from Host header
                     then do
                       mbHost <- getHost
                       case mbHost of
                            Maybe [Char]
    Nothing    -> [Char] -> GititServerPart [Char]
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "Could not determine base URL"
                            Just [Char]
    hn    -> [Char] -> GititServerPart [Char]
    forall a. a -> ServerPartT (ReaderT WikiState IO) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([Char] -> GititServerPart [Char])
    -> [Char] -> GititServerPart [Char]
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "http://" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    hn [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    base'
                     else case baseUrl cfg ++ base' of
                               w :: [Char]
    w@(Char
    'h':Char
    't':Char
    't':Char
    'p':Char
    's':Char
    ':':Char
    '/':Char
    '/':[Char]
    _) -> [Char] -> GititServerPart [Char]
    forall a. a -> ServerPartT (ReaderT WikiState IO) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [Char]
    w
                               x :: [Char]
    x@(Char
    'h':Char
    't':Char
    't':Char
    'p':Char
    ':':Char
    '/':Char
    '/':[Char]
    _) -> [Char] -> GititServerPart [Char]
    forall a. a -> ServerPartT (ReaderT WikiState IO) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [Char]
    x
                               [Char]
    y                                 -> [Char] -> GititServerPart [Char]
    forall a. a -> ServerPartT (ReaderT WikiState IO) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([Char] -> GititServerPart [Char])
    -> [Char] -> GititServerPart [Char]
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "http://" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    y
      let fc = FeedConfig{
                  fcTitle :: [Char]
    fcTitle = Config -> [Char]
    wikiTitle Config
    cfg
                , fcBaseUrl :: [Char]
    fcBaseUrl = [Char]
    feedBase
                , fcFeedDays :: Integer
    fcFeedDays = Config -> Integer
    feedDays Config
    cfg }
      path' <- getPath     -- e.g. "foo/bar" if they hit /_feed/foo/bar
      let file = ([Char]
    path' [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    `orIfNull` [Char]
    "_site") [Char] -> [Char] -> [Char]
    <.> [Char]
    "feed"
      let mbPath = if [Char] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Char]
    path' then Maybe [Char]
    forall a. Maybe a
    Nothing else [Char] -> Maybe [Char]
    forall a. a -> Maybe a
    Just [Char]
    path'
      -- first, check for a cached version that is recent enough
      now <- liftIO getCurrentTime
      let isRecentEnough UTCTime
    t = NominalDiffTime -> Integer
    forall b. Integral b => NominalDiffTime -> b
    forall a b. (RealFrac a, Integral b) => a -> b
    truncate (UTCTime -> UTCTime -> NominalDiffTime
    diffUTCTime UTCTime
    now UTCTime
    t) Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    < Integer
    60 Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    * Config -> Integer
    feedRefreshTime Config
    cfg
      mbCached <- lookupCache file
      case mbCached of
           Just (UTCTime
    modtime, ByteString
    contents) | UTCTime -> Bool
    isRecentEnough UTCTime
    modtime -> do
                let emptyResponse :: Response
    emptyResponse = [Char] -> Response -> Response
    setContentType [Char]
    "application/atom+xml; charset=utf-8" (Response -> Response) -> (() -> Response) -> () -> Response
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . () -> Response
    forall a. ToMessage a => a -> Response
    toResponse (() -> Response) -> () -> Response
    forall a b. (a -> b) -> a -> b
    $ ()
                Response -> Handler
    forall (m :: * -> *) a. FilterMonad Response m => a -> m a
    ok (Response -> Handler) -> Response -> Handler
    forall a b. (a -> b) -> a -> b
    $ Response
    emptyResponse{rsBody = B.fromChunks [contents]}
           Maybe (UTCTime, ByteString)
    _ -> do
                fs <- GititServerPart FileStore
    getFileStore
                resp' <- liftM toResponse $ liftIO (filestoreToXmlFeed fc fs mbPath)
                cacheContents file $ S.concat $ B.toChunks $ rsBody resp'
                ok . setContentType "application/atom+xml; charset=UTF-8" $ resp'