version 0.2.0.00.2.0.0

13 files changed, 669 insertions, 227 deletions

diff --git a/CHANGELOG.md b/CHANGELOG.md
index 9b45b5e..f4a2b14 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -1,4 +1,10 @@
 # Changelog
 
+- 0.2.0.0 (2016-10-13)
+    * Add theming support.
+    * Fix links display.
+    * Add support for wrapping.
+    * Allow org mode as input format.
+
 - 0.1.0.0 (2016-10-02)
     * Upload first version from hotel wifi in Kalaw.
diff --git a/patat.cabal b/patat.cabal
index 792060d..d5f450e 100644
--- a/patat.cabal
+++ b/patat.cabal
@@ -1,5 +1,5 @@
 Name:                patat
-Version:             0.1.0.0
+Version:             0.2.0.0
 Synopsis:            Terminal-based presentations using Pandoc
 Description:         Terminal-based presentations using Pandoc
 License:             GPL-2
@@ -24,9 +24,11 @@ Executable patat
   Default-language:  Haskell2010
 
   Build-depends:
+    aeson                >= 0.11 && < 1.1,
     ansi-terminal        >= 0.6  && < 0.7,
     ansi-wl-pprint       >= 0.6  && < 0.7,
     base                 >= 4.6  && < 4.10,
+    bytestring           >= 0.10 && < 0.11,
     containers           >= 0.5  && < 0.6,
     directory            >= 1.2  && < 1.3,
     filepath             >= 1.4  && < 1.5,
@@ -34,9 +36,13 @@ Executable patat
     optparse-applicative >= 0.12 && < 0.14,
     pandoc               >= 1.17 && < 1.18,
     terminal-size        >= 0.3  && < 0.4,
-    time                 >= 1.4  && < 1.7
+    text                 >= 1.2  && < 1.3,
+    time                 >= 1.4  && < 1.7,
+    yaml                 >= 0.7  && < 0.9
 
   Other-modules:
+    Data.Aeson.Extended
+    Data.Aeson.TH.Extended
     Data.Data.Extended
     Patat.Presentation
     Patat.Presentation.Display
@@ -45,4 +51,5 @@ Executable patat
     Patat.Presentation.Internal
     Patat.Presentation.Read
     Patat.PrettyPrint
+    Patat.Theme
     Text.Pandoc.Extended
diff --git a/src/Data/Aeson/Extended.hs b/src/Data/Aeson/Extended.hs
new file mode 100644
index 0000000..9b95cec
--- /dev/null
+++ b/src/Data/Aeson/Extended.hs
@@ -0,0 +1,22 @@
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+module Data.Aeson.Extended
+    ( module Data.Aeson
+
+    , FlexibleNum (..)
+    ) where
+
+import           Control.Applicative ((<$>))
+import           Data.Aeson
+import qualified Data.Text           as T
+import           Text.Read           (readMaybe)
+import           Prelude
+
+-- | This can be parsed from a JSON string in addition to a JSON number.
+newtype FlexibleNum a = FlexibleNum {unFlexibleNum :: a}
+    deriving (Show, ToJSON)
+
+instance (FromJSON a, Read a) => FromJSON (FlexibleNum a) where
+    parseJSON (String str) = case readMaybe (T.unpack str) of
+        Nothing -> fail $ "Could not parse " ++ T.unpack str ++ " as a number"
+        Just x  -> return (FlexibleNum x)
+    parseJSON val = FlexibleNum <$> parseJSON val
diff --git a/src/Data/Aeson/TH/Extended.hs b/src/Data/Aeson/TH/Extended.hs
new file mode 100644
index 0000000..0fa5487
--- /dev/null
+++ b/src/Data/Aeson/TH/Extended.hs
@@ -0,0 +1,21 @@
+--------------------------------------------------------------------------------
+module Data.Aeson.TH.Extended
+    ( module Data.Aeson.TH
+    , dropPrefixOptions
+    ) where
+
+
+--------------------------------------------------------------------------------
+import           Data.Aeson.TH
+import           Data.Char     (isUpper, toLower)
+
+
+--------------------------------------------------------------------------------
+dropPrefixOptions :: Options
+dropPrefixOptions = defaultOptions
+    { fieldLabelModifier = dropPrefix
+    }
+  where
+    dropPrefix str = case break isUpper str of
+        (_, (y : ys)) -> toLower y : ys
+        _             -> str
diff --git a/src/Main.hs b/src/Main.hs
index 2278478..4394835 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -96,7 +96,7 @@ assertAnsiFeatures = do
 --------------------------------------------------------------------------------
 main :: IO ()
 main = do
-    options   <- OA.execParser parserInfo
+    options   <- OA.customExecParser (OA.prefs OA.showHelpOnError) parserInfo
     errOrPres <- readPresentation (oFilePath options)
     pres      <- either (errorAndExit . return) return errOrPres
 
diff --git a/src/Patat/Presentation.hs b/src/Patat/Presentation.hs
index 9addefb..bf6c2b3 100644
--- a/src/Patat/Presentation.hs
+++ b/src/Patat/Presentation.hs
@@ -1,5 +1,8 @@
 module Patat.Presentation
