summaryrefslogtreecommitdiff
path: root/src/Text/Pandoc/Highlighting.hs
diff options
context:
space:
mode:
authorfiddlosopher <fiddlosopher@788f1e2b-df1e-0410-8736-df70ead52e1b>2009-01-24 20:00:26 +0000
committerfiddlosopher <fiddlosopher@788f1e2b-df1e-0410-8736-df70ead52e1b>2009-01-24 20:00:26 +0000
commit42aca57dee8d88afa5fac512aeb1198102908865 (patch)
tree1c6a98bd226f4fffde6768010715bc1d80e5d168 /src/Text/Pandoc/Highlighting.hs
parent39e8d8486693029abfef84c45e85416f7c775280 (diff)
Moved all haskell source to src subdirectory.
git-svn-id: https://pandoc.googlecode.com/svn/trunk@1528 788f1e2b-df1e-0410-8736-df70ead52e1b
Diffstat (limited to 'src/Text/Pandoc/Highlighting.hs')
-rw-r--r--src/Text/Pandoc/Highlighting.hs64
1 files changed, 64 insertions, 0 deletions
diff --git a/src/Text/Pandoc/Highlighting.hs b/src/Text/Pandoc/Highlighting.hs
new file mode 100644
index 000000000..6726f1a42
--- /dev/null
+++ b/src/Text/Pandoc/Highlighting.hs
@@ -0,0 +1,64 @@
+{-# LANGUAGE CPP #-}
+{-
+Copyright (C) 2008 John MacFarlane <jgm@berkeley.edu>
+
+This program is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+This program is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this program; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+-}
+
+{- |
+ Module : Text.Pandoc.Highlighting
+ Copyright : Copyright (C) 2008 John MacFarlane
+ License : GNU GPL, version 2 or above
+
+ Maintainer : John MacFarlane <jgm@berkeley.edu>
+ Stability : alpha
+ Portability : portable
+
+Exports functions for syntax highlighting.
+-}
+
+module Text.Pandoc.Highlighting ( languages, highlightHtml, defaultHighlightingCss ) where
+import Text.XHtml
+import Text.Pandoc.Definition
+#ifdef _HIGHLIGHTING
+import Text.Highlighting.Kate ( languages, highlightAs, formatAsXHtml, FormatOption (..), defaultHighlightingCss )
+import Data.List (find, lookup)
+import Data.Maybe (fromMaybe)
+import Data.Char (toLower)
+
+highlightHtml :: Attr -> String -> Either String Html
+highlightHtml (_, classes, keyvals) rawCode =
+ let firstNum = read $ fromMaybe "1" $ lookup "startFrom" keyvals
+ fmtOpts = [OptNumberFrom firstNum] ++
+ case find (`elem` ["number","numberLines","number-lines"]) classes of
+ Nothing -> []
+ Just _ -> [OptNumberLines]
+ lcLanguages = map (map toLower) languages
+ in case find (\c -> (map toLower c) `elem` lcLanguages) classes of
+ Nothing -> Left "Unknown or unsupported language"
+ Just language -> case highlightAs language rawCode of
+ Left err -> Left err
+ Right hl -> Right $ formatAsXHtml fmtOpts language hl
+
+#else
+defaultHighlightingCss :: String
+defaultHighlightingCss = ""
+
+languages :: [String]
+languages = []
+
+highlightHtml :: Attr -> String -> Either String Html
+highlightHtml _ _ = Left "Pandoc was not compiled with support for highlighting"
+#endif