Skip to content
Browse files

Put map of mime types in config instead of filepath.

  • Loading branch information...
1 parent 3c019e8 commit 65e1e242cd3e5d0bb633bc122f6d07e105ce7cc1 @jgm committed Jun 15, 2009
Showing with 55 additions and 58 deletions.
  1. +2 −1 Network/Gitit.hs
  2. +46 −2 Network/Gitit/Config.hs
  3. +1 −1 Network/Gitit/ContentTransformer.hs
  4. +2 −3 Network/Gitit/Framework.hs
  5. +2 −48 Network/Gitit/State.hs
  6. +1 −2 Network/Gitit/Types.hs
  7. +1 −1 gitit.hs
View
3 Network/Gitit.hs
@@ -20,13 +20,13 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
-}
module Network.Gitit ( initializeAppState
- , readMimeTypesFile
, Config(..)
, User(..)
, Cache(..)
, emptyCache
, loadPlugin
, wikiHandler
+ , readMimeTypesFile
)
where
import Network.Gitit.Types
@@ -35,6 +35,7 @@ import Network.Gitit.State
import Network.Gitit.Server
import Network.Gitit.Plugins (loadPlugin)
import Network.Gitit.Handlers
+import Network.Gitit.Config (readMimeTypesFile)
import Control.Monad.Reader
-- TODO: parameterize on getLoggedInUser
View
48 Network/Gitit/Config.hs
@@ -20,9 +20,12 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
{- Functions for parsing command line options and reading the config file.
-}
-module Network.Gitit.Config ( getConfigFromOpts )
+module Network.Gitit.Config ( getConfigFromOpts, readMimeTypesFile )
where
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
@@ -151,6 +154,7 @@ extractConfig cp = do
markupHelpPath <- liftIO $ getDataFileName $ "data" </> "markupHelp" </> markupHelpFile
markupHelpText <- liftM (writeHtmlString defaultWriterOptions . readMarkdown defaultParserState) $
liftIO $ readFile markupHelpPath
+ mimeMap' <- liftIO $ readMimeTypesFile cfMimeTypesFile
-- create template file if it doesn't exist
liftIO $ do
@@ -205,7 +209,7 @@ extractConfig cp = do
, recaptchaPrivateKey = cfRecaptchaPrivateKey
, compressResponses = cfCompressResponses
, maxCacheSize = readNumber "max-cache-size" cfMaxCacheSize
- , mimeTypesFile = cfMimeTypesFile
+ , mimeMap = mimeMap'
, jsMath = False
, mailCommand = cfMailCommand
, resetPasswordMessage = fromQuotedMultiline cfResetPasswordMessage
@@ -253,3 +257,43 @@ getConfigFromOpts = do
defaultConfig <- extractConfig cp'
getArgs >>= parseArgs >>= foldM (handleFlag cp') defaultConfig
+-- | Read a file associating mime types with extensions, and return a
+-- map from extensions to types. Each line of the file consists of a
+-- mime type, followed by space, followed by a list of zero or more
+-- extensions, separated by spaces. Example: text/plain txt text
+readMimeTypesFile :: FilePath -> IO (M.Map String String)
+readMimeTypesFile f = catch
+ (liftM (foldr go M.empty . map words . lines) $ readFile f)
+ handleMimeTypesFileNotFound
+ where go [] m = m -- skip blank lines
+ go (x:xs) m = foldr (\ext m' -> M.insert ext x m') m xs
+ handleMimeTypesFileNotFound e = do
+ logM "gitit" WARNING $ "Could not read mime types file: " ++
+ f ++ "\n" ++ show e ++ "\n" ++ "Using defaults instead."
+ return mimeTypes
+
+{-
+-- | Ready collection of common mime types. (Copied from
+-- Happstack.Server.HTTP.FileServe.)
+mimeTypes :: M.Map String String
+mimeTypes = M.fromList
+ [("xml","application/xml")
+ ,("xsl","application/xml")
+ ,("js","text/javascript")
+ ,("html","text/html")
+ ,("htm","text/html")
+ ,("css","text/css")
+ ,("gif","image/gif")
+ ,("jpg","image/jpeg")
+ ,("png","image/png")
+ ,("txt","text/plain")
+ ,("doc","application/msword")
+ ,("exe","application/octet-stream")
+ ,("pdf","application/pdf")
+ ,("zip","application/zip")
+ ,("gz","application/x-gzip")
+ ,("ps","application/postscript")
+ ,("rtf","application/rtf")
+ ,("wav","application/x-wav")
+ ,("hs","text/plain")]
+-}
View
2 Network/Gitit/ContentTransformer.hs
@@ -273,7 +273,7 @@ textResponse (Just c) = mimeResponse c "text/plain; charset=utf-8"
mimeFileResponse :: Maybe String -> ContentTransformer Response
mimeFileResponse Nothing = error "Unable to retrieve file contents."
mimeFileResponse (Just c) =
- mimeResponse c =<< getMimeTypeForExtension . takeExtension =<< getFileName
+ mimeResponse c =<< lift . getMimeTypeForExtension . takeExtension =<< getFileName
mimeResponse :: Monad m => String -> String -> m Response
mimeResponse c mimeType =
View
5 Network/Gitit/Framework.hs
@@ -47,7 +47,6 @@ import Network.Gitit.Server
import Network.Gitit.State
import Network.Gitit.Types
import Data.Char (toLower, isAscii, isDigit, isLetter)
-import Control.Monad.Trans (MonadIO)
import Control.Monad (mzero, liftM, MonadPlus)
import qualified Data.Map as M
import Data.ByteString.UTF8 (toString)
@@ -201,9 +200,9 @@ urlForPage base' page = base' ++
pathForPage :: String -> FilePath
pathForPage page = page <.> "page"
-getMimeTypeForExtension :: MonadIO m => String -> m String
+getMimeTypeForExtension :: String -> GititServerPart String
getMimeTypeForExtension ext = do
- mimes <- queryAppState mimeMap
+ mimes <- liftM mimeMap getConfig
return $ case M.lookup (dropWhile (=='.') $ map toLower ext) mimes of
Nothing -> "application/octet-stream"
Just t -> t
View
50 Network/Gitit/State.hs
@@ -37,69 +37,23 @@ import Data.Ord (comparing)
import Text.XHtml (Html, renderHtmlFragment, primHtml)
import System.Log.Logger (Priority(..), logM)
import Network.Gitit.Types
-import Network.Gitit.Server (mimeTypes)
appstate :: IORef AppState
appstate = unsafePerformIO $ newIORef AppState { sessions = undefined
, users = undefined
- , mimeMap = undefined
, cache = undefined
, plugins = undefined }
initializeAppState :: MonadIO m
- => Config
- -> M.Map String User
+ => M.Map String User
-> [Plugin]
-> m ()
-initializeAppState conf users' plugins' = do
- mimeMapFromFile <- liftIO $ readMimeTypesFile (mimeTypesFile conf)
+initializeAppState users' plugins' = do
updateAppState $ \s -> s { sessions = Sessions M.empty
, users = users'
- , mimeMap = mimeMapFromFile
, cache = emptyCache
, plugins = plugins' }
--- | Read a file associating mime types with extensions, and return a
--- map from extensions to types. Each line of the file consists of a
--- mime type, followed by space, followed by a list of zero or more
--- extensions, separated by spaces. Example: text/plain txt text
-readMimeTypesFile :: FilePath -> IO (M.Map String String)
-readMimeTypesFile f = catch
- (liftM (foldr go M.empty . map words . lines) $ readFile f)
- handleMimeTypesFileNotFound
- where go [] m = m -- skip blank lines
- go (x:xs) m = foldr (\ext m' -> M.insert ext x m') m xs
- handleMimeTypesFileNotFound e = do
- logM "gitit" WARNING $ "Could not read mime types file: " ++
- f ++ "\n" ++ show e ++ "\n" ++ "Using defaults instead."
- return mimeTypes
-
-{-
--- | Ready collection of common mime types. (Copied from
--- Happstack.Server.HTTP.FileServe.)
-mimeTypes :: M.Map String String
-mimeTypes = M.fromList
- [("xml","application/xml")
- ,("xsl","application/xml")
- ,("js","text/javascript")
- ,("html","text/html")
- ,("htm","text/html")
- ,("css","text/css")
- ,("gif","image/gif")
- ,("jpg","image/jpeg")
- ,("png","image/png")
- ,("txt","text/plain")
- ,("doc","application/msword")
- ,("exe","application/octet-stream")
- ,("pdf","application/pdf")
- ,("zip","application/zip")
- ,("gz","application/x-gzip")
- ,("ps","application/postscript")
- ,("rtf","application/rtf")
- ,("wav","application/x-wav")
- ,("hs","text/plain")]
--}
-
updateAppState :: MonadIO m => (AppState -> AppState) -> m ()
updateAppState fn = liftIO $! atomicModifyIORef appstate $ \st -> (fn st, ())
View
3 Network/Gitit/Types.hs
@@ -81,7 +81,7 @@ data Config = Config {
recaptchaPrivateKey :: String,
compressResponses :: Bool, -- should responses be compressed?
maxCacheSize :: Integer, -- max size (bytes) of memory page cache
- mimeTypesFile :: FilePath, -- file assoc mime types with file exts
+ mimeMap :: M.Map String String, -- map assoc mime types with file exts
jsMath :: Bool, -- true if jsMath files are present
mailCommand :: String, -- command to send notification emails
resetPasswordMessage :: String, -- text of password reset email
@@ -110,7 +110,6 @@ data User = User {
data AppState = AppState {
sessions :: Sessions SessionData,
users :: M.Map String User,
- mimeMap :: M.Map String String,
cache :: Cache,
plugins :: [Plugin]
}
View
2 gitit.hs
@@ -78,7 +78,7 @@ main = do
unless (null $ pluginModules conf') $ logM "gitit" WARNING "Finished loading plugins."
-- initialize state
- initializeAppState conf' users' plugins'
+ initializeAppState users' plugins'
-- setup the page repository and static files, if they don't exist
createRepoIfMissing conf'

0 comments on commit 65e1e24

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