Permalink
Browse files

Use custom readFileUTF8 instead of broken System.IO.UTF8.

This way we have a uniform solution for GHC 6.10 and 6.12,
and don't have to use CPP tricks.

This change fixes categories on GHC 6.12.  Resolves Issue #98.
  • Loading branch information...
1 parent 19b5ed2 commit fc0b5eb0b9e42e771a753a111b925168efc718b8 @jgm committed Mar 22, 2010
Showing with 38 additions and 56 deletions.
  1. +4 −11 Network/Gitit/Config.hs
  2. +2 −2 Network/Gitit/Export.hs
  3. +5 −12 Network/Gitit/Handlers.hs
  4. +6 −12 Network/Gitit/Initialize.hs
  5. +10 −1 Network/Gitit/Util.hs
  6. +11 −18 gitit.hs
@@ -28,7 +28,7 @@ import Network.Gitit.Types
import Network.Gitit.Server (mimeTypes)
import Network.Gitit.Framework
import Network.Gitit.Authentication (formAuthHandlers, httpAuthHandlers)
-import Network.Gitit.Util (parsePageType)
+import Network.Gitit.Util (parsePageType, readFileUTF8)
import System.Log.Logger (logM, Priority(..))
import qualified Data.Map as M
import Data.ConfigFile hiding (readfile)
@@ -37,13 +37,6 @@ import System.Log.Logger ()
import Data.List (intercalate)
import Data.Char (toLower, toUpper, isDigit)
import Paths_gitit (getDataFileName)
--- Note: ghc >= 6.12 (base >=4.2) supports unicode through iconv
--- So we use System.IO.UTF8 only if we have an earlier version
-#if MIN_VERSION_base(4,2,0)
-#else
-import Prelude hiding (readFile)
-import System.IO.UTF8
-#endif
import System.FilePath ((</>))
import Text.Pandoc hiding (MathML)
@@ -62,7 +55,7 @@ readfile :: MonadError CPError m
-> FilePath
-> IO (m ConfigParser)
readfile cp path' = do
- contents <- readFile path'
+ contents <- readFileUTF8 path'
return $ readstring cp contents
extractConfig :: ConfigParser -> IO Config
@@ -112,7 +105,7 @@ extractConfig cp = do
let markupHelpFile = show pt ++ if lhs then "+LHS" else ""
markupHelpPath <- liftIO $ getDataFileName $ "data" </> "markupHelp" </> markupHelpFile
markupHelpText <- liftM (writeHtmlString defaultWriterOptions . readMarkdown defaultParserState) $
- liftIO $ readFile markupHelpPath
+ liftIO $ readFileUTF8 markupHelpPath
mimeMap' <- liftIO $ readMimeTypesFile cfMimeTypesFile
let authMethod = map toLower cfAuthenticationMethod
@@ -235,7 +228,7 @@ getDefaultConfig = getDefaultConfigParser >>= extractConfig
-- 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)
+ (liftM (foldr go M.empty . map words . lines) $ readFileUTF8 f)
handleMimeTypesFileNotFound
where go [] m = m -- skip blank lines
go (x:xs) m = foldr (\ext -> M.insert ext x) m xs
@@ -26,7 +26,7 @@ import Text.Pandoc.ODT (saveOpenDocumentAsODT)
import Text.Pandoc.Shared (escapeStringUsing)
import Network.Gitit.Server
import Network.Gitit.Framework (pathForPage)
-import Network.Gitit.Util (withTempDir)
+import Network.Gitit.Util (withTempDir, readFileUTF8)
import Network.Gitit.State (getConfig)
import Network.Gitit.Types
import Network.Gitit.Cache (cacheContents, lookupCache)
@@ -179,7 +179,7 @@ respondPDF page pndc = do
case canary of
ExitSuccess -> do pdfBS <- L.readFile (tempdir </> page <.> "pdf")
return $ Right (useCache cfg, pdfBS)
- ExitFailure n -> do l <- readFile (tempdir </> page <.> "log")
+ ExitFailure n -> do l <- readFileUTF8 (tempdir </> page <.> "log")
return $ Left (n, l)
case pdf' of
Left (n,logOutput) -> simpleErrorHandler ("PDF creation failed with code: " ++
@@ -60,7 +60,7 @@ 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.Util (orIfNull, readFileUTF8)
import Network.Gitit.Cache (expireCachedFile, lookupCache, cacheContents)
import Network.Gitit.ContentTransformer (showRawPage, showFileAsText, showPage,
exportPage, showHighlightedSource, preview, applyPreCommitPlugins)
@@ -69,14 +69,7 @@ import Control.Exception (throwIO, catch, try)
import Data.ByteString.UTF8 (toString)
import System.Time
import System.FilePath
-import Prelude hiding (readFile, catch)
--- Note: ghc >= 6.12 (base >=4.2) supports unicode through iconv
--- So we use System.IO.UTF8 only if we have an earlier version
-#if MIN_VERSION_base(4,2,0)
-import Prelude (readFile)
-#else
-import System.IO.UTF8
-#endif
+import Prelude hiding (catch)
import Network.Gitit.State
import Text.XHtml hiding ( (</>), dir, method, password, rev )
import qualified Text.XHtml as X ( method )
@@ -699,7 +692,7 @@ categoryPage = do
let pages = filter (\f -> isPageFile f && not (isDiscussPageFile f)) files
matches <- liftM catMaybes $
forM pages $ \f ->
- liftIO (readFile $ repoPath </> f) >>= \s ->
+ liftIO (readFileUTF8 $ repoPath </> f) >>= \s ->
return $ if category `elem` (extractCategories s)
then Just $ dropExtension f
else Nothing
@@ -724,8 +717,8 @@ categoryListPage = do
let pages = filter (\f -> isPageFile f && not (isDiscussPageFile f)) files
categories <- liftIO $
liftM (nub . sort . concat) $
- forM pages $
- liftM extractCategories . (readFile . (repoPath </>))
+ forM pages $ \f ->
+ liftM extractCategories (readFileUTF8 (repoPath </> f))
base' <- getWikiBase
let toCatLink ctg = li <<
[ anchor ! [href $ base' ++ "/_category" ++ urlForPage ctg] << ctg ]
@@ -27,6 +27,7 @@ where
import System.FilePath ((</>), (<.>))
import Data.FileStore
import qualified Data.Map as M
+import Network.Gitit.Util (readFileUTF8)
import Network.Gitit.Types
import Network.Gitit.State
import Network.Gitit.Framework
@@ -36,13 +37,6 @@ import Paths_gitit (getDataFileName)
import Control.Exception (throwIO, try)
import System.Directory (copyFile, createDirectoryIfMissing, doesDirectoryExist, doesFileExist)
import Control.Monad (unless, forM_, liftM)
--- Note: ghc >= 6.12 (base >=4.2) supports unicode through iconv
--- So we use System.IO.UTF8 only if we have an earlier version
-#if MIN_VERSION_base(4,2,0)
-#else
-import Prelude hiding (readFile)
-import System.IO.UTF8
-#endif
import Text.Pandoc
import System.Log.Logger (logM, Priority(..))
import qualified Text.StringTemplate as T
@@ -56,7 +50,7 @@ initializeGititState conf = do
userFileExists <- doesFileExist userFile'
users' <- if userFileExists
- then liftM (M.fromList . read) $ readFile userFile'
+ then liftM (M.fromList . read) $ readFileUTF8 userFile'
else return M.empty
templ <- compilePageTemplate (templatesDir conf)
@@ -140,14 +134,14 @@ createDefaultPages conf = do
RST -> writeRST defOpts . toPandoc
welcomepath <- getDataFileName $ "data" </> "FrontPage" <.> "page"
- welcomecontents <- liftM converter $ readFile welcomepath
+ welcomecontents <- liftM converter $ readFileUTF8 welcomepath
helppath <- getDataFileName $ "data" </> "Help" <.> "page"
- helpcontentsInitial <- liftM converter $ readFile helppath
+ helpcontentsInitial <- liftM converter $ readFileUTF8 helppath
markuppath <- getDataFileName $ "data" </> "markup" <.> show pt
- helpcontentsMarkup <- liftM converter $ readFile markuppath
+ helpcontentsMarkup <- liftM converter $ readFileUTF8 markuppath
let helpcontents = helpcontentsInitial ++ "\n\n" ++ helpcontentsMarkup
usersguidepath <- getDataFileName "README.markdown"
- usersguidecontents <- liftM converter $ readFile usersguidepath
+ usersguidecontents <- liftM converter $ readFileUTF8 usersguidepath
-- add front page, help page, and user's guide
let auth = Author "Gitit" ""
createIfMissing fs (frontPage conf <.> "page") auth "Default front page" welcomecontents
View
@@ -16,7 +16,8 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
{- Utility functions for Gitit.
-}
-module Network.Gitit.Util ( inDir
+module Network.Gitit.Util ( readFileUTF8
+ , inDir
, withTempDir
, orIfNull
, splitCategories
@@ -31,7 +32,15 @@ import System.FilePath ((</>), (<.>))
import System.IO.Error (isAlreadyExistsError)
import Control.Monad.Trans (liftIO)
import Data.Char (toLower)
+import Data.ByteString.Lazy.UTF8 (toString)
+import qualified Data.ByteString.Lazy as B
import Network.Gitit.Types
+import Control.Monad (liftM)
+import Codec.Binary.UTF8.String (encodeString)
+
+-- | Read file as UTF-8 string. Encode filename as UTF-8.
+readFileUTF8 :: FilePath -> IO String
+readFileUTF8 f = liftM toString $ B.readFile $ encodeString f
-- | Perform a function a directory and return to working directory.
inDir :: FilePath -> IO a -> IO a
View
@@ -21,7 +21,7 @@ module Main where
import Network.Gitit
import Network.Gitit.Server
-import Prelude hiding (readFile, catch)
+import Network.Gitit.Util (readFileUTF8)
import System.Directory
import Data.Maybe (isNothing)
import Control.Monad.Reader
@@ -30,17 +30,12 @@ import System.Log.Logger (Priority(..), setLevel, setHandlers,
import System.Log.Handler.Simple (fileHandler)
import System.Environment
import System.Exit
-import System.IO (stdout, stderr)
+import System.IO (stderr)
import System.Console.GetOpt
import Data.Version (showVersion)
--- Note: ghc >= 6.12 (base >=4.2) supports unicode through iconv
--- So we use System.IO.UTF8 only if we have an earlier version
-#if MIN_VERSION_base(4,2,0)
-import Prelude (readFile)
-import System.IO (hPutStrLn)
-#else
-import System.IO.UTF8
-#endif
+import qualified Data.ByteString as B
+import Data.ByteString.UTF8 (fromString)
+
import Paths_gitit (version, getDataFileName)
main :: IO ()
@@ -50,7 +45,6 @@ main = do
opts <- getArgs >>= parseArgs
defaultConfig <- getDefaultConfig
conf <- foldM handleFlag defaultConfig opts
-
-- check for external programs that are needed
let repoProg = case repositoryType conf of
Mercurial -> "hg"
@@ -117,8 +111,7 @@ parseArgs argv = do
progname <- getProgName
case getOpt Permute flags argv of
(opts,_,[]) -> return opts
- (_,_,errs) -> hPutStrLn stderr (concat errs ++ usageInfo (usageHeader progname) flags) >>
- exitWith (ExitFailure 1)
+ (_,_,errs) -> putErr (ExitFailure 1) (concat errs ++ usageInfo (usageHeader progname) flags)
usageHeader :: String -> String
usageHeader progname = "Usage: " ++ progname ++ " [opts...]"
@@ -140,12 +133,12 @@ handleFlag :: Config -> Opt -> IO Config
handleFlag conf opt = do
progname <- getProgName
case opt of
- Help -> hPutStrLn stderr (usageInfo (usageHeader progname) flags) >> exitWith ExitSuccess
- Version -> hPutStrLn stderr (progname ++ " version " ++ showVersion version ++ compileInfo ++ copyrightMessage) >> exitWith ExitSuccess
- PrintDefaultConfig -> getDataFileName "data/default.conf" >>= readFile >>=
- hPutStrLn stdout >> exitWith ExitSuccess
+ Help -> putErr ExitSuccess (usageInfo (usageHeader progname) flags)
+ Version -> putErr ExitSuccess (progname ++ " version " ++ showVersion version ++ compileInfo ++ copyrightMessage)
+ PrintDefaultConfig -> getDataFileName "data/default.conf" >>= readFileUTF8 >>= B.putStrLn . fromString >> exitWith ExitSuccess
Debug -> return conf{ debugMode = True }
Port p -> return conf{ portNumber = p }
ConfigFile fname -> getConfigFromFile fname
-
+putErr :: ExitCode -> String -> IO a
+putErr c s = B.hPutStrLn stderr (fromString s) >> exitWith c

0 comments on commit fc0b5eb

Please sign in to comment.