    {-# 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
                          , exportPage
                          , 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,
            exportPage, 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.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
    $ \uri :: String
    uri ->
      let path' :: String
    path' = String -> String
    uriPath String
    uri
      in  do FileStore
    fs <- GititServerPart FileStore
    getFileStore
             let rev :: Maybe String
    rev = Params -> Maybe String
    pRevision Params
    params
             String
    mimetype <- String -> GititServerPart String
    getMimeTypeForExtension
                          (String -> String
    takeExtension String
    path')
             Either FileStoreError ByteString
    res <- IO (Either FileStoreError ByteString)
    -> ServerPartT
         (ReaderT WikiState IO) (Either FileStoreError ByteString)
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO (Either FileStoreError ByteString)
     -> ServerPartT
          (ReaderT WikiState IO) (Either FileStoreError ByteString))
    -> IO (Either FileStoreError ByteString)
    -> ServerPartT
         (ReaderT WikiState IO) (Either FileStoreError ByteString)
    forall a b. (a -> b) -> a -> b
    $ IO ByteString -> IO (Either FileStoreError ByteString)
    forall e a. Exception e => IO a -> IO (Either e a)
    E.try
                    (FileStore -> String -> Maybe String -> IO ByteString
    FileStore -> forall a. Contents a => String -> Maybe String -> IO a
    retrieve FileStore
    fs String
    path' Maybe String
    rev :: IO B.ByteString)
             case Either FileStoreError ByteString
    res of
                    Right contents :: ByteString
    contents -> ServerPartT (ReaderT WikiState IO) ()
    forall a (m :: * -> *). FilterMonad a m => m ()
    ignoreFilters ServerPartT (ReaderT WikiState IO) () -> Handler -> Handler
    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 :: ByteString
    rsBody = ByteString
    contents})
                                        -- ugly hack
                    Left NotFound  -> Handler
    forall (m :: * -> *) a. MonadPlus m => m a
    mzero
                    Left e :: 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
      Request
    req <- ServerPartT (ReaderT WikiState IO) Request
    forall (m :: * -> *). ServerMonad m => m Request
    askRq
      IO () -> ServerPartT (ReaderT WikiState IO) ()
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> ServerPartT (ReaderT WikiState IO) ())
    -> IO () -> ServerPartT (ReaderT WikiState IO) ()
    forall a b. (a -> b) -> a -> b
    $ String -> Priority -> String -> IO ()
    logM "gitit" Priority
    DEBUG (Request -> String
    forall a. Show a => a -> String
    show Request
    req)
      String
    page <- GititServerPart String
    getPage
      IO () -> ServerPartT (ReaderT WikiState IO) ()
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> ServerPartT (ReaderT WikiState IO) ())
    -> IO () -> ServerPartT (ReaderT WikiState IO) ()
    forall a b. (a -> b) -> a -> b
    $ String -> Priority -> String -> IO ()
    logM "gitit" Priority
    DEBUG (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ "Page = '" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    page String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ "'\n" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++
                  Params -> String
    forall a. Show a => a -> String
    show Params
    params
      Handler
    forall (m :: * -> *) a. MonadPlus m => m a
    mzero

    randomPage :: Handler
    randomPage :: Handler
    randomPage = do
      FileStore
    fs <- GititServerPart FileStore
    getFileStore
      String
    base' <- GititServerPart String
    forall (m :: * -> *). ServerMonad m => m String
    getWikiBase
      [String]
    prunedFiles <- IO [String] -> ServerPartT (ReaderT WikiState IO) [String]
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (FileStore -> IO [String]
    index FileStore
    fs) ServerPartT (ReaderT WikiState IO) [String]
    -> ([String] -> ServerPartT (ReaderT WikiState IO) [String])
    -> ServerPartT (ReaderT WikiState IO) [String]
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= (String -> ServerPartT (ReaderT WikiState IO) Bool)
    -> [String] -> ServerPartT (ReaderT WikiState IO) [String]
    forall (m :: * -> *) a.
    Applicative m =>
    (a -> m Bool) -> [a] -> m [a]
    filterM String -> ServerPartT (ReaderT WikiState IO) Bool
    isPageFile ServerPartT (ReaderT WikiState IO) [String]
    -> ([String] -> ServerPartT (ReaderT WikiState IO) [String])
    -> ServerPartT (ReaderT WikiState IO) [String]
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= (String -> ServerPartT (ReaderT WikiState IO) Bool)
    -> [String] -> ServerPartT (ReaderT WikiState IO) [String]
    forall (m :: * -> *) a.
    Applicative m =>
    (a -> m Bool) -> [a] -> m [a]
    filterM String -> ServerPartT (ReaderT WikiState IO) Bool
    isNotDiscussPageFile
      let pages :: [String]
    pages = (String -> String) -> [String] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map String -> String
    dropExtension [String]
    prunedFiles
      if [String] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [String]
    pages
         then String -> Handler
    forall a. HasCallStack => String -> a
    error "No pages found!"
         else do
           DiffTime
    secs <- IO DiffTime -> ServerPartT (ReaderT WikiState IO) DiffTime
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO ((UTCTime -> DiffTime) -> IO UTCTime -> IO DiffTime
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap UTCTime -> DiffTime
    utctDayTime IO UTCTime
    getCurrentTime)
           let newPage :: String
    newPage = [String]
    pages [String] -> Int -> String
    forall a. [a] -> Int -> a
    !!
                         (DiffTime -> Int
    forall a b. (RealFrac a, Integral b) => a -> b
    truncate (DiffTime
    secs DiffTime -> DiffTime -> DiffTime
    forall a. Num a => a -> a -> a
    * 1000000) Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `mod` [String] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [String]
    pages)
           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
    newPage) (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
    << "Redirecting to a random page"

    discussPage :: Handler
    discussPage :: Handler
    discussPage = do
      String
    page <- GititServerPart String
    getPage
      String
    base' <- GititServerPart String
    forall (m :: * -> *). ServerMonad m => m String
    getWikiBase
      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 (if String -> Bool
    isDiscussPage String
    page then String
    page else ('@'Char -> String -> String
    forall a. a -> [a] -> [a]
    :String
    page))) (Response -> Handler) -> Response -> Handler
    forall a b. (a -> b) -> a -> b
    $
                         String -> Response
    forall a. ToMessage a => a -> Response
    toResponse "Redirecting to discussion page"

    createPage :: Handler
    createPage :: Handler
    createPage = do
      String
    page <- GititServerPart String
    getPage
      String
    base' <- GititServerPart String
    forall (m :: * -> *). ServerMonad m => m String
    getWikiBase
      case String
    page of
           ('_':_) -> Handler
    forall (m :: * -> *) a. MonadPlus m => m a
    mzero   -- don't allow creation of _index, etc.
           _       -> PageLayout -> Html -> Handler
    formattedPage PageLayout
    defaultPageLayout{
                                          pgPageName :: String
    pgPageName = String
    page
                                        , pgTabs :: [Tab]
    pgTabs = []
                                        , pgTitle :: String
    pgTitle = "Create " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    page String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ "?"
                                        } (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
                            ("There is no page named '" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    page String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ "'. 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]
    ++ "/_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
    <<
                                  ("Create the page '" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    page String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ "'")
                          , 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]
    ++ "/_search?" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++
                                    ([(String, String)] -> String
    urlEncodeVars [("patterns", String
    page)])] (Html -> Html) -> String -> Html
    forall a b. HTML a => (Html -> b) -> a -> b
    <<
                                  ("Search for pages containing the text '" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++
                                    String
    page String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ "'")])

    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 "post", String -> HtmlAttr
    enctype "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 "file"] (Html -> Html) -> String -> Html
    forall a b. HTML a => (Html -> b) -> a -> b
    << "File to upload:"
                  , Html
    br
                  , String -> Html
    afile "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 "wikiname"] (Html -> Html) -> String -> Html
    forall a b. HTML a => (Html -> b) -> a -> b
    << "Name on wiki, including extension"
                  , Html -> Html
    noscript (Html -> Html) -> String -> Html
    forall a b. HTML a => (Html -> b) -> a -> b
    << " (leave blank to use the same filename)"
                  , String -> Html
    stringToHtml ":"
                  , Html
    br
                  , String -> Html
    textfield "wikiname" Html -> [HtmlAttr] -> Html
    forall a. ADDATTRS a => a -> [HtmlAttr] -> a
    ! [String -> HtmlAttr
    value String
    wikiname]
                  , String -> Html
    primHtmlChar "nbsp"
                  , String -> String -> Html
    checkbox "overwrite" "yes"
                  , Html -> Html
    label (Html -> Html) -> [HtmlAttr] -> Html -> Html
    forall a. ADDATTRS a => a -> [HtmlAttr] -> a
    ! [String -> HtmlAttr
    thefor "overwrite"] (Html -> Html) -> String -> Html
    forall a b. HTML a => (Html -> b) -> a -> b
    << "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 "logMsg"] (Html -> Html) -> String -> Html
    forall a b. HTML a => (Html -> b) -> a -> b
    << "Description of content or changes:"
                  , Html
    br
                  , String -> Html
    textfield "logMsg" Html -> [HtmlAttr] -> Html
    forall a. ADDATTRS a => a -> [HtmlAttr] -> a
    ! [String -> HtmlAttr
    size "60", String -> HtmlAttr
    value String
    logMsg]
                  , String -> String -> Html
    submit "upload" "Upload" ]
           ]
      PageLayout -> Html -> Handler
    formattedPage PageLayout
    defaultPageLayout{
                       pgMessages :: [String]
    pgMessages = Params -> [String]
    pMessages Params
    params,
                       pgScripts :: [String]
    pgScripts = ["uploadForm.js"],
                       pgShowPageTools :: Bool
    pgShowPageTools = Bool
    False,
                       pgTabs :: [Tab]
    pgTabs = [],
                       pgTitle :: String
    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
    =='/')
                     (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
      Config
    cfg <- GititServerPart Config
    getConfig
      Bool
    wPF <- String -> ServerPartT (ReaderT WikiState IO) Bool
    isPageFile String
    wikiname
      Maybe User
    mbUser <- GititServerPart (Maybe User)
    getLoggedInUser
      (user :: String
    user, email :: String
    email) <- case Maybe User
    mbUser of
                            Nothing -> (String, String)
    -> ServerPartT (ReaderT WikiState IO) (String, String)
    forall (m :: * -> *) a. Monad m => a -> m a
    return ("Anonymous", "")
                            Just u :: User
    u  -> (String, String)
    -> ServerPartT (ReaderT WikiState IO) (String, String)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (User -> String
    uUsername User
    u, User -> String
    uEmail User
    u)
      let overwrite :: Bool
    overwrite = Params -> Bool
    pOverwrite Params
    params
      FileStore
    fs <- GititServerPart FileStore
    getFileStore
      Bool
    exists <- IO Bool -> ServerPartT (ReaderT WikiState IO) Bool
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO Bool -> ServerPartT (ReaderT WikiState IO) Bool)
    -> IO Bool -> ServerPartT (ReaderT WikiState IO) Bool
    forall a b. (a -> b) -> a -> b
    $ IO Bool -> (FileStoreError -> IO Bool) -> IO Bool
    forall e a. Exception e => IO a -> (e -> IO a) -> IO a
    E.catch (FileStore -> String -> IO String
    latest FileStore
    fs String
    wikiname IO String -> IO Bool -> IO Bool
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Bool -> IO Bool
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    True) ((FileStoreError -> IO Bool) -> IO Bool)
    -> (FileStoreError -> IO Bool) -> IO Bool
    forall a b. (a -> b) -> a -> b
    $ \e :: FileStoreError
    e ->
                          if FileStoreError
    e FileStoreError -> FileStoreError -> Bool
    forall a. Eq a => a -> a -> Bool
    == FileStoreError
    NotFound
                             then Bool -> IO Bool
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    False
                             else FileStoreError -> IO Any
    forall e a. Exception e => e -> IO a
    E.throwIO FileStoreError
    e IO Any -> IO Bool -> IO Bool
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Bool -> IO Bool
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    True
      let inStaticDir :: Bool
    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 :: Bool
    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]
    dirs' = String -> [String]
    splitDirectories (String -> [String]) -> String -> [String]
    forall a b. (a -> b) -> a -> b
    $ String -> String
    takeDirectory String
    wikiname
      let imageExtensions :: [String]
    imageExtensions = [".png", ".jpg", ".gif"]
      let errors :: [String]
    errors = [(Bool, String)] -> [String]
    validate
                     [ (String -> 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,
                        "Description cannot be empty.")
                     , (".." String -> [String] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [String]
    dirs', "Wikiname cannot contain '..'")
                     , (String -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null String
    origPath, "File not found.")
                     , (Bool
    inStaticDir,  "Destination is inside static directory.")
                     , (Bool
    inTemplatesDir,  "Destination is inside templates directory.")
                     , (Bool -> Bool
    not Bool
    overwrite Bool -> Bool -> Bool
    && Bool
    exists, "A file named '" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    wikiname String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++
                        "' already exists in the repository: choose a new name " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++
                        "or check the box to overwrite the existing file.")
                     , (Bool
    wPF,
                        "This file extension is reserved for wiki pages.")
                     ]
      if [String] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [String]
    errors
         then do
           String -> ServerPartT (ReaderT WikiState IO) ()
    expireCachedFile String
    wikiname ServerPartT (ReaderT WikiState IO) ()
    -> ServerPartT (ReaderT WikiState IO) ()
    -> ServerPartT (ReaderT WikiState IO) ()
    forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
    `mplus` () -> ServerPartT (ReaderT WikiState IO) ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
           ByteString
    fileContents <- IO ByteString -> ServerPartT (ReaderT WikiState IO) ByteString
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO ByteString -> ServerPartT (ReaderT WikiState IO) ByteString)
    -> IO ByteString -> ServerPartT (ReaderT WikiState IO) ByteString
    forall a b. (a -> b) -> a -> b
    $ String -> IO ByteString
    B.readFile String
    filePath
           let len :: Int64
    len = ByteString -> Int64
    B.length ByteString
    fileContents
           IO () -> ServerPartT (ReaderT WikiState IO) ()
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> ServerPartT (ReaderT WikiState IO) ())
    -> IO () -> ServerPartT (ReaderT WikiState IO) ()
    forall a b. (a -> b) -> a -> b
    $ FileStore -> String -> Author -> String -> ByteString -> IO ()
    FileStore
    -> forall a. Contents a => String -> Author -> String -> a -> IO ()
    save FileStore
    fs String
    wikiname (String -> String -> Author
    Author String
    user String
    email) String
    logMsg ByteString
    fileContents
           let contents :: Html
    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
    << ("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]
    ++ " bytes")
                 , if String -> String
    takeExtension String
    wikiname String -> [String] -> 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
    << "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
    << ("![alt text](/" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    wikiname String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ ")")
                      else Html -> Html
    p (Html -> Html) -> String -> Html
    forall a b. HTML a => (Html -> b) -> a -> b
    << "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
    << ("[link label](/" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    wikiname String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ ")") ]
           PageLayout -> Html -> Handler
    formattedPage PageLayout
    defaultPageLayout{
                           pgMessages :: [String]
    pgMessages = Params -> [String]
    pMessages Params
    params,
                           pgShowPageTools :: Bool
    pgShowPageTools = Bool
    False,
                           pgTabs :: [Tab]
    pgTabs = [],
                           pgTitle :: String
    pgTitle = "Upload successful"}
                         Html
    contents
         else [String] -> Handler -> Handler
    forall (m :: * -> *) a. ServerMonad m => [String] -> m a -> m a
    withMessages [String]
    errors Handler
    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
      FileStore
    fs <- GititServerPart FileStore
    getFileStore
      [String]
    pruned_files <- IO [String] -> ServerPartT (ReaderT WikiState IO) [String]
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (FileStore -> IO [String]
    index FileStore
    fs) ServerPartT (ReaderT WikiState IO) [String]
    -> ([String] -> ServerPartT (ReaderT WikiState IO) [String])
    -> ServerPartT (ReaderT WikiState IO) [String]
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= (String -> ServerPartT (ReaderT WikiState IO) Bool)
    -> [String] -> ServerPartT (ReaderT WikiState IO) [String]
    forall (m :: * -> *) a.
    Applicative m =>
    (a -> m Bool) -> [a] -> m [a]
    filterM String -> ServerPartT (ReaderT WikiState IO) Bool
    isPageFile
      let allPageNames :: [String]
    allPageNames = (String -> String) -> [String] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map String -> String
    dropExtension [String]
    pruned_files
      let findPage :: (String -> Bool) -> Maybe String
    findPage f :: 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 -> Bool
    exactMatch f :: String
    f = String
    gotopage String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    f
      let insensitiveMatch :: String -> Bool
    insensitiveMatch f :: 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 -> Bool
    prefixMatch f :: 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)
      String
    base' <- GititServerPart String
    forall (m :: * -> *). ServerMonad m => m String
    getWikiBase
      case (String -> Bool) -> Maybe String
    findPage String -> Bool
    exactMatch of
           Just m :: 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
                         "Redirecting to exact match"
           Nothing -> case (String -> Bool) -> Maybe String
    findPage String -> Bool
    insensitiveMatch of
                           Just m :: 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
                                        "Redirecting to case-insensitive match"
                           Nothing -> case (String -> Bool) -> Maybe String
    findPage String -> Bool
    prefixMatch of
                                           Just m :: 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
    $ "Redirecting" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++
                                                        " to partial match"
                                           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]
      FileStore
    fs <- GititServerPart FileStore
    getFileStore
      [SearchMatch]
    matchLines <- if [String] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [String]
    patterns
                       then [SearchMatch] -> ServerPartT (ReaderT WikiState IO) [SearchMatch]
    forall (m :: * -> *) a. Monad m => a -> m a
    return []
                       else IO [SearchMatch]
    -> ServerPartT (ReaderT WikiState IO) [SearchMatch]
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO [SearchMatch]
     -> ServerPartT (ReaderT WikiState IO) [SearchMatch])
    -> IO [SearchMatch]
    -> ServerPartT (ReaderT WikiState IO) [SearchMatch]
    forall a b. (a -> b) -> a -> b
    $ IO [SearchMatch]
    -> (FileStoreError -> IO [SearchMatch]) -> IO [SearchMatch]
    forall e a. Exception e => IO a -> (e -> IO a) -> IO a
    E.catch (FileStore -> SearchQuery -> IO [SearchMatch]
    search FileStore
    fs SearchQuery :: [String] -> Bool -> Bool -> Bool -> SearchQuery
    SearchQuery{
                                                      queryPatterns :: [String]
    queryPatterns = [String]
    patterns
                                                    , queryWholeWords :: Bool
    queryWholeWords = Bool
    True
                                                    , queryMatchAll :: Bool
    queryMatchAll = Bool
    True
                                                    , queryIgnoreCase :: Bool
    queryIgnoreCase = Bool
    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 (m :: * -> *) a. Monad m => a -> m a
    return [])
      let contentMatches :: [String]
    contentMatches = (SearchMatch -> String) -> [SearchMatch] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map SearchMatch -> String
    matchResourceName [SearchMatch]
    matchLines
      [String]
    allPages <- IO [String] -> ServerPartT (ReaderT WikiState IO) [String]
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (FileStore -> IO [String]
    index FileStore
    fs) ServerPartT (ReaderT WikiState IO) [String]
    -> ([String] -> ServerPartT (ReaderT WikiState IO) [String])
    -> ServerPartT (ReaderT WikiState IO) [String]
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= (String -> ServerPartT (ReaderT WikiState IO) Bool)
    -> [String] -> ServerPartT (ReaderT WikiState IO) [String]
    forall (m :: * -> *) a.
    Applicative m =>
    (a -> m Bool) -> [a] -> m [a]
    filterM String -> ServerPartT (ReaderT WikiState IO) Bool
    isPageFile
      let slashToSpace :: String -> String
    slashToSpace = (Char -> Char) -> String -> String
    forall a b. (a -> b) -> [a] -> [b]
    map (\c :: Char
    c -> if Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == '/' then ' ' else Char
    c)
      let inPageName :: String -> String -> Bool
    inPageName pageName' :: String
    pageName' x :: String
    x = String
    x String -> [String] -> 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 -> Bool
    matchesPatterns pageName' :: String
    pageName' = Bool -> Bool
    not ([String] -> 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]
    pageNameMatches = (String -> Bool) -> [String] -> [String]
    forall a. (a -> Bool) -> [a] -> [a]
    filter String -> Bool
    matchesPatterns [String]
    allPages
      [String]
    prunedFiles <- (String -> ServerPartT (ReaderT WikiState IO) Bool)
    -> [String] -> ServerPartT (ReaderT WikiState IO) [String]
    forall (m :: * -> *) a.
    Applicative m =>
    (a -> m Bool) -> [a] -> m [a]
    filterM String -> ServerPartT (ReaderT WikiState IO) Bool
    isPageFile ([String]
    contentMatches [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++ [String]
    pageNameMatches)
      let allMatchedFiles :: [String]
    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 -> [String]
    matchesInFile f :: String
    f =  (SearchMatch -> Maybe String) -> [SearchMatch] -> [String]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe (\x :: 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])]
    matches = (String -> (String, [String])) -> [String] -> [(String, [String])]
    forall a b. (a -> b) -> [a] -> [b]
    map (\f :: String
    f -> (String
    f, String -> [String]
    matchesInFile String
    f)) [String]
    allMatchedFiles
      let relevance :: (String, t a) -> Int
    relevance (f :: String
    f, ms :: t a
    ms) = 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 (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [String]
    pageNameMatches
                                             then 100
                                             else 0
      let preamble :: Html
    preamble = if [String] -> 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
    << ["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 (t :: * -> *) a. Foldable t => t a -> Int
    length [(String, [String])]
    matches) String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ " matches found for ")
                                   , Html -> Html
    thespan (Html -> Html) -> [HtmlAttr] -> Html -> Html
    forall a. ADDATTRS a => a -> [HtmlAttr] -> a
    ! [String -> HtmlAttr
    identifier "pattern"] (Html -> Html) -> String -> Html
    forall a b. HTML a => (Html -> b) -> a -> b
    << [String] -> String
    unwords [String]
    patterns]
      String
    base' <- GititServerPart String
    forall (m :: * -> *). ServerMonad m => m String
    getWikiBase
      let toMatchListItem :: (String, [String]) -> Html
    toMatchListItem (file :: String
    file, contents :: [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
    forall a. [a] -> [a] -> [a]
    ++ Int -> String
    forall a. Show a => a -> String
    show ([String] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [String]
    contents) String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ " matching lines)")
            , String -> Html
    stringToHtml " "
            , Html -> Html
    anchor (Html -> Html) -> [HtmlAttr] -> Html -> Html
    forall a. ADDATTRS a => a -> [HtmlAttr] -> a
    ! [String -> HtmlAttr
    href "#", String -> HtmlAttr
    theclass "showmatch",
                        String -> HtmlAttr
    thestyle "display: none;"] (Html -> Html) -> String -> Html
    forall a b. HTML a => (Html -> b) -> a -> b
    << if [String] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [String]
    contents Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > 0
                                                         then "[show matches]"
                                                         else ""
            , Html -> Html
    pre (Html -> Html) -> [HtmlAttr] -> Html -> Html
    forall a. ADDATTRS a => a -> [HtmlAttr] -> a
    ! [String -> HtmlAttr
    theclass "matches"] (Html -> Html) -> String -> Html
    forall a b. HTML a => (Html -> b) -> a -> b
    << [String] -> String
    unlines [String]
    contents]
      let htmlMatches :: Html
    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)
      PageLayout -> Html -> Handler
    formattedPage PageLayout
    defaultPageLayout{
                      pgMessages :: [String]
    pgMessages = Params -> [String]
    pMessages Params
    params,
                      pgShowPageTools :: Bool
    pgShowPageTools = Bool
    False,
                      pgTabs :: [Tab]
    pgTabs = [],
                      pgScripts :: [String]
    pgScripts = ["search.js"],
                      pgTitle :: String
    pgTitle = "Search results"}
                    Html
    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
      String
    page <- GititServerPart String
    getPage
      Config
    cfg <- GititServerPart Config
    getConfig
      String -> String -> Params -> Handler
    showHistory (String -> String -> String
    pathForPage String
    page (String -> String) -> String -> String
    forall a b. (a -> b) -> a -> b
    $ Config -> String
    defaultExtension Config
    cfg) String
    page Params
    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
      String
    file <- GititServerPart String
    getPage
      String -> String -> Params -> Handler
    showHistory String
    file String
    file Params
    params

    showHistory :: String -> String -> Params -> Handler
    showHistory :: String -> String -> Params -> Handler
    showHistory file :: String
    file page :: String
    page params :: Params
    params =  do
      FileStore
    fs <- GititServerPart FileStore
    getFileStore
      [Revision]
    hist <- IO [Revision] -> ServerPartT (ReaderT WikiState IO) [Revision]
    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)
                (Int -> Maybe Int
    forall a. a -> Maybe a
    Just (Int -> Maybe Int) -> Int -> Maybe Int
    forall a b. (a -> b) -> a -> b
    $ Params -> Int
    pLimit Params
    params)
      String
    base' <- GititServerPart String
    forall (m :: * -> *). ServerMonad m => m String
    getWikiBase
      let versionToHtml :: Revision -> Int -> Html
    versionToHtml rev :: Revision
    rev pos :: Int
    pos = Html -> Html
    li (Html -> Html) -> [HtmlAttr] -> Html -> Html
    forall a. ADDATTRS a => a -> [HtmlAttr] -> a
    ! [String -> HtmlAttr
    theclass "difflink", String -> Int -> HtmlAttr
    intAttr "order" Int
    pos,
                                        String -> String -> HtmlAttr
    strAttr "revision" (Revision -> String
    revId Revision
    rev),
                                        String -> String -> HtmlAttr
    strAttr "diffurl" (String
    base' String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ "/_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 "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 " ("
            , Html -> Html
    thespan (Html -> Html) -> [HtmlAttr] -> Html -> Html
    forall a. ADDATTRS a => a -> [HtmlAttr] -> a
    ! [String -> HtmlAttr
    theclass "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]
    ++ "/_activity?" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++
                [(String, String)] -> String
    urlEncodeVars [("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 "): "
            , 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]
    ++ "?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 "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 " [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]
    ++ "/_diff" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> String
    urlForPage String
    page String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ "?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
    <<
                      "previous" ] [Html] -> [Html] -> [Html]
    forall a. [a] -> [a] -> [a]
    ++
                 (if Int
    pos Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    /= 1
                      then [ String -> Html
    primHtmlChar "nbsp"
                           , String -> Html
    primHtmlChar "bull"
                           , String -> Html
    primHtmlChar "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]
    ++ "/_diff" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> String
    urlForPage String
    page String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ "?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
    << "current"
                           ]
                      else []) [Html] -> [Html] -> [Html]
    forall a. [a] -> [a] -> [a]
    ++
                 [String -> Html
    stringToHtml "]"])
            ]
      let contents :: Html
    contents = if [Revision] -> 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 "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 (t :: * -> *) a. Foldable t => t a -> Int
    length [Revision]
    hist, ([Revision] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Revision]
    hist Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - 1)..1]
      let more :: Html
    more = if [Revision] -> 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]
    ++ "/_history" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> String
    urlForPage String
    page
                                     String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ "?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
    + 100)] (Html -> Html) -> String -> Html
    forall a b. HTML a => (Html -> b) -> a -> b
    <<
                                     "Show more..."
                    else Html
    noHtml
      let tabs :: [Tab]
    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
      PageLayout -> Html -> Handler
    formattedPage PageLayout
    defaultPageLayout{
                       pgPageName :: String
    pgPageName = String
    page,
                       pgMessages :: [String]
    pgMessages = Params -> [String]
    pMessages Params
    params,
                       pgScripts :: [String]
    pgScripts = ["dragdiff.js"],
                       pgTabs :: [Tab]
    pgTabs = [Tab]
    tabs,
                       pgSelectedTab :: Tab
    pgSelectedTab = Tab
    HistoryTab,
                       pgTitle :: String
    pgTitle = ("Changes to " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    page)
                       } (Html -> Handler) -> Html -> Handler
    forall a b. (a -> b) -> a -> b
    $ Html
    contents Html -> Html -> Html
    forall a b. (HTML a, HTML b) => a -> b -> Html
    +++ Html
    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
      Config
    cfg <- GititServerPart Config
    getConfig
      UTCTime
    currTime <- IO UTCTime -> ServerPartT (ReaderT WikiState IO) UTCTime
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO IO UTCTime
    getCurrentTime
      let defaultDaysAgo :: NominalDiffTime
    defaultDaysAgo = Int -> NominalDiffTime
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Config -> Int
    recentActivityDays Config
    cfg)
      let daysAgo :: UTCTime
    daysAgo = NominalDiffTime -> UTCTime -> UTCTime
    addUTCTime (NominalDiffTime
    defaultDaysAgo NominalDiffTime -> NominalDiffTime -> NominalDiffTime
    forall a. Num a => a -> a -> a
    * (-60) NominalDiffTime -> NominalDiffTime -> NominalDiffTime
    forall a. Num a => a -> a -> a
    * 60 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
    forall a. Num a => a -> a -> a
    * 24) UTCTime
    currTime
      let since :: Maybe UTCTime
    since = case Params -> Maybe UTCTime
    pSince Params
    params of
                       Nothing -> UTCTime -> Maybe UTCTime
    forall a. a -> Maybe a
    Just UTCTime
    daysAgo
                       Just t :: UTCTime
    t  -> UTCTime -> Maybe UTCTime
    forall a. a -> Maybe a
    Just UTCTime
    t
      let forUser :: Maybe String
    forUser = Params -> Maybe String
    pForUser Params
    params
      FileStore
    fs <- GititServerPart FileStore
    getFileStore
      [Revision]
    hist <- IO [Revision] -> ServerPartT (ReaderT WikiState IO) [Revision]
    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 [] (Maybe UTCTime -> Maybe UTCTime -> TimeRange
    TimeRange Maybe UTCTime
    since Maybe UTCTime
    forall a. Maybe a
    Nothing)
                         (Int -> Maybe Int
    forall a. a -> Maybe a
    Just (Int -> Maybe Int) -> Int -> Maybe Int
    forall a b. (a -> b) -> a -> b
    $ Params -> Int
    pLimit Params
    params)
      let hist' :: [Revision]
    hist' = case Maybe String
    forUser of
                       Nothing -> [Revision]
    hist
                       Just u :: String
    u  -> (Revision -> Bool) -> [Revision] -> [Revision]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (\r :: 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 :: Change -> String
    fileFromChange (Added f :: String
    f)    = String
    f
          fileFromChange (Modified f :: String
    f) = String
    f
          fileFromChange (Deleted f :: String
    f)  = String
    f
      String
    base' <- GititServerPart String
    forall (m :: * -> *). ServerMonad m => m String
    getWikiBase
      let fileAnchor :: String -> String -> Html
    fileAnchor revis :: String
    revis file :: String
    file = if String -> String
    takeExtension String
    file String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == "." 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]
    ++ "/_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]
    ++ "?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]
    ++ "?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] -> String -> [Html]
    filesFor changes :: [Change]
    changes revis :: String
    revis = Html -> [Html] -> [Html]
    forall a. a -> [a] -> [a]
    intersperse (String -> Html
    stringToHtml " ") ([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
    heading = Html -> Html
    h1 (Html -> Html) -> String -> Html
    forall a b. HTML a => (Html -> b) -> a -> b
    << ("Recent changes by " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> Maybe String -> String
    forall a. a -> Maybe a -> a
    fromMaybe "all users" Maybe String
    forUser)
      let revToListItem :: Revision -> Html
    revToListItem rev :: 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 "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 " ("
            , Html -> Html
    thespan (Html -> Html) -> [HtmlAttr] -> Html -> Html
    forall a. ADDATTRS a => a -> [HtmlAttr] -> a
    ! [String -> HtmlAttr
    theclass "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]
    ++ "/_activity?" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++
                  [(String, String)] -> String
    urlEncodeVars [("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 "): "
            , Html -> Html
    thespan (Html -> Html) -> [HtmlAttr] -> Html -> Html
    forall a. ADDATTRS a => a -> [HtmlAttr] -> a
    ! [String -> HtmlAttr
    theclass "subject"] (Html -> Html) -> String -> Html
    forall a b. HTML a => (Html -> b) -> a -> b
    << Revision -> String
    revDescription Revision
    rev
            , String -> Html
    stringToHtml " ("
            , Html -> Html
    thespan (Html -> Html) -> [HtmlAttr] -> Html -> Html
    forall a. ADDATTRS a => a -> [HtmlAttr] -> a
    ! [String -> HtmlAttr
    theclass "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 ")"
            ]
      let contents :: Html
    contents = Html -> Html
    ulist (Html -> Html) -> [HtmlAttr] -> Html -> Html
    forall a. ADDATTRS a => a -> [HtmlAttr] -> a
    ! [String -> HtmlAttr
    theclass "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'
      PageLayout -> Html -> Handler
    formattedPage PageLayout
    defaultPageLayout{
                      pgMessages :: [String]
    pgMessages = Params -> [String]
    pMessages Params
    params,
                      pgShowPageTools :: Bool
    pgShowPageTools = Bool
    False,
                      pgTabs :: [Tab]
    pgTabs = [],
                      pgTitle :: String
    pgTitle = "Recent changes"
                      } (Html
    heading Html -> Html -> Html
    forall a b. (HTML a, HTML b) => a -> b -> Html
    +++ Html
    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
      String
    page <- GititServerPart String
    getPage
      Config
    cfg <- GititServerPart Config
    getConfig
      String -> String -> Params -> Handler
    showDiff (String -> String -> String
    pathForPage String
    page (String -> String) -> String -> String
    forall a b. (a -> b) -> a -> b
    $ Config -> String
    defaultExtension Config
    cfg) String
    page Params
    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
      String
    page <- GititServerPart String
    getPage
      String -> String -> Params -> Handler
    showDiff String
    page String
    page Params
    params

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

    getDiff :: FileStore -> FilePath -> Maybe RevisionId -> Maybe RevisionId
            -> IO Html
    getDiff :: FileStore -> String -> Maybe String -> Maybe String -> IO Html
    getDiff fs :: FileStore
    fs file :: String
    file from :: Maybe String
    from to :: Maybe String
    to = do
      [Diff [String]]
    rawDiff <- FileStore
    -> String -> Maybe String -> Maybe String -> IO [Diff [String]]
    diff FileStore
    fs String
    file Maybe String
    from Maybe String
    to
      let diffLineToHtml :: Diff [String] -> Html
    diffLineToHtml (Both xs :: [String]
    xs _) = Html -> Html
    thespan (Html -> Html) -> String -> Html
    forall a b. HTML a => (Html -> b) -> a -> b
    << [String] -> String
    unlines [String]
    xs
          diffLineToHtml (First xs :: [String]
    xs) = Html -> Html
    thespan (Html -> Html) -> [HtmlAttr] -> Html -> Html
    forall a. ADDATTRS a => a -> [HtmlAttr] -> a
    ! [String -> HtmlAttr
    theclass "deleted"] (Html -> Html) -> String -> Html
    forall a b. HTML a => (Html -> b) -> a -> b
    << [String] -> String
    unlines [String]
    xs
          diffLineToHtml (Second xs :: [String]
    xs) = Html -> Html
    thespan (Html -> Html) -> [HtmlAttr] -> Html -> Html
    forall a. ADDATTRS a => a -> [HtmlAttr] -> a
    ! [String -> HtmlAttr
    theclass "added"]  (Html -> Html) -> String -> Html
    forall a b. HTML a => (Html -> b) -> a -> b
    << [String] -> String
    unlines [String]
    xs
      Html -> IO Html
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Html -> IO Html) -> Html -> IO Html
    forall a b. (a -> b) -> a -> b
    $ Html -> Html
    h2 (Html -> Html) -> [HtmlAttr] -> Html -> Html
    forall a. ADDATTRS a => a -> [HtmlAttr] -> a
    ! [String -> HtmlAttr
    theclass "revision"] (Html -> Html) -> String -> Html
    forall a b. HTML a => (Html -> b) -> a -> b
    <<
                 ("Changes from " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> Maybe String -> String
    forall a. a -> Maybe a -> a
    fromMaybe "beginning" Maybe String
    from String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++
                  " to " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> Maybe String -> String
    forall a. a -> Maybe a -> a
    fromMaybe "current" Maybe String
    to) Html -> Html -> Html
    forall a b. (HTML a, HTML b) => a -> b -> Html
    +++
               Html -> Html
    pre (Html -> Html) -> [HtmlAttr] -> Html -> Html
    forall a. ADDATTRS a => a -> [HtmlAttr] -> a
    ! [String -> HtmlAttr
    theclass "diff"] (Html -> Html) -> [Html] -> Html
    forall a b. HTML a => (Html -> b) -> a -> b
    << (Diff [String] -> Html) -> [Diff [String]] -> [Html]
    forall a b. (a -> b) -> [a] -> [b]
    map Diff [String] -> Html
    diffLineToHtml [Diff [String]]
    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
    params = do
      let rev :: Maybe String
    rev = Params -> Maybe String
    pRevision Params
    params  -- if this is set, we're doing a revert
      FileStore
    fs <- GititServerPart FileStore
    getFileStore
      String
    page <- GititServerPart String
    getPage
      Config
    cfg <- GititServerPart Config
    getConfig
      let getRevisionAndText :: IO (Maybe String, String)
    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 String
    c <- IO String -> IO String
    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 -> String -> Maybe String -> IO String
    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)
                Revision
    r <- IO Revision -> IO Revision
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO Revision -> IO Revision) -> IO Revision -> IO Revision
    forall a b. (a -> b) -> a -> b
    $ FileStore -> String -> IO String
    latest FileStore
    fs (String -> String -> String
    pathForPage String
    page (String -> String) -> String -> String
    forall a b. (a -> b) -> a -> b
    $ Config -> String
    defaultExtension Config
    cfg) IO String -> (String -> IO Revision) -> IO Revision
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= FileStore -> String -> IO Revision
    revision FileStore
    fs
                (Maybe String, String) -> IO (Maybe String, String)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (String -> Maybe String
    forall a. a -> Maybe a
    Just (String -> Maybe String) -> String -> Maybe String
    forall a b. (a -> b) -> a -> b
    $ Revision -> String
    revId Revision
    r, String
    c))
            (\e :: 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 (m :: * -> *) a. Monad m => a -> m a
    return (Maybe String
    forall a. Maybe a
    Nothing, "")
                      else FileStoreError -> IO (Maybe String, String)
    forall e a. Exception e => e -> IO a
    E.throwIO FileStoreError
    e)
      (mbRev :: Maybe String
    mbRev, raw :: String
    raw) <- case Params -> Maybe String
    pEditedText Params
    params of
                             Nothing -> IO (Maybe String, String)
    -> ServerPartT (ReaderT WikiState IO) (Maybe String, String)
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO IO (Maybe String, String)
    getRevisionAndText
                             Just t :: String
    t  -> let r :: Maybe String
    r = if String -> 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 (m :: * -> *) a. Monad m => a -> m a
    return (Maybe String
    r, String
    t)
      let messages :: [String]
    messages = Params -> [String]
    pMessages Params
    params
      let logMsg :: String
    logMsg = Params -> String
    pLogMsg Params
    params
      let sha1Box :: Html
    sha1Box = case Maybe String
    mbRev of
                     Just r :: String
    r  -> String -> Html
    textfield "sha1" Html -> [HtmlAttr] -> Html
    forall a. ADDATTRS a => a -> [HtmlAttr] -> a
    ! [String -> HtmlAttr
    thestyle "display: none",
                                                    String -> HtmlAttr
    value String
    r]
                     Nothing -> Html
    noHtml
      let readonly :: [HtmlAttr]
    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 "readonly" "yes",
                              String -> String -> HtmlAttr
    strAttr "style" "color: gray"]
                        else []
      String
    base' <- GititServerPart String
    forall (m :: * -> *). ServerMonad m => m String
    getWikiBase
      let editForm :: Html
    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 "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 "80", String -> HtmlAttr
    name "editedText",
                                      String -> HtmlAttr
    identifier "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 "logMsg"] (Html -> Html) -> String -> Html
    forall a b. HTML a => (Html -> b) -> a -> b
    << "Description of changes:"
                       , Html
    br
                       , String -> Html
    textfield "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 "update" "Save"
                       , String -> Html
    primHtmlChar "nbsp"
                       , String -> String -> Html
    submit "cancel" "Discard"
                       , String -> Html
    primHtmlChar "nbsp"
                       , Html
    input Html -> [HtmlAttr] -> Html
    forall a. ADDATTRS a => a -> [HtmlAttr] -> a
    ! [String -> HtmlAttr
    thetype "button", String -> HtmlAttr
    theclass "editButton",
                                  String -> HtmlAttr
    identifier "previewButton",
                                  String -> String -> HtmlAttr
    strAttr "onClick" "updatePreviewPane();",
                                  String -> String -> HtmlAttr
    strAttr "style" "display: none;",
                                  String -> HtmlAttr
    value "Preview" ]
                       , Html -> Html
    thediv (Html -> Html) -> [HtmlAttr] -> Html -> Html
    forall a. ADDATTRS a => a -> [HtmlAttr] -> a
    ! [ String -> HtmlAttr
    identifier "previewpane" ] (Html -> Html) -> Html -> Html
    forall a b. HTML a => (Html -> b) -> a -> b
    << Html
    noHtml
                       ]
      let pgScripts' :: [String]
    pgScripts' = ["preview.js"]
      let pgScripts'' :: [String]
    pgScripts'' = case Config -> MathMethod
    mathMethod Config
    cfg of
           MathML       -> "MathMLinHTML.js" String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    : [String]
    pgScripts'
           MathJax url :: String
    url  -> String
    url String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    : [String]
    pgScripts'
           _            -> [String]
    pgScripts'
      PageLayout -> Html -> Handler
    formattedPage PageLayout
    defaultPageLayout{
                      pgPageName :: String
    pgPageName = String
    page,
                      pgMessages :: [String]
    pgMessages = [String]
    messages,
                      pgRevision :: Maybe String
    pgRevision = Maybe String
    rev,
                      pgShowPageTools :: Bool
    pgShowPageTools = Bool
    False,
                      pgShowSiteNav :: Bool
    pgShowSiteNav = Bool
    False,
                      pgMarkupHelp :: Maybe Text
    pgMarkupHelp = Text -> Maybe Text
    forall a. a -> Maybe a
    Just (Text -> Maybe Text) -> Text -> Maybe Text
    forall a b. (a -> b) -> a -> b
    $ Config -> Text
    markupHelp Config
    cfg,
                      pgSelectedTab :: Tab
    pgSelectedTab = Tab
    EditTab,
                      pgScripts :: [String]
    pgScripts = [String]
    pgScripts'',
                      pgTitle :: String
    pgTitle = ("Editing " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    page)
                      } Html
    editForm

    confirmDelete :: Handler
    confirmDelete :: Handler
    confirmDelete = do
      String
    page <- GititServerPart String
    getPage
      FileStore
    fs <- GititServerPart FileStore
    getFileStore
      Config
    cfg <- GititServerPart Config
    getConfig
      -- determine whether there is a corresponding page, and if not whether there
      -- is a corresponding file
      Either FileStoreError String
    pageTest <- IO (Either FileStoreError String)
    -> ServerPartT
         (ReaderT WikiState IO) (Either FileStoreError String)
    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 -> String -> String
    pathForPage String
    page (String -> String) -> String -> String
    forall a b. (a -> b) -> a -> b
    $ Config -> String
    defaultExtension Config
    cfg)
      String
    fileToDelete <- case Either FileStoreError String
    pageTest of
                           Right _        -> String -> GititServerPart String
    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  NotFound -> do
                             Either FileStoreError String
    fileTest <- IO (Either FileStoreError String)
    -> ServerPartT
         (ReaderT WikiState IO) (Either FileStoreError String)
    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 Either FileStoreError String
    fileTest of
                                  Right _       -> String -> GititServerPart String
    forall (m :: * -> *) a. Monad m => a -> m a
    return String
    page  -- a source file
                                  Left NotFound -> String -> GititServerPart String
    forall (m :: * -> *) a. Monad m => a -> m a
    return ""
                                  Left e :: FileStoreError
    e        -> String -> GititServerPart String
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail (FileStoreError -> String
    forall a. Show a => a -> String
    show FileStoreError
    e)
                           Left e :: FileStoreError
    e        -> String -> GititServerPart String
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail (FileStoreError -> String
    forall a. Show a => a -> String
    show FileStoreError
    e)
      let confirmForm :: Html
    confirmForm = String -> Html -> Html
    gui "" (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
    << "Are you sure you want to delete this page?"
            , Html
    input Html -> [HtmlAttr] -> Html
    forall a. ADDATTRS a => a -> [HtmlAttr] -> a
    ! [String -> HtmlAttr
    thetype "text", String -> HtmlAttr
    name "filetodelete",
                       String -> String -> HtmlAttr
    strAttr "style" "display: none;", String -> HtmlAttr
    value String
    fileToDelete]
            , String -> String -> Html
    submit "confirm" "Yes, delete it!"
            , String -> Html
    stringToHtml " "
            , String -> String -> Html
    submit "cancel" "No, keep it!"
            , Html
    br ]
      PageLayout -> Html -> Handler
    formattedPage PageLayout
    defaultPageLayout{ pgTitle :: String
    pgTitle = "Delete " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    page String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ "?" } (Html -> Handler) -> Html -> Handler
    forall a b. (a -> b) -> a -> b
    $
        if String -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null String
    fileToDelete
           then Html -> Html
    ulist (Html -> Html) -> [HtmlAttr] -> Html -> Html
    forall a. ADDATTRS a => a -> [HtmlAttr] -> a
    ! [String -> HtmlAttr
    theclass "messages"] (Html -> Html) -> Html -> Html
    forall a b. HTML a => (Html -> b) -> a -> b
    << Html -> Html
    li (Html -> Html) -> String -> Html
    forall a b. HTML a => (Html -> b) -> a -> b
    <<
                "There is no file or page by that name."
           else Html
    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
      String
    page <- GititServerPart String
    getPage
      Config
    cfg <- GititServerPart Config
    getConfig
      let file :: String
    file = Params -> String
    pFileToDelete Params
    params
      Maybe User
    mbUser <- GititServerPart (Maybe User)
    getLoggedInUser
      (user :: String
    user, email :: String
    email) <- case Maybe User
    mbUser of
                            Nothing -> (String, String)
    -> ServerPartT (ReaderT WikiState IO) (String, String)
    forall (m :: * -> *) a. Monad m => a -> m a
    return ("Anonymous", "")
                            Just u :: User
    u  -> (String, String)
    -> ServerPartT (ReaderT WikiState IO) (String, String)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (User -> String
    uUsername User
    u, User -> String
    uEmail User
    u)
      let author :: Author
    author = String -> String -> Author
    Author String
    user String
    email
      let descrip :: String
    descrip = Config -> String
    deleteSummary Config
    cfg
      String
    base' <- GititServerPart String
    forall (m :: * -> *). ServerMonad m => m String
    getWikiBase
      if Params -> Bool
    pConfirm Params
    params Bool -> Bool -> Bool
    && (String
    file String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    page Bool -> Bool -> Bool
    || String
    file String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    page String -> String -> String
    <.> (Config -> String
    defaultExtension Config
    cfg))
         then do
           FileStore
    fs <- GititServerPart FileStore
    getFileStore
           IO () -> ServerPartT (ReaderT WikiState IO) ()
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> ServerPartT (ReaderT WikiState IO) ())
    -> IO () -> ServerPartT (ReaderT WikiState IO) ()
    forall a b. (a -> b) -> a -> b
    $ FileStore -> String -> Author -> String -> IO ()
    Data.FileStore.delete FileStore
    fs String
    file Author
    author String
    descrip
           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]
    ++ "/") (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
    << "File deleted"
         else 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
    << "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
      String
    page <- GititServerPart String
    getPage
      Config
    cfg <- GititServerPart Config
    getConfig
      Maybe User
    mbUser <- GititServerPart (Maybe User)
    getLoggedInUser
      (user :: String
    user, email :: String
    email) <- case Maybe User
    mbUser of
                            Nothing -> (String, String)
    -> ServerPartT (ReaderT WikiState IO) (String, String)
    forall (m :: * -> *) a. Monad m => a -> m a
    return ("Anonymous", "")
                            Just u :: User
    u  -> (String, String)
    -> ServerPartT (ReaderT WikiState IO) (String, String)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (User -> String
    uUsername User
    u, User -> String
    uEmail User
    u)
      String
    editedText <- case Params -> Maybe String
    pEditedText Params
    params of
                         Nothing -> String -> GititServerPart String
    forall a. HasCallStack => String -> a
    error "No body text in POST request"
                         Just b :: String
    b  -> String -> GititServerPart String
    applyPreCommitPlugins String
    b
      let logMsg :: String
    logMsg = Params -> String
    pLogMsg Params
    params String -> String -> String
    forall a. [a] -> [a] -> [a]
    `orIfNull` Config -> String
    defaultSummary Config
    cfg
      let oldSHA1 :: String
    oldSHA1 = Params -> String
    pSHA1 Params
    params
      FileStore
    fs <- GititServerPart FileStore
    getFileStore
      String
    base' <- GititServerPart String
    forall (m :: * -> *). ServerMonad m => m String
    getWikiBase
      if String -> 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
         then [String] -> Handler -> Handler
    forall (m :: * -> *) a. ServerMonad m => [String] -> m a -> m a
    withMessages ["Description cannot be empty."] Handler
    editPage
         else do
           Bool
    -> ServerPartT (ReaderT WikiState IO) ()
    -> ServerPartT (ReaderT WikiState IO) ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (String -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length String
    editedText Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Integer -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Config -> Integer
    maxPageSize Config
    cfg)) (ServerPartT (ReaderT WikiState IO) ()
     -> ServerPartT (ReaderT WikiState IO) ())
    -> ServerPartT (ReaderT WikiState IO) ()
    -> ServerPartT (ReaderT WikiState IO) ()
    forall a b. (a -> b) -> a -> b
    $
              String -> ServerPartT (ReaderT WikiState IO) ()
    forall a. HasCallStack => String -> a
    error "Page exceeds maximum size."
           -- check SHA1 in case page has been modified, merge
           Either MergeInfo ()
    modifyRes <- if String -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null String
    oldSHA1
                           then IO (Either MergeInfo ())
    -> ServerPartT (ReaderT WikiState IO) (Either MergeInfo ())
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO (Either MergeInfo ())
     -> ServerPartT (ReaderT WikiState IO) (Either MergeInfo ()))
    -> IO (Either MergeInfo ())
    -> ServerPartT (ReaderT WikiState IO) (Either MergeInfo ())
    forall a b. (a -> b) -> a -> b
    $ FileStore -> String -> Author -> String -> String -> IO ()
    forall a.
    Contents a =>
    FileStore -> String -> Author -> String -> a -> IO ()
    create FileStore
    fs (String -> String -> String
    pathForPage String
    page (String -> String) -> String -> String
    forall a b. (a -> b) -> a -> b
    $ Config -> String
    defaultExtension Config
    cfg)
                                           (String -> String -> Author
    Author String
    user String
    email) String
    logMsg String
    editedText IO () -> IO (Either MergeInfo ()) -> IO (Either MergeInfo ())
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >>
                                         Either MergeInfo () -> IO (Either MergeInfo ())
    forall (m :: * -> *) a. Monad m => a -> m a
    return (() -> Either MergeInfo ()
    forall a b. b -> Either a b
    Right ())
                           else do
                             String -> ServerPartT (ReaderT WikiState IO) ()
    expireCachedFile (String -> String -> String
    pathForPage String
    page (String -> String) -> String -> String
    forall a b. (a -> b) -> a -> b
    $ Config -> String
    defaultExtension Config
    cfg) ServerPartT (ReaderT WikiState IO) ()
    -> ServerPartT (ReaderT WikiState IO) ()
    -> ServerPartT (ReaderT WikiState IO) ()
    forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
    `mplus` () -> ServerPartT (ReaderT WikiState IO) ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
                             IO (Either MergeInfo ())
    -> ServerPartT (ReaderT WikiState IO) (Either MergeInfo ())
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO (Either MergeInfo ())
     -> ServerPartT (ReaderT WikiState IO) (Either MergeInfo ()))
    -> IO (Either MergeInfo ())
    -> ServerPartT (ReaderT WikiState IO) (Either MergeInfo ())
    forall a b. (a -> b) -> a -> b
    $ IO (Either MergeInfo ())
    -> (FileStoreError -> IO (Either MergeInfo ()))
    -> IO (Either MergeInfo ())
    forall e a. Exception e => IO a -> (e -> IO a) -> IO a
    E.catch (FileStore
    -> String
    -> String
    -> Author
    -> String
    -> String
    -> IO (Either MergeInfo ())
    forall a.
    Contents a =>
    FileStore
    -> String
    -> String
    -> Author
    -> String
    -> a
    -> IO (Either MergeInfo ())
    modify FileStore
    fs (String -> String -> String
    pathForPage String
    page (String -> String) -> String -> String
    forall a b. (a -> b) -> a -> b
    $ Config -> String
    defaultExtension Config
    cfg)
                                                String
    oldSHA1 (String -> String -> Author
    Author String
    user String
    email) String
    logMsg
                                                String
    editedText)
                                         (\e :: FileStoreError
    e -> if FileStoreError
    e FileStoreError -> FileStoreError -> Bool
    forall a. Eq a => a -> a -> Bool
    == FileStoreError
    Unchanged
                                                   then Either MergeInfo () -> IO (Either MergeInfo ())
    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. Exception e => e -> IO a
    E.throwIO FileStoreError
    e)
           case Either MergeInfo ()
    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
    << "Page updated"
                Left (MergeInfo mergedWithRev :: Revision
    mergedWithRev conflicts :: Bool
    conflicts mergedText :: String
    mergedText) -> do
                   let mergeMsg :: String
    mergeMsg = "The page has been edited since you checked it out. " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++
                          "Changes from revision " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Revision -> String
    revId Revision
    mergedWithRev String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++
                          " have been merged into your edits below. " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++
                          if Bool
    conflicts
                             then "Please resolve conflicts and Save."
                             else "Please review and Save."
                   Params -> Handler
    editPage' (Params -> Handler) -> Params -> Handler
    forall a b. (a -> b) -> a -> b
    $
                     Params
    params{ pEditedText :: Maybe String
    pEditedText = String -> Maybe String
    forall a. a -> Maybe a
    Just String
    mergedText,
                             pSHA1 :: String
    pSHA1       = Revision -> String
    revId Revision
    mergedWithRev,
                             pMessages :: [String]
    pMessages   = [String
    mergeMsg] }

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

    fileListToHtml :: String -> String -> String -> [Resource] -> Html
    fileListToHtml :: String -> String -> String -> [Resource] -> Html
    fileListToHtml base' :: String
    base' prefix :: String
    prefix ext :: String
    ext files :: [Resource]
    files =
      let fileLink :: Resource -> Html
    fileLink (FSFile f :: String
    f) | String -> String
    takeExtension String
    f String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == "." 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 "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 f :: String
    f) = Html -> Html
    li (Html -> Html) -> [HtmlAttr] -> Html -> Html
    forall a. ADDATTRS a => a -> [HtmlAttr] -> a
    ! [String -> HtmlAttr
    theclass "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]
    ++ "_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
    << "(delete)"
            ]
          fileLink (FSDirectory f :: String
    f) =
            Html -> Html
    li (Html -> Html) -> [HtmlAttr] -> Html -> Html
    forall a. ADDATTRS a => a -> [HtmlAttr] -> a
    ! [String -> HtmlAttr
    theclass "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]
    ++ "/"] (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 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 -> String -> String
    forall a. a -> [a] -> [a]
    : String
    prefix
          uplink :: Html
    uplink = ([String] -> Html -> Html) -> Html -> [[String]] -> Html
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr (\d :: [String]
    d accum :: 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 "updir",
                                             String -> HtmlAttr
    href (String -> HtmlAttr) -> String -> HtmlAttr
    forall a b. (a -> b) -> a -> b
    $ if [String] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [String]
    d Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= 1
                                                       then String
    base' String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ "/_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 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 "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 "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
      String
    path' <- GititServerPart String
    forall (m :: * -> *). ServerMonad m => m String
    getPath
      Config
    cfg <- GititServerPart Config
    getConfig
      let pcategories :: [String]
    pcategories = (Char -> Bool) -> String -> [String]
    forall a. (a -> Bool) -> [a] -> [[a]]
    wordsBy (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    ==',') String
    path'
      let repoPath :: String
    repoPath = Config -> String
    repositoryPath Config
    cfg
      let categoryDescription :: String
    categoryDescription = "Category: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ (String -> [String] -> String
    forall a. [a] -> [[a]] -> [a]
    intercalate " + " [String]
    pcategories)
      FileStore
    fs <- GititServerPart FileStore
    getFileStore
      [String]
    pages <- IO [String] -> ServerPartT (ReaderT WikiState IO) [String]
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (FileStore -> IO [String]
    index FileStore
    fs) ServerPartT (ReaderT WikiState IO) [String]
    -> ([String] -> ServerPartT (ReaderT WikiState IO) [String])
    -> ServerPartT (ReaderT WikiState IO) [String]
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= (String -> ServerPartT (ReaderT WikiState IO) Bool)
    -> [String] -> ServerPartT (ReaderT WikiState IO) [String]
    forall (m :: * -> *) a.
    Applicative m =>
    (a -> m Bool) -> [a] -> m [a]
    filterM String -> ServerPartT (ReaderT WikiState IO) Bool
    isPageFile ServerPartT (ReaderT WikiState IO) [String]
    -> ([String] -> ServerPartT (ReaderT WikiState IO) [String])
    -> ServerPartT (ReaderT WikiState IO) [String]
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= (String -> ServerPartT (ReaderT WikiState IO) Bool)
    -> [String] -> ServerPartT (ReaderT WikiState IO) [String]
    forall (m :: * -> *) a.
    Applicative m =>
    (a -> m Bool) -> [a] -> m [a]
    filterM String -> ServerPartT (ReaderT WikiState IO) Bool
    isNotDiscussPageFile
      [(String, [String])]
    matches <- ([Maybe (String, [String])] -> [(String, [String])])
    -> ServerPartT (ReaderT WikiState IO) [Maybe (String, [String])]
    -> ServerPartT (ReaderT WikiState IO) [(String, [String])]
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM [Maybe (String, [String])] -> [(String, [String])]
    forall a. [Maybe a] -> [a]
    catMaybes (ServerPartT (ReaderT WikiState IO) [Maybe (String, [String])]
     -> ServerPartT (ReaderT WikiState IO) [(String, [String])])
    -> ServerPartT (ReaderT WikiState IO) [Maybe (String, [String])]
    -> ServerPartT (ReaderT WikiState IO) [(String, [String])]
    forall a b. (a -> b) -> a -> b
    $
                 [String]
    -> (String
        -> ServerPartT (ReaderT WikiState IO) (Maybe (String, [String])))
    -> ServerPartT (ReaderT WikiState IO) [Maybe (String, [String])]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    t a -> (a -> m b) -> m (t b)
    forM [String]
    pages ((String
      -> ServerPartT (ReaderT WikiState IO) (Maybe (String, [String])))
     -> ServerPartT (ReaderT WikiState IO) [Maybe (String, [String])])
    -> (String
        -> ServerPartT (ReaderT WikiState IO) (Maybe (String, [String])))
    -> ServerPartT (ReaderT WikiState IO) [Maybe (String, [String])]
    forall a b. (a -> b) -> a -> b
    $ \f :: String
    f -> do
                   [String]
    categories <- IO [String] -> ServerPartT (ReaderT WikiState IO) [String]
    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
                   Maybe (String, [String])
    -> ServerPartT (ReaderT WikiState IO) (Maybe (String, [String]))
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe (String, [String])
     -> ServerPartT (ReaderT WikiState IO) (Maybe (String, [String])))
    -> Maybe (String, [String])
    -> ServerPartT (ReaderT WikiState IO) (Maybe (String, [String]))
    forall a b. (a -> b) -> a -> b
    $ if (String -> Bool) -> [String] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all ( String -> [String] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [String]
    categories) [String]
    pcategories
                               then (String, [String]) -> Maybe (String, [String])
    forall a. a -> Maybe a
    Just (String
    f, [String]
    categories [String] -> [String] -> [String]
    forall a. Eq a => [a] -> [a] -> [a]
    \\ [String]
    pcategories)
                               else Maybe (String, [String])
    forall a. Maybe a
    Nothing
      String
    base' <- GititServerPart String
    forall (m :: * -> *). ServerMonad m => m String
    getWikiBase
      let toMatchListItem :: String -> Html
    toMatchListItem file :: 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 -> Html
    toRemoveListItem cat :: 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 (t :: * -> *) a. Foldable t => t a -> Bool
    null ([String] -> [String]
    forall a. [a] -> [a]
    tail [String]
    pcategories)
             then "/_categories"
             else "/_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
    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
    forall a. [a] -> [a] -> [a]
    ++ String
    cat) ]
      let toAddListItem :: String -> Html
    toAddListItem cat :: 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]
    ++
              "/_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
    forall a. [a] -> [a] -> [a]
    ++ String
    cat) ]
            (Html -> Html) -> String -> Html
    forall a b. HTML a => (Html -> b) -> a -> b
    << ("+" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    cat) ]
      let matchList :: Html
    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 "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)
      PageLayout -> Html -> Handler
    formattedPage PageLayout
    defaultPageLayout{
                      pgPageName :: String
    pgPageName = String
    categoryDescription,
                      pgShowPageTools :: Bool
    pgShowPageTools = Bool
    False,
                      pgTabs :: [Tab]
    pgTabs = [],
                      pgScripts :: [String]
    pgScripts = ["search.js"],
                      pgTitle :: String
    pgTitle = String
    categoryDescription }
                    Html
    matchList

    categoryListPage :: Handler
    categoryListPage :: Handler
    categoryListPage = do
      Config
    cfg <- GititServerPart Config
    getConfig
      let repoPath :: String
    repoPath = Config -> String
    repositoryPath Config
    cfg
      FileStore
    fs <- GititServerPart FileStore
    getFileStore
      [String]
    pages <- IO [String] -> ServerPartT (ReaderT WikiState IO) [String]
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (FileStore -> IO [String]
    index FileStore
    fs) ServerPartT (ReaderT WikiState IO) [String]
    -> ([String] -> ServerPartT (ReaderT WikiState IO) [String])
    -> ServerPartT (ReaderT WikiState IO) [String]
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= (String -> ServerPartT (ReaderT WikiState IO) Bool)
    -> [String] -> ServerPartT (ReaderT WikiState IO) [String]
    forall (m :: * -> *) a.
    Applicative m =>
    (a -> m Bool) -> [a] -> m [a]
    filterM String -> ServerPartT (ReaderT WikiState IO) Bool
    isPageFile ServerPartT (ReaderT WikiState IO) [String]
    -> ([String] -> ServerPartT (ReaderT WikiState IO) [String])
    -> ServerPartT (ReaderT WikiState IO) [String]
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= (String -> ServerPartT (ReaderT WikiState IO) Bool)
    -> [String] -> ServerPartT (ReaderT WikiState IO) [String]
    forall (m :: * -> *) a.
    Applicative m =>
    (a -> m Bool) -> [a] -> m [a]
    filterM String -> ServerPartT (ReaderT WikiState IO) Bool
    isNotDiscussPageFile
      [String]
    categories <- IO [String] -> ServerPartT (ReaderT WikiState IO) [String]
    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]] -> [String]) -> IO [[String]] -> IO [String]
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM ([String] -> [String]
    forall a. Eq a => [a] -> [a]
    nub ([String] -> [String])
    -> ([[String]] -> [String]) -> [[String]] -> [String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [String] -> [String]
    forall a. Ord a => [a] -> [a]
    sort ([String] -> [String])
    -> ([[String]] -> [String]) -> [[String]] -> [String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [[String]] -> [String]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat) (IO [[String]] -> IO [String]) -> IO [[String]] -> IO [String]
    forall a b. (a -> b) -> a -> b
    $ [String] -> (String -> IO [String]) -> IO [[String]]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    t a -> (a -> m b) -> m (t b)
    forM [String]
    pages ((String -> IO [String]) -> IO [[String]])
    -> (String -> IO [String]) -> IO [[String]]
    forall a b. (a -> b) -> a -> b
    $ \f :: String
    f ->
                      String -> IO [String]
    readCategories (String
    repoPath String -> String -> String
    </> String
    f)
      String
    base' <- GititServerPart String
    forall (m :: * -> *). ServerMonad m => m String
    getWikiBase
      let toCatLink :: String -> Html
    toCatLink ctg :: 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]
    ++ "/_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
    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
      PageLayout -> Html -> Handler
    formattedPage PageLayout
    defaultPageLayout{
                      pgPageName :: String
    pgPageName = "Categories",
                      pgShowPageTools :: Bool
    pgShowPageTools = Bool
    False,
                      pgTabs :: [Tab]
    pgTabs = [],
                      pgScripts :: [String]
    pgScripts = ["search.js"],
                      pgTitle :: String
    pgTitle = "Categories" } Html
    htmlMatches

    expireCache :: Handler
    expireCache :: Handler
    expireCache = do
      String
    page <- GititServerPart String
    getPage
      Config
    cfg <- GititServerPart Config
    getConfig
      -- try it as a page first, then as an uploaded file
      String -> ServerPartT (ReaderT WikiState IO) ()
    expireCachedFile (String -> String -> String
    pathForPage String
    page (String -> String) -> String -> String
    forall a b. (a -> b) -> a -> b
    $ Config -> String
    defaultExtension Config
    cfg)
      String -> ServerPartT (ReaderT WikiState IO) ()
    expireCachedFile String
    page
      Response -> Handler
    forall (m :: * -> *) a. FilterMonad Response m => a -> m a
    ok (Response -> Handler) -> Response -> Handler
    forall a b. (a -> b) -> a -> b
    $ () -> Response
    forall a. ToMessage a => a -> Response
    toResponse ()

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