-    ( Presentation (..)
+    ( PresentationSettings (..)
+    , defaultPresentationSettings
+
+    , Presentation (..)
     , readPresentation
     , displayPresentation
     , dumpPresentation
diff --git a/src/Patat/Presentation/Display.hs b/src/Patat/Presentation/Display.hs
index 50b9e05..cdbd49e 100644
--- a/src/Patat/Presentation/Display.hs
+++ b/src/Patat/Presentation/Display.hs
@@ -9,13 +9,20 @@ module Patat.Presentation.Display
 
 
 --------------------------------------------------------------------------------
+import           Control.Applicative              ((<$>))
+import           Control.Monad                    (mplus)
+import qualified Data.Aeson.Extended              as A
 import           Data.Data.Extended               (grecQ)
 import           Data.List                        (intersperse)
+import           Data.Maybe                       (fromMaybe)
 import           Data.Monoid                      (mconcat, mempty, (<>))
+import qualified Data.Text                        as T
 import           Patat.Presentation.Display.Table
 import           Patat.Presentation.Internal
 import           Patat.PrettyPrint                ((<$$>), (<+>))
 import qualified Patat.PrettyPrint                as PP
+import           Patat.Theme                      (Theme (..))
+import qualified Patat.Theme                      as Theme
 import qualified System.Console.ANSI              as Ansi
 import qualified System.Console.Terminal.Size     as Terminal
 import qualified Text.Pandoc.Extended             as Pandoc
@@ -30,14 +37,22 @@ displayPresentation Presentation {..} = do
 
     -- Get terminal width/title
     mbWindow <- Terminal.size
-    let termWidth   = maybe 72 Terminal.width  mbWindow
-        termHeight  = maybe 24 Terminal.height mbWindow
-        title       = PP.toString (prettyInlines pTitle)
+    let columns = fromMaybe 72 $
+            (A.unFlexibleNum <$> psColumns pSettings) `mplus`
+            (Terminal.width  <$> mbWindow)
+        rows    = fromMaybe 24 $
+            (A.unFlexibleNum <$> psRows pSettings) `mplus`
+            (Terminal.height <$> mbWindow)
+
+    let settings    = pSettings {psColumns = Just $ A.FlexibleNum columns}
+        theme       = fromMaybe Theme.defaultTheme (psTheme settings)
+        title       = PP.toString (prettyInlines theme pTitle)
         titleWidth  = length title
-        titleOffset = (termWidth - titleWidth) `div` 2
+        titleOffset = (columns - titleWidth) `div` 2
+        borders     = themed (themeBorders theme)
 
     Ansi.setCursorColumn titleOffset
-    PP.putDoc $ PP.dullyellow $ PP.string title
+    PP.putDoc $ borders $ PP.string title
     putStrLn ""
     putStrLn ""
 
@@ -45,50 +60,61 @@ displayPresentation Presentation {..} = do
             []      -> mempty
             (s : _) -> s
 
-    PP.putDoc $ prettySlide slide
+    PP.putDoc $ withWrapSettings settings $ prettySlide theme slide
     putStrLn ""
 
     let active      = show (pActiveSlide + 1) ++ " / " ++ show (length pSlides)
         activeWidth = length active
 
-    Ansi.setCursorPosition (termHeight - 2) 0
-    PP.putDoc $ " " <> PP.dullyellow (prettyInlines pAuthor)
-    Ansi.setCursorColumn (termWidth - activeWidth - 1)
-    PP.putDoc $ PP.dullyellow $ PP.string active
+    Ansi.setCursorPosition (rows - 2) 0
+    PP.putDoc $ " " <> borders (prettyInlines theme pAuthor)
+    Ansi.setCursorColumn (columns - activeWidth - 1)
+    PP.putDoc $ borders $ PP.string active
     putStrLn ""
 
 
 --------------------------------------------------------------------------------
 dumpPresentation :: Presentation -> IO ()
-dumpPresentation =
-    PP.putDoc . PP.vcat . intersperse "----------" . map prettySlide . pSlides
+dumpPresentation pres =
+    let theme = fromMaybe Theme.defaultTheme (psTheme $ pSettings pres) in
+    PP.putDoc $ withWrapSettings (pSettings pres) $
+        PP.vcat $ intersperse "----------" $
+        map (prettySlide theme) $ pSlides pres
 
 
 --------------------------------------------------------------------------------
-prettySlide :: Slide -> PP.Doc
-prettySlide slide@(Slide blocks) =
-    prettyBlocks blocks <>
-    case prettyReferences slide of
+withWrapSettings :: PresentationSettings -> PP.Doc -> PP.Doc
+withWrapSettings ps = case (psWrap ps, psColumns ps) of
+    (Just True,  Just (A.FlexibleNum col)) -> PP.wrapAt (Just col)
+    _                                      -> id
+
+
+--------------------------------------------------------------------------------
+prettySlide :: Theme -> Slide -> PP.Doc
+prettySlide theme slide@(Slide blocks) =
+    prettyBlocks theme blocks <>
+    case prettyReferences theme slide of
         []   -> mempty
-        refs -> PP.newline <> PP.vcat refs
+        refs -> PP.hardline <> PP.vcat refs
 
 
 --------------------------------------------------------------------------------
-prettyBlock :: Pandoc.Block -> PP.Doc
+prettyBlock :: Theme -> Pandoc.Block -> PP.Doc
 
-prettyBlock (Pandoc.Plain inlines) = prettyInlines inlines
+prettyBlock theme (Pandoc.Plain inlines) = prettyInlines theme inlines
 
-prettyBlock (Pandoc.Para inlines) = prettyInlines inlines <> PP.newline
+prettyBlock theme (Pandoc.Para inlines) =
+    prettyInlines theme inlines <> PP.hardline
 
-prettyBlock (Pandoc.Header i _ inlines) =
-    PP.dullblue (PP.string (replicate i '#') <+> prettyInlines inlines) <>
-    PP.newline
+prettyBlock theme@Theme {..} (Pandoc.Header i _ inlines) =
+    themed themeHeader (PP.string (replicate i '#') <+> prettyInlines theme inlines) <>
+    PP.hardline
 
-prettyBlock (Pandoc.CodeBlock _ txt) = PP.vcat
+prettyBlock Theme {..} (Pandoc.CodeBlock _ txt) = PP.vcat
     [ let ind = PP.NotTrimmable "   " in
-      PP.indent ind ind $ PP.ondullblack $ PP.dullwhite $ PP.string line
+      PP.indent ind ind $ themed themeCodeBlock $ PP.string line
     | line <- blockified txt
-    ] <> PP.newline
+    ] <> PP.hardline
   where
     blockified str =
         let ls       = lines str
@@ -96,21 +122,32 @@ prettyBlock (Pandoc.CodeBlock _ txt) = PP.vcat
             extend l = " " ++ l ++ replicate (longest - length l) ' ' ++ " " in
         map extend $ [""] ++ ls ++ [""]
 
-prettyBlock (Pandoc.BulletList bss) = PP.vcat
+prettyBlock theme (Pandoc.BulletList bss) = PP.vcat
     [ PP.indent
-        (PP.NotTrimmable $ PP.dullmagenta "  - ")
+        (PP.NotTrimmable $ themed (themeBulletList theme) prefix)
         (PP.Trimmable "    ")
-        (prettyBlocks bs)
+        (prettyBlocks theme' bs)
     | bs <- bss
-    ] <> PP.newline
-
-prettyBlock (Pandoc.OrderedList _ bss) = PP.vcat
+    ] <> PP.hardline
+  where
+    prefix = "  " <> PP.string [marker] <> " "
+    marker = case T.unpack <$> themeBulletListMarkers theme of
+        Just (x : _) -> x
+        _            -> '-'
+
+    -- Cycle the markers.
+    theme' = theme
+        { themeBulletListMarkers =
+            (\ls -> T.drop 1 ls <> T.take 1 ls) <$> themeBulletListMarkers theme
+        }
+
+prettyBlock theme@Theme {..} (Pandoc.OrderedList _ bss) = PP.vcat
     [ PP.indent
-        (PP.NotTrimmable $ PP.dullmagenta $ PP.string prefix)
+        (PP.NotTrimmable $ themed themeOrderedList $ PP.string prefix)
         (PP.Trimmable "    ")
-        (prettyBlocks bs)
+        (prettyBlocks theme bs)
     | (prefix, bs) <- zip padded bss
-    ] <> PP.newline
+    ] <> PP.hardline
   where
     padded  = [n ++ replicate (4 - length n) ' ' | n <- numbers]
     numbers =
@@ -118,107 +155,114 @@ prettyBlock (Pandoc.OrderedList _ bss) = PP.vcat
         | i <- [1 .. length bss]
         ]
 
-prettyBlock (Pandoc.RawBlock _ t) = PP.string t <> PP.newline
+prettyBlock _theme (Pandoc.RawBlock _ t) = PP.string t <> PP.hardline
 
-prettyBlock Pandoc.HorizontalRule = "---"
+prettyBlock _theme Pandoc.HorizontalRule = "---"
 
