summaryrefslogtreecommitdiff
path: root/src/Text/Pandoc/Shared.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Text/Pandoc/Shared.hs')
-rw-r--r--src/Text/Pandoc/Shared.hs105
1 files changed, 77 insertions, 28 deletions
diff --git a/src/Text/Pandoc/Shared.hs b/src/Text/Pandoc/Shared.hs
index 9717e1bc8..cd5b19164 100644
--- a/src/Text/Pandoc/Shared.hs
+++ b/src/Text/Pandoc/Shared.hs
@@ -32,6 +32,7 @@ module Text.Pandoc.Shared (
-- * List processing
splitBy,
splitByIndices,
+ splitStringByIndices,
substitute,
-- * Text processing
backslashEscapes,
@@ -44,8 +45,9 @@ module Text.Pandoc.Shared (
camelCaseToHyphenated,
toRomanNumeral,
escapeURI,
- unescapeURI,
tabFilter,
+ -- * Date/time
+ normalizeDate,
-- * Pandoc block and inline list processing
orderedListMarkers,
normalizeSpaces,
@@ -68,21 +70,31 @@ module Text.Pandoc.Shared (
inDirectory,
findDataFile,
readDataFile,
+ -- * Error handling
+ err,
+ warn,
) where
import Text.Pandoc.Definition
import Text.Pandoc.Generic
-import qualified Text.Pandoc.UTF8 as UTF8 (readFile)
-import Data.Char ( toLower, isLower, isUpper, isAlpha, isAscii,
- isLetter, isDigit )
+import qualified Text.Pandoc.UTF8 as UTF8
+import System.Environment (getProgName)
+import System.Exit (exitWith, ExitCode(..))
+import Data.Char ( toLower, isLower, isUpper, isAlpha,
+ isLetter, isDigit, isSpace )
import Data.List ( find, isPrefixOf, intercalate )
-import Network.URI ( isAllowedInURI, escapeURIString, unEscapeString )
-import Codec.Binary.UTF8.String ( encodeString, decodeString )
+import Network.URI ( escapeURIString )
import System.Directory
import System.FilePath ( (</>) )
import Data.Generics (Typeable, Data)
import qualified Control.Monad.State as S
+import Control.Monad (msum)
import Paths_pandoc (getDataFileName)
+import Text.Pandoc.Highlighting (Style, pygments)
+import Text.Pandoc.Pretty (charWidth)
+import System.Locale (defaultTimeLocale)
+import Data.Time
+import System.IO (stderr)
--
-- List processing
@@ -96,12 +108,23 @@ splitBy isSep lst =
rest' = dropWhile isSep rest
in first:(splitBy isSep rest')
--- | Split list into chunks divided at specified indices.
splitByIndices :: [Int] -> [a] -> [[a]]
splitByIndices [] lst = [lst]
-splitByIndices (x:xs) lst =
- let (first, rest) = splitAt x lst in
- first:(splitByIndices (map (\y -> y - x) xs) rest)
+splitByIndices (x:xs) lst = first:(splitByIndices (map (\y -> y - x) xs) rest)
+ where (first, rest) = splitAt x lst
+
+-- | Split string into chunks divided at specified indices.
+splitStringByIndices :: [Int] -> [Char] -> [[Char]]
+splitStringByIndices [] lst = [lst]
+splitStringByIndices (x:xs) lst =
+ let (first, rest) = splitAt' x lst in
+ first : (splitStringByIndices (map (\y -> y - x) xs) rest)
+
+splitAt' :: Int -> [Char] -> ([Char],[Char])
+splitAt' _ [] = ([],[])
+splitAt' n xs | n <= 0 = ([],xs)
+splitAt' n (x:xs) = (x:ys,zs)
+ where (ys,zs) = splitAt' (n - charWidth x) xs
-- | Replace each occurrence of one sublist in a list with another.
substitute :: (Eq a) => [a] -> [a] -> [a] -> [a]
@@ -181,16 +204,9 @@ toRomanNumeral x =
_ | x >= 1 -> "I" ++ toRomanNumeral (x - 1)
_ -> ""
--- | Escape unicode characters in a URI. Characters that are
--- already valid in a URI, including % and ?, are left alone.
+-- | Escape whitespace in URI.
escapeURI :: String -> String
-escapeURI = escapeURIString isAllowedInURI . encodeString
-
--- | Unescape unicode and some special characters in a URI, but
--- without introducing spaces.
-unescapeURI :: String -> String
-unescapeURI = escapeURIString (\c -> isAllowedInURI c || not (isAscii c)) .
- decodeString . unEscapeString
+escapeURI = escapeURIString (not . isSpace)
-- | Convert tabs to spaces and filter out DOS line endings.
-- Tabs will be preserved if tab stop is set to 0.
@@ -213,6 +229,18 @@ tabFilter tabStop =
in go tabStop
--
+-- Date/time
+--
+
+-- | Parse a date and convert (if possible) to "YYYY-MM-DD" format.
+normalizeDate :: String -> Maybe String
+normalizeDate s = fmap (formatTime defaultTimeLocale "%F")
+ (msum $ map (\fs -> parsetimeWith fs s) formats :: Maybe Day)
+ where parsetimeWith = parseTime defaultTimeLocale
+ formats = ["%x","%m/%d/%Y", "%D","%F", "%d %b %Y",
+ "%d %B %Y", "%b. %d, %Y", "%B %d, %Y"]
+
+--
-- Pandoc block and inline list processing
--
@@ -304,9 +332,9 @@ consolidateInlines (Str x : ys) =
fromStr (Str z) = z
fromStr _ = error "consolidateInlines - fromStr - not a Str"
consolidateInlines (Space : ys) = Space : rest
- where isSpace Space = True
- isSpace _ = False
- rest = consolidateInlines $ dropWhile isSpace ys
+ where isSp Space = True
+ isSp _ = False
+ rest = consolidateInlines $ dropWhile isSp ys
consolidateInlines (Emph xs : Emph ys : zs) = consolidateInlines $
Emph (xs ++ ys) : zs
consolidateInlines (Strong xs : Strong ys : zs) = consolidateInlines $
@@ -334,10 +362,6 @@ stringify = queryWith go
go (Str x) = x
go (Code _ x) = x
go (Math _ x) = x
- go EmDash = "--"
- go EnDash = "-"
- go Apostrophe = "'"
- go Ellipses = "..."
go LineBreak = " "
go _ = ""
@@ -458,6 +482,7 @@ data ObfuscationMethod = NoObfuscation
-- | Varieties of HTML slide shows.
data HTMLSlideVariant = S5Slides
| SlidySlides
+ | DZSlides
| NoSlides
deriving (Show, Read, Eq)
@@ -488,9 +513,13 @@ data WriterOptions = WriterOptions
, writerCiteMethod :: CiteMethod -- ^ How to print cites
, writerBiblioFiles :: [FilePath] -- ^ Biblio files to use for citations
, writerHtml5 :: Bool -- ^ Produce HTML5
+ , writerBeamer :: Bool -- ^ Produce beamer LaTeX slide show
+ , writerSlideLevel :: Maybe Int -- ^ Force header level of slides
, writerChapters :: Bool -- ^ Use "chapter" for top-level sects
, writerListings :: Bool -- ^ Use listings package for code
- , writerAscii :: Bool -- ^ Avoid non-ascii characters
+ , writerHighlight :: Bool -- ^ Highlight source code
+ , writerHighlightStyle :: Style -- ^ Style to use for highlighting
+ , writerSetextHeaders :: Bool -- ^ Use setext headers for levels 1-2 in markdown
} deriving Show
{-# DEPRECATED writerXeTeX "writerXeTeX no longer does anything" #-}
@@ -522,9 +551,13 @@ defaultWriterOptions =
, writerCiteMethod = Citeproc
, writerBiblioFiles = []
, writerHtml5 = False
+ , writerBeamer = False
+ , writerSlideLevel = Nothing
, writerChapters = False
, writerListings = False
- , writerAscii = False
+ , writerHighlight = False
+ , writerHighlightStyle = pygments
+ , writerSetextHeaders = True
}
--
@@ -554,3 +587,19 @@ findDataFile (Just u) f = do
-- Cabal data directory.
readDataFile :: Maybe FilePath -> FilePath -> IO String
readDataFile userDir fname = findDataFile userDir fname >>= UTF8.readFile
+
+--
+-- Error reporting
+--
+
+err :: Int -> String -> IO a
+err exitCode msg = do
+ name <- getProgName
+ UTF8.hPutStrLn stderr $ name ++ ": " ++ msg
+ exitWith $ ExitFailure exitCode
+ return undefined
+
+warn :: String -> IO ()
+warn msg = do
+ name <- getProgName
+ UTF8.hPutStrLn stderr $ name ++ ": " ++ msg