    {-# LANGUAGE ScopedTypeVariables #-}
    {-
    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 Text.XHtml hiding ( (</>), dir, method, password, rev )
    import qualified Text.XHtml as X ( method )
    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(..))

    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) -> (String -> Handler) -> Handler
    forall (m :: * -> *) a. ServerMonad m => (String -> m a) -> m a
    uriRest ((String -> Handler) -> Handler) -> (String -> Handler) -> Handler
    forall a b. (a -> b) -> a -> b
    $ \String
    uri ->
      let path' :: String
    path' = String -> String
    uriPath String
    uri
      in  do fs <- GititServerPart FileStore
    getFileStore
             let rev = Params -> Maybe String
    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
    $ String -> Response -> Response
    setContentType String
    mimetype (Response -> Response) -> Response -> Response
    forall a b. (a -> b) -> a -> b
    $
                                        (Html -> Response
    forall a. ToMessage a => a -> Response
    toResponse Html
    noHtml) {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         -> String -> Handler
    forall a. HasCallStack => String -> a
    error (FileStoreError -> String
    forall a. Show a => a -> String
    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 = (String -> String) -> [String] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map String -> String
    dropExtension [String]
    prunedFiles
      if null pages
         then error "No pages found!"
         else do
           secs <- liftIO (fmap utctDayTime getCurrentTime)
           let newPage = [String]
    pages [String] -> Int -> String
    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` [String] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [String]
    pages)
           seeOther (base' ++ urlForPage newPage) $ toResponse $
             p << "Redirecting to a random page"

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

    createPage :: Handler
    createPage :: Handler
    createPage = do
      page <- GititServerPart String
    getPage
      base' <- getWikiBase
      case page of
           (Char
    '_':String
    _) -> Handler
    forall a. ServerPartT (ReaderT WikiState IO) a
    forall (m :: * -> *) a. MonadPlus m => m a
    mzero   -- don't allow creation of _index, etc.
           String
    _       -> 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. HTML a => (Html -> b) -> a -> b
    << String -> Html
    stringToHtml
                            (String
    "There is no page named '" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    page String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "'. You can:"))
                            Html -> Html -> Html
    forall a b. (HTML a, HTML b) => a -> b -> Html
    +++
                        ([Html] -> Html
    forall a. HTML a => [a] -> Html
    unordList ([Html] -> Html) -> [Html] -> Html
    forall a b. (a -> b) -> a -> b
    $
                          [ Html -> Html
    anchor (Html -> Html) -> [HtmlAttr] -> Html -> Html
    forall a. ADDATTRS a => a -> [HtmlAttr] -> a
    !
                                [String -> HtmlAttr
    href (String -> HtmlAttr) -> String -> HtmlAttr
    forall a b. (a -> b) -> a -> b
    $ String
    base' String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "/_edit" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> String
    urlForPage String
    page] (Html -> Html) -> String -> Html
    forall a b. HTML a => (Html -> b) -> a -> b
    <<
                                  (String
    "Create the page '" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    page String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "'")
                          , Html -> Html
    anchor (Html -> Html) -> [HtmlAttr] -> Html -> Html
    forall a. ADDATTRS a => a -> [HtmlAttr] -> a
    !
                                [String -> HtmlAttr
    href (String -> HtmlAttr) -> String -> HtmlAttr
    forall a b. (a -> b) -> a -> b
    $ String
    base' String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "/_search?" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++
                                    ([(String, String)] -> String
    urlEncodeVars [(String
    "patterns", String
    page)])] (Html -> Html) -> String -> Html
    forall a b. HTML a => (Html -> b) -> a -> b
    <<
                                  (String
    "Search for pages containing the text '" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++
                                    String
    page String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "'")])

    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 :: String
    origPath = Params -> String
    pFilename Params
    params
      let wikiname :: String
    wikiname = Params -> String
    pWikiname Params
    params String -> String -> String
    forall a. [a] -> [a] -> [a]
    `orIfNull` String -> String
    takeFileName String
    origPath
      let logMsg :: String
    logMsg = Params -> String
    pLogMsg Params
    params
      let upForm :: Html
    upForm = Html -> Html
    form (Html -> Html) -> [HtmlAttr] -> Html -> Html
    forall a. ADDATTRS a => a -> [HtmlAttr] -> a
    ! [String -> HtmlAttr
    X.method String
    "post", String -> HtmlAttr
    enctype String
    "multipart/form-data"] (Html -> Html) -> Html -> Html
    forall a b. HTML a => (Html -> b) -> a -> b
    <<
           Html -> Html
    fieldset (Html -> Html) -> [Html] -> Html
    forall a b. HTML a => (Html -> b) -> a -> b
    <<
           [ Html -> Html
    p (Html -> Html) -> [Html] -> Html
    forall a b. HTML a => (Html -> b) -> a -> b
    << [Html -> Html
    label (Html -> Html) -> [HtmlAttr] -> Html -> Html
    forall a. ADDATTRS a => a -> [HtmlAttr] -> a
    ! [String -> HtmlAttr
    thefor String
    "file"] (Html -> Html) -> String -> Html
    forall a b. HTML a => (Html -> b) -> a -> b
    << String
    "File to upload:"
                  , Html
    br
                  , String -> Html
    afile String
    "file" Html -> [HtmlAttr] -> Html
    forall a. ADDATTRS a => a -> [HtmlAttr] -> a
    ! [String -> HtmlAttr
    value String
    origPath] ]
           , Html -> Html
    p (Html -> Html) -> [Html] -> Html
    forall a b. HTML a => (Html -> b) -> a -> b
    << [ Html -> Html
    label (Html -> Html) -> [HtmlAttr] -> Html -> Html
    forall a. ADDATTRS a => a -> [HtmlAttr] -> a
    ! [String -> HtmlAttr
    thefor String
    "wikiname"] (Html -> Html) -> String -> Html
    forall a b. HTML a => (Html -> b) -> a -> b
    << String
    "Name on wiki, including extension"
                  , Html -> Html
    noscript (Html -> Html) -> String -> Html
    forall a b. HTML a => (Html -> b) -> a -> b
    << String
    " (leave blank to use the same filename)"
                  , String -> Html
    stringToHtml String
    ":"
                  , Html
    br
                  , String -> Html
    textfield String
    "wikiname" Html -> [HtmlAttr] -> Html
    forall a. ADDATTRS a => a -> [HtmlAttr] -> a
    ! [String -> HtmlAttr
    value String
    wikiname]
                  , String -> Html
    primHtmlChar String
    "nbsp"
                  , String -> String -> Html
    checkbox String
    "overwrite" String
    "yes"
                  , Html -> Html
    label (Html -> Html) -> [HtmlAttr] -> Html -> Html
    forall a. ADDATTRS a => a -> [HtmlAttr] -> a
    ! [String -> HtmlAttr
    thefor String
    "overwrite"] (Html -> Html) -> String -> Html
    forall a b. HTML a => (Html -> b) -> a -> b
    << String
    "Overwrite existing file" ]
           , Html -> Html
    p (Html -> Html) -> [Html] -> Html
    forall a b. HTML a => (Html -> b) -> a -> b
    << [ Html -> Html
    label (Html -> Html) -> [HtmlAttr] -> Html -> Html
    forall a. ADDATTRS a => a -> [HtmlAttr] -> a
    ! [String -> HtmlAttr
    thefor String
    "logMsg"] (Html -> Html) -> String -> Html
    forall a b. HTML a => (Html -> b) -> a -> b
    << String
    "Description of content or changes:"
                  , Html
    br
                  , String -> Html
    textfield String
    "logMsg" Html -> [HtmlAttr] -> Html
    forall a. ADDATTRS a => a -> [HtmlAttr] -> a
    ! [String -> HtmlAttr
    size String
    "60", String -> HtmlAttr
    value String
    logMsg]
                  , String -> String -> Html
    submit String
    "upload" String
    "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 :: String
    origPath = Params -> String
    pFilename Params
    params
      let filePath :: String
    filePath = Params -> String
    pFilePath Params
    params
      let wikiname :: String
    wikiname = String -> String
    normalise
                     (String -> String) -> String -> String
    forall a b. (a -> b) -> a -> b
    $ (Char -> Bool) -> String -> String
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    ==Char
    '/')
                     (String -> String) -> String -> String
    forall a b. (a -> b) -> a -> b
    $ Params -> String
    pWikiname Params
    params String -> String -> String
    forall a. [a] -> [a] -> [a]
    `orIfNull` String -> String
    takeFileName String
    origPath
      let logMsg :: String
    logMsg = Params -> String
    pLogMsg Params
    params
      cfg <- GititServerPart Config
    getConfig
      wPF <- isPageFile wikiname
      mbUser <- getLoggedInUser
      (user, email) <- case mbUser of
                            Maybe User
    Nothing -> (String, String)
    -> ServerPartT (ReaderT WikiState IO) (String, String)
    forall a. a -> ServerPartT (ReaderT WikiState IO) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (String
    "Anonymous", String
    "")
                            Just User
    u  -> (String, String)
    -> ServerPartT (ReaderT WikiState IO) (String, String)
    forall a. a -> ServerPartT (ReaderT WikiState IO) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (User -> String
    uUsername User
    u, User -> String
    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 -> String
    staticDir Config
    cfg String -> String -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isPrefixOf` (Config -> String
    repositoryPath Config
    cfg String -> String -> String
    </> String
    wikiname)
      let inTemplatesDir = Config -> String
    templatesDir Config
    cfg String -> String -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isPrefixOf` (Config -> String
    repositoryPath Config
    cfg String -> String -> String
    </> String
    wikiname)
      let dirs' = String -> [String]
    splitDirectories (String -> [String]) -> String -> [String]
    forall a b. (a -> b) -> a -> b
    $ String -> String
    takeDirectory String
    wikiname
      let imageExtensions = [String
    ".png", String
    ".jpg", String
    ".gif"]
      let errors = [(Bool, String)] -> [String]
    validate
                     [ (String -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null (String -> Bool) -> (String -> String) -> String -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Char -> Bool) -> String -> String
    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) (String -> Bool) -> String -> Bool
    forall a b. (a -> b) -> a -> b
    $ String
    logMsg,
                        String
    "Description cannot be empty.")
                     , (String
    ".." String -> [String] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [String]
    dirs', String
    "Wikiname cannot contain '..'")
                     , (String -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null String
    origPath, String
    "File not found.")
                     , (Bool
    inStaticDir,  String
    "Destination is inside static directory.")
                     , (Bool
    inTemplatesDir,  String
    "Destination is inside templates directory.")
                     , (Bool -> Bool
    not Bool
    overwrite Bool -> Bool -> Bool
    && Bool
    exists, String
    "A file named '" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    wikiname String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++
                        String
    "' already exists in the repository: choose a new name " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++
                        String
    "or check the box to overwrite the existing file.")
                     , (Bool
    wPF,
                        String
    "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
    thediv (Html -> Html) -> [Html] -> Html
    forall a b. HTML a => (Html -> b) -> a -> b
    <<
                 [ Html -> Html
    h2 (Html -> Html) -> String -> Html
    forall a b. HTML a => (Html -> b) -> a -> b
    << (String
    "Uploaded " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Int64 -> String
    forall a. Show a => a -> String
    show Int64
    len String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " bytes")
                 , if String -> String
    takeExtension String
    wikiname String -> [String] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [String]
    imageExtensions
                      then Html -> Html
    p (Html -> Html) -> String -> Html
    forall a b. HTML a => (Html -> b) -> a -> b
    << String
    "To add this image to a page, use:" Html -> Html -> Html
    forall a b. (HTML a, HTML b) => a -> b -> Html
    +++
                           Html -> Html
    pre (Html -> Html) -> String -> Html
    forall a b. HTML a => (Html -> b) -> a -> b
    << (String
    "![alt text](/" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    wikiname String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ")")
                      else Html -> Html
    p (Html -> Html) -> String -> Html
    forall a b. HTML a => (Html -> b) -> a -> b
    << String
    "To link to this resource from a page, use:" Html -> Html -> Html
    forall a b. (HTML a, HTML b) => a -> b -> Html
    +++
                           Html -> Html
    pre (Html -> Html) -> String -> Html
    forall a b. HTML a => (Html -> b) -> a -> b
    << (String
    "[link label](/" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    wikiname String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ")") ]
           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 :: String
    gotopage = Params -> String
    pGotoPage Params
    params
      fs <- GititServerPart FileStore
    getFileStore
      pruned_files <- liftIO (index fs) >>= filterM isPageFile
      let allPageNames = (String -> String) -> [String] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map String -> String
    dropExtension [String]
    pruned_files
      let findPage String -> Bool
    f = (String -> Bool) -> [String] -> Maybe String
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
    find String -> Bool
    f [String]
    allPageNames
      let exactMatch String
    f = String
    gotopage String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    f
      let insensitiveMatch String
    f = ((Char -> Char) -> String -> String
    forall a b. (a -> b) -> [a] -> [b]
    map Char -> Char
    toLower String
    gotopage) String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == ((Char -> Char) -> String -> String
    forall a b. (a -> b) -> [a] -> [b]
    map Char -> Char
    toLower String
    f)
      let prefixMatch String
    f = ((Char -> Char) -> String -> String
    forall a b. (a -> b) -> [a] -> [b]
    map Char -> Char
    toLower String
    gotopage) String -> String -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isPrefixOf` ((Char -> Char) -> String -> String
    forall a b. (a -> b) -> [a] -> [b]
    map Char -> Char
    toLower String
    f)
      base' <- getWikiBase
      case findPage exactMatch of
           Just String
    m  -> String -> Response -> Handler
    forall (m :: * -> *) uri res.
    (FilterMonad Response m, ToSURI uri) =>
    uri -> res -> m res
    seeOther (String
    base' String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> String
    urlForPage String
    m) (Response -> Handler) -> Response -> Handler
    forall a b. (a -> b) -> a -> b
    $ String -> Response
    forall a. ToMessage a => a -> Response
    toResponse
                         String
    "Redirecting to exact match"
           Maybe String
    Nothing -> case (String -> Bool) -> Maybe String
    findPage String -> Bool
    insensitiveMatch of
                           Just String
    m  -> String -> Response -> Handler
    forall (m :: * -> *) uri res.
    (FilterMonad Response m, ToSURI uri) =>
    uri -> res -> m res
    seeOther (String
    base' String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> String
    urlForPage String
    m) (Response -> Handler) -> Response -> Handler
    forall a b. (a -> b) -> a -> b
    $ String -> Response
    forall a. ToMessage a => a -> Response
    toResponse
                                        String
    "Redirecting to case-insensitive match"
                           Maybe String
    Nothing -> case (String -> Bool) -> Maybe String
    findPage String -> Bool
    prefixMatch of
                                           Just String
    m  -> String -> Response -> Handler
    forall (m :: * -> *) uri res.
    (FilterMonad Response m, ToSURI uri) =>
    uri -> res -> m res
    seeOther (String
    base' String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> String
    urlForPage String
    m) (Response -> Handler) -> Response -> Handler
    forall a b. (a -> b) -> a -> b
    $
                                                      String -> Response
    forall a. ToMessage a => a -> Response
    toResponse (String -> Response) -> String -> Response
    forall a b. (a -> b) -> a -> b
    $ String
    "Redirecting" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++
                                                        String
    " to partial match"
                                           Maybe String
    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 :: [String]
    patterns = Params -> [String]
    pPatterns Params
    params [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    `orIfNull` [Params -> String
    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 -> String) -> [SearchMatch] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map SearchMatch -> String
    matchResourceName [SearchMatch]
    matchLines
      allPages <- liftIO (index fs) >>= filterM isPageFile
      let slashToSpace = (Char -> Char) -> String -> String
    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 String
    pageName' String
    x = String
    x String -> [String] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` (String -> [String]
    words (String -> [String]) -> String -> [String]
    forall a b. (a -> b) -> a -> b
    $ String -> String
    slashToSpace (String -> String) -> String -> String
    forall a b. (a -> b) -> a -> b
    $ String -> String
    dropExtension String
    pageName')
      let matchesPatterns String
    pageName' = Bool -> Bool
    not ([String] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [String]
    patterns) Bool -> Bool -> Bool
    &&
           (String -> Bool) -> [String] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all (String -> String -> Bool
    inPageName ((Char -> Char) -> String -> String
    forall a b. (a -> b) -> [a] -> [b]
    map Char -> Char
    toLower String
    pageName')) ((String -> String) -> [String] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map ((Char -> Char) -> String -> String
    forall a b. (a -> b) -> [a] -> [b]
    map Char -> Char
    toLower) [String]
    patterns)
      let pageNameMatches = (String -> Bool) -> [String] -> [String]
    forall a. (a -> Bool) -> [a] -> [a]
    filter String -> Bool
    matchesPatterns [String]
    allPages
      prunedFiles <- filterM isPageFile (contentMatches ++ pageNameMatches)
      let allMatchedFiles = [String] -> [String]
    forall a. Eq a => [a] -> [a]
    nub ([String] -> [String]) -> [String] -> [String]
    forall a b. (a -> b) -> a -> b
    $ [String]
    prunedFiles
      let matchesInFile String
    f =  (SearchMatch -> Maybe String) -> [SearchMatch] -> [String]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe (\SearchMatch
    x -> if SearchMatch -> String
    matchResourceName SearchMatch
    x String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    f
                                                then String -> Maybe String
    forall a. a -> Maybe a
    Just (SearchMatch -> String
    matchLine SearchMatch
    x)
                                                else Maybe String
    forall a. Maybe a
    Nothing) [SearchMatch]
    matchLines
      let matches = (String -> (String, [String])) -> [String] -> [(String, [String])]
    forall a b. (a -> b) -> [a] -> [b]
    map (\String
    f -> (String
    f, String -> [String]
    matchesInFile String
    f)) [String]
    allMatchedFiles
      let relevance (String
    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 String
    f String -> [String] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [String]
    pageNameMatches
                                             then Int
    100
                                             else Int
    0
      let preamble = if [String] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [String]
    patterns
                        then Html -> Html
    h3 (Html -> Html) -> [String] -> Html
    forall a b. HTML a => (Html -> b) -> a -> b
    << [String
    "Please enter a search term."]
                        else Html -> Html
    h3 (Html -> Html) -> [Html] -> Html
    forall a b. HTML a => (Html -> b) -> a -> b
    << [ String -> Html
    stringToHtml (Int -> String
    forall a. Show a => a -> String
    show ([(String, [String])] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [(String, [String])]
    matches) String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " matches found for ")
                                   , Html -> Html
    thespan (Html -> Html) -> [HtmlAttr] -> Html -> Html
    forall a. ADDATTRS a => a -> [HtmlAttr] -> a
    ! [String -> HtmlAttr
    identifier String
    "pattern"] (Html -> Html) -> String -> Html
    forall a b. HTML a => (Html -> b) -> a -> b
    << [String] -> String
    unwords [String]
    patterns]
      base' <- getWikiBase
      let toMatchListItem (String
    file, [String]
    contents) = Html -> Html
    li (Html -> Html) -> [Html] -> Html
    forall a b. HTML a => (Html -> b) -> a -> b
    <<
            [ Html -> Html
    anchor (Html -> Html) -> [HtmlAttr] -> Html -> Html
    forall a. ADDATTRS a => a -> [HtmlAttr] -> a
    ! [String -> HtmlAttr
    href (String -> HtmlAttr) -> String -> HtmlAttr
    forall a b. (a -> b) -> a -> b
    $ String
    base' String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> String
    urlForPage (String -> String
    dropExtension String
    file)] (Html -> Html) -> String -> Html
    forall a b. HTML a => (Html -> b) -> a -> b
    << String -> String
    dropExtension String
    file
            , String -> Html
    stringToHtml (String
    " (" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Int -> String
    forall a. Show a => a -> String
    show ([String] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [String]
    contents) String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " matching lines)")
            , String -> Html
    stringToHtml String
    " "
            , Html -> Html
    anchor (Html -> Html) -> [HtmlAttr] -> Html -> Html
    forall a. ADDATTRS a => a -> [HtmlAttr] -> a
    ! [String -> HtmlAttr
    href String
    "#", String -> HtmlAttr
    theclass String
    "showmatch",
                        String -> HtmlAttr
    thestyle String
    "display: none;"] (Html -> Html) -> String -> Html
    forall a b. HTML a => (Html -> b) -> a -> b
    << if [String] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [String]
    contents Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    0
                                                         then String
    "[show matches]"
                                                         else String
    ""
            , Html -> Html
    pre (Html -> Html) -> [HtmlAttr] -> Html -> Html
    forall a. ADDATTRS a => a -> [HtmlAttr] -> a
    ! [String -> HtmlAttr
    theclass String
    "matches"] (Html -> Html) -> String -> Html
    forall a b. HTML a => (Html -> b) -> a -> b
    << [String] -> String
    unlines [String]
    contents]
      let htmlMatches = Html
    preamble Html -> Html -> Html
    forall a b. (HTML a, HTML b) => a -> b -> Html
    +++
                        Html -> Html
    olist (Html -> Html) -> [Html] -> Html
    forall a b. HTML a => (Html -> b) -> a -> b
    << ((String, [String]) -> Html) -> [(String, [String])] -> [Html]
    forall a b. (a -> b) -> [a] -> [b]
    map (String, [String]) -> Html
    toMatchListItem
                                 ([(String, [String])] -> [(String, [String])]
    forall a. [a] -> [a]
    reverse ([(String, [String])] -> [(String, [String])])
    -> [(String, [String])] -> [(String, [String])]
    forall a b. (a -> b) -> a -> b
    $ ((String, [String]) -> (String, [String]) -> Ordering)
    -> [(String, [String])] -> [(String, [String])]
    forall a. (a -> a -> Ordering) -> [a] -> [a]
    sortBy (((String, [String]) -> Int)
    -> (String, [String]) -> (String, [String]) -> Ordering
    forall a b. Ord a => (b -> a) -> b -> b -> Ordering
    comparing (String, [String]) -> Int
    forall {t :: * -> *} {a}. Foldable t => (String, t a) -> Int
    relevance) [(String, [String])]
    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 String
    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 String
    getPage
      showHistory file file params

    showHistory :: String -> String -> Params -> Handler
    showHistory :: String -> String -> Params -> Handler
    showHistory String
    file String
    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) -> [HtmlAttr] -> Html -> Html
    forall a. ADDATTRS a => a -> [HtmlAttr] -> a
    ! [String -> HtmlAttr
    theclass String
    "difflink", String -> Int -> HtmlAttr
    intAttr String
    "order" Int
    pos,
                                        String -> String -> HtmlAttr
    strAttr String
    "revision" (Revision -> String
    revId Revision
    rev),
                                        String -> String -> HtmlAttr
    strAttr String
    "diffurl" (String
    base' String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "/_diff/" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    page)] (Html -> Html) -> [Html] -> Html
    forall a b. HTML a => (Html -> b) -> a -> b
    <<
            [ Html -> Html
    thespan (Html -> Html) -> [HtmlAttr] -> Html -> Html
    forall a. ADDATTRS a => a -> [HtmlAttr] -> a
    ! [String -> HtmlAttr
    theclass String
    "date"] (Html -> Html) -> String -> Html
    forall a b. HTML a => (Html -> b) -> a -> b
    << (UTCTime -> String
    forall a. Show a => a -> String
    show (UTCTime -> String) -> UTCTime -> String
    forall a b. (a -> b) -> a -> b
    $ Revision -> UTCTime
    revDateTime Revision
    rev)
            , String -> Html
    stringToHtml String
    " ("
            , Html -> Html
    thespan (Html -> Html) -> [HtmlAttr] -> Html -> Html
    forall a. ADDATTRS a => a -> [HtmlAttr] -> a
    ! [String -> HtmlAttr
    theclass String
    "author"] (Html -> Html) -> Html -> Html
    forall a b. HTML a => (Html -> b) -> a -> b
    << Html -> Html
    anchor (Html -> Html) -> [HtmlAttr] -> Html -> Html
    forall a. ADDATTRS a => a -> [HtmlAttr] -> a
    ! [String -> HtmlAttr
    href (String -> HtmlAttr) -> String -> HtmlAttr
    forall a b. (a -> b) -> a -> b
    $ String
    base' String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "/_activity?" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++
                [(String, String)] -> String
    urlEncodeVars [(String
    "forUser", Author -> String
    authorName (Author -> String) -> Author -> String
    forall a b. (a -> b) -> a -> b
    $ Revision -> Author
    revAuthor Revision
    rev)]] (Html -> Html) -> String -> Html
    forall a b. HTML a => (Html -> b) -> a -> b
    <<
                  (Author -> String
    authorName (Author -> String) -> Author -> String
    forall a b. (a -> b) -> a -> b
    $ Revision -> Author
    revAuthor Revision
    rev)
            , String -> Html
    stringToHtml String
    "): "
            , Html -> Html
    anchor (Html -> Html) -> [HtmlAttr] -> Html -> Html
    forall a. ADDATTRS a => a -> [HtmlAttr] -> a
    ! [String -> HtmlAttr
    href (String
    base' String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> String
    urlForPage String
    page String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "?revision=" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Revision -> String
    revId Revision
    rev)] (Html -> Html) -> Html -> Html
    forall a b. HTML a => (Html -> b) -> a -> b
    <<
               Html -> Html
    thespan (Html -> Html) -> [HtmlAttr] -> Html -> Html
    forall a. ADDATTRS a => a -> [HtmlAttr] -> a
    ! [String -> HtmlAttr
    theclass String
    "subject"] (Html -> Html) -> String -> Html
    forall a b. HTML a => (Html -> b) -> a -> b
    <<  Revision -> String
    revDescription Revision
    rev
            , Html -> Html
    noscript (Html -> Html) -> [Html] -> Html
    forall a b. HTML a => (Html -> b) -> a -> b
    <<
                ([ String -> Html
    stringToHtml String
    " [compare with "
                 , Html -> Html
    anchor (Html -> Html) -> [HtmlAttr] -> Html -> Html
    forall a. ADDATTRS a => a -> [HtmlAttr] -> a
    ! [String -> HtmlAttr
    href (String -> HtmlAttr) -> String -> HtmlAttr
    forall a b. (a -> b) -> a -> b
    $ String
    base' String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "/_diff" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> String
    urlForPage String
    page String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "?to=" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Revision -> String
    revId Revision
    rev] (Html -> Html) -> String -> Html
    forall a b. HTML a => (Html -> b) -> a -> b
    <<
                      String
    "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 [ String -> Html
    primHtmlChar String
    "nbsp"
                           , String -> Html
    primHtmlChar String
    "bull"
                           , String -> Html
    primHtmlChar String
    "nbsp"
                           , Html -> Html
    anchor (Html -> Html) -> [HtmlAttr] -> Html -> Html
    forall a. ADDATTRS a => a -> [HtmlAttr] -> a
    ! [String -> HtmlAttr
    href (String -> HtmlAttr) -> String -> HtmlAttr
    forall a b. (a -> b) -> a -> b
    $ String
    base' String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "/_diff" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> String
    urlForPage String
    page String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "?from=" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++
                                      Revision -> String
    revId Revision
    rev] (Html -> Html) -> String -> Html
    forall a b. HTML a => (Html -> b) -> a -> b
    << String
    "current"
                           ]
                      else []) [Html] -> [Html] -> [Html]
    forall a. [a] -> [a] -> [a]
    ++
                 [String -> Html
    stringToHtml String
    "]"])
            ]
      let contents = if [Revision] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Revision]
    hist
                        then Html
    noHtml
                        else Html -> Html
    ulist (Html -> Html) -> [HtmlAttr] -> Html -> Html
    forall a. ADDATTRS a => a -> [HtmlAttr] -> a
    ! [String -> HtmlAttr
    theclass String
    "history"] (Html -> Html) -> [Html] -> Html
    forall a b. HTML a => (Html -> 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
    anchor (Html -> Html) -> [HtmlAttr] -> Html -> Html
    forall a. ADDATTRS a => a -> [HtmlAttr] -> a
    ! [String -> HtmlAttr
    href (String -> HtmlAttr) -> String -> HtmlAttr
    forall a b. (a -> b) -> a -> b
    $ String
    base' String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "/_history" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> String
    urlForPage String
    page
                                     String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "?limit=" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Int -> String
    forall a. Show a => a -> String
    show (Params -> Int
    pLimit Params
    params Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    100)] (Html -> Html) -> String -> Html
    forall a b. HTML a => (Html -> b) -> a -> b
    <<
                                     String
    "Show more..."
                    else Html
    noHtml
      let tabs = if String
    file String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    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 String
    pForUser Params
    params
      fs <- getFileStore
      hist <- liftIO $ history fs [] (TimeRange since Nothing)
                         (Just $ pLimit params)
      let hist' = case Maybe String
    forUser of
                       Maybe String
    Nothing -> [Revision]
    hist
                       Just String
    u  -> (Revision -> Bool) -> [Revision] -> [Revision]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (\Revision
    r -> Author -> String
    authorName (Revision -> Author
    revAuthor Revision
    r) String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    u) [Revision]
    hist
      let fileFromChange (Added String
    f)    = String
    f
          fileFromChange (Modified String
    f) = String
    f
          fileFromChange (Deleted String
    f)  = String
    f
      base' <- getWikiBase
      let fileAnchor String
    revis String
    file = if String -> String
    takeExtension String
    file String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    "." String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ (Config -> String
    defaultExtension Config
    cfg)
            then Html -> Html
    anchor (Html -> Html) -> [HtmlAttr] -> Html -> Html
    forall a. ADDATTRS a => a -> [HtmlAttr] -> a
    ! [String -> HtmlAttr
    href (String -> HtmlAttr) -> String -> HtmlAttr
    forall a b. (a -> b) -> a -> b
    $ String
    base' String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "/_diff" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> String
    urlForPage (String -> String
    dropExtension String
    file) String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "?to=" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    revis] (Html -> Html) -> String -> Html
    forall a b. HTML a => (Html -> b) -> a -> b
    << String -> String
    dropExtension String
    file
            else Html -> Html
    anchor (Html -> Html) -> [HtmlAttr] -> Html -> Html
    forall a. ADDATTRS a => a -> [HtmlAttr] -> a
    ! [String -> HtmlAttr
    href (String -> HtmlAttr) -> String -> HtmlAttr
    forall a b. (a -> b) -> a -> b
    $ String
    base' String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> String
    urlForPage String
    file String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "?revision=" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    revis] (Html -> Html) -> String -> Html
    forall a b. HTML a => (Html -> b) -> a -> b
    << String
    file
      let filesFor [Change]
    changes String
    revis = Html -> [Html] -> [Html]
    forall a. a -> [a] -> [a]
    intersperse (String -> Html
    stringToHtml String
    " ") ([Html] -> [Html]) -> [Html] -> [Html]
    forall a b. (a -> b) -> a -> b
    $
            (Change -> Html) -> [Change] -> [Html]
    forall a b. (a -> b) -> [a] -> [b]
    map (String -> String -> Html
    fileAnchor String
    revis (String -> Html) -> (Change -> String) -> Change -> Html
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Change -> String
    fileFromChange) [Change]
    changes
      let heading = Html -> Html
    h1 (Html -> Html) -> String -> Html
    forall a b. HTML a => (Html -> b) -> a -> b
    << (String
    "Recent changes by " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> Maybe String -> String
    forall a. a -> Maybe a -> a
    fromMaybe String
    "all users" Maybe String
    forUser)
      let revToListItem Revision
    rev = Html -> Html
    li (Html -> Html) -> [Html] -> Html
    forall a b. HTML a => (Html -> b) -> a -> b
    <<
            [ Html -> Html
    thespan (Html -> Html) -> [HtmlAttr] -> Html -> Html
    forall a. ADDATTRS a => a -> [HtmlAttr] -> a
    ! [String -> HtmlAttr
    theclass String
    "date"] (Html -> Html) -> String -> Html
    forall a b. HTML a => (Html -> b) -> a -> b
    << (UTCTime -> String
    forall a. Show a => a -> String
    show (UTCTime -> String) -> UTCTime -> String
    forall a b. (a -> b) -> a -> b
    $ Revision -> UTCTime
    revDateTime Revision
    rev)
            , String -> Html
    stringToHtml String
    " ("
            , Html -> Html
    thespan (Html -> Html) -> [HtmlAttr] -> Html -> Html
    forall a. ADDATTRS a => a -> [HtmlAttr] -> a
    ! [String -> HtmlAttr
    theclass String
    "author"] (Html -> Html) -> Html -> Html
    forall a b. HTML a => (Html -> b) -> a -> b
    <<
                Html -> Html
    anchor (Html -> Html) -> [HtmlAttr] -> Html -> Html
    forall a. ADDATTRS a => a -> [HtmlAttr] -> a
    ! [String -> HtmlAttr
    href (String -> HtmlAttr) -> String -> HtmlAttr
    forall a b. (a -> b) -> a -> b
    $ String
    base' String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "/_activity?" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++
                  [(String, String)] -> String
    urlEncodeVars [(String
    "forUser", Author -> String
    authorName (Author -> String) -> Author -> String
    forall a b. (a -> b) -> a -> b
    $ Revision -> Author
    revAuthor Revision
    rev)]] (Html -> Html) -> String -> Html
    forall a b. HTML a => (Html -> b) -> a -> b
    <<
                    (Author -> String
    authorName (Author -> String) -> Author -> String
    forall a b. (a -> b) -> a -> b
    $ Revision -> Author
    revAuthor Revision
    rev)
            , String -> Html
    stringToHtml String
    "): "
            , Html -> Html
    thespan (Html -> Html) -> [HtmlAttr] -> Html -> Html
    forall a. ADDATTRS a => a -> [HtmlAttr] -> a
    ! [String -> HtmlAttr
    theclass String
    "subject"] (Html -> Html) -> String -> Html
    forall a b. HTML a => (Html -> b) -> a -> b
    << Revision -> String
    revDescription Revision
    rev
            , String -> Html
    stringToHtml String
    " ("
            , Html -> Html
    thespan (Html -> Html) -> [HtmlAttr] -> Html -> Html
    forall a. ADDATTRS a => a -> [HtmlAttr] -> a
    ! [String -> HtmlAttr
    theclass String
    "files"] (Html -> Html) -> [Html] -> Html
    forall a b. HTML a => (Html -> b) -> a -> b
    << [Change] -> String -> [Html]
    filesFor (Revision -> [Change]
    revChanges Revision
    rev) (Revision -> String
    revId Revision
    rev)
            , String -> Html
    stringToHtml String
    ")"
            ]
      let contents = Html -> Html
    ulist (Html -> Html) -> [HtmlAttr] -> Html -> Html
    forall a. ADDATTRS a => a -> [HtmlAttr] -> a
    ! [String -> HtmlAttr
    theclass String
    "history"] (Html -> Html) -> [Html] -> Html
    forall a b. HTML a => (Html -> b) -> a -> b
    << (Revision -> Html) -> [Revision] -> [Html]
    forall a b. (a -> b) -> [a] -> [b]
    map 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 String
    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 String
    getPage
      showDiff page page params

    showDiff :: String -> String -> Params -> Handler
    showDiff :: String -> String -> Params -> Handler
    showDiff String
    file String
    page Params
    params = do
      let from :: Maybe String
    from = Params -> Maybe String
    pFrom Params
    params
      let to :: Maybe String
    to = Params -> Maybe String
    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 String
    from Maybe String -> Maybe String -> Bool
    forall a. Eq a => a -> a -> Bool
    == Maybe String
    forall a. Maybe a
    Nothing Bool -> Bool -> Bool
    && Maybe String
    to Maybe String -> Maybe String -> Bool
    forall a. Eq a => a -> a -> Bool
    == Maybe String
    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 String
    _, Maybe String
    _)        -> Maybe String -> ServerPartT (ReaderT WikiState IO) (Maybe String)
    forall a. a -> ServerPartT (ReaderT WikiState IO) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe String
    from
                  (Maybe String
    Nothing, Maybe String
    Nothing) -> Maybe String -> ServerPartT (ReaderT WikiState IO) (Maybe String)
    forall a. a -> ServerPartT (ReaderT WikiState IO) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe String
    from
                  (Maybe String
    Nothing, Just String
    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 -> [String] -> TimeRange -> Maybe Int -> IO [Revision]
    history FileStore
    fs [String
    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 -> String -> String -> Bool
    idsMatch FileStore
    fs (Revision -> String
    revId Revision
    r) String
    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 -> String -> Maybe String -> Maybe String -> IO Html
    getDiff FileStore
    fs String
    file Maybe String
    from Maybe String
    to = do
      rawDiff <- FileStore
    -> String -> Maybe String -> Maybe String -> IO [Diff [String]]
    diff FileStore
    fs String
    file Maybe String
    from Maybe String
    to
      let diffLineToHtml (Both [String]
    xs [String]
    _) = Html -> Html
    thespan (Html -> Html) -> String -> Html
    forall a b. HTML a => (Html -> b) -> a -> b
    << [String] -> String
    unlines [String]
    xs
          diffLineToHtml (First [String]
    xs) = Html -> Html
    thespan (Html -> Html) -> [HtmlAttr] -> Html -> Html
    forall a. ADDATTRS a => a -> [HtmlAttr] -> a
    ! [String -> HtmlAttr
    theclass String
    "deleted"] (Html -> Html) -> String -> Html
    forall a b. HTML a => (Html -> b) -> a -> b
    << [String] -> String
    unlines [String]
    xs
          diffLineToHtml (Second [String]
    xs) = Html -> Html
    thespan (Html -> Html) -> [HtmlAttr] -> Html -> Html
    forall a. ADDATTRS a => a -> [HtmlAttr] -> a
    ! [String -> HtmlAttr
    theclass String
    "added"]  (Html -> Html) -> String -> Html
    forall a b. HTML a => (Html -> b) -> a -> b
    << [String] -> String
    unlines [String]
    xs
      return $ h2 ! [theclass "revision"] <<
                 ("Changes from " ++ fromMaybe "beginning" from ++
                  " to " ++ fromMaybe "current" to) +++
               pre ! [theclass "diff"] << map 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'

    editPage' :: Params -> Handler
    editPage' :: Params -> Handler
    editPage' Params
    params = do
      let rev :: Maybe String
    rev = Params -> Maybe String
    pRevision Params
    params  -- if this is set, we're doing a revert
      fs <- GititServerPart FileStore
    getFileStore
      page <- getPage
      cfg <- getConfig
      let getRevisionAndText = IO (Maybe String, String)
    -> (FileStoreError -> IO (Maybe String, String))
    -> IO (Maybe String, String)
    forall e a. Exception e => IO a -> (e -> IO a) -> IO a
    E.catch
            (do c <- IO String -> IO String
    forall a. IO a -> IO a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO String -> IO String) -> IO String -> IO String
    forall a b. (a -> b) -> a -> b
    $ FileStore -> forall a. Contents a => String -> Maybe String -> IO a
    retrieve FileStore
    fs (String -> String -> String
    pathForPage String
    page (String -> String) -> String -> String
    forall a b. (a -> b) -> a -> b
    $ Config -> String
    defaultExtension Config
    cfg) Maybe String
    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 String, String) -> IO (Maybe String, String)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe String
    forall a. Maybe a
    Nothing, String
    "")
                      else FileStoreError -> IO (Maybe String, String)
    forall e a. (HasCallStack, Exception e) => e -> IO a
    E.throwIO FileStoreError
    e)
      (mbRev, raw) <- case pEditedText params of
                             Maybe String
    Nothing -> IO (Maybe String, String)
    -> ServerPartT (ReaderT WikiState IO) (Maybe String, String)
    forall a. IO a -> ServerPartT (ReaderT WikiState IO) a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO IO (Maybe String, String)
    getRevisionAndText
                             Just String
    t  -> let r :: Maybe String
    r = if String -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null (Params -> String
    pSHA1 Params
    params)
                                                   then Maybe String
    forall a. Maybe a
    Nothing
                                                   else String -> Maybe String
    forall a. a -> Maybe a
    Just (Params -> String
    pSHA1 Params
    params)
                                        in (Maybe String, String)
    -> ServerPartT (ReaderT WikiState IO) (Maybe String, String)
    forall a. a -> ServerPartT (ReaderT WikiState IO) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe String
    r, String
    t)
      let messages = Params -> [String]
    pMessages Params
    params
      let logMsg = Params -> String
    pLogMsg Params
    params
      let sha1Box = case Maybe String
    mbRev of
                     Just String
    r  -> String -> Html
    textfield String
    "sha1" Html -> [HtmlAttr] -> Html
    forall a. ADDATTRS a => a -> [HtmlAttr] -> a
    ! [String -> HtmlAttr
    thestyle String
    "display: none",
                                                    String -> HtmlAttr
    value String
    r]
                     Maybe String
    Nothing -> Html
    noHtml
      let readonly = if Maybe String -> Bool
    forall a. Maybe a -> Bool
    isJust (Params -> Maybe String
    pRevision Params
    params)
                        -- disable editing of text box if it's a revert
                        then [String -> String -> HtmlAttr
    strAttr String
    "readonly" String
    "yes",
                              String -> String -> HtmlAttr
    strAttr String
    "style" String
    "color: gray"]
                        else []
      base' <- getWikiBase
      let editForm = String -> Html -> Html
    gui (String
    base' String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> String
    urlForPage String
    page) (Html -> Html) -> [HtmlAttr] -> Html -> Html
    forall a. ADDATTRS a => a -> [HtmlAttr] -> a
    ! [String -> HtmlAttr
    identifier String
    "editform"] (Html -> Html) -> [Html] -> Html
    forall a b. HTML a => (Html -> b) -> a -> b
    <<
                       [ Html
    sha1Box
                       , Html -> Html
    textarea (Html -> Html) -> [HtmlAttr] -> Html -> Html
    forall a. ADDATTRS a => a -> [HtmlAttr] -> a
    ! ([HtmlAttr]
    readonly [HtmlAttr] -> [HtmlAttr] -> [HtmlAttr]
    forall a. [a] -> [a] -> [a]
    ++ [String -> HtmlAttr
    cols String
    "80", String -> HtmlAttr
    name String
    "editedText",
                                      String -> HtmlAttr
    identifier String
    "editedText"]) (Html -> Html) -> String -> Html
    forall a b. HTML a => (Html -> b) -> a -> b
    << String
    raw
                       , Html
    br
                       , Html -> Html
    label (Html -> Html) -> [HtmlAttr] -> Html -> Html
    forall a. ADDATTRS a => a -> [HtmlAttr] -> a
    ! [String -> HtmlAttr
    thefor String
    "logMsg"] (Html -> Html) -> String -> Html
    forall a b. HTML a => (Html -> b) -> a -> b
    << String
    "Description of changes:"
                       , Html
    br
                       , String -> Html
    textfield String
    "logMsg" Html -> [HtmlAttr] -> Html
    forall a. ADDATTRS a => a -> [HtmlAttr] -> a
    ! ([HtmlAttr]
    readonly [HtmlAttr] -> [HtmlAttr] -> [HtmlAttr]
    forall a. [a] -> [a] -> [a]
    ++ [String -> HtmlAttr
    value (String
    logMsg String -> String -> String
    forall a. [a] -> [a] -> [a]
    `orIfNull` Config -> String
    defaultSummary Config
    cfg) ])
                       , String -> String -> Html
    submit String
    "update" String
    "Save"
                       , String -> Html
    primHtmlChar String
    "nbsp"
                       , String -> String -> Html
    submit String
    "cancel" String
    "Discard"
                       , String -> Html
    primHtmlChar String
    "nbsp"
                       , Html
    input Html -> [HtmlAttr] -> Html
    forall a. ADDATTRS a => a -> [HtmlAttr] -> a
    ! [String -> HtmlAttr
    thetype String
    "button", String -> HtmlAttr
    theclass String
    "editButton",
                                  String -> HtmlAttr
    identifier String
    "previewButton",
                                  String -> String -> HtmlAttr
    strAttr String
    "onClick" String
    "updatePreviewPane();",
                                  String -> String -> HtmlAttr
    strAttr String
    "style" String
    "display: none;",
                                  String -> HtmlAttr
    value String
    "Preview" ]
                       , Html -> Html
    thediv (Html -> Html) -> [HtmlAttr] -> Html -> Html
    forall a. ADDATTRS a => a -> [HtmlAttr] -> a
    ! [ String -> HtmlAttr
    identifier String
    "previewpane" ] (Html -> Html) -> Html -> Html
    forall a b. HTML a => (Html -> b) -> a -> b
    << Html
    noHtml
                       ]
      let pgScripts' = [String
    "preview.js"]
      let pgScripts'' = case Config -> MathMethod
    mathMethod Config
    cfg of
           MathMethod
    MathML       -> String
    "MathMLinHTML.js" String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    : [String]
    pgScripts'
           MathJax String
    url  -> String
    url String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    : [String]
    pgScripts'
           MathMethod
    _            -> [String]
    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 String
    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 String
    _        -> String -> GititServerPart String
    forall a. a -> ServerPartT (ReaderT WikiState IO) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (String -> GititServerPart String)
    -> String -> GititServerPart String
    forall a b. (a -> b) -> a -> b
    $ String -> String -> String
    pathForPage String
    page (String -> String) -> String -> String
    forall a b. (a -> b) -> a -> b
    $ Config -> String
    defaultExtension Config
    cfg -- a page
                           Left  FileStoreError
    NotFound -> do
                             fileTest <- IO (Either FileStoreError String)
    -> ServerPartT
         (ReaderT WikiState IO) (Either FileStoreError String)
    forall a. IO a -> ServerPartT (ReaderT WikiState IO) a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO (Either FileStoreError String)
     -> ServerPartT
          (ReaderT WikiState IO) (Either FileStoreError String))
    -> IO (Either FileStoreError String)
    -> ServerPartT
         (ReaderT WikiState IO) (Either FileStoreError String)
    forall a b. (a -> b) -> a -> b
    $ IO String -> IO (Either FileStoreError String)
    forall e a. Exception e => IO a -> IO (Either e a)
    E.try (IO String -> IO (Either FileStoreError String))
    -> IO String -> IO (Either FileStoreError String)
    forall a b. (a -> b) -> a -> b
    $ FileStore -> String -> IO String
    latest FileStore
    fs String
    page
                             case fileTest of
                                  Right String
    _       -> String -> GititServerPart String
    forall a. a -> ServerPartT (ReaderT WikiState IO) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return String
    page  -- a source file
                                  Left FileStoreError
    NotFound -> String -> GititServerPart String
    forall a. a -> ServerPartT (ReaderT WikiState IO) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return String
    ""
                                  Left FileStoreError
    e        -> String -> GititServerPart String
    forall a. String -> ServerPartT (ReaderT WikiState IO) a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail (FileStoreError -> String
    forall a. Show a => a -> String
    show FileStoreError
    e)
                           Left FileStoreError
    e        -> String -> GititServerPart String
    forall a. String -> ServerPartT (ReaderT WikiState IO) a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail (FileStoreError -> String
    forall a. Show a => a -> String
    show FileStoreError
    e)
      let confirmForm = String -> Html -> Html
    gui String
    "" (Html -> Html) -> [Html] -> Html
    forall a b. HTML a => (Html -> b) -> a -> b
    <<
            [ Html -> Html
    p (Html -> Html) -> String -> Html
    forall a b. HTML a => (Html -> b) -> a -> b
    << String
    "Are you sure you want to delete this page?"
            , Html
    input Html -> [HtmlAttr] -> Html
    forall a. ADDATTRS a => a -> [HtmlAttr] -> a
    ! [String -> HtmlAttr
    thetype String
    "text", String -> HtmlAttr
    name String
    "filetodelete",
                       String -> String -> HtmlAttr
    strAttr String
    "style" String
    "display: none;", String -> HtmlAttr
    value String
    fileToDelete]
            , String -> String -> Html
    submit String
    "confirm" String
    "Yes, delete it!"
            , String -> Html
    stringToHtml String
    " "
            , String -> String -> Html
    submit String
    "cancel" String
    "No, keep it!"
            , Html
    br ]
      formattedPage defaultPageLayout{ pgTitle = "Delete " ++ page ++ "?" } $
        if null fileToDelete
           then ulist ! [theclass "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 String
    getPage
      cfg <- getConfig
      let file = Params -> String
    pFileToDelete Params
    params
      mbUser <- getLoggedInUser
      (user, email) <- case mbUser of
                            Maybe User
    Nothing -> (String, String)
    -> ServerPartT (ReaderT WikiState IO) (String, String)
    forall a. a -> ServerPartT (ReaderT WikiState IO) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (String
    "Anonymous", String
    "")
                            Just User
    u  -> (String, String)
    -> ServerPartT (ReaderT WikiState IO) (String, String)
    forall a. a -> ServerPartT (ReaderT WikiState IO) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (User -> String
    uUsername User
    u, User -> String
    uEmail User
    u)
      let author = String -> String -> Author
    Author String
    user String
    email
      let descrip = Config -> String
    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 String
    getPage
      cfg <- getConfig
      mbUser <- getLoggedInUser
      (user, email) <- case mbUser of
                            Maybe User
    Nothing -> (String, String)
    -> ServerPartT (ReaderT WikiState IO) (String, String)
    forall a. a -> ServerPartT (ReaderT WikiState IO) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (String
    "Anonymous", String
    "")
                            Just User
    u  -> (String, String)
    -> ServerPartT (ReaderT WikiState IO) (String, String)
    forall a. a -> ServerPartT (ReaderT WikiState IO) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (User -> String
    uUsername User
    u, User -> String
    uEmail User
    u)
      editedText <- case pEditedText params of
                         Maybe String
    Nothing -> String -> GititServerPart String
    forall a. HasCallStack => String -> a
    error String
    "No body text in POST request"
                         Just String
    b  -> String -> GititServerPart String
    applyPreCommitPlugins String
    b
      let logMsg = Params -> String
    pLogMsg Params
    params String -> String -> String
    forall a. [a] -> [a] -> [a]
    `orIfNull` Config -> String
    defaultSummary Config
    cfg
      let oldSHA1 = Params -> String
    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 () -> String -> Response -> Handler
    forall (m :: * -> *) uri res.
    (FilterMonad Response m, ToSURI uri) =>
    uri -> res -> m res
    seeOther (String
    base' String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> String
    urlForPage String
    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) -> String -> Html
    forall a b. HTML a => (Html -> b) -> a -> b
    << String
    "Page updated"
                Left (MergeInfo Revision
    mergedWithRev Bool
    conflicts String
    mergedText) -> do
                   let mergeMsg :: String
    mergeMsg = String
    "The page has been edited since you checked it out. " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++
                          String
    "Changes from revision " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Revision -> String
    revId Revision
    mergedWithRev String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++
                          String
    " have been merged into your edits below. " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++
                          if Bool
    conflicts
                             then String
    "Please resolve conflicts and Save."
                             else String
    "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 String
    forall (m :: * -> *). ServerMonad m => m String
    getPath
      base' <- getWikiBase
      cfg <- getConfig
      let ext = Config -> String
    defaultExtension Config
    cfg
      let prefix' = if String -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null String
    path' then String
    "" else String
    path' String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "/"
      fs <- getFileStore
      listing <- liftIO $ directory fs prefix'
      let isNotDiscussionPage (FSFile String
    f) = String -> ServerPartT (ReaderT WikiState IO) Bool
    isNotDiscussPageFile String
    f
          isNotDiscussionPage (FSDirectory String
    _) = 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 = String -> String -> String -> [Resource] -> Html
    fileListToHtml String
    base' String
    prefix' String
    ext [Resource]
    prunedListing
      formattedPage defaultPageLayout{
                      pgPageName = prefix',
                      pgShowPageTools = False,
                      pgTabs = [],
                      pgScripts = [],
                      pgTitle = "Contents"} htmlIndex

    fileListToHtml :: String -> String -> String -> [Resource] -> Html
    fileListToHtml :: String -> String -> String -> [Resource] -> Html
    fileListToHtml String
    base' String
    prefix String
    ext [Resource]
    files =
      let fileLink :: Resource -> Html
    fileLink (FSFile String
    f) | String -> String
    takeExtension String
    f String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    "." String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ext =
            Html -> Html
    li (Html -> Html) -> [HtmlAttr] -> Html -> Html
    forall a. ADDATTRS a => a -> [HtmlAttr] -> a
    ! [String -> HtmlAttr
    theclass String
    "page"  ] (Html -> Html) -> Html -> Html
    forall a b. HTML a => (Html -> b) -> a -> b
    <<
              Html -> Html
    anchor (Html -> Html) -> [HtmlAttr] -> Html -> Html
    forall a. ADDATTRS a => a -> [HtmlAttr] -> a
    ! [String -> HtmlAttr
    href (String -> HtmlAttr) -> String -> HtmlAttr
    forall a b. (a -> b) -> a -> b
    $ String
    base' String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> String
    urlForPage (String
    prefix String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> String
    dropExtension String
    f)] (Html -> Html) -> String -> Html
    forall a b. HTML a => (Html -> b) -> a -> b
    <<
                String -> String
    dropExtension String
    f
          fileLink (FSFile String
    f) = Html -> Html
    li (Html -> Html) -> [HtmlAttr] -> Html -> Html
    forall a. ADDATTRS a => a -> [HtmlAttr] -> a
    ! [String -> HtmlAttr
    theclass String
    "upload"] (Html -> Html) -> Html -> Html
    forall a b. HTML a => (Html -> b) -> a -> b
    << [Html] -> Html
    forall a. HTML a => [a] -> Html
    concatHtml
            [ Html -> Html
    anchor (Html -> Html) -> [HtmlAttr] -> Html -> Html
    forall a. ADDATTRS a => a -> [HtmlAttr] -> a
    ! [String -> HtmlAttr
    href (String -> HtmlAttr) -> String -> HtmlAttr
    forall a b. (a -> b) -> a -> b
    $ String
    base' String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> String
    urlForPage (String
    prefix String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    f)] (Html -> Html) -> String -> Html
    forall a b. HTML a => (Html -> b) -> a -> b
    << String
    f
            , Html -> Html
    anchor (Html -> Html) -> [HtmlAttr] -> Html -> Html
    forall a. ADDATTRS a => a -> [HtmlAttr] -> a
    ! [String -> HtmlAttr
    href (String -> HtmlAttr) -> String -> HtmlAttr
    forall a b. (a -> b) -> a -> b
    $ String
    base' String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "_delete" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> String
    urlForPage (String
    prefix String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    f)] (Html -> Html) -> String -> Html
    forall a b. HTML a => (Html -> b) -> a -> b
    << String
    "(delete)"
            ]
          fileLink (FSDirectory String
    f) =
            Html -> Html
    li (Html -> Html) -> [HtmlAttr] -> Html -> Html
    forall a. ADDATTRS a => a -> [HtmlAttr] -> a
    ! [String -> HtmlAttr
    theclass String
    "folder"] (Html -> Html) -> Html -> Html
    forall a b. HTML a => (Html -> b) -> a -> b
    <<
              Html -> Html
    anchor (Html -> Html) -> [HtmlAttr] -> Html -> Html
    forall a. ADDATTRS a => a -> [HtmlAttr] -> a
    ! [String -> HtmlAttr
    href (String -> HtmlAttr) -> String -> HtmlAttr
    forall a b. (a -> b) -> a -> b
    $ String
    base' String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> String
    urlForPage (String
    prefix String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    f) String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "/"] (Html -> Html) -> String -> Html
    forall a b. HTML a => (Html -> b) -> a -> b
    << String
    f
          updirs :: [[String]]
    updirs = Int -> [[String]] -> [[String]]
    forall a. Int -> [a] -> [a]
    drop Int
    1 ([[String]] -> [[String]]) -> [[String]] -> [[String]]
    forall a b. (a -> b) -> a -> b
    $ [String] -> [[String]]
    forall a. [a] -> [[a]]
    inits ([String] -> [[String]]) -> [String] -> [[String]]
    forall a b. (a -> b) -> a -> b
    $ String -> [String]
    splitPath (String -> [String]) -> String -> [String]
    forall a b. (a -> b) -> a -> b
    $ Char
    '/' Char -> String -> String
    forall a. a -> [a] -> [a]
    : String
    prefix
          uplink :: Html
    uplink = ([String] -> Html -> Html) -> Html -> [[String]] -> Html
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr (\[String]
    d Html
    accum ->
                      [Html] -> Html
    forall a. HTML a => [a] -> Html
    concatHtml [ Html -> Html
    anchor (Html -> Html) -> [HtmlAttr] -> Html -> Html
    forall a. ADDATTRS a => a -> [HtmlAttr] -> a
    ! [String -> HtmlAttr
    theclass String
    "updir",
                                             String -> HtmlAttr
    href (String -> HtmlAttr) -> String -> HtmlAttr
    forall a b. (a -> b) -> a -> b
    $ if [String] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [String]
    d Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    1
                                                       then String
    base' String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "/_index"
                                                       else String
    base' String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++
                                                            String -> String
    urlForPage ([String] -> String
    joinPath ([String] -> String) -> [String] -> String
    forall a b. (a -> b) -> a -> b
    $ Int -> [String] -> [String]
    forall a. Int -> [a] -> [a]
    drop Int
    1 [String]
    d)] (Html -> Html) -> String -> Html
    forall a b. HTML a => (Html -> b) -> a -> b
    <<
                      String -> [String] -> String
    forall a. HasCallStack => String -> [a] -> a
    lastNote String
    "fileListToHtml" [String]
    d, Html
    accum]) Html
    noHtml [[String]]
    updirs
      in Html
    uplink Html -> Html -> Html
    forall a b. (HTML a, HTML b) => a -> b -> Html
    +++ Html -> Html
    ulist (Html -> Html) -> [HtmlAttr] -> Html -> Html
    forall a. ADDATTRS a => a -> [HtmlAttr] -> a
    ! [String -> HtmlAttr
    theclass String
    "index"] (Html -> Html) -> [Html] -> Html
    forall a b. HTML a => (Html -> b) -> a -> b
    << (Resource -> Html) -> [Resource] -> [Html]
    forall a b. (a -> b) -> [a] -> [b]
    map 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 String
    forall (m :: * -> *). ServerMonad m => m String
    getPath
      cfg <- getConfig
      let pcategories = (Char -> Bool) -> String -> [String]
    forall a. (a -> Bool) -> [a] -> [[a]]
    wordsBy (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    ==Char
    ',') String
    path'
      let repoPath = Config -> String
    repositoryPath Config
    cfg
      let categoryDescription = String
    "Category: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ (String -> [String] -> String
    forall a. [a] -> [[a]] -> [a]
    intercalate String
    " + " [String]
    pcategories)
      fs <- getFileStore
      pages <- liftIO (index fs) >>= filterM isPageFile >>= filterM isNotDiscussPageFile
      matches <- liftM catMaybes $
                 forM pages $ \String
    f -> do
                   categories <- IO [String] -> ServerPartT (ReaderT WikiState IO) [String]
    forall a. IO a -> ServerPartT (ReaderT WikiState IO) a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO [String] -> ServerPartT (ReaderT WikiState IO) [String])
    -> IO [String] -> ServerPartT (ReaderT WikiState IO) [String]
    forall a b. (a -> b) -> a -> b
    $ String -> IO [String]
    readCategories (String -> IO [String]) -> String -> IO [String]
    forall a b. (a -> b) -> a -> b
    $ String
    repoPath String -> String -> String
    </> String
    f
                   return $ if all ( `elem` categories) pcategories
                               then Just (f, categories \\ pcategories)
                               else Nothing
      base' <- getWikiBase
      let toMatchListItem String
    file = Html -> Html
    li (Html -> Html) -> [Html] -> Html
    forall a b. HTML a => (Html -> b) -> a -> b
    <<
            [ Html -> Html
    anchor (Html -> Html) -> [HtmlAttr] -> Html -> Html
    forall a. ADDATTRS a => a -> [HtmlAttr] -> a
    ! [String -> HtmlAttr
    href (String -> HtmlAttr) -> String -> HtmlAttr
    forall a b. (a -> b) -> a -> b
    $ String
    base' String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> String
    urlForPage (String -> String
    dropExtension String
    file)] (Html -> Html) -> String -> Html
    forall a b. HTML a => (Html -> b) -> a -> b
    << String -> String
    dropExtension String
    file ]
      let toRemoveListItem String
    cat = Html -> Html
    li (Html -> Html) -> [Html] -> Html
    forall a b. HTML a => (Html -> b) -> a -> b
    <<
            [ Html -> Html
    anchor (Html -> Html) -> [HtmlAttr] -> Html -> Html
    forall a. ADDATTRS a => a -> [HtmlAttr] -> a
    ! [String -> HtmlAttr
    href (String -> HtmlAttr) -> String -> HtmlAttr
    forall a b. (a -> b) -> a -> b
    $ String
    base' String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++
            (if [String] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null ([String] -> [String]
    forall a. HasCallStack => [a] -> [a]
    tail [String]
    pcategories)
             then String
    "/_categories"
             else String
    "/_category" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> String
    urlForPage (String -> [String] -> String
    forall a. [a] -> [[a]] -> [a]
    intercalate String
    "," ([String] -> String) -> [String] -> String
    forall a b. (a -> b) -> a -> b
    $ String -> [String] -> [String]
    forall a. Eq a => a -> [a] -> [a]
    Data.List.delete String
    cat [String]
    pcategories)) ]
            (Html -> Html) -> String -> Html
    forall a b. HTML a => (Html -> b) -> a -> b
    << (String
    "-" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    cat) ]
      let toAddListItem String
    cat = Html -> Html
    li (Html -> Html) -> [Html] -> Html
    forall a b. HTML a => (Html -> b) -> a -> b
    <<
            [ Html -> Html
    anchor (Html -> Html) -> [HtmlAttr] -> Html -> Html
    forall a. ADDATTRS a => a -> [HtmlAttr] -> a
    ! [String -> HtmlAttr
    href (String -> HtmlAttr) -> String -> HtmlAttr
    forall a b. (a -> b) -> a -> b
    $ String
    base' String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++
              String
    "/_category" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> String
    urlForPage (String
    path' String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "," String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    cat) ]
            (Html -> Html) -> String -> Html
    forall a b. HTML a => (Html -> b) -> a -> b
    << (String
    "+" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    cat) ]
      let matchList = Html -> Html
    ulist (Html -> Html) -> [Html] -> Html
    forall a b. HTML a => (Html -> b) -> a -> b
    << (String -> Html) -> [String] -> [Html]
    forall a b. (a -> b) -> [a] -> [b]
    map String -> Html
    toMatchListItem (([String], [[String]]) -> [String]
    forall a b. (a, b) -> a
    fst (([String], [[String]]) -> [String])
    -> ([String], [[String]]) -> [String]
    forall a b. (a -> b) -> a -> b
    $ [(String, [String])] -> ([String], [[String]])
    forall a b. [(a, b)] -> ([a], [b])
    unzip [(String, [String])]
    matches) Html -> Html -> Html
    forall a b. (HTML a, HTML b) => a -> b -> Html
    +++
                      Html -> Html
    thediv (Html -> Html) -> [HtmlAttr] -> Html -> Html
    forall a. ADDATTRS a => a -> [HtmlAttr] -> a
    ! [ String -> HtmlAttr
    identifier String
    "categoryList" ] (Html -> Html) -> Html -> Html
    forall a b. HTML a => (Html -> b) -> a -> b
    <<
                      Html -> Html
    ulist (Html -> Html) -> [Html] -> Html
    forall a b. HTML a => (Html -> b) -> a -> b
    << [Html] -> [Html] -> [Html]
    forall a. [a] -> [a] -> [a]
    (++) ((String -> Html) -> [String] -> [Html]
    forall a b. (a -> b) -> [a] -> [b]
    map String -> Html
    toAddListItem ([String] -> [String]
    forall a. Eq a => [a] -> [a]
    nub ([String] -> [String]) -> [String] -> [String]
    forall a b. (a -> b) -> a -> b
    $ [[String]] -> [String]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat ([[String]] -> [String]) -> [[String]] -> [String]
    forall a b. (a -> b) -> a -> b
    $ ([String], [[String]]) -> [[String]]
    forall a b. (a, b) -> b
    snd (([String], [[String]]) -> [[String]])
    -> ([String], [[String]]) -> [[String]]
    forall a b. (a -> b) -> a -> b
    $ [(String, [String])] -> ([String], [[String]])
    forall a b. [(a, b)] -> ([a], [b])
    unzip [(String, [String])]
    matches))
                                    ((String -> Html) -> [String] -> [Html]
    forall a b. (a -> b) -> [a] -> [b]
    map String -> Html
    toRemoveListItem [String]
    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 -> String
    repositoryPath Config
    cfg
      fs <- getFileStore
      pages <- liftIO (index fs) >>= filterM isPageFile >>= filterM isNotDiscussPageFile
      categories <- liftIO $ liftM (nub . sort . concat) $ forM pages $ \String
    f ->
                      String -> IO [String]
    readCategories (String
    repoPath String -> String -> String
    </> String
    f)
      base' <- getWikiBase
      let toCatLink String
    ctg = Html -> Html
    li (Html -> Html) -> [Html] -> Html
    forall a b. HTML a => (Html -> b) -> a -> b
    <<
            [ Html -> Html
    anchor (Html -> Html) -> [HtmlAttr] -> Html -> Html
    forall a. ADDATTRS a => a -> [HtmlAttr] -> a
    ! [String -> HtmlAttr
    href (String -> HtmlAttr) -> String -> HtmlAttr
    forall a b. (a -> b) -> a -> b
    $ String
    base' String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "/_category" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> String
    urlForPage String
    ctg] (Html -> Html) -> String -> Html
    forall a b. HTML a => (Html -> b) -> a -> b
    << String
    ctg ]
      let htmlMatches = Html -> Html
    ulist (Html -> Html) -> [Html] -> Html
    forall a b. HTML a => (Html -> b) -> a -> b
    << (String -> Html) -> [String] -> [Html]
    forall a b. (a -> b) -> [a] -> [b]
    map String -> Html
    toCatLink [String]
    categories
      formattedPage defaultPageLayout{
                      pgPageName = "Categories",
                      pgShowPageTools = False,
                      pgTabs = [],
                      pgScripts = ["search.js"],
                      pgTitle = "Categories" } htmlMatches

    expireCache :: Handler
    expireCache :: Handler
    expireCache = do
      page <- GititServerPart String
    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 String
    Nothing    -> String -> GititServerPart String
    forall a. HasCallStack => String -> a
    error String
    "Could not determine base URL"
                            Just String
    hn    -> String -> GititServerPart String
    forall a. a -> ServerPartT (ReaderT WikiState IO) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (String -> GititServerPart String)
    -> String -> GititServerPart String
    forall a b. (a -> b) -> a -> b
    $ String
    "http://" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    hn String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    base'
                     else case baseUrl cfg ++ base' of
                               w :: String
    w@(Char
    'h':Char
    't':Char
    't':Char
    'p':Char
    's':Char
    ':':Char
    '/':Char
    '/':String
    _) -> String -> GititServerPart String
    forall a. a -> ServerPartT (ReaderT WikiState IO) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return String
    w
                               x :: String
    x@(Char
    'h':Char
    't':Char
    't':Char
    'p':Char
    ':':Char
    '/':Char
    '/':String
    _) -> String -> GititServerPart String
    forall a. a -> ServerPartT (ReaderT WikiState IO) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return String
    x
                               String
    y                                 -> String -> GititServerPart String
    forall a. a -> ServerPartT (ReaderT WikiState IO) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (String -> GititServerPart String)
    -> String -> GititServerPart String
    forall a b. (a -> b) -> a -> b
    $ String
    "http://" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    y
      let fc = FeedConfig{
                  fcTitle :: String
    fcTitle = Config -> String
    wikiTitle Config
    cfg
                , fcBaseUrl :: String
    fcBaseUrl = String
    feedBase
                , fcFeedDays :: Integer
    fcFeedDays = Config -> Integer
    feedDays Config
    cfg }
      path' <- getPath     -- e.g. "foo/bar" if they hit /_feed/foo/bar
      let file = (String
    path' String -> String -> String
    forall a. [a] -> [a] -> [a]
    `orIfNull` String
    "_site") String -> String -> String
    <.> String
    "feed"
      let mbPath = if String -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null String
    path' then Maybe String
    forall a. Maybe a
    Nothing else String -> Maybe String
    forall a. a -> Maybe a
    Just String
    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 = String -> Response -> Response
    setContentType String
    "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'