-prettyBlock (Pandoc.BlockQuote bs) =
-    let quote = PP.NotTrimmable (PP.dullgreen "> ") in
-    PP.indent quote quote (prettyBlocks bs)
+prettyBlock theme@Theme {..} (Pandoc.BlockQuote bs) =
+    let quote = PP.NotTrimmable (themed themeBlockQuote "> ") in
+    PP.indent quote quote (prettyBlocks theme bs)
 
-prettyBlock (Pandoc.Table caption aligns _ headers rows) = prettyTable Table
-    { tCaption = prettyInlines caption
-    , tAligns  = map align aligns
-    , tHeaders = map prettyBlocks headers
-    , tRows    = map (map prettyBlocks) rows
-    }
-  where
-    align Pandoc.AlignLeft    = PP.AlignLeft
-    align Pandoc.AlignCenter  = PP.AlignCenter
-    align Pandoc.AlignDefault = PP.AlignLeft
-    align Pandoc.AlignRight   = PP.AlignRight
-
-prettyBlock (Pandoc.Div _attrs blocks) = prettyBlocks blocks
-
-prettyBlock (Pandoc.DefinitionList terms) =
+prettyBlock theme@Theme {..} (Pandoc.DefinitionList terms) =
     PP.vcat $ map prettyDefinition terms
   where
     prettyDefinition (term, definitions) =
-        PP.dullblue (prettyInlines term) <$$> PP.newline <> PP.vcat
+        themed themeDefinitionTerm (prettyInlines theme term) <$$>
+        PP.hardline <> PP.vcat
         [ PP.indent
-            (PP.NotTrimmable (PP.dullmagenta ":   "))
+            (PP.NotTrimmable (themed themeDefinitionList ":   "))
             (PP.Trimmable "    ") $
-            prettyBlocks (Pandoc.plainToPara definition)
+            prettyBlocks theme (Pandoc.plainToPara definition)
         | definition <- definitions
         ]
 
-prettyBlock Pandoc.Null = mempty
+prettyBlock theme (Pandoc.Table caption aligns _ headers rows) =
+    PP.wrapAt Nothing $
+    prettyTable theme Table
+        { tCaption = prettyInlines theme caption
+        , tAligns  = map align aligns
+        , tHeaders = map (prettyBlocks theme) headers
+        , tRows    = map (map (prettyBlocks theme)) rows
+        }
+  where
+    align Pandoc.AlignLeft    = PP.AlignLeft
+    align Pandoc.AlignCenter  = PP.AlignCenter
+    align Pandoc.AlignDefault = PP.AlignLeft
+    align Pandoc.AlignRight   = PP.AlignRight
+
+prettyBlock theme (Pandoc.Div _attrs blocks) = prettyBlocks theme blocks
+
+prettyBlock _theme Pandoc.Null = mempty
 
 
 --------------------------------------------------------------------------------
-prettyBlocks :: [Pandoc.Block] -> PP.Doc
-prettyBlocks = PP.vcat . map prettyBlock
+prettyBlocks :: Theme -> [Pandoc.Block] -> PP.Doc
+prettyBlocks theme = PP.vcat . map (prettyBlock theme)
 
 
 --------------------------------------------------------------------------------
-prettyInline :: Pandoc.Inline -> PP.Doc
+prettyInline :: Theme -> Pandoc.Inline -> PP.Doc
 
-prettyInline Pandoc.Space = PP.space
+prettyInline _theme Pandoc.Space = PP.space
 
-prettyInline (Pandoc.Str str) = PP.string str
+prettyInline _theme (Pandoc.Str str) = PP.string str
 
-prettyInline (Pandoc.Emph inlines) =
-    PP.dullgreen $ prettyInlines inlines
+prettyInline theme@Theme {..} (Pandoc.Emph inlines) =
+    themed themeEmph $
+    prettyInlines theme inlines
 
-prettyInline (Pandoc.Strong inlines) =
-    PP.dullred $ PP.bold $ prettyInlines inlines
+prettyInline theme@Theme {..} (Pandoc.Strong inlines) =
+    themed themeStrong $
+    prettyInlines theme inlines
 
-prettyInline (Pandoc.Code _ txt) =
-    PP.ondullblack $ PP.dullwhite $ " " <> PP.string txt <> " "
+prettyInline Theme {..} (Pandoc.Code _ txt) =
+    themed themeCode $
+    " " <> PP.string txt <> " "
 
-prettyInline link@(Pandoc.Link _attrs text (target, _title))
+prettyInline theme@Theme {..} link@(Pandoc.Link _attrs text (target, _title))
     | isReferenceLink link =
-        "[" <> PP.dullcyan (prettyInlines text) <> "]"
+        "[" <> themed themeLinkText (prettyInlines theme text) <> "]"
     | otherwise =
-        "<" <> PP.dullcyan (PP.underline $ PP.string target) <> ">"
+        "<" <> themed themeLinkTarget (PP.string target) <> ">"
 
-prettyInline Pandoc.SoftBreak = PP.newline
+prettyInline _theme Pandoc.SoftBreak = PP.softline
 
-prettyInline Pandoc.LineBreak = PP.newline
+prettyInline _theme Pandoc.LineBreak = PP.hardline
 
-prettyInline (Pandoc.Strikeout t) =
-    "~~" <> PP.ondullred (prettyInlines t) <> "~~"
+prettyInline theme@Theme {..} (Pandoc.Strikeout t) =
+    "~~" <> themed themeStrikeout (prettyInlines theme t) <> "~~"
 
-prettyInline (Pandoc.Quoted Pandoc.SingleQuote t) =
-    "'" <> PP.dullgreen (prettyInlines t) <> "'"
-prettyInline (Pandoc.Quoted Pandoc.DoubleQuote t) =
-    "'" <> PP.dullgreen (prettyInlines t) <> "'"
+prettyInline theme@Theme {..} (Pandoc.Quoted Pandoc.SingleQuote t) =
+    "'" <> themed themeQuoted (prettyInlines theme t) <> "'"
+prettyInline theme@Theme {..} (Pandoc.Quoted Pandoc.DoubleQuote t) =
+    "'" <> themed themeQuoted (prettyInlines theme t) <> "'"
 
-prettyInline (Pandoc.Math _ t) = PP.dullgreen (PP.string t)
+prettyInline Theme {..} (Pandoc.Math _ t) =
+    themed themeMath (PP.string t)
 
-prettyInline (Pandoc.Image _ _ (tit, src)) =
-    "![" <> PP.dullgreen (PP.string tit) <> "](" <>
-    PP.dullcyan (PP.underline (PP.string src)) <> ")"
+prettyInline theme@Theme {..} (Pandoc.Image _attrs text (target, _title)) =
+    "![" <> themed themeImageText (prettyInlines theme text) <> "](" <>
+    themed themeImageTarget (PP.string target) <> ")"
 
 -- These elements aren't really supported.
