Skip to content
Browse files

Refactoring:

+ introduced WikiState, including Config, filestore,
  and compiled template (one per wiki, in contrast
  to AppState)
+ moved template file creation from N.G.Config to gitit.hs.
  • Loading branch information...
1 parent 6d4c88d commit d7d984fff5517272557f4c4bdd183b525866b6a9 @jgm committed Jun 15, 2009
Showing with 67 additions and 36 deletions.
  1. +15 −1 Network/Gitit.hs
  2. +13 −26 Network/Gitit/Config.hs
  3. +7 −0 Network/Gitit/Framework.hs
  4. +2 −1 Network/Gitit/Initialize.hs
  5. +2 −1 Network/Gitit/Layout.hs
  6. +6 −2 Network/Gitit/State.hs
  7. +11 −4 Network/Gitit/Types.hs
  8. +11 −1 gitit.hs
View
16 Network/Gitit.hs
@@ -38,6 +38,12 @@ import Network.Gitit.Plugins (loadPlugin)
import Network.Gitit.Handlers
import Network.Gitit.Config (readMimeTypesFile, getDefaultConfig)
import Control.Monad.Reader
+import System.Directory
+import System.FilePath
+import Prelude hiding (readFile)
+import System.IO.UTF8
+import Paths_gitit
+import qualified Text.StringTemplate as T
wikiHandler :: Config -> ServerPart Response
wikiHandler conf = do
@@ -47,8 +53,16 @@ wikiHandler conf = do
case authenticationMethod conf of
FormAuth -> authHandler : wikiHandlers
_ -> wikiHandlers
+ let fs = filestoreFromConfig conf
+ templateText <- liftIO $ do
+ templateExists <- doesFileExist $ templateFile conf
+ if templateExists
+ then readFile $ templateFile conf
+ else getDataFileName ("data" </> "template.html") >>= readFile
+ let templ = T.newSTMP templateText
+ let ws = WikiState { wikiConfig = conf, wikiFileStore = fs, wikiTemplate = templ }
-- TODO - rearrange so handleAny doesn't get compressed
- staticHandler `mplus` (mapServerPartT (unpackReaderT conf) $
+ staticHandler `mplus` (mapServerPartT (unpackReaderT ws) $
if compressResponses conf
then compressedResponseFilter >> msum handlers
else msum handlers)
View
39 Network/Gitit/Config.hs
@@ -28,12 +28,10 @@ import Network.Gitit.Types
import Network.Gitit.Server (mimeTypes)
import System.Log.Logger (logM, Priority(..))
import qualified Data.Map as M
-import Data.FileStore
import System.Environment
import System.Exit
import System.IO (stdout, stderr)
import System.Console.GetOpt
-import System.Directory
import Data.ConfigFile
import Control.Monad.Error
import System.Log.Logger ()
@@ -46,7 +44,6 @@ import System.IO.UTF8
import System.FilePath ((</>))
import Control.Monad (liftM)
import Text.Pandoc
-import qualified Text.StringTemplate as T
data Opt
= Help
@@ -160,24 +157,13 @@ extractConfig cp = do
mimeMap' <- liftIO $ readMimeTypesFile cfMimeTypesFile
- -- create template file if it doesn't exist
- liftIO $ do
- templateExists <- doesFileExist cfTemplateFile
- unless templateExists $ do
- templatePath <- getDataFileName $ "data" </> "template.html"
- copyFile templatePath cfTemplateFile
- hPutStrLn stderr $ "Created default " ++ cfTemplateFile
-
- compiledTemplate <- liftM T.newSTMP $ liftIO $ readFile cfTemplateFile
-
- let (filestore', repotype') = case (map toLower cfRepositoryType) of
- "git" -> (gitFileStore cfRepositoryPath, "git")
- "darcs" -> (darcsFileStore cfRepositoryPath, "darcs")
- x -> error $ "Unknown repository type: " ++ x
+ let repotype' = case map toLower cfRepositoryType of
+ "git" -> Git
+ "darcs" -> Darcs
+ x -> error $ "Unknown repository type: " ++ x
return $! Config{
- filestore = filestore'
- , repositoryPath = cfRepositoryPath
+ repositoryPath = cfRepositoryPath
, repositoryType = repotype'
, defaultPageType = pt
, defaultLHS = lhs
@@ -188,7 +174,7 @@ extractConfig cp = do
_ -> error
"Invalid authentication-method.\nLegal values are: form, http"
, userFile = cfUserFile
- , template = compiledTemplate
+ , templateFile = cfTemplateFile
, logFile = cfLogFile
, logLevel = let levelString = map toUpper cfLogLevel
levels = ["DEBUG", "INFO", "NOTICE", "WARNING", "ERROR",
@@ -254,16 +240,17 @@ lrStrip :: String -> String
lrStrip = reverse . dropWhile isWhitespace . reverse . dropWhile isWhitespace
where isWhitespace = (`elem` " \t\n")
-getDefaultConfig :: IO Config
-getDefaultConfig = do
+getDefaultConfigParser :: IO ConfigParser
+getDefaultConfigParser = do
cp <- getDataFileName "data/default.conf" >>= readfile emptyCP
- let cp' = forceEither cp
- extractConfig cp'
+ return $ forceEither cp
+
+getDefaultConfig :: IO Config
+getDefaultConfig = getDefaultConfigParser >>= extractConfig
getConfigFromOpts :: IO Config
getConfigFromOpts = do
- cp <- getDataFileName "data/default.conf" >>= readfile emptyCP
- let cp' = forceEither cp
+ cp' <- getDefaultConfigParser
defaultConfig <- extractConfig cp'
getArgs >>= parseArgs >>= foldM (handleFlag cp') defaultConfig
View
7 Network/Gitit/Framework.hs
@@ -41,11 +41,13 @@ module Network.Gitit.Framework ( getLoggedInUser
, guardPath
, guardIndex
, withInput
+ , filestoreFromConfig
)
where
import Network.Gitit.Server
import Network.Gitit.State
import Network.Gitit.Types
+import Data.FileStore
import Data.Char (toLower, isAscii, isDigit, isLetter)
import Control.Monad (mzero, liftM, MonadPlus)
import qualified Data.Map as M
@@ -257,3 +259,8 @@ withInput name val handler = do
})
localRq (\rq -> rq{ rqInputs = newInp : inps }) handler
+filestoreFromConfig :: Config -> FileStore
+filestoreFromConfig conf =
+ case repositoryType conf of
+ Git -> gitFileStore $ repositoryPath conf
+ Darcs -> darcsFileStore $ repositoryPath conf
View
3 Network/Gitit/Initialize.hs
@@ -21,6 +21,7 @@ where
import System.FilePath ((</>), (<.>), takeExtension)
import Data.FileStore
import Network.Gitit.Types
+import Network.Gitit.Framework
import Paths_gitit (getDataFileName)
import Control.Exception (throwIO, try)
import System.Directory (copyFile, createDirectoryIfMissing, doesDirectoryExist, getDirectoryContents)
@@ -34,7 +35,7 @@ import Text.Pandoc.Shared (HTMLMathMethod(..))
-- | Create page repository unless it exists.
createRepoIfMissing :: Config -> IO ()
createRepoIfMissing conf = do
- let fs = filestore conf
+ let fs = filestoreFromConfig conf
repoExists <- try (initialize fs) >>= \res ->
case res of
Right _ -> return False
View
3 Network/Gitit/Layout.hs
@@ -90,6 +90,7 @@ formattedPage layout page params htmlContents = do
else ulist ! [theclass "messages"] <<
map (li <<) messages
cfg <- getConfig
+ templ <- getTemplate
let filledTemp = T.render .
T.setAttribute "base" base' .
T.setAttribute "pagetitle" pageTitle .
@@ -133,7 +134,7 @@ formattedPage layout page params htmlContents = do
T.setAttribute "tabs" (renderHtmlFragment tabs) .
T.setAttribute "messages" (renderHtmlFragment htmlMessages) .
T.setAttribute "content" (renderHtmlFragment htmlContents) $
- template cfg
+ templ
ok $ setContentType "text/html" $ toResponse $ encodeString filledTemp
exportBox :: String -> String -> Params -> Html
View
8 Network/Gitit/State.hs
@@ -37,6 +37,7 @@ import Data.Ord (comparing)
import Text.XHtml (Html, renderHtmlFragment, primHtml)
import System.Log.Logger (Priority(..), logM)
import Network.Gitit.Types
+import qualified Text.StringTemplate as T
appstate :: IORef AppState
appstate = unsafePerformIO $ newIORef AppState { sessions = undefined
@@ -218,10 +219,13 @@ getSession :: MonadIO m => SessionKey -> m (Maybe SessionData)
getSession key = queryAppState $ M.lookup key . unsession . sessions
getConfig :: GititServerPart Config
-getConfig = ask
+getConfig = liftM wikiConfig ask
getFileStore :: GititServerPart FileStore
-getFileStore = liftM filestore getConfig
+getFileStore = liftM wikiFileStore ask
+
+getTemplate :: GititServerPart (T.StringTemplate String)
+getTemplate = liftM wikiTemplate ask
getDefaultPageType :: GititServerPart PageType
getDefaultPageType = liftM defaultPageType getConfig
View
15 Network/Gitit/Types.hs
@@ -47,17 +47,18 @@ data AuthenticationMethod = FormAuth
| HTTPAuth
| CustomAuth (GititServerPart (Maybe User))
+data FileStoreType = Git | Darcs deriving Show
+
-- | Data structure for information read from config file.
data Config = Config {
- filestore :: FileStore, -- filestore for pages
repositoryPath :: FilePath, -- path of repository containing filestore
- repositoryType :: String, -- type of repository ("git" or "darcs")
+ repositoryType :: FileStoreType, -- type of repository
defaultPageType :: PageType, -- default page markup type for this wiki
defaultLHS :: Bool, -- treat as literate haskell by default?
showLHSBirdTracks :: Bool, -- show Haskell code with bird tracks
authenticationMethod :: AuthenticationMethod, -- use forms or HTTP digest?
userFile :: FilePath, -- path of users database
- template :: T.StringTemplate String, -- compiled page template
+ templateFile :: FilePath, -- page template
logFile :: FilePath, -- path of server log file
logLevel :: Priority, -- severity filter for log messages
-- (DEBUG, INFO, NOTICE, WARNING, ERROR,
@@ -293,7 +294,13 @@ instance FromData Command where
"showraw", "history", "export", "diff",
"cancel", "update", "delete", "discuss"]
-type GititServerPart = ServerPartT (ReaderT Config IO)
+data WikiState = WikiState {
+ wikiConfig :: Config
+ , wikiFileStore :: FileStore
+ , wikiTemplate :: T.StringTemplate String
+ }
+
+type GititServerPart = ServerPartT (ReaderT WikiState IO)
type Handler = GititServerPart Response
View
12 gitit.hs
@@ -34,6 +34,8 @@ import Control.Monad.Reader
import System.Log.Logger (logM, Priority(..), setLevel, setHandlers,
getLogger, saveGlobalLogger)
import System.Log.Handler.Simple (fileHandler)
+import Data.Char (toLower)
+import Paths_gitit
main :: IO ()
main = do
@@ -42,7 +44,8 @@ main = do
conf <- getConfigFromOpts
-- check for external programs that are needed
- let prereqs = ["grep", repositoryType conf]
+ let repoProg = map toLower $ show $ repositoryType conf
+ let prereqs = ["grep", repoProg]
forM_ prereqs $ \prog ->
findExecutable prog >>= \mbFind ->
when (isNothing mbFind) $ error $
@@ -85,6 +88,13 @@ main = do
let staticdir = staticDir conf'
createStaticIfMissing staticdir
+ -- create template file if it doesn't exist
+ templateExists <- doesFileExist (templateFile conf')
+ unless templateExists $ do
+ templatePath <- getDataFileName $ "data" </> "template.html"
+ copyFile templatePath (templateFile conf')
+ logM "gitit" WARNING $ "Created default " ++ templateFile conf'
+
let serverConf = Conf { validator = Nothing, port = portNumber conf' }
-- start the server
tid <- forkIO $ simpleHTTP serverConf $ wikiHandler conf'

0 comments on commit d7d984f

Please sign in to comment.
Something went wrong with that request. Please try again.