{-# LANGUAGE ScopedTypeVariables #-}
module Network.Gitit.Handlers (
handleAny
, debugHandler
, randomPage
, discussPage
, createPage
, showActivity
, goToPage
, searchResults
, uploadForm
, uploadFile
, indexPage
, categoryPage
, categoryListPage
, preview
, showRawPage
, showFileAsText
, showPageHistory
, showFileHistory
, showPage
, showPageDiff
, showFileDiff
, updatePage
, editPage
, deletePage
, confirmDelete
, showHighlightedSource
, expireCache
, feedHandler
)
where
import Safe
import Network.Gitit.Server
import Network.Gitit.Framework
import Network.Gitit.Layout
import Network.Gitit.Types
import Network.Gitit.Feed (filestoreToXmlFeed, FeedConfig(..))
import Network.Gitit.Util (orIfNull)
import Network.Gitit.Cache (expireCachedFile, lookupCache, cacheContents)
import Network.Gitit.ContentTransformer (showRawPage, showFileAsText, showPage,
showHighlightedSource, preview, applyPreCommitPlugins)
import Network.Gitit.Page (readCategories)
import qualified Control.Exception as E
import System.FilePath
import Network.Gitit.State
import Text.XHtml hiding ( (</>), dir, method, password, rev )
import qualified Text.XHtml as X ( method )
import Data.List (intercalate, intersperse, delete, nub, sortBy, find, isPrefixOf, inits, sort, (\\))
import Data.List.Split (wordsBy)
import Data.Maybe (fromMaybe, mapMaybe, isJust, catMaybes)
import Data.Ord (comparing)
import Data.Char (toLower, isSpace)
import Control.Monad.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 = forall (m :: * -> *) a r.
(HasRqData m, FromData a, MonadPlus m, ServerMonad m) =>
(a -> m r) -> m r
withData forall a b. (a -> b) -> a -> b
$ \(Params
params :: Params) -> forall (m :: * -> *) a. ServerMonad m => (String -> m a) -> m a
uriRest forall a b. (a -> b) -> a -> b
$ \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 <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall e a. Exception e => IO a -> IO (Either e a)
E.try
(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 ByteString
contents -> forall a (m :: * -> *). FilterMonad a m => m ()
ignoreFilters forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
(forall (m :: * -> *) a. FilterMonad Response m => a -> m a
ok forall a b. (a -> b) -> a -> b
$ String -> Response -> Response
setContentType String
mimetype forall a b. (a -> b) -> a -> b
$
(forall a. ToMessage a => a -> Response
toResponse Html
noHtml) {rsBody :: ByteString
rsBody = ByteString
contents})
Left FileStoreError
NotFound -> forall (m :: * -> *) a. MonadPlus m => m a
mzero
Left FileStoreError
e -> forall a. HasCallStack => String -> a
error (forall a. Show a => a -> String
show FileStoreError
e)
debugHandler :: Handler
debugHandler :: Handler
debugHandler = forall (m :: * -> *) a r.
(HasRqData m, FromData a, MonadPlus m, ServerMonad m) =>
(a -> m r) -> m r
withData forall a b. (a -> b) -> a -> b
$ \(Params
params :: Params) -> do
Request
req <- forall (m :: * -> *). ServerMonad m => m Request
askRq
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> Priority -> String -> IO ()
logM String
"gitit" Priority
DEBUG (forall a. Show a => a -> String
show Request
req)
String
page <- GititServerPart String
getPage
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> Priority -> String -> IO ()
logM String
"gitit" Priority
DEBUG forall a b. (a -> b) -> a -> b
$ String
"Page = '" forall a. [a] -> [a] -> [a]
++ String
page forall a. [a] -> [a] -> [a]
++ String
"'\n" forall a. [a] -> [a] -> [a]
++
forall a. Show a => a -> String
show Params
params
forall (m :: * -> *) a. MonadPlus m => m a
mzero
randomPage :: Handler
randomPage :: Handler
randomPage = do
FileStore
fs <- GititServerPart FileStore
getFileStore
String
base' <- forall (m :: * -> *). ServerMonad m => m String
getWikiBase
[String]
prunedFiles <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FileStore -> IO [String]
index FileStore
fs) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM String -> GititServerPart Bool
isPageFile forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM String -> GititServerPart Bool
isNotDiscussPageFile
let pages :: [String]
pages = forall a b. (a -> b) -> [a] -> [b]
map String -> String
dropExtension [String]
prunedFiles
if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
pages
then forall a. HasCallStack => String -> a
error String
"No pages found!"
else do
DiffTime
secs <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (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 forall a. [a] -> Int -> a
!!
(forall a b. (RealFrac a, Integral b) => a -> b
truncate (DiffTime
secs forall a. Num a => a -> a -> a
* DiffTime
1000000) forall a. Integral a => a -> a -> a
`mod` forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
pages)
forall (m :: * -> *) uri res.
(FilterMonad Response m, ToSURI uri) =>
uri -> res -> m res
seeOther (String
base' forall a. [a] -> [a] -> [a]
++ String -> String
urlForPage String
newPage) forall a b. (a -> b) -> a -> b
$ forall a. ToMessage a => a -> Response
toResponse forall a b. (a -> b) -> a -> b
$
Html -> Html
p forall a b. HTML a => (Html -> b) -> a -> b
<< String
"Redirecting to a random page"
discussPage :: Handler
discussPage :: Handler
discussPage = do
String
page <- GititServerPart String
getPage
String
base' <- forall (m :: * -> *). ServerMonad m => m String
getWikiBase
forall (m :: * -> *) uri res.
(FilterMonad Response m, ToSURI uri) =>
uri -> res -> m res
seeOther (String
base' forall a. [a] -> [a] -> [a]
++ String -> String
urlForPage (if String -> Bool
isDiscussPage String
page then String
page else (Char
'@'forall a. a -> [a] -> [a]
:String
page))) forall a b. (a -> b) -> a -> b
$
forall a. ToMessage a => a -> Response
toResponse String
"Redirecting to discussion page"
createPage :: Handler
createPage :: Handler
createPage = do
String
page <- GititServerPart String
getPage
String
base' <- forall (m :: * -> *). ServerMonad m => m String
getWikiBase
case String
page of
(Char
'_':String
_) -> forall (m :: * -> *) a. MonadPlus m => m a
mzero
String
_ -> PageLayout -> Html -> Handler
formattedPage PageLayout
defaultPageLayout{
pgPageName :: String
pgPageName = String
page
, pgTabs :: [Tab]
pgTabs = []
, pgTitle :: String
pgTitle = String
"Create " forall a. [a] -> [a] -> [a]
++ String
page forall a. [a] -> [a] -> [a]
++ String
"?"
} forall a b. (a -> b) -> a -> b
$
(Html -> Html
p forall a b. HTML a => (Html -> b) -> a -> b
<< String -> Html
stringToHtml
(String
"There is no page named '" forall a. [a] -> [a] -> [a]
++ String
page forall a. [a] -> [a] -> [a]
++ String
"'. You can:"))
forall a b. (HTML a, HTML b) => a -> b -> Html
+++
(forall a. HTML a => [a] -> Html
unordList forall a b. (a -> b) -> a -> b
$
[ Html -> Html
anchor forall a. ADDATTRS a => a -> [HtmlAttr] -> a
!
[String -> HtmlAttr
href forall a b. (a -> b) -> a -> b
$ String
base' forall a. [a] -> [a] -> [a]
++ String
"/_edit" forall a. [a] -> [a] -> [a]
++ String -> String
urlForPage String
page] forall a b. HTML a => (Html -> b) -> a -> b
<<
(String
"Create the page '" forall a. [a] -> [a] -> [a]
++ String
page forall a. [a] -> [a] -> [a]
++ String
"'")
, Html -> Html
anchor forall a. ADDATTRS a => a -> [HtmlAttr] -> a
!
[String -> HtmlAttr
href forall a b. (a -> b) -> a -> b
$ String
base' forall a. [a] -> [a] -> [a]
++ String
"/_search?" forall a. [a] -> [a] -> [a]
++
([(String, String)] -> String
urlEncodeVars [(String
"patterns", String
page)])] forall a b. HTML a => (Html -> b) -> a -> b
<<
(String
"Search for pages containing the text '" forall a. [a] -> [a] -> [a]
++
String
page forall a. [a] -> [a] -> [a]
++ String
"'")])
uploadForm :: Handler
uploadForm :: Handler
uploadForm = forall (m :: * -> *) a r.
(HasRqData m, FromData a, MonadPlus m, ServerMonad m) =>
(a -> m r) -> m r
withData 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 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 forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [String -> HtmlAttr
X.method String
"post", String -> HtmlAttr
enctype String
"multipart/form-data"] forall a b. HTML a => (Html -> b) -> a -> b
<<
Html -> Html
fieldset forall a b. HTML a => (Html -> b) -> a -> b
<<
[ Html -> Html
p forall a b. HTML a => (Html -> b) -> a -> b
<< [Html -> Html
label forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [String -> HtmlAttr
thefor String
"file"] forall a b. HTML a => (Html -> b) -> a -> b
<< String
"File to upload:"
, Html
br
, String -> Html
afile String
"file" forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [String -> HtmlAttr
value String
origPath] ]
, Html -> Html
p forall a b. HTML a => (Html -> b) -> a -> b
<< [ Html -> Html
label forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [String -> HtmlAttr
thefor String
"wikiname"] forall a b. HTML a => (Html -> b) -> a -> b
<< String
"Name on wiki, including extension"
, Html -> Html
noscript forall a b. HTML a => (Html -> b) -> a -> b
<< String
" (leave blank to use the same filename)"
, String -> Html
stringToHtml String
":"
, Html
br
, String -> Html
textfield String
"wikiname" forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [String -> HtmlAttr
value String
wikiname]
, String -> Html
primHtmlChar String
"nbsp"
, String -> String -> Html
checkbox String
"overwrite" String
"yes"
, Html -> Html
label forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [String -> HtmlAttr
thefor String
"overwrite"] forall a b. HTML a => (Html -> b) -> a -> b
<< String
"Overwrite existing file" ]
, Html -> Html
p forall a b. HTML a => (Html -> b) -> a -> b
<< [ Html -> Html
label forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [String -> HtmlAttr
thefor String
"logMsg"] forall a b. HTML a => (Html -> b) -> a -> b
<< String
"Description of content or changes:"
, Html
br
, String -> Html
textfield String
"logMsg" forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [String -> HtmlAttr
size String
"60", String -> HtmlAttr
value String
logMsg]
, String -> String -> Html
submit String
"upload" String
"Upload" ]
]
PageLayout -> Html -> Handler
formattedPage PageLayout
defaultPageLayout{
pgMessages :: [String]
pgMessages = Params -> [String]
pMessages Params
params,
pgScripts :: [String]
pgScripts = [String
"uploadForm.js"],
pgShowPageTools :: Bool
pgShowPageTools = Bool
False,
pgTabs :: [Tab]
pgTabs = [],
pgTitle :: String
pgTitle = String
"Upload a file"} Html
upForm
uploadFile :: Handler
uploadFile :: Handler
uploadFile = forall (m :: * -> *) a r.
(HasRqData m, FromData a, MonadPlus m, ServerMonad m) =>
(a -> m r) -> m r
withData 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
forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall a. Eq a => a -> a -> Bool
==Char
'/')
forall a b. (a -> b) -> a -> b
$ Params -> String
pWikiname Params
params 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 -> GititServerPart Bool
isPageFile String
wikiname
Maybe User
mbUser <- GititServerPart (Maybe User)
getLoggedInUser
(String
user, String
email) <- case Maybe User
mbUser of
Maybe User
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return (String
"Anonymous", String
"")
Just User
u -> 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 <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall e a. Exception e => IO a -> (e -> IO a) -> IO a
E.catch (FileStore -> String -> IO String
latest FileStore
fs String
wikiname forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True) forall a b. (a -> b) -> a -> b
$ \FileStoreError
e ->
if FileStoreError
e forall a. Eq a => a -> a -> Bool
== FileStoreError
NotFound
then forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
else forall e a. Exception e => e -> IO a
E.throwIO FileStoreError
e forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
let inStaticDir :: Bool
inStaticDir = Config -> String
staticDir Config
cfg 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 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 forall a b. (a -> b) -> a -> b
$ String -> String
takeDirectory String
wikiname
let imageExtensions :: [String]
imageExtensions = [String
".png", String
".jpg", String
".gif"]
let errors :: [String]
errors = [(Bool, String)] -> [String]
validate
[ (forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSpace) forall a b. (a -> b) -> a -> b
$ String
logMsg,
String
"Description cannot be empty.")
, (String
".." forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
dirs', String
"Wikiname cannot contain '..'")
, (forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
origPath, String
"File not found.")
, (Bool
inStaticDir, String
"Destination is inside static directory.")
, (Bool
inTemplatesDir, String
"Destination is inside templates directory.")
, (Bool -> Bool
not Bool
overwrite Bool -> Bool -> Bool
&& Bool
exists, String
"A file named '" forall a. [a] -> [a] -> [a]
++ String
wikiname forall a. [a] -> [a] -> [a]
++
String
"' already exists in the repository: choose a new name " forall a. [a] -> [a] -> [a]
++
String
"or check the box to overwrite the existing file.")
, (Bool
wPF,
String
"This file extension is reserved for wiki pages.")
]
if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
errors
then do
String -> ServerPartT (ReaderT WikiState IO) ()
expireCachedFile String
wikiname forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` forall (m :: * -> *) a. Monad m => a -> m a
return ()
ByteString
fileContents <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> IO ByteString
B.readFile String
filePath
let len :: Int64
len = ByteString -> Int64
B.length ByteString
fileContents
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ 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 forall a b. HTML a => (Html -> b) -> a -> b
<<
[ Html -> Html
h2 forall a b. HTML a => (Html -> b) -> a -> b
<< (String
"Uploaded " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int64
len forall a. [a] -> [a] -> [a]
++ String
" bytes")
, if String -> String
takeExtension String
wikiname forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
imageExtensions
then Html -> Html
p forall a b. HTML a => (Html -> b) -> a -> b
<< String
"To add this image to a page, use:" forall a b. (HTML a, HTML b) => a -> b -> Html
+++
Html -> Html
pre forall a b. HTML a => (Html -> b) -> a -> b
<< (String
"![alt text](/" forall a. [a] -> [a] -> [a]
++ String
wikiname forall a. [a] -> [a] -> [a]
++ String
")")
else Html -> Html
p forall a b. HTML a => (Html -> b) -> a -> b
<< String
"To link to this resource from a page, use:" forall a b. (HTML a, HTML b) => a -> b -> Html
+++
Html -> Html
pre forall a b. HTML a => (Html -> b) -> a -> b
<< (String
"[link label](/" forall a. [a] -> [a] -> [a]
++ String
wikiname forall a. [a] -> [a] -> [a]
++ String
")") ]
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 = String
"Upload successful"}
Html
contents
else forall (m :: * -> *) a. ServerMonad m => [String] -> m a -> m a
withMessages [String]
errors Handler
uploadForm
goToPage :: Handler
goToPage :: Handler
goToPage = forall (m :: * -> *) a r.
(HasRqData m, FromData a, MonadPlus m, ServerMonad m) =>
(a -> m r) -> m r
withData 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 <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FileStore -> IO [String]
index FileStore
fs) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM String -> GititServerPart Bool
isPageFile
let allPageNames :: [String]
allPageNames = forall a b. (a -> b) -> [a] -> [b]
map String -> String
dropExtension [String]
pruned_files
let findPage :: (String -> Bool) -> Maybe String
findPage String -> Bool
f = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find String -> Bool
f [String]
allPageNames
let exactMatch :: String -> Bool
exactMatch String
f = String
gotopage forall a. Eq a => a -> a -> Bool
== String
f
let insensitiveMatch :: String -> Bool
insensitiveMatch String
f = (forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
gotopage) forall a. Eq a => a -> a -> Bool
== (forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
f)
let prefixMatch :: String -> Bool
prefixMatch String
f = (forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
gotopage) forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` (forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
f)
String
base' <- forall (m :: * -> *). ServerMonad m => m String
getWikiBase
case (String -> Bool) -> Maybe String
findPage String -> Bool
exactMatch of
Just String
m -> forall (m :: * -> *) uri res.
(FilterMonad Response m, ToSURI uri) =>
uri -> res -> m res
seeOther (String
base' forall a. [a] -> [a] -> [a]
++ String -> String
urlForPage String
m) forall a b. (a -> b) -> a -> b
$ forall a. ToMessage a => a -> Response
toResponse
String
"Redirecting to exact match"
Maybe String
Nothing -> case (String -> Bool) -> Maybe String
findPage String -> Bool
insensitiveMatch of
Just String
m -> forall (m :: * -> *) uri res.
(FilterMonad Response m, ToSURI uri) =>
uri -> res -> m res
seeOther (String
base' forall a. [a] -> [a] -> [a]
++ String -> String
urlForPage String
m) forall a b. (a -> b) -> a -> b
$ forall a. ToMessage a => a -> Response
toResponse
String
"Redirecting to case-insensitive match"
Maybe String
Nothing -> case (String -> Bool) -> Maybe String
findPage String -> Bool
prefixMatch of
Just String
m -> forall (m :: * -> *) uri res.
(FilterMonad Response m, ToSURI uri) =>
uri -> res -> m res
seeOther (String
base' forall a. [a] -> [a] -> [a]
++ String -> String
urlForPage String
m) forall a b. (a -> b) -> a -> b
$
forall a. ToMessage a => a -> Response
toResponse forall a b. (a -> b) -> a -> b
$ String
"Redirecting" forall a. [a] -> [a] -> [a]
++
String
" to partial match"
Maybe String
Nothing -> Handler
searchResults
searchResults :: Handler
searchResults :: Handler
searchResults = forall (m :: * -> *) a r.
(HasRqData m, FromData a, MonadPlus m, ServerMonad m) =>
(a -> m r) -> m r
withData forall a b. (a -> b) -> a -> b
$ \(Params
params :: Params) -> do
let patterns :: [String]
patterns = Params -> [String]
pPatterns Params
params forall a. [a] -> [a] -> [a]
`orIfNull` [Params -> String
pGotoPage Params
params]
FileStore
fs <- GititServerPart FileStore
getFileStore
[SearchMatch]
matchLines <- if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
patterns
then forall (m :: * -> *) a. Monad m => a -> m a
return []
else forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall e a. Exception e => IO a -> (e -> IO a) -> IO a
E.catch (FileStore -> SearchQuery -> IO [SearchMatch]
search FileStore
fs SearchQuery{
queryPatterns :: [String]
queryPatterns = [String]
patterns
, queryWholeWords :: Bool
queryWholeWords = Bool
True
, queryMatchAll :: Bool
queryMatchAll = Bool
True
, queryIgnoreCase :: Bool
queryIgnoreCase = Bool
True })
(\(FileStoreError
_ :: FileStoreError) -> forall (m :: * -> *) a. Monad m => a -> m a
return [])
let contentMatches :: [String]
contentMatches = forall a b. (a -> b) -> [a] -> [b]
map SearchMatch -> String
matchResourceName [SearchMatch]
matchLines
[String]
allPages <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FileStore -> IO [String]
index FileStore
fs) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM String -> GititServerPart Bool
isPageFile
let slashToSpace :: String -> String
slashToSpace = forall a b. (a -> b) -> [a] -> [b]
map (\Char
c -> if Char
c forall a. Eq a => a -> a -> Bool
== Char
'/' then Char
' ' else Char
c)
let inPageName :: String -> String -> Bool
inPageName String
pageName' String
x = String
x forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (String -> [String]
words forall a b. (a -> b) -> a -> b
$ String -> String
slashToSpace forall a b. (a -> b) -> a -> b
$ String -> String
dropExtension String
pageName')
let matchesPatterns :: String -> Bool
matchesPatterns String
pageName' = Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
patterns) Bool -> Bool -> Bool
&&
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (String -> String -> Bool
inPageName (forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
pageName')) (forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower) [String]
patterns)
let pageNameMatches :: [String]
pageNameMatches = forall a. (a -> Bool) -> [a] -> [a]
filter String -> Bool
matchesPatterns [String]
allPages
[String]
prunedFiles <- forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM String -> GititServerPart Bool
isPageFile ([String]
contentMatches forall a. [a] -> [a] -> [a]
++ [String]
pageNameMatches)
let allMatchedFiles :: [String]
allMatchedFiles = forall a. Eq a => [a] -> [a]
nub forall a b. (a -> b) -> a -> b
$ [String]
prunedFiles
let matchesInFile :: String -> [String]
matchesInFile String
f = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\SearchMatch
x -> if SearchMatch -> String
matchResourceName SearchMatch
x forall a. Eq a => a -> a -> Bool
== String
f
then forall a. a -> Maybe a
Just (SearchMatch -> String
matchLine SearchMatch
x)
else forall a. Maybe a
Nothing) [SearchMatch]
matchLines
let matches :: [(String, [String])]
matches = forall a b. (a -> b) -> [a] -> [b]
map (\String
f -> (String
f, String -> [String]
matchesInFile String
f)) [String]
allMatchedFiles
let relevance :: (String, t a) -> Int
relevance (String
f, t a
ms) = forall (t :: * -> *) a. Foldable t => t a -> Int
length t a
ms forall a. Num a => a -> a -> a
+ if String
f forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
pageNameMatches
then Int
100
else Int
0
let preamble :: Html
preamble = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
patterns
then Html -> Html
h3 forall a b. HTML a => (Html -> b) -> a -> b
<< [String
"Please enter a search term."]
else Html -> Html
h3 forall a b. HTML a => (Html -> b) -> a -> b
<< [ String -> Html
stringToHtml (forall a. Show a => a -> String
show (forall (t :: * -> *) a. Foldable t => t a -> Int
length [(String, [String])]
matches) forall a. [a] -> [a] -> [a]
++ String
" matches found for ")
, Html -> Html
thespan forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [String -> HtmlAttr
identifier String
"pattern"] forall a b. HTML a => (Html -> b) -> a -> b
<< [String] -> String
unwords [String]
patterns]
String
base' <- forall (m :: * -> *). ServerMonad m => m String
getWikiBase
let toMatchListItem :: (String, [String]) -> Html
toMatchListItem (String
file, [String]
contents) = Html -> Html
li forall a b. HTML a => (Html -> b) -> a -> b
<<
[ Html -> Html
anchor forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [String -> HtmlAttr
href forall a b. (a -> b) -> a -> b
$ String
base' forall a. [a] -> [a] -> [a]
++ String -> String
urlForPage (String -> String
dropExtension String
file)] forall a b. HTML a => (Html -> b) -> a -> b
<< String -> String
dropExtension String
file
, String -> Html
stringToHtml (String
" (" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
contents) forall a. [a] -> [a] -> [a]
++ String
" matching lines)")
, String -> Html
stringToHtml String
" "
, Html -> Html
anchor forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [String -> HtmlAttr
href String
"#", String -> HtmlAttr
theclass String
"showmatch",
String -> HtmlAttr
thestyle String
"display: none;"] forall a b. HTML a => (Html -> b) -> a -> b
<< if forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
contents forall a. Ord a => a -> a -> Bool
> Int
0
then String
"[show matches]"
else String
""
, Html -> Html
pre forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [String -> HtmlAttr
theclass String
"matches"] forall a b. HTML a => (Html -> b) -> a -> b
<< [String] -> String
unlines [String]
contents]
let htmlMatches :: Html
htmlMatches = Html
preamble forall a b. (HTML a, HTML b) => a -> b -> Html
+++
Html -> Html
olist forall a b. HTML a => (Html -> b) -> a -> b
<< forall a b. (a -> b) -> [a] -> [b]
map (String, [String]) -> Html
toMatchListItem
(forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing 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 = [String
"search.js"],
pgTitle :: String
pgTitle = String
"Search results"}
Html
htmlMatches
showPageHistory :: Handler
showPageHistory :: Handler
showPageHistory = forall (m :: * -> *) a r.
(HasRqData m, FromData a, MonadPlus m, ServerMonad m) =>
(a -> m r) -> m r
withData 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 forall a b. (a -> b) -> a -> b
$ Config -> String
defaultExtension Config
cfg) String
page Params
params
showFileHistory :: Handler
showFileHistory :: Handler
showFileHistory = forall (m :: * -> *) a r.
(HasRqData m, FromData a, MonadPlus m, ServerMonad m) =>
(a -> m r) -> m r
withData 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 String
file String
page Params
params = do
FileStore
fs <- GititServerPart FileStore
getFileStore
[Revision]
hist <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO 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 forall a. Maybe a
Nothing forall a. Maybe a
Nothing)
(forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Params -> Int
pLimit Params
params)
String
base' <- forall (m :: * -> *). ServerMonad m => m String
getWikiBase
let versionToHtml :: Revision -> Int -> Html
versionToHtml Revision
rev Int
pos = Html -> Html
li forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [String -> HtmlAttr
theclass String
"difflink", String -> Int -> HtmlAttr
intAttr String
"order" Int
pos,
String -> String -> HtmlAttr
strAttr String
"revision" (Revision -> String
revId Revision
rev),
String -> String -> HtmlAttr
strAttr String
"diffurl" (String
base' forall a. [a] -> [a] -> [a]
++ String
"/_diff/" forall a. [a] -> [a] -> [a]
++ String
page)] forall a b. HTML a => (Html -> b) -> a -> b
<<
[ Html -> Html
thespan forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [String -> HtmlAttr
theclass String
"date"] forall a b. HTML a => (Html -> b) -> a -> b
<< (forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ Revision -> UTCTime
revDateTime Revision
rev)
, String -> Html
stringToHtml String
" ("
, Html -> Html
thespan forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [String -> HtmlAttr
theclass String
"author"] forall a b. HTML a => (Html -> b) -> a -> b
<< Html -> Html
anchor forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [String -> HtmlAttr
href forall a b. (a -> b) -> a -> b
$ String
base' forall a. [a] -> [a] -> [a]
++ String
"/_activity?" forall a. [a] -> [a] -> [a]
++
[(String, String)] -> String
urlEncodeVars [(String
"forUser", Author -> String
authorName forall a b. (a -> b) -> a -> b
$ Revision -> Author
revAuthor Revision
rev)]] forall a b. HTML a => (Html -> b) -> a -> b
<<
(Author -> String
authorName forall a b. (a -> b) -> a -> b
$ Revision -> Author
revAuthor Revision
rev)
, String -> Html
stringToHtml String
"): "
, Html -> Html
anchor forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [String -> HtmlAttr
href (String
base' forall a. [a] -> [a] -> [a]
++ String -> String
urlForPage String
page forall a. [a] -> [a] -> [a]
++ String
"?revision=" forall a. [a] -> [a] -> [a]
++ Revision -> String
revId Revision
rev)] forall a b. HTML a => (Html -> b) -> a -> b
<<
Html -> Html
thespan forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [String -> HtmlAttr
theclass String
"subject"] forall a b. HTML a => (Html -> b) -> a -> b
<< Revision -> String
revDescription Revision
rev
, Html -> Html
noscript forall a b. HTML a => (Html -> b) -> a -> b
<<
([ String -> Html
stringToHtml String
" [compare with "
, Html -> Html
anchor forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [String -> HtmlAttr
href forall a b. (a -> b) -> a -> b
$ String
base' forall a. [a] -> [a] -> [a]
++ String
"/_diff" forall a. [a] -> [a] -> [a]
++ String -> String
urlForPage String
page forall a. [a] -> [a] -> [a]
++ String
"?to=" forall a. [a] -> [a] -> [a]
++ Revision -> String
revId Revision
rev] forall a b. HTML a => (Html -> b) -> a -> b
<<
String
"previous" ] forall a. [a] -> [a] -> [a]
++
(if Int
pos forall a. Eq a => a -> a -> Bool
/= Int
1
then [ String -> Html
primHtmlChar String
"nbsp"
, String -> Html
primHtmlChar String
"bull"
, String -> Html
primHtmlChar String
"nbsp"
, Html -> Html
anchor forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [String -> HtmlAttr
href forall a b. (a -> b) -> a -> b
$ String
base' forall a. [a] -> [a] -> [a]
++ String
"/_diff" forall a. [a] -> [a] -> [a]
++ String -> String
urlForPage String
page forall a. [a] -> [a] -> [a]
++ String
"?from=" forall a. [a] -> [a] -> [a]
++
Revision -> String
revId Revision
rev] forall a b. HTML a => (Html -> b) -> a -> b
<< String
"current"
]
else []) forall a. [a] -> [a] -> [a]
++
[String -> Html
stringToHtml String
"]"])
]
let contents :: Html
contents = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Revision]
hist
then Html
noHtml
else Html -> Html
ulist forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [String -> HtmlAttr
theclass String
"history"] forall a b. HTML a => (Html -> b) -> a -> b
<<
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Revision -> Int -> Html
versionToHtml [Revision]
hist
[forall (t :: * -> *) a. Foldable t => t a -> Int
length [Revision]
hist, (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Revision]
hist forall a. Num a => a -> a -> a
- Int
1)..Int
1]
let more :: Html
more = if forall (t :: * -> *) a. Foldable t => t a -> Int
length [Revision]
hist forall a. Eq a => a -> a -> Bool
== Params -> Int
pLimit Params
params
then Html -> Html
anchor forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [String -> HtmlAttr
href forall a b. (a -> b) -> a -> b
$ String
base' forall a. [a] -> [a] -> [a]
++ String
"/_history" forall a. [a] -> [a] -> [a]
++ String -> String
urlForPage String
page
forall a. [a] -> [a] -> [a]
++ String
"?limit=" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (Params -> Int
pLimit Params
params forall a. Num a => a -> a -> a
+ Int
100)] forall a b. HTML a => (Html -> b) -> a -> b
<<
String
"Show more..."
else Html
noHtml
let tabs :: [Tab]
tabs = if String
file forall a. Eq a => a -> a -> Bool
== String
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 = [String
"dragdiff.js"],
pgTabs :: [Tab]
pgTabs = [Tab]
tabs,
pgSelectedTab :: Tab
pgSelectedTab = Tab
HistoryTab,
pgTitle :: String
pgTitle = (String
"Changes to " forall a. [a] -> [a] -> [a]
++ String
page)
} forall a b. (a -> b) -> a -> b
$ Html
contents forall a b. (HTML a, HTML b) => a -> b -> Html
+++ Html
more
showActivity :: Handler
showActivity :: Handler
showActivity = forall (m :: * -> *) a r.
(HasRqData m, FromData a, MonadPlus m, ServerMonad m) =>
(a -> m r) -> m r
withData forall a b. (a -> b) -> a -> b
$ \(Params
params :: Params) -> do
Config
cfg <- GititServerPart Config
getConfig
UTCTime
currTime <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
let defaultDaysAgo :: NominalDiffTime
defaultDaysAgo = 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 forall a. Num a => a -> a -> a
* (-NominalDiffTime
60) forall a. Num a => a -> a -> a
* NominalDiffTime
60 forall a. Num a => a -> a -> a
* NominalDiffTime
24) UTCTime
currTime
let since :: Maybe UTCTime
since = case Params -> Maybe UTCTime
pSince Params
params of
Maybe UTCTime
Nothing -> forall a. a -> Maybe a
Just UTCTime
daysAgo
Just UTCTime
t -> 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 <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO 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 forall a. Maybe a
Nothing)
(forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Params -> Int
pLimit Params
params)
let hist' :: [Revision]
hist' = case Maybe String
forUser of
Maybe String
Nothing -> [Revision]
hist
Just String
u -> forall a. (a -> Bool) -> [a] -> [a]
filter (\Revision
r -> Author -> String
authorName (Revision -> Author
revAuthor Revision
r) forall a. Eq a => a -> a -> Bool
== String
u) [Revision]
hist
let fileFromChange :: Change -> String
fileFromChange (Added String
f) = String
f
fileFromChange (Modified String
f) = String
f
fileFromChange (Deleted String
f) = String
f
String
base' <- forall (m :: * -> *). ServerMonad m => m String
getWikiBase
let fileAnchor :: String -> String -> Html
fileAnchor String
revis String
file = if String -> String
takeExtension String
file forall a. Eq a => a -> a -> Bool
== String
"." forall a. [a] -> [a] -> [a]
++ (Config -> String
defaultExtension Config
cfg)
then Html -> Html
anchor forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [String -> HtmlAttr
href forall a b. (a -> b) -> a -> b
$ String
base' forall a. [a] -> [a] -> [a]
++ String
"/_diff" forall a. [a] -> [a] -> [a]
++ String -> String
urlForPage (String -> String
dropExtension String
file) forall a. [a] -> [a] -> [a]
++ String
"?to=" forall a. [a] -> [a] -> [a]
++ String
revis] forall a b. HTML a => (Html -> b) -> a -> b
<< String -> String
dropExtension String
file
else Html -> Html
anchor forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [String -> HtmlAttr
href forall a b. (a -> b) -> a -> b
$ String
base' forall a. [a] -> [a] -> [a]
++ String -> String
urlForPage String
file forall a. [a] -> [a] -> [a]
++ String
"?revision=" forall a. [a] -> [a] -> [a]
++ String
revis] forall a b. HTML a => (Html -> b) -> a -> b
<< String
file
let filesFor :: [Change] -> String -> [Html]
filesFor [Change]
changes String
revis = forall a. a -> [a] -> [a]
intersperse (String -> Html
stringToHtml String
" ") forall a b. (a -> b) -> a -> b
$
forall a b. (a -> b) -> [a] -> [b]
map (String -> String -> Html
fileAnchor String
revis forall b c a. (b -> c) -> (a -> b) -> a -> c
. Change -> String
fileFromChange) [Change]
changes
let heading :: Html
heading = Html -> Html
h1 forall a b. HTML a => (Html -> b) -> a -> b
<< (String
"Recent changes by " forall a. [a] -> [a] -> [a]
++ forall a. a -> Maybe a -> a
fromMaybe String
"all users" Maybe String
forUser)
let revToListItem :: Revision -> Html
revToListItem Revision
rev = Html -> Html
li forall a b. HTML a => (Html -> b) -> a -> b
<<
[ Html -> Html
thespan forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [String -> HtmlAttr
theclass String
"date"] forall a b. HTML a => (Html -> b) -> a -> b
<< (forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ Revision -> UTCTime
revDateTime Revision
rev)
, String -> Html
stringToHtml String
" ("
, Html -> Html
thespan forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [String -> HtmlAttr
theclass String
"author"] forall a b. HTML a => (Html -> b) -> a -> b
<<
Html -> Html
anchor forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [String -> HtmlAttr
href forall a b. (a -> b) -> a -> b
$ String
base' forall a. [a] -> [a] -> [a]
++ String
"/_activity?" forall a. [a] -> [a] -> [a]
++
[(String, String)] -> String
urlEncodeVars [(String
"forUser", Author -> String
authorName forall a b. (a -> b) -> a -> b
$ Revision -> Author
revAuthor Revision
rev)]] forall a b. HTML a => (Html -> b) -> a -> b
<<
(Author -> String
authorName forall a b. (a -> b) -> a -> b
$ Revision -> Author
revAuthor Revision
rev)
, String -> Html
stringToHtml String
"): "
, Html -> Html
thespan forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [String -> HtmlAttr
theclass String
"subject"] forall a b. HTML a => (Html -> b) -> a -> b
<< Revision -> String
revDescription Revision
rev
, String -> Html
stringToHtml String
" ("
, Html -> Html
thespan forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [String -> HtmlAttr
theclass String
"files"] forall a b. HTML a => (Html -> b) -> a -> b
<< [Change] -> String -> [Html]
filesFor (Revision -> [Change]
revChanges Revision
rev) (Revision -> String
revId Revision
rev)
, String -> Html
stringToHtml String
")"
]
let contents :: Html
contents = Html -> Html
ulist forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [String -> HtmlAttr
theclass String
"history"] forall a b. HTML a => (Html -> b) -> a -> b
<< 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 = String
"Recent changes"
} (Html
heading forall a b. (HTML a, HTML b) => a -> b -> Html
+++ Html
contents)
showPageDiff :: Handler
showPageDiff :: Handler
showPageDiff = forall (m :: * -> *) a r.
(HasRqData m, FromData a, MonadPlus m, ServerMonad m) =>
(a -> m r) -> m r
withData 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 forall a b. (a -> b) -> a -> b
$ Config -> String
defaultExtension Config
cfg) String
page Params
params
showFileDiff :: Handler
showFileDiff :: Handler
showFileDiff = forall (m :: * -> *) a r.
(HasRqData m, FromData a, MonadPlus m, ServerMonad m) =>
(a -> m r) -> m r
withData 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 String
file String
page Params
params = do
let from :: Maybe String
from = Params -> Maybe String
pFrom Params
params
let to :: Maybe String
to = Params -> Maybe String
pTo Params
params
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe String
from forall a. Eq a => a -> a -> Bool
== forall a. Maybe a
Nothing Bool -> Bool -> Bool
&& Maybe String
to forall a. Eq a => a -> a -> Bool
== forall a. Maybe a
Nothing) forall (m :: * -> *) a. MonadPlus m => m a
mzero
FileStore
fs <- GititServerPart FileStore
getFileStore
Maybe String
from' <- case (Maybe String
from, Maybe String
to) of
(Just String
_, Maybe String
_) -> forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
from
(Maybe String
Nothing, Maybe String
Nothing) -> forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
from
(Maybe String
Nothing, Just String
t) -> do
[Revision]
pageHist <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO 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 forall a. Maybe a
Nothing forall a. Maybe a
Nothing)
forall a. Maybe a
Nothing
let ([Revision]
_, [Revision]
upto) = forall a. (a -> Bool) -> [a] -> ([a], [a])
break (\Revision
r -> FileStore -> String -> String -> Bool
idsMatch FileStore
fs (Revision -> String
revId Revision
r) String
t)
[Revision]
pageHist
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if forall (t :: * -> *) a. Foldable t => t a -> Int
length [Revision]
upto forall a. Ord a => a -> a -> Bool
>= Int
2
then forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Revision -> String
revId forall a b. (a -> b) -> a -> b
$ [Revision]
upto forall a. [a] -> Int -> a
!! Int
1
else forall a. Maybe a
Nothing
Either FileStoreError Html
result' <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall e a. Exception e => IO a -> IO (Either e a)
E.try 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 FileStoreError
NotFound -> forall (m :: * -> *) a. MonadPlus m => m a
mzero
Left FileStoreError
e -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall e a. Exception e => e -> IO a
E.throwIO FileStoreError
e
Right Html
htmlDiff -> PageLayout -> Html -> Handler
formattedPage PageLayout
defaultPageLayout{
pgPageName :: String
pgPageName = String
page,
pgRevision :: Maybe String
pgRevision = Maybe String
from' 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 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 FileStore
fs String
file Maybe String
from 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 [String]
xs [String]
_) = Html -> Html
thespan forall a b. HTML a => (Html -> b) -> a -> b
<< [String] -> String
unlines [String]
xs
diffLineToHtml (First [String]
xs) = Html -> Html
thespan forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [String -> HtmlAttr
theclass String
"deleted"] forall a b. HTML a => (Html -> b) -> a -> b
<< [String] -> String
unlines [String]
xs
diffLineToHtml (Second [String]
xs) = Html -> Html
thespan forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [String -> HtmlAttr
theclass String
"added"] forall a b. HTML a => (Html -> b) -> a -> b
<< [String] -> String
unlines [String]
xs
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Html -> Html
h2 forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [String -> HtmlAttr
theclass String
"revision"] forall a b. HTML a => (Html -> b) -> a -> b
<<
(String
"Changes from " forall a. [a] -> [a] -> [a]
++ forall a. a -> Maybe a -> a
fromMaybe String
"beginning" Maybe String
from forall a. [a] -> [a] -> [a]
++
String
" to " forall a. [a] -> [a] -> [a]
++ forall a. a -> Maybe a -> a
fromMaybe String
"current" Maybe String
to) forall a b. (HTML a, HTML b) => a -> b -> Html
+++
Html -> Html
pre forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [String -> HtmlAttr
theclass String
"diff"] forall a b. HTML a => (Html -> b) -> a -> b
<< forall a b. (a -> b) -> [a] -> [b]
map Diff [String] -> Html
diffLineToHtml [Diff [String]]
rawDiff
editPage :: Handler
editPage :: Handler
editPage = forall (m :: * -> *) a r.
(HasRqData m, FromData a, MonadPlus m, ServerMonad m) =>
(a -> m r) -> m r
withData Params -> Handler
editPage'
editPage' :: Params -> Handler
editPage' :: Params -> Handler
editPage' Params
params = do
let rev :: Maybe String
rev = Params -> Maybe String
pRevision Params
params
FileStore
fs <- GititServerPart FileStore
getFileStore
String
page <- GititServerPart String
getPage
Config
cfg <- GititServerPart Config
getConfig
let getRevisionAndText :: IO (Maybe String, String)
getRevisionAndText = forall e a. Exception e => IO a -> (e -> IO a) -> IO a
E.catch
(do String
c <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ FileStore -> forall a. Contents a => String -> Maybe String -> IO a
retrieve FileStore
fs (String -> String -> String
pathForPage String
page forall a b. (a -> b) -> a -> b
$ Config -> String
defaultExtension Config
cfg) Maybe String
rev
Revision
r <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ FileStore -> String -> IO String
latest FileStore
fs (String -> String -> String
pathForPage String
page forall a b. (a -> b) -> a -> b
$ Config -> String
defaultExtension Config
cfg) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FileStore -> String -> IO Revision
revision FileStore
fs
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Revision -> String
revId Revision
r, String
c))
(\FileStoreError
e -> if FileStoreError
e forall a. Eq a => a -> a -> Bool
== FileStoreError
NotFound
then forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Maybe a
Nothing, String
"")
else forall e a. Exception e => e -> IO a
E.throwIO FileStoreError
e)
(Maybe String
mbRev, String
raw) <- case Params -> Maybe String
pEditedText Params
params of
Maybe String
Nothing -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (Maybe String, String)
getRevisionAndText
Just String
t -> let r :: Maybe String
r = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Params -> String
pSHA1 Params
params)
then forall a. Maybe a
Nothing
else forall a. a -> Maybe a
Just (Params -> String
pSHA1 Params
params)
in 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 String
r -> String -> Html
textfield String
"sha1" forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [String -> HtmlAttr
thestyle String
"display: none",
String -> HtmlAttr
value String
r]
Maybe String
Nothing -> Html
noHtml
let readonly :: [HtmlAttr]
readonly = if forall a. Maybe a -> Bool
isJust (Params -> Maybe String
pRevision Params
params)
then [String -> String -> HtmlAttr
strAttr String
"readonly" String
"yes",
String -> String -> HtmlAttr
strAttr String
"style" String
"color: gray"]
else []
String
base' <- forall (m :: * -> *). ServerMonad m => m String
getWikiBase
let editForm :: Html
editForm = String -> Html -> Html
gui (String
base' forall a. [a] -> [a] -> [a]
++ String -> String
urlForPage String
page) forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [String -> HtmlAttr
identifier String
"editform"] forall a b. HTML a => (Html -> b) -> a -> b
<<
[ Html
sha1Box
, Html -> Html
textarea forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! ([HtmlAttr]
readonly forall a. [a] -> [a] -> [a]
++ [String -> HtmlAttr
cols String
"80", String -> HtmlAttr
name String
"editedText",
String -> HtmlAttr
identifier String
"editedText"]) forall a b. HTML a => (Html -> b) -> a -> b
<< String
raw
, Html
br
, Html -> Html
label forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [String -> HtmlAttr
thefor String
"logMsg"] forall a b. HTML a => (Html -> b) -> a -> b
<< String
"Description of changes:"
, Html
br
, String -> Html
textfield String
"logMsg" forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! ([HtmlAttr]
readonly forall a. [a] -> [a] -> [a]
++ [String -> HtmlAttr
value (String
logMsg forall a. [a] -> [a] -> [a]
`orIfNull` Config -> String
defaultSummary Config
cfg) ])
, String -> String -> Html
submit String
"update" String
"Save"
, String -> Html
primHtmlChar String
"nbsp"
, String -> String -> Html
submit String
"cancel" String
"Discard"
, String -> Html
primHtmlChar String
"nbsp"
, Html
input forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [String -> HtmlAttr
thetype String
"button", String -> HtmlAttr
theclass String
"editButton",
String -> HtmlAttr
identifier String
"previewButton",
String -> String -> HtmlAttr
strAttr String
"onClick" String
"updatePreviewPane();",
String -> String -> HtmlAttr
strAttr String
"style" String
"display: none;",
String -> HtmlAttr
value String
"Preview" ]
, Html -> Html
thediv forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [ String -> HtmlAttr
identifier String
"previewpane" ] forall a b. HTML a => (Html -> b) -> a -> b
<< Html
noHtml
]
let pgScripts' :: [String]
pgScripts' = [String
"preview.js"]
let pgScripts'' :: [String]
pgScripts'' = case Config -> MathMethod
mathMethod Config
cfg of
MathMethod
MathML -> String
"MathMLinHTML.js" forall a. a -> [a] -> [a]
: [String]
pgScripts'
MathJax String
url -> String
url forall a. a -> [a] -> [a]
: [String]
pgScripts'
MathMethod
_ -> [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 = forall a. a -> Maybe a
Just 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 = (String
"Editing " 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
Either FileStoreError String
pageTest <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall e a. Exception e => IO a -> IO (Either e a)
E.try forall a b. (a -> b) -> a -> b
$ FileStore -> String -> IO String
latest FileStore
fs (String -> String -> String
pathForPage String
page forall a b. (a -> b) -> a -> b
$ Config -> String
defaultExtension Config
cfg)
String
fileToDelete <- case Either FileStoreError String
pageTest of
Right String
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String -> String -> String
pathForPage String
page forall a b. (a -> b) -> a -> b
$ Config -> String
defaultExtension Config
cfg
Left FileStoreError
NotFound -> do
Either FileStoreError String
fileTest <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall e a. Exception e => IO a -> IO (Either e a)
E.try forall a b. (a -> b) -> a -> b
$ FileStore -> String -> IO String
latest FileStore
fs String
page
case Either FileStoreError String
fileTest of
Right String
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return String
page
Left FileStoreError
NotFound -> forall (m :: * -> *) a. Monad m => a -> m a
return String
""
Left FileStoreError
e -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail (forall a. Show a => a -> String
show FileStoreError
e)
Left FileStoreError
e -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail (forall a. Show a => a -> String
show FileStoreError
e)
let confirmForm :: Html
confirmForm = String -> Html -> Html
gui String
"" forall a b. HTML a => (Html -> b) -> a -> b
<<
[ Html -> Html
p forall a b. HTML a => (Html -> b) -> a -> b
<< String
"Are you sure you want to delete this page?"
, Html
input forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [String -> HtmlAttr
thetype String
"text", String -> HtmlAttr
name String
"filetodelete",
String -> String -> HtmlAttr
strAttr String
"style" String
"display: none;", String -> HtmlAttr
value String
fileToDelete]
, String -> String -> Html
submit String
"confirm" String
"Yes, delete it!"
, String -> Html
stringToHtml String
" "
, String -> String -> Html
submit String
"cancel" String
"No, keep it!"
, Html
br ]
PageLayout -> Html -> Handler
formattedPage PageLayout
defaultPageLayout{ pgTitle :: String
pgTitle = String
"Delete " forall a. [a] -> [a] -> [a]
++ String
page forall a. [a] -> [a] -> [a]
++ String
"?" } forall a b. (a -> b) -> a -> b
$
if forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
fileToDelete
then Html -> Html
ulist forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [String -> HtmlAttr
theclass String
"messages"] forall a b. HTML a => (Html -> b) -> a -> b
<< Html -> Html
li forall a b. HTML a => (Html -> b) -> a -> b
<<
String
"There is no file or page by that name."
else Html
confirmForm
deletePage :: Handler
deletePage :: Handler
deletePage = forall (m :: * -> *) a r.
(HasRqData m, FromData a, MonadPlus m, ServerMonad m) =>
(a -> m r) -> m r
withData 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
(String
user, String
email) <- case Maybe User
mbUser of
Maybe User
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return (String
"Anonymous", String
"")
Just User
u -> 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' <- forall (m :: * -> *). ServerMonad m => m String
getWikiBase
if Params -> Bool
pConfirm Params
params Bool -> Bool -> Bool
&& (String
file forall a. Eq a => a -> a -> Bool
== String
page Bool -> Bool -> Bool
|| String
file forall a. Eq a => a -> a -> Bool
== String
page String -> String -> String
<.> (Config -> String
defaultExtension Config
cfg))
then do
FileStore
fs <- GititServerPart FileStore
getFileStore
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ FileStore -> String -> Author -> String -> IO ()
Data.FileStore.delete FileStore
fs String
file Author
author String
descrip
forall (m :: * -> *) uri res.
(FilterMonad Response m, ToSURI uri) =>
uri -> res -> m res
seeOther (String
base' forall a. [a] -> [a] -> [a]
++ String
"/") forall a b. (a -> b) -> a -> b
$ forall a. ToMessage a => a -> Response
toResponse forall a b. (a -> b) -> a -> b
$ Html -> Html
p forall a b. HTML a => (Html -> b) -> a -> b
<< String
"File deleted"
else forall (m :: * -> *) uri res.
(FilterMonad Response m, ToSURI uri) =>
uri -> res -> m res
seeOther (String
base' forall a. [a] -> [a] -> [a]
++ String -> String
urlForPage String
page) forall a b. (a -> b) -> a -> b
$ forall a. ToMessage a => a -> Response
toResponse forall a b. (a -> b) -> a -> b
$ Html -> Html
p forall a b. HTML a => (Html -> b) -> a -> b
<< String
"Not deleted"
updatePage :: Handler
updatePage :: Handler
updatePage = forall (m :: * -> *) a r.
(HasRqData m, FromData a, MonadPlus m, ServerMonad m) =>
(a -> m r) -> m r
withData 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
(String
user, String
email) <- case Maybe User
mbUser of
Maybe User
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return (String
"Anonymous", String
"")
Just User
u -> 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
Maybe String
Nothing -> forall a. HasCallStack => String -> a
error String
"No body text in POST request"
Just String
b -> String -> GititServerPart String
applyPreCommitPlugins String
b
let logMsg :: String
logMsg = Params -> String
pLogMsg Params
params 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' <- forall (m :: * -> *). ServerMonad m => m String
getWikiBase
if forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSpace) forall a b. (a -> b) -> a -> b
$ String
logMsg
then forall (m :: * -> *) a. ServerMonad m => [String] -> m a -> m a
withMessages [String
"Description cannot be empty."] Handler
editPage
else do
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall (t :: * -> *) a. Foldable t => t a -> Int
length String
editedText forall a. Ord a => a -> a -> Bool
> forall a b. (Integral a, Num b) => a -> b
fromIntegral (Config -> Integer
maxPageSize Config
cfg)) forall a b. (a -> b) -> a -> b
$
forall a. HasCallStack => String -> a
error String
"Page exceeds maximum size."
Either MergeInfo ()
modifyRes <- if forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
oldSHA1
then forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a.
Contents a =>
FileStore -> String -> Author -> String -> a -> IO ()
create FileStore
fs (String -> String -> String
pathForPage String
page forall a b. (a -> b) -> a -> b
$ Config -> String
defaultExtension Config
cfg)
(String -> String -> Author
Author String
user String
email) String
logMsg String
editedText forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. b -> Either a b
Right ())
else do
String -> ServerPartT (ReaderT WikiState IO) ()
expireCachedFile (String -> String -> String
pathForPage String
page forall a b. (a -> b) -> a -> b
$ Config -> String
defaultExtension Config
cfg) forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` forall (m :: * -> *) a. Monad m => a -> m a
return ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall e a. Exception e => IO a -> (e -> IO a) -> IO a
E.catch (forall a.
Contents a =>
FileStore
-> String
-> String
-> Author
-> String
-> a
-> IO (Either MergeInfo ())
modify FileStore
fs (String -> String -> String
pathForPage String
page 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)
(\FileStoreError
e -> if FileStoreError
e forall a. Eq a => a -> a -> Bool
== FileStoreError
Unchanged
then forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. b -> Either a b
Right ())
else forall e a. Exception e => e -> IO a
E.throwIO FileStoreError
e)
case Either MergeInfo ()
modifyRes of
Right () -> forall (m :: * -> *) uri res.
(FilterMonad Response m, ToSURI uri) =>
uri -> res -> m res
seeOther (String
base' forall a. [a] -> [a] -> [a]
++ String -> String
urlForPage String
page) forall a b. (a -> b) -> a -> b
$ forall a. ToMessage a => a -> Response
toResponse forall a b. (a -> b) -> a -> b
$ Html -> Html
p forall a b. HTML a => (Html -> b) -> a -> b
<< String
"Page updated"
Left (MergeInfo Revision
mergedWithRev Bool
conflicts String
mergedText) -> do
let mergeMsg :: String
mergeMsg = String
"The page has been edited since you checked it out. " forall a. [a] -> [a] -> [a]
++
String
"Changes from revision " forall a. [a] -> [a] -> [a]
++ Revision -> String
revId Revision
mergedWithRev forall a. [a] -> [a] -> [a]
++
String
" have been merged into your edits below. " forall a. [a] -> [a] -> [a]
++
if Bool
conflicts
then String
"Please resolve conflicts and Save."
else String
"Please review and Save."
Params -> Handler
editPage' forall a b. (a -> b) -> a -> b
$
Params
params{ pEditedText :: Maybe String
pEditedText = 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' <- forall (m :: * -> *). ServerMonad m => m String
getPath
String
base' <- 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 forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
path' then String
"" else String
path' forall a. [a] -> [a] -> [a]
++ String
"/"
FileStore
fs <- GititServerPart FileStore
getFileStore
[Resource]
listing <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ FileStore -> String -> IO [Resource]
directory FileStore
fs String
prefix'
let isNotDiscussionPage :: Resource -> GititServerPart Bool
isNotDiscussionPage (FSFile String
f) = String -> GititServerPart Bool
isNotDiscussPageFile String
f
isNotDiscussionPage (FSDirectory String
_) = forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
[Resource]
prunedListing <- forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM Resource -> GititServerPart 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 = String
"Contents"} Html
htmlIndex
fileListToHtml :: String -> String -> String -> [Resource] -> Html
fileListToHtml :: String -> String -> String -> [Resource] -> Html
fileListToHtml String
base' String
prefix String
ext [Resource]
files =
let fileLink :: Resource -> Html
fileLink (FSFile String
f) | String -> String
takeExtension String
f forall a. Eq a => a -> a -> Bool
== String
"." forall a. [a] -> [a] -> [a]
++ String
ext =
Html -> Html
li forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [String -> HtmlAttr
theclass String
"page" ] forall a b. HTML a => (Html -> b) -> a -> b
<<
Html -> Html
anchor forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [String -> HtmlAttr
href forall a b. (a -> b) -> a -> b
$ String
base' forall a. [a] -> [a] -> [a]
++ String -> String
urlForPage (String
prefix forall a. [a] -> [a] -> [a]
++ String -> String
dropExtension String
f)] forall a b. HTML a => (Html -> b) -> a -> b
<<
String -> String
dropExtension String
f
fileLink (FSFile String
f) = Html -> Html
li forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [String -> HtmlAttr
theclass String
"upload"] forall a b. HTML a => (Html -> b) -> a -> b
<< forall a. HTML a => [a] -> Html
concatHtml
[ Html -> Html
anchor forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [String -> HtmlAttr
href forall a b. (a -> b) -> a -> b
$ String
base' forall a. [a] -> [a] -> [a]
++ String -> String
urlForPage (String
prefix forall a. [a] -> [a] -> [a]
++ String
f)] forall a b. HTML a => (Html -> b) -> a -> b
<< String
f
, Html -> Html
anchor forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [String -> HtmlAttr
href forall a b. (a -> b) -> a -> b
$ String
base' forall a. [a] -> [a] -> [a]
++ String
"_delete" forall a. [a] -> [a] -> [a]
++ String -> String
urlForPage (String
prefix forall a. [a] -> [a] -> [a]
++ String
f)] forall a b. HTML a => (Html -> b) -> a -> b
<< String
"(delete)"
]
fileLink (FSDirectory String
f) =
Html -> Html
li forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [String -> HtmlAttr
theclass String
"folder"] forall a b. HTML a => (Html -> b) -> a -> b
<<
Html -> Html
anchor forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [String -> HtmlAttr
href forall a b. (a -> b) -> a -> b
$ String
base' forall a. [a] -> [a] -> [a]
++ String -> String
urlForPage (String
prefix forall a. [a] -> [a] -> [a]
++ String
f) forall a. [a] -> [a] -> [a]
++ String
"/"] forall a b. HTML a => (Html -> b) -> a -> b
<< String
f
updirs :: [[String]]
updirs = forall a. Int -> [a] -> [a]
drop Int
1 forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [[a]]
inits forall a b. (a -> b) -> a -> b
$ String -> [String]
splitPath forall a b. (a -> b) -> a -> b
$ Char
'/' forall a. a -> [a] -> [a]
: String
prefix
uplink :: Html
uplink = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\[String]
d Html
accum ->
forall a. HTML a => [a] -> Html
concatHtml [ Html -> Html
anchor forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [String -> HtmlAttr
theclass String
"updir",
String -> HtmlAttr
href forall a b. (a -> b) -> a -> b
$ if forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
d forall a. Ord a => a -> a -> Bool
<= Int
1
then String
base' forall a. [a] -> [a] -> [a]
++ String
"/_index"
else String
base' forall a. [a] -> [a] -> [a]
++
String -> String
urlForPage ([String] -> String
joinPath forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> [a]
drop Int
1 [String]
d)] forall a b. HTML a => (Html -> b) -> a -> b
<<
forall a. HasCallStack => String -> [a] -> a
lastNote String
"fileListToHtml" [String]
d, Html
accum]) Html
noHtml [[String]]
updirs
in Html
uplink forall a b. (HTML a, HTML b) => a -> b -> Html
+++ Html -> Html
ulist forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [String -> HtmlAttr
theclass String
"index"] forall a b. HTML a => (Html -> b) -> a -> b
<< forall a b. (a -> b) -> [a] -> [b]
map Resource -> Html
fileLink [Resource]
files
categoryPage :: Handler
categoryPage :: Handler
categoryPage = do
String
path' <- forall (m :: * -> *). ServerMonad m => m String
getPath
Config
cfg <- GititServerPart Config
getConfig
let pcategories :: [String]
pcategories = forall a. (a -> Bool) -> [a] -> [[a]]
wordsBy (forall a. Eq a => a -> a -> Bool
==Char
',') String
path'
let repoPath :: String
repoPath = Config -> String
repositoryPath Config
cfg
let categoryDescription :: String
categoryDescription = String
"Category: " forall a. [a] -> [a] -> [a]
++ (forall a. [a] -> [[a]] -> [a]
intercalate String
" + " [String]
pcategories)
FileStore
fs <- GititServerPart FileStore
getFileStore
[String]
pages <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FileStore -> IO [String]
index FileStore
fs) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM String -> GititServerPart Bool
isPageFile forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM String -> GititServerPart Bool
isNotDiscussPageFile
[(String, [String])]
matches <- forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall a. [Maybe a] -> [a]
catMaybes forall a b. (a -> b) -> a -> b
$
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [String]
pages forall a b. (a -> b) -> a -> b
$ \String
f -> do
[String]
categories <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> IO [String]
readCategories forall a b. (a -> b) -> a -> b
$ String
repoPath String -> String -> String
</> String
f
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ( forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
categories) [String]
pcategories
then forall a. a -> Maybe a
Just (String
f, [String]
categories forall a. Eq a => [a] -> [a] -> [a]
\\ [String]
pcategories)
else forall a. Maybe a
Nothing
String
base' <- forall (m :: * -> *). ServerMonad m => m String
getWikiBase
let toMatchListItem :: String -> Html
toMatchListItem String
file = Html -> Html
li forall a b. HTML a => (Html -> b) -> a -> b
<<
[ Html -> Html
anchor forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [String -> HtmlAttr
href forall a b. (a -> b) -> a -> b
$ String
base' forall a. [a] -> [a] -> [a]
++ String -> String
urlForPage (String -> String
dropExtension String
file)] forall a b. HTML a => (Html -> b) -> a -> b
<< String -> String
dropExtension String
file ]
let toRemoveListItem :: String -> Html
toRemoveListItem String
cat = Html -> Html
li forall a b. HTML a => (Html -> b) -> a -> b
<<
[ Html -> Html
anchor forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [String -> HtmlAttr
href forall a b. (a -> b) -> a -> b
$ String
base' forall a. [a] -> [a] -> [a]
++
(if forall (t :: * -> *) a. Foldable t => t a -> Bool
null (forall a. [a] -> [a]
tail [String]
pcategories)
then String
"/_categories"
else String
"/_category" forall a. [a] -> [a] -> [a]
++ String -> String
urlForPage (forall a. [a] -> [[a]] -> [a]
intercalate String
"," forall a b. (a -> b) -> a -> b
$ forall a. Eq a => a -> [a] -> [a]
Data.List.delete String
cat [String]
pcategories)) ]
forall a b. HTML a => (Html -> b) -> a -> b
<< (String
"-" forall a. [a] -> [a] -> [a]
++ String
cat) ]
let toAddListItem :: String -> Html
toAddListItem String
cat = Html -> Html
li forall a b. HTML a => (Html -> b) -> a -> b
<<
[ Html -> Html
anchor forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [String -> HtmlAttr
href forall a b. (a -> b) -> a -> b
$ String
base' forall a. [a] -> [a] -> [a]
++
String
"/_category" forall a. [a] -> [a] -> [a]
++ String -> String
urlForPage (String
path' forall a. [a] -> [a] -> [a]
++ String
"," forall a. [a] -> [a] -> [a]
++ String
cat) ]
forall a b. HTML a => (Html -> b) -> a -> b
<< (String
"+" forall a. [a] -> [a] -> [a]
++ String
cat) ]
let matchList :: Html
matchList = Html -> Html
ulist forall a b. HTML a => (Html -> b) -> a -> b
<< forall a b. (a -> b) -> [a] -> [b]
map String -> Html
toMatchListItem (forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall a b. [(a, b)] -> ([a], [b])
unzip [(String, [String])]
matches) forall a b. (HTML a, HTML b) => a -> b -> Html
+++
Html -> Html
thediv forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [ String -> HtmlAttr
identifier String
"categoryList" ] forall a b. HTML a => (Html -> b) -> a -> b
<<
Html -> Html
ulist forall a b. HTML a => (Html -> b) -> a -> b
<< forall a. [a] -> [a] -> [a]
(++) (forall a b. (a -> b) -> [a] -> [b]
map String -> Html
toAddListItem (forall a. Eq a => [a] -> [a]
nub forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall a b. [(a, b)] -> ([a], [b])
unzip [(String, [String])]
matches))
(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 = [String
"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 <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FileStore -> IO [String]
index FileStore
fs) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM String -> GititServerPart Bool
isPageFile forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM String -> GititServerPart Bool
isNotDiscussPageFile
[String]
categories <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (forall a. Eq a => [a] -> [a]
nub forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => [a] -> [a]
sort forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat) forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [String]
pages forall a b. (a -> b) -> a -> b
$ \String
f ->
String -> IO [String]
readCategories (String
repoPath String -> String -> String
</> String
f)
String
base' <- forall (m :: * -> *). ServerMonad m => m String
getWikiBase
let toCatLink :: String -> Html
toCatLink String
ctg = Html -> Html
li forall a b. HTML a => (Html -> b) -> a -> b
<<
[ Html -> Html
anchor forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [String -> HtmlAttr
href forall a b. (a -> b) -> a -> b
$ String
base' forall a. [a] -> [a] -> [a]
++ String
"/_category" forall a. [a] -> [a] -> [a]
++ String -> String
urlForPage String
ctg] forall a b. HTML a => (Html -> b) -> a -> b
<< String
ctg ]
let htmlMatches :: Html
htmlMatches = Html -> Html
ulist forall a b. HTML a => (Html -> b) -> a -> b
<< forall a b. (a -> b) -> [a] -> [b]
map String -> Html
toCatLink [String]
categories
PageLayout -> Html -> Handler
formattedPage PageLayout
defaultPageLayout{
pgPageName :: String
pgPageName = String
"Categories",
pgShowPageTools :: Bool
pgShowPageTools = Bool
False,
pgTabs :: [Tab]
pgTabs = [],
pgScripts :: [String]
pgScripts = [String
"search.js"],
pgTitle :: String
pgTitle = String
"Categories" } Html
htmlMatches
expireCache :: Handler
expireCache :: Handler
expireCache = do
String
page <- GititServerPart String
getPage
Config
cfg <- GititServerPart Config
getConfig
String -> ServerPartT (ReaderT WikiState IO) ()
expireCachedFile (String -> String -> String
pathForPage String
page forall a b. (a -> b) -> a -> b
$ Config -> String
defaultExtension Config
cfg)
String -> ServerPartT (ReaderT WikiState IO) ()
expireCachedFile String
page
forall (m :: * -> *) a. FilterMonad Response m => a -> m a
ok forall a b. (a -> b) -> a -> b
$ forall a. ToMessage a => a -> Response
toResponse ()
feedHandler :: Handler
feedHandler :: Handler
feedHandler = do
Config
cfg <- GititServerPart Config
getConfig
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ Config -> Bool
useFeed Config
cfg) forall (m :: * -> *) a. MonadPlus m => m a
mzero
String
base' <- forall (m :: * -> *). ServerMonad m => m String
getWikiBase
String
feedBase <- if forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Config -> String
baseUrl Config
cfg)
then do
Maybe String
mbHost <- forall (m :: * -> *). ServerMonad m => m (Maybe String)
getHost
case Maybe String
mbHost of
Maybe String
Nothing -> forall a. HasCallStack => String -> a
error String
"Could not determine base URL"
Just String
hn -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String
"http://" forall a. [a] -> [a] -> [a]
++ String
hn forall a. [a] -> [a] -> [a]
++ String
base'
else case Config -> String
baseUrl Config
cfg forall a. [a] -> [a] -> [a]
++ String
base' of
w :: String
w@(Char
'h':Char
't':Char
't':Char
'p':Char
's':Char
':':Char
'/':Char
'/':String
_) -> forall (m :: * -> *) a. Monad m => a -> m a
return String
w
x :: String
x@(Char
'h':Char
't':Char
't':Char
'p':Char
':':Char
'/':Char
'/':String
_) -> forall (m :: * -> *) a. Monad m => a -> m a
return String
x
String
y -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String
"http://" forall a. [a] -> [a] -> [a]
++ String
y
let fc :: FeedConfig
fc = FeedConfig{
fcTitle :: String
fcTitle = Config -> String
wikiTitle Config
cfg
, fcBaseUrl :: String
fcBaseUrl = String
feedBase
, fcFeedDays :: Integer
fcFeedDays = Config -> Integer
feedDays Config
cfg }
String
path' <- forall (m :: * -> *). ServerMonad m => m String
getPath
let file :: String
file = (String
path' forall a. [a] -> [a] -> [a]
`orIfNull` String
"_site") String -> String -> String
<.> String
"feed"
let mbPath :: Maybe String
mbPath = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
path' then forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just String
path'
UTCTime
now <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
let isRecentEnough :: UTCTime -> Bool
isRecentEnough UTCTime
t = forall a b. (RealFrac a, Integral b) => a -> b
truncate (UTCTime -> UTCTime -> NominalDiffTime
diffUTCTime UTCTime
now UTCTime
t) forall a. Ord a => a -> a -> Bool
< Integer
60 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 (UTCTime
modtime, ByteString
contents) | UTCTime -> Bool
isRecentEnough UTCTime
modtime -> do
let emptyResponse :: Response
emptyResponse = String -> Response -> Response
setContentType String
"application/atom+xml; charset=utf-8" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToMessage a => a -> Response
toResponse forall a b. (a -> b) -> a -> b
$ ()
forall (m :: * -> *) a. FilterMonad Response m => a -> m a
ok forall a b. (a -> b) -> a -> b
$ Response
emptyResponse{rsBody :: ByteString
rsBody = [ByteString] -> ByteString
B.fromChunks [ByteString
contents]}
Maybe (UTCTime, ByteString)
_ -> do
FileStore
fs <- GititServerPart FileStore
getFileStore
Response
resp' <- forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall a. ToMessage a => a -> Response
toResponse forall a b. (a -> b) -> a -> b
$ 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 forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
S.concat forall a b. (a -> b) -> a -> b
$ ByteString -> [ByteString]
B.toChunks forall a b. (a -> b) -> a -> b
$ Response -> ByteString
rsBody Response
resp'
forall (m :: * -> *) a. FilterMonad Response m => a -> m a
ok forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Response -> Response
setContentType String
"application/atom+xml; charset=UTF-8" forall a b. (a -> b) -> a -> b
$ Response
resp'