-prettyInline (Pandoc.Cite      _ t) = prettyInlines t
-prettyInline (Pandoc.Span      _ t) = prettyInlines t
-prettyInline (Pandoc.RawInline _ t) = PP.string t
-prettyInline (Pandoc.Note        t) = prettyBlocks t
-prettyInline (Pandoc.Superscript t) = prettyInlines t
-prettyInline (Pandoc.Subscript   t) = prettyInlines t
-prettyInline (Pandoc.SmallCaps   t) = prettyInlines t
+prettyInline theme  (Pandoc.Cite      _ t) = prettyInlines theme t
+prettyInline theme  (Pandoc.Span      _ t) = prettyInlines theme t
+prettyInline _theme (Pandoc.RawInline _ t) = PP.string t
+prettyInline theme  (Pandoc.Note        t) = prettyBlocks  theme t
+prettyInline theme  (Pandoc.Superscript t) = prettyInlines theme t
+prettyInline theme  (Pandoc.Subscript   t) = prettyInlines theme t
+prettyInline theme  (Pandoc.SmallCaps   t) = prettyInlines theme t
 -- prettyInline unsupported = PP.ondullred $ PP.string $ show unsupported
 
 
 --------------------------------------------------------------------------------
-prettyInlines :: [Pandoc.Inline] -> PP.Doc
-prettyInlines = mconcat . map prettyInline
+prettyInlines :: Theme -> [Pandoc.Inline] -> PP.Doc
+prettyInlines theme = mconcat . map (prettyInline theme)
 
 
 --------------------------------------------------------------------------------
-prettyReferences :: Slide -> [PP.Doc]
-prettyReferences =
+prettyReferences :: Theme -> Slide -> [PP.Doc]
+prettyReferences theme@Theme {..} =
     map prettyReference . getReferences . unSlide
   where
     getReferences :: [Pandoc.Block] -> [Pandoc.Inline]
@@ -226,9 +270,10 @@ prettyReferences =
 
     prettyReference :: Pandoc.Inline -> PP.Doc
     prettyReference (Pandoc.Link _attrs text (target, title)) =
-        "[" <> PP.dullgreen (prettyInlines $ Pandoc.newlineToSpace text) <>
+        "[" <>
+        themed themeLinkText (prettyInlines theme $ Pandoc.newlineToSpace text) <>
         "](" <>
-        PP.dullcyan (PP.underline (PP.string target)) <>
+        themed themeLinkTarget (PP.string target) <>
         (if null title
             then mempty
             else PP.space <> "\"" <> PP.string title <> "\"")
diff --git a/src/Patat/Presentation/Display/Table.hs b/src/Patat/Presentation/Display/Table.hs
index 181c55a..fee68c9 100644
--- a/src/Patat/Presentation/Display/Table.hs
+++ b/src/Patat/Presentation/Display/Table.hs
@@ -4,6 +4,8 @@
 module Patat.Presentation.Display.Table
     ( Table (..)
     , prettyTable
+
+    , themed
     ) where
 
 
@@ -12,6 +14,8 @@ import           Data.List         (intersperse, transpose)
 import           Data.Monoid       (mconcat, mempty, (<>))
 import           Patat.PrettyPrint ((<$$>))
 import qualified Patat.PrettyPrint as PP
+import           Patat.Theme       (Theme (..))
+import qualified Patat.Theme       as Theme
 import           Prelude
 
 
@@ -26,25 +30,26 @@ data Table = Table
 
 --------------------------------------------------------------------------------
 prettyTable
-    :: Table -> PP.Doc
-prettyTable Table {..} = PP.indent (PP.Trimmable "  ") (PP.Trimmable "  ") $
-    lineIf (not isHeaderLess) (hcat2 headerHeight
-        [ PP.dullblue (PP.align w a (vpad headerHeight header))
-        | (w, a, header) <- zip3 columnWidths tAligns tHeaders
-        ]) <>
-    dashedHeaderSeparator columnWidths <$$>
-    joinRows
-        [ hcat2 rowHeight
-            [ PP.align w a (vpad rowHeight cell)
-            | (w, a, cell) <- zip3 columnWidths tAligns row
-            ]
-        | (rowHeight, row) <- zip rowHeights tRows
-        ] <$$>
-    lineIf isHeaderLess (dashedHeaderSeparator columnWidths) <>
-    lineIf
-        (not $ PP.null tCaption) (PP.newline <> "Table: " <> tCaption)
+    :: Theme -> Table -> PP.Doc
+prettyTable theme@Theme {..} Table {..} =
+    PP.indent (PP.Trimmable "  ") (PP.Trimmable "  ") $
+        lineIf (not isHeaderLess) (hcat2 headerHeight
+            [ themed themeTableHeader (PP.align w a (vpad headerHeight header))
+            | (w, a, header) <- zip3 columnWidths tAligns tHeaders
+            ]) <>
+        dashedHeaderSeparator theme columnWidths <$$>
+        joinRows
+            [ hcat2 rowHeight
+                [ PP.align w a (vpad rowHeight cell)
+                | (w, a, cell) <- zip3 columnWidths tAligns row
+                ]
+            | (rowHeight, row) <- zip rowHeights tRows
+            ] <$$>
+        lineIf isHeaderLess (dashedHeaderSeparator theme columnWidths) <>
+        lineIf
+            (not $ PP.null tCaption) (PP.hardline <> "Table: " <> tCaption)
   where
-    lineIf cond line = if cond then line <> PP.newline else mempty
+    lineIf cond line = if cond then line <> PP.hardline else mempty
 
     joinRows
         | all (all isSimpleCell) tRows = PP.vcat
@@ -67,7 +72,7 @@ prettyTable Table {..} = PP.indent (PP.Trimmable "  ") (PP.Trimmable "  ") $
     vpad :: Int -> PP.Doc -> PP.Doc
     vpad height doc =
         let (actual, _) = PP.dimensions doc in
-        doc <> mconcat (replicate (height - actual) PP.newline)
+        doc <> mconcat (replicate (height - actual) PP.hardline)
 
     safeMax = foldr max 0
 
@@ -76,7 +81,7 @@ prettyTable Table {..} = PP.indent (PP.Trimmable "  ") (PP.Trimmable "  ") $
 
     spaces2 :: Int -> PP.Doc
     spaces2 rowHeight =
-        mconcat $ intersperse PP.newline $
+        mconcat $ intersperse PP.hardline $
         replicate rowHeight (PP.string "  ")
 
 
@@ -86,8 +91,17 @@ isSimpleCell = (<= 1) . fst . PP.dimensions
 
 
 --------------------------------------------------------------------------------
-dashedHeaderSeparator :: [Int] -> PP.Doc
-dashedHeaderSeparator columnWidths = mconcat $ intersperse (PP.string "  ")
-    [ PP.dullmagenta (PP.string (replicate w '-'))
-    | w <- columnWidths
-    ]
+dashedHeaderSeparator :: Theme -> [Int] -> PP.Doc
+dashedHeaderSeparator Theme {..} columnWidths =
+    mconcat $ intersperse (PP.string "  ")
+        [ themed themeTableSeparator (PP.string (replicate w '-'))
+        | w <- columnWidths
+        ]
+
+
+--------------------------------------------------------------------------------
+-- | This does not really belong in the module.
+themed :: Maybe Theme.Style -> PP.Doc -> PP.Doc
+themed Nothing                    = id
+themed (Just (Theme.Style []))    = id
+themed (Just (Theme.Style codes)) = PP.ansi codes
diff --git a/src/Patat/Presentation/Internal.hs b/src/Patat/Presentation/Internal.hs
index 1780db3..f11c46b 100644
--- a/src/Patat/Presentation/Internal.hs
+++ b/src/Patat/Presentation/Internal.hs
@@ -1,14 +1,21 @@
 --------------------------------------------------------------------------------
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE TemplateHaskell            #-}
 module Patat.Presentation.Internal
     ( Presentation (..)
+    , PresentationSettings (..)
+    , defaultPresentationSettings
     , Slide (..)
     ) where
 
 
 --------------------------------------------------------------------------------
