{-
Copyright (C) 2009 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
-}

{- | Functions for embedding a gitit wiki into a Happstack application.

The following is a minimal standalone wiki program:

> import Network.Gitit
> import Happstack.Server.SimpleHTTP
>
> main = do
>   conf <- getDefaultConfig
>   createStaticIfMissing conf
>   createTemplateIfMissing conf
>   createRepoIfMissing conf
>   initializeGititState conf
>   simpleHTTP nullConf{port = 5001} $ wiki conf

Here is a more complex example, which serves different wikis
under different paths, and uses a custom authentication scheme:

> import Network.Gitit
> import Control.Monad
> import Text.XHtml hiding (dir)
> import Happstack.Server.SimpleHTTP
>
> type WikiSpec = (String, FileStoreType, PageType)
>
> wikis = [ ("markdownWiki", Git, Markdown)
>         , ("latexWiki", Darcs, LaTeX) ]
>
> -- custom authentication
> myWithUser :: Handler -> Handler
> myWithUser handler = do
>   -- replace the following with a function that retrieves
>   -- the logged in user for your happstack app:
>   user <- return "testuser"
>   localRq (setHeader "REMOTE_USER" user) handler
>
> myAuthHandler = msum
>   [ dir "_login"  $ seeOther "/your/login/url"  $ toResponse ()
>   , dir "_logout" $ seeOther "/your/logout/url" $ toResponse () ]
>
> handlerFor :: Config -> WikiSpec -> ServerPart Response
> handlerFor conf (path', fstype, pagetype) = dir path' $
>   wiki conf{ repositoryPath = path'
>            , repositoryType = fstype
>            , defaultPageType = pagetype}
>
> indexPage :: ServerPart Response
> indexPage = ok $ toResponse $
>   (p << "Wiki index") +++
>   ulist << map (\(path', _, _) -> li << hotlink (path' ++ "/") << path') wikis
>
> main = do
>   conf <- getDefaultConfig
>   let conf' = conf{authHandler = myAuthHandler, withUser = myWithUser}
>   forM wikis $ \(path', fstype, pagetype) -> do
>     let conf'' = conf'{ repositoryPath = path'
>                       , repositoryType = fstype
>                       , defaultPageType = pagetype
>                       }
>     createStaticIfMissing conf''
>     createRepoIfMissing conf''
>   createTemplateIfMissing conf'
>   initializeGititState conf'
>   simpleHTTP nullConf{port = 5001} $
>     (nullDir >> indexPage) `mplus` msum (map (handlerFor conf') wikis)

-}

module Network.Gitit (
                     -- * Wiki handlers
                       wiki
                     , reloadTemplates
                     , runHandler
                     -- * Initialization
                     , module Network.Gitit.Initialize
                     -- * Configuration
                     , module Network.Gitit.Config
                     , loginUserForm
                     -- * Types
                     , module Network.Gitit.Types
                     -- * Tools for building handlers
                     , module Network.Gitit.Framework
                     , module Network.Gitit.Layout
                     , module Network.Gitit.ContentTransformer
                     , module Network.Gitit.Page
                     , getFileStore
                     , getUser
                     , getConfig
                     , queryGititState
                     , updateGititState
                     )
where
import Network.Gitit.Types
import Network.Gitit.Server
import Network.Gitit.Framework
import Network.Gitit.Handlers
import Network.Gitit.Initialize
import Network.Gitit.Config
import Network.Gitit.Layout
import Network.Gitit.State
        (getFileStore, getUser, getConfig, queryGititState, updateGititState)
import Network.Gitit.ContentTransformer
import Network.Gitit.Page
import Network.Gitit.Authentication (loginUserForm)
import Paths_gitit (getDataFileName)
import Control.Monad
import Control.Monad.Reader
import Prelude hiding (readFile)
import qualified Data.ByteString.Char8 as B
import System.FilePath ((</>))
import System.Directory (getTemporaryDirectory)
import Safe

-- | Happstack handler for a gitit wiki.
wiki :: Config -> ServerPart Response
wiki :: Config -> ServerPart Response
wiki Config
conf = do
  tempDir <- IO String -> ServerPartT IO String
forall a. IO a -> ServerPartT IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO String
getTemporaryDirectory
  let maxSize = Integer -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Int64) -> Integer -> Int64
forall a b. (a -> b) -> a -> b
$ Config -> Integer
maxUploadSize Config
conf
  decodeBody $ defaultBodyPolicy tempDir maxSize maxSize maxSize
  let static = Config -> String
staticDir Config
conf
  defaultStatic <- liftIO $ getDataFileName $ "data" </> "static"
  -- if file not found in staticDir, we check also in the data/static
  -- directory, which contains defaults
  let staticHandler = ServerPart Response -> ServerPart Response
forall (m :: * -> *). ServerMonad m => m Response -> m Response
withExpiresHeaders (ServerPart Response -> ServerPart Response)
-> ServerPart Response -> ServerPart Response
forall a b. (a -> b) -> a -> b
$
        String -> ServerPart Response
serveDirectory' String
static ServerPart Response -> ServerPart Response -> ServerPart Response
forall a. ServerPartT IO a -> ServerPartT IO a -> ServerPartT IO a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` String -> ServerPart Response
serveDirectory' String
defaultStatic
  let debugHandler' = [ServerPartT (ReaderT WikiState IO) Response]
-> ServerPartT (ReaderT WikiState IO) Response
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum [ServerPartT (ReaderT WikiState IO) Response
debugHandler | Config -> Bool
debugMode Config
conf]
  let handlers = ServerPartT (ReaderT WikiState IO) Response
debugHandler' ServerPartT (ReaderT WikiState IO) Response
-> ServerPartT (ReaderT WikiState IO) Response
-> ServerPartT (ReaderT WikiState IO) Response
forall a.
ServerPartT (ReaderT WikiState IO) a
-> ServerPartT (ReaderT WikiState IO) a
-> ServerPartT (ReaderT WikiState IO) a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Config -> ServerPartT (ReaderT WikiState IO) Response
authHandler Config
conf ServerPartT (ReaderT WikiState IO) Response
-> ServerPartT (ReaderT WikiState IO) Response
-> ServerPartT (ReaderT WikiState IO) Response
forall a.
ServerPartT (ReaderT WikiState IO) a
-> ServerPartT (ReaderT WikiState IO) a
-> ServerPartT (ReaderT WikiState IO) a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus`
                 AuthenticationLevel
-> ServerPartT (ReaderT WikiState IO) Response
-> ServerPartT (ReaderT WikiState IO) Response
authenticate AuthenticationLevel
ForRead ([ServerPartT (ReaderT WikiState IO) Response]
-> ServerPartT (ReaderT WikiState IO) Response
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum [ServerPartT (ReaderT WikiState IO) Response]
wikiHandlers)
  let fs = Config -> FileStore
filestoreFromConfig Config
conf
  let ws = WikiState { wikiConfig :: Config
wikiConfig = Config
conf, wikiFileStore :: FileStore
wikiFileStore = FileStore
fs }
  if compressResponses conf
     then compressedResponseFilter
     else return ""
  staticHandler `mplus` runHandler ws (withUser conf handlers)

-- | Like 'serveDirectory', but if file is not found, fail instead of
-- returning a 404 error.
serveDirectory' :: FilePath -> ServerPart Response
serveDirectory' :: String -> ServerPart Response
serveDirectory' String
p = do
  rq <- ServerPartT IO Request
forall (m :: * -> *). ServerMonad m => m Request
askRq
  resp' <- serveDirectory EnableBrowsing [] p
  if rsCode resp' == 404 || lastNote "fileServeStrict'" (rqUri rq) == '/'
     then mzero  -- pass through if not found or directory index
     else
       -- turn off compresion filter unless it's text
       case getHeader "Content-Type" resp' of
            Just ByteString
ct | String -> ByteString
B.pack String
"text/" ByteString -> ByteString -> Bool
`B.isPrefixOf` ByteString
ct -> Response -> ServerPart Response
forall a. a -> ServerPartT IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Response
resp'
            Maybe ByteString
_ -> ServerPartT IO ()
forall a (m :: * -> *). FilterMonad a m => m ()
ignoreFilters ServerPartT IO () -> ServerPart Response -> ServerPart Response
forall a b.
ServerPartT IO a -> ServerPartT IO b -> ServerPartT IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Response -> ServerPart Response
forall a. a -> ServerPartT IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Response
resp'

wikiHandlers :: [Handler]
wikiHandlers :: [ServerPartT (ReaderT WikiState IO) Response]
wikiHandlers =
  [ -- redirect /wiki -> /wiki/ when gitit is being served at /wiki
    -- so that relative wikilinks on the page will work properly:
    GititServerPart ()
guardBareBase GititServerPart ()
-> ServerPartT (ReaderT WikiState IO) String
-> ServerPartT (ReaderT WikiState IO) String
forall a b.
ServerPartT (ReaderT WikiState IO) a
-> ServerPartT (ReaderT WikiState IO) b
-> ServerPartT (ReaderT WikiState IO) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ServerPartT (ReaderT WikiState IO) String
forall (m :: * -> *). ServerMonad m => m String
getWikiBase ServerPartT (ReaderT WikiState IO) String
-> (String -> ServerPartT (ReaderT WikiState IO) Response)
-> ServerPartT (ReaderT WikiState IO) Response
forall a b.
ServerPartT (ReaderT WikiState IO) a
-> (a -> ServerPartT (ReaderT WikiState IO) b)
-> ServerPartT (ReaderT WikiState IO) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \String
b -> String -> Response -> ServerPartT (ReaderT WikiState IO) Response
forall (m :: * -> *) a res.
(FilterMonad Response m, ToSURI a) =>
a -> res -> m res
movedPermanently (String
b String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"/") (() -> Response
forall a. ToMessage a => a -> Response
toResponse ())
  , String
-> ServerPartT (ReaderT WikiState IO) Response
-> ServerPartT (ReaderT WikiState IO) Response
forall (m :: * -> *) a.
(ServerMonad m, MonadPlus m) =>
String -> m a -> m a
dir String
"_activity" ServerPartT (ReaderT WikiState IO) Response
showActivity
  , String
-> ServerPartT (ReaderT WikiState IO) Response
-> ServerPartT (ReaderT WikiState IO) Response
forall (m :: * -> *) a.
(ServerMonad m, MonadPlus m) =>
String -> m a -> m a
dir String
"_go"       ServerPartT (ReaderT WikiState IO) Response
goToPage
  , Method -> GititServerPart ()
forall (m :: * -> *) method.
(ServerMonad m, MonadPlus m, MatchMethod method) =>
method -> m ()
method Method
GET GititServerPart ()
-> ServerPartT (ReaderT WikiState IO) Response
-> ServerPartT (ReaderT WikiState IO) Response
forall a b.
ServerPartT (ReaderT WikiState IO) a
-> ServerPartT (ReaderT WikiState IO) b
-> ServerPartT (ReaderT WikiState IO) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String
-> ServerPartT (ReaderT WikiState IO) Response
-> ServerPartT (ReaderT WikiState IO) Response
forall (m :: * -> *) a.
(ServerMonad m, MonadPlus m) =>
String -> m a -> m a
dir String
"_search"   ServerPartT (ReaderT WikiState IO) Response
searchResults
  , String
-> ServerPartT (ReaderT WikiState IO) Response
-> ServerPartT (ReaderT WikiState IO) Response
forall (m :: * -> *) a.
(ServerMonad m, MonadPlus m) =>
String -> m a -> m a
dir String
"_upload"   (ServerPartT (ReaderT WikiState IO) Response
 -> ServerPartT (ReaderT WikiState IO) Response)
-> ServerPartT (ReaderT WikiState IO) Response
-> ServerPartT (ReaderT WikiState IO) Response
forall a b. (a -> b) -> a -> b
$  do Bool -> GititServerPart ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> GititServerPart ())
-> ServerPartT (ReaderT WikiState IO) Bool -> GititServerPart ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Bool -> ServerPartT (ReaderT WikiState IO) Bool
forall a. a -> ServerPartT (ReaderT WikiState IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> ServerPartT (ReaderT WikiState IO) Bool)
-> (Config -> Bool)
-> Config
-> ServerPartT (ReaderT WikiState IO) Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> Bool
uploadsAllowed (Config -> ServerPartT (ReaderT WikiState IO) Bool)
-> ServerPartT (ReaderT WikiState IO) Config
-> ServerPartT (ReaderT WikiState IO) Bool
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ServerPartT (ReaderT WikiState IO) Config
getConfig
                          [ServerPartT (ReaderT WikiState IO) Response]
-> ServerPartT (ReaderT WikiState IO) Response
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum [ Method -> GititServerPart ()
forall (m :: * -> *) method.
(ServerMonad m, MonadPlus m, MatchMethod method) =>
method -> m ()
method Method
GET  GititServerPart ()
-> ServerPartT (ReaderT WikiState IO) Response
-> ServerPartT (ReaderT WikiState IO) Response
forall a b.
ServerPartT (ReaderT WikiState IO) a
-> ServerPartT (ReaderT WikiState IO) b
-> ServerPartT (ReaderT WikiState IO) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> AuthenticationLevel
-> ServerPartT (ReaderT WikiState IO) Response
-> ServerPartT (ReaderT WikiState IO) Response
authenticate AuthenticationLevel
ForModify ServerPartT (ReaderT WikiState IO) Response
uploadForm
                                 , Method -> GititServerPart ()
forall (m :: * -> *) method.
(ServerMonad m, MonadPlus m, MatchMethod method) =>
method -> m ()
method Method
POST GititServerPart ()
-> ServerPartT (ReaderT WikiState IO) Response
-> ServerPartT (ReaderT WikiState IO) Response
forall a b.
ServerPartT (ReaderT WikiState IO) a
-> ServerPartT (ReaderT WikiState IO) b
-> ServerPartT (ReaderT WikiState IO) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> AuthenticationLevel
-> ServerPartT (ReaderT WikiState IO) Response
-> ServerPartT (ReaderT WikiState IO) Response
authenticate AuthenticationLevel
ForModify ServerPartT (ReaderT WikiState IO) Response
uploadFile ]
  , String
-> ServerPartT (ReaderT WikiState IO) Response
-> ServerPartT (ReaderT WikiState IO) Response
forall (m :: * -> *) a.
(ServerMonad m, MonadPlus m) =>
String -> m a -> m a
dir String
"_random"   (ServerPartT (ReaderT WikiState IO) Response
 -> ServerPartT (ReaderT WikiState IO) Response)
-> ServerPartT (ReaderT WikiState IO) Response
-> ServerPartT (ReaderT WikiState IO) Response
forall a b. (a -> b) -> a -> b
$ Method -> GititServerPart ()
forall (m :: * -> *) method.
(ServerMonad m, MonadPlus m, MatchMethod method) =>
method -> m ()
method Method
GET  GititServerPart ()
-> ServerPartT (ReaderT WikiState IO) Response
-> ServerPartT (ReaderT WikiState IO) Response
forall a b.
ServerPartT (ReaderT WikiState IO) a
-> ServerPartT (ReaderT WikiState IO) b
-> ServerPartT (ReaderT WikiState IO) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ServerPartT (ReaderT WikiState IO) Response
randomPage
  , String
-> ServerPartT (ReaderT WikiState IO) Response
-> ServerPartT (ReaderT WikiState IO) Response
forall (m :: * -> *) a.
(ServerMonad m, MonadPlus m) =>
String -> m a -> m a
dir String
"_index"    ServerPartT (ReaderT WikiState IO) Response
indexPage
  , String
-> ServerPartT (ReaderT WikiState IO) Response
-> ServerPartT (ReaderT WikiState IO) Response
forall (m :: * -> *) a.
(ServerMonad m, MonadPlus m) =>
String -> m a -> m a
dir String
"_feed"     ServerPartT (ReaderT WikiState IO) Response
feedHandler
  , String
-> ServerPartT (ReaderT WikiState IO) Response
-> ServerPartT (ReaderT WikiState IO) Response
forall (m :: * -> *) a.
(ServerMonad m, MonadPlus m) =>
String -> m a -> m a
dir String
"_category" ServerPartT (ReaderT WikiState IO) Response
categoryPage
  , String
-> ServerPartT (ReaderT WikiState IO) Response
-> ServerPartT (ReaderT WikiState IO) Response
forall (m :: * -> *) a.
(ServerMonad m, MonadPlus m) =>
String -> m a -> m a
dir String
"_categories" ServerPartT (ReaderT WikiState IO) Response
categoryListPage
  , String
-> ServerPartT (ReaderT WikiState IO) Response
-> ServerPartT (ReaderT WikiState IO) Response
forall (m :: * -> *) a.
(ServerMonad m, MonadPlus m) =>
String -> m a -> m a
dir String
"_expire"     ServerPartT (ReaderT WikiState IO) Response
expireCache
  , String
-> ServerPartT (ReaderT WikiState IO) Response
-> ServerPartT (ReaderT WikiState IO) Response
forall (m :: * -> *) a.
(ServerMonad m, MonadPlus m) =>
String -> m a -> m a
dir String
"_showraw"  (ServerPartT (ReaderT WikiState IO) Response
 -> ServerPartT (ReaderT WikiState IO) Response)
-> ServerPartT (ReaderT WikiState IO) Response
-> ServerPartT (ReaderT WikiState IO) Response
forall a b. (a -> b) -> a -> b
$ [ServerPartT (ReaderT WikiState IO) Response]
-> ServerPartT (ReaderT WikiState IO) Response
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum
      [ ServerPartT (ReaderT WikiState IO) Response
showRawPage
      , (String -> Bool) -> GititServerPart ()
guardPath String -> Bool
isSourceCode GititServerPart ()
-> ServerPartT (ReaderT WikiState IO) Response
-> ServerPartT (ReaderT WikiState IO) Response
forall a b.
ServerPartT (ReaderT WikiState IO) a
-> ServerPartT (ReaderT WikiState IO) b
-> ServerPartT (ReaderT WikiState IO) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ServerPartT (ReaderT WikiState IO) Response
showFileAsText ]
  , String
-> ServerPartT (ReaderT WikiState IO) Response
-> ServerPartT (ReaderT WikiState IO) Response
forall (m :: * -> *) a.
(ServerMonad m, MonadPlus m) =>
String -> m a -> m a
dir String
"_history"  (ServerPartT (ReaderT WikiState IO) Response
 -> ServerPartT (ReaderT WikiState IO) Response)
-> ServerPartT (ReaderT WikiState IO) Response
-> ServerPartT (ReaderT WikiState IO) Response
forall a b. (a -> b) -> a -> b
$ [ServerPartT (ReaderT WikiState IO) Response]
-> ServerPartT (ReaderT WikiState IO) Response
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum
      [ ServerPartT (ReaderT WikiState IO) Response
showPageHistory
      , (String -> Bool) -> GititServerPart ()
guardPath String -> Bool
isSourceCode GititServerPart ()
-> ServerPartT (ReaderT WikiState IO) Response
-> ServerPartT (ReaderT WikiState IO) Response
forall a b.
ServerPartT (ReaderT WikiState IO) a
-> ServerPartT (ReaderT WikiState IO) b
-> ServerPartT (ReaderT WikiState IO) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ServerPartT (ReaderT WikiState IO) Response
showFileHistory ]
  , String
-> ServerPartT (ReaderT WikiState IO) Response
-> ServerPartT (ReaderT WikiState IO) Response
forall (m :: * -> *) a.
(ServerMonad m, MonadPlus m) =>
String -> m a -> m a
dir String
"_edit" (ServerPartT (ReaderT WikiState IO) Response
 -> ServerPartT (ReaderT WikiState IO) Response)
-> ServerPartT (ReaderT WikiState IO) Response
-> ServerPartT (ReaderT WikiState IO) Response
forall a b. (a -> b) -> a -> b
$ AuthenticationLevel
-> ServerPartT (ReaderT WikiState IO) Response
-> ServerPartT (ReaderT WikiState IO) Response
authenticate AuthenticationLevel
ForModify (ServerPartT (ReaderT WikiState IO) Response
-> ServerPartT (ReaderT WikiState IO) Response
-> ServerPartT (ReaderT WikiState IO) Response
unlessNoEdit ServerPartT (ReaderT WikiState IO) Response
editPage ServerPartT (ReaderT WikiState IO) Response
showPage)
  , String
-> ServerPartT (ReaderT WikiState IO) Response
-> ServerPartT (ReaderT WikiState IO) Response
forall (m :: * -> *) a.
(ServerMonad m, MonadPlus m) =>
String -> m a -> m a
dir String
"_diff" (ServerPartT (ReaderT WikiState IO) Response
 -> ServerPartT (ReaderT WikiState IO) Response)
-> ServerPartT (ReaderT WikiState IO) Response
-> ServerPartT (ReaderT WikiState IO) Response
forall a b. (a -> b) -> a -> b
$ [ServerPartT (ReaderT WikiState IO) Response]
-> ServerPartT (ReaderT WikiState IO) Response
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum
      [ ServerPartT (ReaderT WikiState IO) Response
showPageDiff
      , (String -> Bool) -> GititServerPart ()
guardPath String -> Bool
isSourceCode GititServerPart ()
-> ServerPartT (ReaderT WikiState IO) Response
-> ServerPartT (ReaderT WikiState IO) Response
forall a b.
ServerPartT (ReaderT WikiState IO) a
-> ServerPartT (ReaderT WikiState IO) b
-> ServerPartT (ReaderT WikiState IO) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ServerPartT (ReaderT WikiState IO) Response
showFileDiff ]
  , String
-> ServerPartT (ReaderT WikiState IO) Response
-> ServerPartT (ReaderT WikiState IO) Response
forall (m :: * -> *) a.
(ServerMonad m, MonadPlus m) =>
String -> m a -> m a
dir String
"_discuss" ServerPartT (ReaderT WikiState IO) Response
discussPage
  , String
-> ServerPartT (ReaderT WikiState IO) Response
-> ServerPartT (ReaderT WikiState IO) Response
forall (m :: * -> *) a.
(ServerMonad m, MonadPlus m) =>
String -> m a -> m a
dir String
"_delete" (ServerPartT (ReaderT WikiState IO) Response
 -> ServerPartT (ReaderT WikiState IO) Response)
-> ServerPartT (ReaderT WikiState IO) Response
-> ServerPartT (ReaderT WikiState IO) Response
forall a b. (a -> b) -> a -> b
$ [ServerPartT (ReaderT WikiState IO) Response]
-> ServerPartT (ReaderT WikiState IO) Response
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum
      [ Method -> GititServerPart ()
forall (m :: * -> *) method.
(ServerMonad m, MonadPlus m, MatchMethod method) =>
method -> m ()
method Method
GET  GititServerPart ()
-> ServerPartT (ReaderT WikiState IO) Response
-> ServerPartT (ReaderT WikiState IO) Response
forall a b.
ServerPartT (ReaderT WikiState IO) a
-> ServerPartT (ReaderT WikiState IO) b
-> ServerPartT (ReaderT WikiState IO) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
          AuthenticationLevel
-> ServerPartT (ReaderT WikiState IO) Response
-> ServerPartT (ReaderT WikiState IO) Response
authenticate AuthenticationLevel
ForModify (ServerPartT (ReaderT WikiState IO) Response
-> ServerPartT (ReaderT WikiState IO) Response
-> ServerPartT (ReaderT WikiState IO) Response
unlessNoDelete ServerPartT (ReaderT WikiState IO) Response
confirmDelete ServerPartT (ReaderT WikiState IO) Response
showPage)
      , Method -> GititServerPart ()
forall (m :: * -> *) method.
(ServerMonad m, MonadPlus m, MatchMethod method) =>
method -> m ()
method Method
POST GititServerPart ()
-> ServerPartT (ReaderT WikiState IO) Response
-> ServerPartT (ReaderT WikiState IO) Response
forall a b.
ServerPartT (ReaderT WikiState IO) a
-> ServerPartT (ReaderT WikiState IO) b
-> ServerPartT (ReaderT WikiState IO) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
          AuthenticationLevel
-> ServerPartT (ReaderT WikiState IO) Response
-> ServerPartT (ReaderT WikiState IO) Response
authenticate AuthenticationLevel
ForModify (ServerPartT (ReaderT WikiState IO) Response
-> ServerPartT (ReaderT WikiState IO) Response
-> ServerPartT (ReaderT WikiState IO) Response
unlessNoDelete ServerPartT (ReaderT WikiState IO) Response
deletePage ServerPartT (ReaderT WikiState IO) Response
showPage) ]
  , String
-> ServerPartT (ReaderT WikiState IO) Response
-> ServerPartT (ReaderT WikiState IO) Response
forall (m :: * -> *) a.
(ServerMonad m, MonadPlus m) =>
String -> m a -> m a
dir String
"_preview" ServerPartT (ReaderT WikiState IO) Response
preview
  , GititServerPart ()
guardIndex GititServerPart ()
-> ServerPartT (ReaderT WikiState IO) Response
-> ServerPartT (ReaderT WikiState IO) Response
forall a b.
ServerPartT (ReaderT WikiState IO) a
-> ServerPartT (ReaderT WikiState IO) b
-> ServerPartT (ReaderT WikiState IO) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ServerPartT (ReaderT WikiState IO) Response
indexPage
  , Method -> GititServerPart ()
forall (m :: * -> *) method.
(ServerMonad m, MonadPlus m, MatchMethod method) =>
method -> m ()
method Method
POST GititServerPart () -> GititServerPart () -> GititServerPart ()
forall a b.
ServerPartT (ReaderT WikiState IO) a
-> ServerPartT (ReaderT WikiState IO) b
-> ServerPartT (ReaderT WikiState IO) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> GititServerPart ()
guardCommand String
"cancel" GititServerPart ()
-> ServerPartT (ReaderT WikiState IO) Response
-> ServerPartT (ReaderT WikiState IO) Response
forall a b.
ServerPartT (ReaderT WikiState IO) a
-> ServerPartT (ReaderT WikiState IO) b
-> ServerPartT (ReaderT WikiState IO) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ServerPartT (ReaderT WikiState IO) Response
showPage
  , Method -> GititServerPart ()
forall (m :: * -> *) method.
(ServerMonad m, MonadPlus m, MatchMethod method) =>
method -> m ()
method Method
POST GititServerPart () -> GititServerPart () -> GititServerPart ()
forall a b.
ServerPartT (ReaderT WikiState IO) a
-> ServerPartT (ReaderT WikiState IO) b
-> ServerPartT (ReaderT WikiState IO) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> GititServerPart ()
guardCommand String
"update" GititServerPart ()
-> ServerPartT (ReaderT WikiState IO) Response
-> ServerPartT (ReaderT WikiState IO) Response
forall a b.
ServerPartT (ReaderT WikiState IO) a
-> ServerPartT (ReaderT WikiState IO) b
-> ServerPartT (ReaderT WikiState IO) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
      AuthenticationLevel
-> ServerPartT (ReaderT WikiState IO) Response
-> ServerPartT (ReaderT WikiState IO) Response
authenticate AuthenticationLevel
ForModify (ServerPartT (ReaderT WikiState IO) Response
-> ServerPartT (ReaderT WikiState IO) Response
-> ServerPartT (ReaderT WikiState IO) Response
unlessNoEdit ServerPartT (ReaderT WikiState IO) Response
updatePage ServerPartT (ReaderT WikiState IO) Response
showPage)
  , ServerPartT (ReaderT WikiState IO) Response
showPage
  , (String -> Bool) -> GititServerPart ()
guardPath String -> Bool
isSourceCode GititServerPart () -> GititServerPart () -> GititServerPart ()
forall a b.
ServerPartT (ReaderT WikiState IO) a
-> ServerPartT (ReaderT WikiState IO) b
-> ServerPartT (ReaderT WikiState IO) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Method -> GititServerPart ()
forall (m :: * -> *) method.
(ServerMonad m, MonadPlus m, MatchMethod method) =>
method -> m ()
method Method
GET GititServerPart ()
-> ServerPartT (ReaderT WikiState IO) Response
-> ServerPartT (ReaderT WikiState IO) Response
forall a b.
ServerPartT (ReaderT WikiState IO) a
-> ServerPartT (ReaderT WikiState IO) b
-> ServerPartT (ReaderT WikiState IO) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ServerPartT (ReaderT WikiState IO) Response
showHighlightedSource
  , ServerPartT (ReaderT WikiState IO) Response
handleAny
  , Response -> ServerPartT (ReaderT WikiState IO) Response
forall (m :: * -> *) a. FilterMonad Response m => a -> m a
notFound (Response -> ServerPartT (ReaderT WikiState IO) Response)
-> ServerPartT (ReaderT WikiState IO) Response
-> ServerPartT (ReaderT WikiState IO) Response
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ((String -> Bool) -> GititServerPart ()
guardPath String -> Bool
isPage GititServerPart ()
-> ServerPartT (ReaderT WikiState IO) Response
-> ServerPartT (ReaderT WikiState IO) Response
forall a b.
ServerPartT (ReaderT WikiState IO) a
-> ServerPartT (ReaderT WikiState IO) b
-> ServerPartT (ReaderT WikiState IO) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ServerPartT (ReaderT WikiState IO) Response
createPage)
  ]

-- | Recompiles the gitit templates.
reloadTemplates :: ServerPart Response
reloadTemplates :: ServerPart Response
reloadTemplates = do
  IO () -> ServerPartT IO ()
forall a. IO a -> ServerPartT IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO ()
recompilePageTemplate
  Response -> ServerPart Response
forall (m :: * -> *) a. FilterMonad Response m => a -> m a
ok (Response -> ServerPart Response)
-> Response -> ServerPart Response
forall a b. (a -> b) -> a -> b
$ String -> Response
forall a. ToMessage a => a -> Response
toResponse String
"Page templates have been recompiled."

-- | Converts a gitit Handler into a standard happstack ServerPart.
runHandler :: WikiState -> Handler -> ServerPart Response
runHandler :: WikiState
-> ServerPartT (ReaderT WikiState IO) Response
-> ServerPart Response
runHandler = (UnWebT (ReaderT WikiState IO) Response -> UnWebT IO Response)
-> ServerPartT (ReaderT WikiState IO) Response
-> ServerPart Response
forall (m :: * -> *) a (n :: * -> *) b.
(UnWebT m a -> UnWebT n b) -> ServerPartT m a -> ServerPartT n b
mapServerPartT ((UnWebT (ReaderT WikiState IO) Response -> UnWebT IO Response)
 -> ServerPartT (ReaderT WikiState IO) Response
 -> ServerPart Response)
-> (WikiState
    -> UnWebT (ReaderT WikiState IO) Response -> UnWebT IO Response)
-> WikiState
-> ServerPartT (ReaderT WikiState IO) Response
-> ServerPart Response
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WikiState
-> UnWebT (ReaderT WikiState IO) Response -> UnWebT IO Response
forall s a. s -> UnWebT (ReaderT s IO) a -> UnWebT IO a
unpackReaderT

unpackReaderT :: s -> UnWebT (ReaderT s IO) a -> UnWebT IO a
unpackReaderT :: forall s a. s -> UnWebT (ReaderT s IO) a -> UnWebT IO a
unpackReaderT s
st UnWebT (ReaderT s IO) a
uw = UnWebT (ReaderT s IO) a
-> s -> IO (Maybe (Either Response a, FilterFun Response))
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT UnWebT (ReaderT s IO) a
uw s
st