Remove CPP from default-extensions; add pragmas to modules as needed.

This commit is contained in:
John MacFarlane 2013-08-04 14:12:13 -07:00
parent 5050cff37c
commit 2d6e0b1530
5 changed files with 4 additions and 10 deletions

View file

@ -1,3 +1,4 @@
{-# LANGUAGE CPP #-}
-- Create pandoc.1 man and pandoc_markdown.5 man pages from README
import Text.Pandoc
import qualified Text.Pandoc.UTF8 as UTF8

View file

@ -277,7 +277,6 @@ Library
Ghc-Options: -rtsopts -Wall -fno-warn-unused-do-bind
Ghc-Prof-Options: -auto-all -caf-all -rtsopts
Default-Language: Haskell98
Default-Extensions: CPP
Other-Extensions: PatternGuards, OverloadedStrings,
ScopedTypeVariables, GeneralizedNewtypeDeriving,
RelaxedPolyRec, DeriveDataTypeable, TypeSynonymInstances,
@ -357,7 +356,6 @@ Executable pandoc
if os(windows)
Cpp-options: -D_WINDOWS
Default-Language: Haskell98
Default-Extensions: CPP
Other-Extensions: PatternGuards, OverloadedStrings,
ScopedTypeVariables, GeneralizedNewtypeDeriving,
RelaxedPolyRec, DeriveDataTypeable, TypeSynonymInstances,
@ -377,7 +375,6 @@ Executable make-pandoc-man-pages
old-time >= 1.0 && < 1.2,
time >= 1.2 && < 1.5
Default-Language: Haskell98
Default-Extensions: CPP
Test-Suite test-pandoc
Type: exitcode-stdio-1.0
@ -415,7 +412,6 @@ Test-Suite test-pandoc
Tests.Writers.LaTeX
Ghc-Options: -rtsopts -Wall -fno-warn-unused-do-bind
Default-Language: Haskell98
Default-Extensions: CPP
benchmark benchmark-pandoc
Type: exitcode-stdio-1.0

View file

@ -1,4 +1,4 @@
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE GeneralizedNewtypeDeriving, CPP #-}
{-
Copyright (C) 2010 John MacFarlane <jgm@berkeley.edu>

View file

@ -1,3 +1,4 @@
{-# LANGUAGE CPP #-}
{-
Copyright (C) 2010 John MacFarlane <jgm@berkeley.edu>

View file

@ -1,4 +1,4 @@
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE PatternGuards, CPP #-}
{-
Copyright (C) 2010 John MacFarlane <jgm@berkeley.edu>
@ -62,11 +62,7 @@ import Text.Pandoc.MIME (getMimeType)
import Prelude hiding (catch)
#endif
import Control.Exception (catch, SomeException)
#if MIN_VERSION_blaze_html(0,5,0)
import Text.Blaze.Html.Renderer.Utf8 (renderHtml)
#else
import Text.Blaze.Renderer.Utf8 (renderHtml)
#endif
-- A Chapter includes a list of blocks and maybe a section
-- number offset. Note, some chapters are unnumbered. The section