-import           Data.Monoid (Monoid)
-import qualified Text.Pandoc as Pandoc
+import           Control.Monad          (mplus)
+import qualified Data.Aeson.Extended    as A
+import qualified Data.Aeson.TH.Extended as A
+import           Data.Monoid            (Monoid (..))
+import qualified Patat.Theme            as Theme
+import qualified Text.Pandoc            as Pandoc
 import           Prelude
 
 
@@ -17,11 +24,48 @@ data Presentation = Presentation
     { pFilePath    :: !FilePath
     , pTitle       :: ![Pandoc.Inline]
     , pAuthor      :: ![Pandoc.Inline]
+    , pSettings    :: !PresentationSettings
     , pSlides      :: [Slide]
     , pActiveSlide :: !Int
     } deriving (Show)
 
 
 --------------------------------------------------------------------------------
+-- | These are patat-specific settings.  That is where they differ from more
+-- general metadata (author, title...)
+data PresentationSettings = PresentationSettings
+    { psRows    :: !(Maybe (A.FlexibleNum Int))
+    , psColumns :: !(Maybe (A.FlexibleNum Int))
+    , psWrap    :: !(Maybe Bool)
+    , psTheme   :: !(Maybe Theme.Theme)
+    } deriving (Show)
+
+
+--------------------------------------------------------------------------------
+instance Monoid PresentationSettings where
+    mempty      = PresentationSettings Nothing Nothing Nothing Nothing
+    mappend l r = PresentationSettings
+        { psRows    = psRows    l `mplus`   psRows    r
+        , psColumns = psColumns l `mplus`   psColumns r
+        , psWrap    = psWrap    l `mplus`   psWrap    r
+        , psTheme   = psTheme   l `mappend` psTheme   r
+        }
+
+
+--------------------------------------------------------------------------------
+defaultPresentationSettings :: PresentationSettings
+defaultPresentationSettings = PresentationSettings
+    { psRows    = Nothing
+    , psColumns = Nothing
+    , psWrap    = Nothing
+    , psTheme   = Just Theme.defaultTheme
+    }
+
+
+--------------------------------------------------------------------------------
 newtype Slide = Slide {unSlide :: [Pandoc.Block]}
     deriving (Monoid, Show)
+
+
+--------------------------------------------------------------------------------
+$(A.deriveJSON A.dropPrefixOptions ''PresentationSettings)
diff --git a/src/Patat/Presentation/Read.hs b/src/Patat/Presentation/Read.hs
index b74b417..c962632 100644
--- a/src/Patat/Presentation/Read.hs
+++ b/src/Patat/Presentation/Read.hs
@@ -1,4 +1,5 @@
 -- | Read a presentation from disk.
+{-# LANGUAGE BangPatterns    #-}
 {-# LANGUAGE RecordWildCards #-}
 module Patat.Presentation.Read
     ( readPresentation
@@ -6,27 +7,38 @@ module Patat.Presentation.Read
 
 
 --------------------------------------------------------------------------------
+import           Control.Monad.Except        (ExceptT (..), runExceptT,
+                                              throwError)
+import           Control.Monad.Trans         (liftIO)
+import qualified Data.Aeson                  as A
+import qualified Data.ByteString             as B
+import           Data.Monoid                 (mempty, (<>))
 import qualified Data.Set                    as Set
+import qualified Data.Yaml                   as Yaml
 import           Patat.Presentation.Internal
-import           System.FilePath             (takeExtension)
-import qualified Text.Pandoc                 as Pandoc
+import           System.Directory            (doesFileExist, getHomeDirectory)
+import           System.FilePath             (takeExtension, (</>))
 import qualified Text.Pandoc.Error           as Pandoc
+import qualified Text.Pandoc.Extended        as Pandoc
+import           Prelude
 
 
 --------------------------------------------------------------------------------
 readPresentation :: FilePath -> IO (Either String Presentation)
-readPresentation filePath = do
-    src <- readFile filePath
-    return $ do
-        reader <- case readExtension ext of
-            Nothing -> Left $ "Unknown extension: " ++ ext
-            Just r  -> Right r
-
-        doc <- case reader src of
-            Left err -> Left $ "Pandoc parsing error: " ++ show err
-            Right x  -> Right x
-
-        pandocToPresentation filePath doc
+readPresentation filePath = runExceptT $ do
+    src    <- liftIO $ readFile filePath
+    reader <- case readExtension ext of
+        Nothing -> throwError $ "Unknown file extension: " ++ show ext
+        Just x  -> return x
+    doc@(Pandoc.Pandoc meta _) <- case reader src of
+        Left  e -> throwError $ "Could not parse document: " ++ show e
+        Right x -> return x
+
+    homeSettings <- ExceptT readHomeSettings
+    metaSettings <- ExceptT $ return $ readMetaSettings meta
+    let settings = metaSettings <> homeSettings <> defaultPresentationSettings
+
+    ExceptT $ return $ pandocToPresentation filePath settings doc
   where
     ext = takeExtension filePath
 
@@ -38,6 +50,7 @@ readExtension fileExt = case fileExt of
     ".md"  -> Just $ Pandoc.readMarkdown Pandoc.def
     ".lhs" -> Just $ Pandoc.readMarkdown lhsOpts
     ""     -> Just $ Pandoc.readMarkdown Pandoc.def
+    ".org" -> Just $ Pandoc.readOrg Pandoc.def
     _      -> Nothing
 
   where
@@ -49,16 +62,44 @@ readExtension fileExt = case fileExt of
 
 --------------------------------------------------------------------------------
 pandocToPresentation
-    :: FilePath -> Pandoc.Pandoc -> Either String Presentation
-pandocToPresentation pFilePath pandoc@(Pandoc.Pandoc meta _) = do
-    let pTitle       = Pandoc.docTitle meta
-        pSlides      = pandocToSlides pandoc
-        pActiveSlide = 0
-        pAuthor      = concat (Pandoc.docAuthors meta)
+    :: FilePath -> PresentationSettings -> Pandoc.Pandoc
+    -> Either String Presentation
+pandocToPresentation pFilePath pSettings pandoc@(Pandoc.Pandoc meta _) = do
+    let !pTitle       = Pandoc.docTitle meta
+        !pSlides      = pandocToSlides pandoc
+        !pActiveSlide = 0
+        !pAuthor      = concat (Pandoc.docAuthors meta)
     return Presentation {..}
 
 
 --------------------------------------------------------------------------------
+-- | Read settings from the metadata block in the Pandoc document.
+readMetaSettings :: Pandoc.Meta -> Either String PresentationSettings
+readMetaSettings meta = case Pandoc.lookupMeta "patat" meta of
+    Nothing  -> return mempty
+    Just val -> resultToEither $! A.fromJSON $! Pandoc.metaToJson val
+  where
+    resultToEither :: A.Result a -> Either String a
+    resultToEither (A.Success x) = Right x
+    resultToEither (A.Error   e) = Left $!
+        "Error parsing patat settings from metadata: " ++ e
+
+
+--------------------------------------------------------------------------------
+-- | Read settings from "$HOME/.patat.yaml".
+readHomeSettings :: IO (Either String PresentationSettings)
+readHomeSettings = do
+    home <- getHomeDirectory
+    let path = home </> ".patat.yaml"
+    exists <- doesFileExist path
+    if not exists
+        then return (Right mempty)
+        else do
+            contents <- B.readFile path
+            return $! Yaml.decodeEither contents
+
+
+--------------------------------------------------------------------------------
 -- | Split a pandoc document into slides.  If the document contains horizonal
 -- rules, we use those as slide delimiters.  If there are no horizontal rules,
 -- we split using h1 headers.
diff --git a/src/Patat/PrettyPrint.hs b/src/Patat/PrettyPrint.hs
index 59f2c6d..7b24b37 100644
--- a/src/Patat/PrettyPrint.hs
+++ b/src/Patat/PrettyPrint.hs
@@ -15,31 +15,22 @@ module Patat.PrettyPrint
     , putDoc
 
     , string
+    , text
     , space
-    , newline
+    , softline
+    , hardline
+
+    , wrapAt
 
     , Trimmable (..)
     , indent
 
+    , ansi
+
     , (<+>)
     , (<$$>)
     , vcat
 
-    , bold
-    , underline
-
-    , dullblack
-    , dullred
-    , dullgreen
-    , dullyellow
-    , dullblue
-    , dullmagenta
-    , dullcyan
-    , dullwhite
-
-    , ondullblack
-    , ondullred
-
     -- * Exotic combinators
     , Alignment (..)
     , align
@@ -50,12 +41,13 @@ module Patat.PrettyPrint
 --------------------------------------------------------------------------------
 import           Control.Monad.Reader (asks, local)
 import           Control.Monad.RWS    (RWS, runRWS)
-import           Control.Monad.State  (get, modify)
+import           Control.Monad.State  (get, gets, modify)
 import           Control.Monad.Writer (tell)
 import           Data.Foldable        (Foldable)
 import qualified Data.List            as L
 import           Data.Monoid          (Monoid, mconcat, mempty, (<>))
 import           Data.String          (IsString (..))
+import qualified Data.Text            as T
 import           Data.Traversable     (Traversable, traverse)
 import qualified System.Console.ANSI  as Ansi
 import qualified System.IO            as IO
@@ -111,8 +103,14 @@ chunkLines chunks = case break (== NewlineChunk) chunks of
 --------------------------------------------------------------------------------
 data DocE
     = String String
-    | Space
-    | Newline
+    | Softspace
+    | Hardspace
+    | Softline
+    | Hardline
+    | WrapAt
+        { wrapAtCol :: Maybe Int
+        , wrapDoc   :: Doc
+        }
     | Ansi
         { ansiCode :: [Ansi.SGR] -> [Ansi.SGR]  -- ^ Modifies current codes.
         , ansiDoc  :: Doc
@@ -126,7 +124,7 @@ data DocE
 
 --------------------------------------------------------------------------------
 chunkToDocE :: Chunk -> DocE
-chunkToDocE NewlineChunk            = Newline
+chunkToDocE NewlineChunk            = Hardline
 chunkToDocE (StringChunk codes str) = Ansi (\_ -> codes) (Doc [String str])
 
 
@@ -149,6 +147,7 @@ instance Show Doc where
 data DocEnv = DocEnv
     { deCodes  :: [Ansi.SGR]  -- ^ Most recent ones first in the list
     , deIndent :: LineBuffer  -- ^ Don't need to store first-line indent
+    , deWrap   :: Maybe Int   -- ^ Wrap at columns
     }
 
 
@@ -182,7 +181,7 @@ bufferToChunks = map trimmableToChunk . reverse . dropWhile isTrimmable
 --------------------------------------------------------------------------------
 docToChunks :: Doc -> Chunks
 docToChunks doc0 =
-    let env0        = DocEnv [] []
+    let env0        = DocEnv [] [] Nothing
         ((), b, cs) = runRWS (go $ unDoc doc0) env0 mempty in
     optimizeChunks (cs <> bufferToChunks b)
   where
@@ -195,18 +194,30 @@ docToChunks doc0 =
         modify (NotTrimmable chunk :)
         go docs
 
-    go (Space : docs) = do
+    go (Softspace : docs) = do
+        hard <- softConversion Softspace docs
+        go (hard : docs)
+
+    go (Hardspace : docs) = do
         chunk <- makeChunk " "
         modify (NotTrimmable chunk :)
         go docs
 
-    go (Newline : docs) = do
+    go (Softline : docs) = do
+        hard <- softConversion Softline docs
+        go (hard : docs)
+
+    go (Hardline : docs) = do
         buffer <- get
         tell $ bufferToChunks buffer <> [NewlineChunk]
         indentation <- asks deIndent
         modify $ \_ -> if L.null docs then [] else indentation
         go docs
 
+    go (WrapAt {..} : docs) = do
+        local (\env -> env {deWrap = wrapAtCol}) $ go (unDoc wrapDoc)
+        go docs
+
     go (Ansi {..} : docs) = do
         local (\env -> env {deCodes = ansiCode (deCodes env)}) $
             go (unDoc ansiDoc)
@@ -223,6 +234,40 @@ docToChunks doc0 =
         codes <- asks deCodes
         return $ StringChunk codes str
 
+    -- Convert 'Softspace' or 'Softline' to 'Hardspace' or 'Hardline'
+    softConversion :: DocE -> [DocE] -> DocM DocE
+    softConversion soft docs = do
+        mbWrapCol <- asks deWrap
+        case mbWrapCol of
+            Nothing     -> return hard
+            Just maxCol -> do
+                -- Slow.
+                currentLine <- gets (concatMap chunkToString . bufferToChunks)
+                let currentCol = length currentLine
+                case nextWordLength docs of
+                    Nothing                            -> return hard
+                    Just l
+                        | currentCol + 1 + l <= maxCol -> return Hardspace
+                        | otherwise                    -> return Hardline
+      where
+        hard = case soft of
+            Softspace -> Hardspace
+            Softline  -> Hardline
+            _         -> soft
+
+    nextWordLength :: [DocE] -> Maybe Int
+    nextWordLength []                 = Nothing
+    nextWordLength (String x : xs)
+        | L.null x                    = nextWordLength xs
+        | otherwise                   = Just (length x)
+    nextWordLength (Softspace : xs)   = nextWordLength xs
+    nextWordLength (Hardspace : xs)   = nextWordLength xs
+    nextWordLength (Softline : xs)    = nextWordLength xs
+    nextWordLength (Hardline : _)     = Nothing
+    nextWordLength (WrapAt {..} : xs) = nextWordLength (unDoc wrapDoc   ++ xs)
+    nextWordLength (Ansi   {..} : xs) = nextWordLength (unDoc ansiDoc   ++ xs)
+    nextWordLength (Indent {..} : xs) = nextWordLength (unDoc indentDoc ++ xs)
+
 
 --------------------------------------------------------------------------------
 toString :: Doc -> String
@@ -263,13 +308,28 @@ string = mkDoc . String  -- TODO (jaspervdj): Newline conversion
 
 
 --------------------------------------------------------------------------------
+text :: T.Text -> Doc
+text = string . T.unpack
+
+
+--------------------------------------------------------------------------------
 space :: Doc
-space = mkDoc Space
+space = mkDoc Softspace
+
+
+--------------------------------------------------------------------------------
+softline :: Doc
+softline = mkDoc Softline
 
 
 --------------------------------------------------------------------------------
-newline :: Doc
-newline = mkDoc Newline
+hardline :: Doc
+hardline = mkDoc Hardline
+
+
+--------------------------------------------------------------------------------
+wrapAt :: Maybe Int -> Doc -> Doc
+wrapAt wrapAtCol wrapDoc = mkDoc WrapAt {..}
 
 
 --------------------------------------------------------------------------------
@@ -282,6 +342,11 @@ indent firstLineDoc otherLinesDoc doc = mkDoc $ Indent
 
 
 --------------------------------------------------------------------------------
+ansi :: [Ansi.SGR] -> Doc -> Doc
+ansi codes =  mkDoc . Ansi (codes ++)
+
+
+--------------------------------------------------------------------------------
 (<+>) :: Doc -> Doc -> Doc
 x <+> y = x <> space <> y
 infixr 6 <+>
@@ -289,60 +354,13 @@ infixr 6 <+>
 
 --------------------------------------------------------------------------------
 (<$$>) :: Doc -> Doc -> Doc
-x <$$> y = x <> newline <> y
+x <$$> y = x <> hardline <> y
 infixr 5 <$$>
 
 
 --------------------------------------------------------------------------------
 vcat :: [Doc] -> Doc
-vcat = mconcat . L.intersperse newline
-
-
---------------------------------------------------------------------------------
-bold :: Doc -> Doc
-bold = mkDoc . Ansi
-    (\codes -> Ansi.SetConsoleIntensity Ansi.BoldIntensity : codes)
-
-
---------------------------------------------------------------------------------
-underline :: Doc -> Doc
-underline = mkDoc . Ansi
-    (\codes -> Ansi.SetUnderlining Ansi.SingleUnderline : codes)
-
-
---------------------------------------------------------------------------------
-dullcolor :: Ansi.Color -> Doc -> Doc
-dullcolor c = mkDoc . Ansi
-    (\codes -> Ansi.SetColor Ansi.Foreground Ansi.Dull c : codes)
-
-
---------------------------------------------------------------------------------
-dullblack, dullred, dullgreen, dullyellow, dullblue, dullmagenta, dullcyan,
-    dullwhite :: Doc -> Doc
-dullblack   = dullcolor Ansi.Black
-dullred     = dullcolor Ansi.Red
-dullgreen   = dullcolor Ansi.Green
-dullyellow  = dullcolor Ansi.Yellow
-dullblue    = dullcolor Ansi.Blue
-dullmagenta = dullcolor Ansi.Magenta
-dullcyan    = dullcolor Ansi.Cyan
-dullwhite   = dullcolor Ansi.White
-
-
---------------------------------------------------------------------------------
-ondullcolor :: Ansi.Color -> Doc -> Doc
-ondullcolor c = mkDoc . Ansi
-    (\codes -> Ansi.SetColor Ansi.Background Ansi.Dull c : codes)
-
-
---------------------------------------------------------------------------------
-ondullblack :: Doc -> Doc
-ondullblack = ondullcolor Ansi.Black
-
-
---------------------------------------------------------------------------------
-ondullred :: Doc -> Doc
-ondullred = ondullcolor Ansi.Red
+vcat = mconcat . L.intersperse hardline
 
 
 --------------------------------------------------------------------------------
diff --git a/src/Patat/Theme.hs b/src/Patat/Theme.hs
new file mode 100644
index 0000000..e3aeb17
--- /dev/null
+++ b/src/Patat/Theme.hs
@@ -0,0 +1,192 @@
+--------------------------------------------------------------------------------
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE OverloadedStrings          #-}
+{-# LANGUAGE TemplateHaskell            #-}
+module Patat.Theme
+    ( Theme (..)
+    , defaultTheme
+    , Style (..)
+    ) where
+
+
+--------------------------------------------------------------------------------
+import           Control.Monad          (mplus)
+import qualified Data.Aeson             as A
+import qualified Data.Aeson.TH.Extended as A
+import           Data.Char              (toUpper)
+import           Data.List              (intercalate)
+import qualified Data.Map               as M
+import           Data.Maybe             (mapMaybe, maybeToList)
+import           Data.Monoid            (Monoid (..), (<>))
+import qualified Data.Text              as T
+import qualified System.Console.ANSI    as Ansi
+import           Prelude
+
+
+--------------------------------------------------------------------------------
+data Theme = Theme
+    { themeBorders           :: !(Maybe Style)
+    , themeHeader            :: !(Maybe Style)
+    , themeCodeBlock         :: !(Maybe Style)
+    , themeBulletList        :: !(Maybe Style)
+    , themeBulletListMarkers :: !(Maybe T.Text)
+    , themeOrderedList       :: !(Maybe Style)
+    , themeBlockQuote        :: !(Maybe Style)
+    , themeDefinitionTerm    :: !(Maybe Style)
+    , themeDefinitionList    :: !(Maybe Style)
+    , themeTableHeader       :: !(Maybe Style)
+    , themeTableSeparator    :: !(Maybe Style)
+    , themeEmph              :: !(Maybe Style)
+    , themeStrong            :: !(Maybe Style)
+    , themeCode              :: !(Maybe Style)
+    , themeLinkText          :: !(Maybe Style)
+    , themeLinkTarget        :: !(Maybe Style)
+    , themeStrikeout         :: !(Maybe Style)
+    , themeQuoted            :: !(Maybe Style)
+    , themeMath              :: !(Maybe Style)
+    , themeImageText         :: !(Maybe Style)
+    , themeImageTarget       :: !(Maybe Style)
+    } deriving (Show)
+
+
+--------------------------------------------------------------------------------
+instance Monoid Theme where
+    mempty = Theme
+        Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
+        Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
+        Nothing Nothing Nothing
+
+    mappend l r = Theme
+        { themeBorders           = mplusOn themeBorders
+        , themeHeader            = mplusOn themeHeader
+        , themeCodeBlock         = mplusOn themeCodeBlock
+        , themeBulletList        = mplusOn themeBulletList
+        , themeBulletListMarkers = mplusOn themeBulletListMarkers
+        , themeOrderedList       = mplusOn themeOrderedList
+        , themeBlockQuote        = mplusOn themeBlockQuote
+        , themeDefinitionTerm    = mplusOn themeDefinitionTerm
+        , themeDefinitionList    = mplusOn themeDefinitionList
+        , themeTableHeader       = mplusOn themeTableHeader
+        , themeTableSeparator    = mplusOn themeTableSeparator
+        , themeEmph              = mplusOn themeEmph
+        , themeStrong            = mplusOn themeStrong
+        , themeCode              = mplusOn themeCode
+        , themeLinkText          = mplusOn themeLinkText
+        , themeLinkTarget        = mplusOn themeLinkTarget
+        , themeStrikeout         = mplusOn themeStrikeout
+        , themeQuoted            = mplusOn themeQuoted
+        , themeMath              = mplusOn themeMath
+        , themeImageText         = mplusOn themeImageText
+        , themeImageTarget       = mplusOn themeImageTarget
+        }
+      where
+        mplusOn f = f l `mplus` f r
+
+
+--------------------------------------------------------------------------------
+defaultTheme :: Theme
+defaultTheme = Theme
+    { themeBorders           = dull Ansi.Yellow
+    , themeHeader            = dull Ansi.Blue
+    , themeCodeBlock         = dull Ansi.White <> ondull Ansi.Black
+    , themeBulletList        = dull Ansi.Magenta
+    , themeBulletListMarkers = Just "-*"
+    , themeOrderedList       = dull Ansi.Magenta
+    , themeBlockQuote        = dull Ansi.Green
+    , themeDefinitionTerm    = dull Ansi.Blue
+    , themeDefinitionList    = dull Ansi.Magenta
+    , themeTableHeader       = dull Ansi.Blue
+    , themeTableSeparator    = dull Ansi.Magenta
+    , themeEmph              = dull Ansi.Green
+    , themeStrong            = dull Ansi.Red <> bold
+    , themeCode              = dull Ansi.White <> ondull Ansi.Black
+    , themeLinkText          = dull Ansi.Green
+    , themeLinkTarget        = dull Ansi.Cyan <> underline
+    , themeStrikeout         = ondull Ansi.Red
+    , themeQuoted            = dull Ansi.Green
+    , themeMath              = dull Ansi.Green
+    , themeImageText         = dull Ansi.Green
+    , themeImageTarget       = dull Ansi.Cyan <> underline
+    }
+  where
+    dull   c  = Just $ Style [Ansi.SetColor Ansi.Foreground Ansi.Dull c]
+    ondull c  = Just $ Style [Ansi.SetColor Ansi.Background Ansi.Dull c]
+    bold      = Just $ Style [Ansi.SetConsoleIntensity Ansi.BoldIntensity]
+    underline = Just $ Style [Ansi.SetUnderlining Ansi.SingleUnderline]
+
+
+--------------------------------------------------------------------------------
+newtype Style = Style {unStyle :: [Ansi.SGR]}
+    deriving (Monoid, Show)
+
+
+--------------------------------------------------------------------------------
+instance A.ToJSON Style where
+    toJSON = A.toJSON . mapMaybe nameForSGR . unStyle
+
+
+--------------------------------------------------------------------------------
+instance A.FromJSON Style where
+    parseJSON val = do
+        names <- A.parseJSON val
+        sgrs  <- mapM toSgr names
+        return $! Style sgrs
+      where
+        toSgr name = case M.lookup name sgrsByName of
+            Just sgr -> return sgr
+            Nothing  -> fail $!
+                "Unknown style: " ++ show name ++ ". Known styles are: " ++
+                intercalate ", " (map show $ M.keys sgrsByName)
+
+
+--------------------------------------------------------------------------------
+nameForSGR :: Ansi.SGR -> Maybe String
+nameForSGR (Ansi.SetColor layer intensity color) = Just $
+    (\str -> case layer of
+        Ansi.Foreground -> str
+        Ansi.Background -> "on" ++ capitalize str) $
+    (case intensity of
+        Ansi.Dull  -> "dull"
+        Ansi.Vivid -> "vivid") ++
+    (case color of
+        Ansi.Black   -> "Black"
+        Ansi.Red     -> "Red"
+        Ansi.Green   -> "Green"
+        Ansi.Yellow  -> "Yellow"
+        Ansi.Blue    -> "Blue"
+        Ansi.Magenta -> "Magenta"
+        Ansi.Cyan    -> "Cyan"
+        Ansi.White   -> "White")
+  where
+    capitalize ""       = ""
+    capitalize (x : xs) = toUpper x : xs
+
+nameForSGR (Ansi.SetUnderlining Ansi.SingleUnderline) = Just "underline"
+
+nameForSGR (Ansi.SetConsoleIntensity Ansi.BoldIntensity) = Just "bold"
+
+nameForSGR _ = Nothing
+
+
+--------------------------------------------------------------------------------
+sgrsByName :: M.Map String Ansi.SGR
+sgrsByName = M.fromList
+    [ (name, sgr)
+    | sgr  <- knownSgrs
+    , name <- maybeToList (nameForSGR sgr)
+    ]
+  where
+    -- | It doesn't really matter if we generate "too much" SGRs here since
+    -- 'nameForSGR' will only pick the ones we support.
+    knownSgrs =
+        [ Ansi.SetColor l i c
+        | l <- [minBound .. maxBound]
+        , i <- [minBound .. maxBound]
+        , c <- [minBound .. maxBound]
+        ] ++
+        [Ansi.SetUnderlining      u | u <- [minBound .. maxBound]] ++
+        [Ansi.SetConsoleIntensity c | c <- [minBound .. maxBound]]
+
+
+--------------------------------------------------------------------------------
+$(A.deriveJSON A.dropPrefixOptions ''Theme)
diff --git a/src/Text/Pandoc/Extended.hs b/src/Text/Pandoc/Extended.hs
index eb01245..ab139a9 100644
--- a/src/Text/Pandoc/Extended.hs
+++ b/src/Text/Pandoc/Extended.hs
@@ -1,21 +1,50 @@
-{-# LANGUAGE LambdaCase #-}
+--------------------------------------------------------------------------------
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE LambdaCase   #-}
 module Text.Pandoc.Extended
     ( module Text.Pandoc
 
     , plainToPara
     , newlineToSpace
+    , metaToJson
     ) where
 
-import Text.Pandoc
-import Data.Data.Extended (grecT)
 
+--------------------------------------------------------------------------------
+import qualified Data.Aeson         as A
+import           Data.Data.Extended (grecT)
+import qualified Data.Map           as M
+import           Data.Monoid        (mempty)
+import           Text.Pandoc
+import           Prelude
+
+
+--------------------------------------------------------------------------------
 plainToPara :: [Block] -> [Block]
 plainToPara = map $ \case
     Plain inlines -> Para inlines
     block         -> block
 
+
+--------------------------------------------------------------------------------
 newlineToSpace :: [Inline] -> [Inline]
 newlineToSpace = grecT $ \case
     SoftBreak -> Space
     LineBreak -> Space
     inline    -> inline
+
+
+--------------------------------------------------------------------------------
+-- | Convert Pandoc's internal metadata value format to JSON.  This makes
+-- parsing some things a bit easier.
+metaToJson :: MetaValue -> A.Value
+metaToJson (MetaMap     m) = A.toJSON $! M.map metaToJson m
+metaToJson (MetaList    l) = A.toJSON $! map metaToJson l
+metaToJson (MetaBool    b) = A.toJSON b
+metaToJson (MetaString  s) = A.toJSON s
+metaToJson (MetaInlines i) =
+    let !t = writeMarkdown def (Pandoc mempty [Plain i]) :: String in
+    A.toJSON t
+metaToJson (MetaBlocks  b) =
+    let !t = writeMarkdown def (Pandoc mempty b) :: String in
+    A.toJSON t