diff --git a/doc/LICENSE b/doc/LICENSE new file mode 100644 index 0000000..62c83ca --- /dev/null +++ b/doc/LICENSE @@ -0,0 +1,30 @@ +Copyright Stefan Dresselhaus (c) 2017 + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Author name here nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/doc/Text-Pandoc-Util-Filter-Cols.html b/doc/Text-Pandoc-Util-Filter-Cols.html index e3dd7ea..dba0cc5 100644 --- a/doc/Text-Pandoc-Util-Filter-Cols.html +++ b/doc/Text-Pandoc-Util-Filter-Cols.html @@ -2,7 +2,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_Text-Pandoc-Util-Filter-Cols.html");}; //]]>

pandoc-slide-filter-0.1.0.0

Safe HaskellNone
LanguageHaskell2010

Text.Pandoc.Util.Filter.Cols

Description

Conversion of lvl-x-headings to x-column-layouts in HTML - especially for use in revealjs-slides

Synopsis

Documentation

cols :: [Block] -> [Block] Source #

This filter makes multi-column-layouts out of lvl-x-headings

Syntax is

    ## a b
+   especially for use in revealjs-slides

Synopsis

  • cols :: [Block] -> [Block]

Documentation

cols :: [Block] -> [Block] Source #

This filter makes multi-column-layouts out of lvl-x-headings

Syntax is

    ## a b
 

yielding a 2-column-layout with aspects a:b i.e. 1:1 for 50/50-layout or 8:2 for 80/20 layout

currently works for 2 and 3-columns, but extension is straight-forward.

If you need multiple Block-Elements inside one column, just wrap them with a <div>:

    ## 2 5
diff --git a/doc/Text-Pandoc-Util-Filter-Media.html b/doc/Text-Pandoc-Util-Filter-Media.html
index 0d20d9d..b079aa5 100644
--- a/doc/Text-Pandoc-Util-Filter-Media.html
+++ b/doc/Text-Pandoc-Util-Filter-Media.html
@@ -1,7 +1,7 @@
 Text.Pandoc.Util.Filter.Media

pandoc-slide-filter-0.1.0.0

Safe HaskellNone
LanguageHaskell2010

Text.Pandoc.Util.Filter.Media

Synopsis

Documentation

media :: Inline -> IO [Inline] Source #

main media-plugin.

Will convert the following syntax

![](foo.aac){#audio}
+

pandoc-slide-filter-0.1.0.0

Safe HaskellNone
LanguageHaskell2010

Text.Pandoc.Util.Filter.Media

Synopsis

  • media :: Inline -> IO [Inline]

Documentation

media :: Inline -> IO [Inline] Source #

main media-plugin.

Will convert the following syntax

![](foo.aac){#audio}
 ![](foo.mp4){#video}
 ![](foo.png){#img}
 ![](foo.svg){#svg}
diff --git a/doc/Text-Pandoc-Util-Filter-Quiz.html b/doc/Text-Pandoc-Util-Filter-Quiz.html
index 6f9d728..266ac54 100644
--- a/doc/Text-Pandoc-Util-Filter-Quiz.html
+++ b/doc/Text-Pandoc-Util-Filter-Quiz.html
@@ -1,4 +1,4 @@
 Text.Pandoc.Util.Filter.Quiz

pandoc-slide-filter-0.1.0.0

Safe HaskellNone
LanguageHaskell2010

Text.Pandoc.Util.Filter.Quiz

Documentation

\ No newline at end of file +

pandoc-slide-filter-0.1.0.0

Safe HaskellNone
LanguageHaskell2010

Text.Pandoc.Util.Filter.Quiz

Documentation

quiz :: Block -> [Block] Source #

\ No newline at end of file diff --git a/doc/Text-Pandoc-Util-Filter-Styling.html b/doc/Text-Pandoc-Util-Filter-Styling.html index b1b5bf4..c823ab2 100644 --- a/doc/Text-Pandoc-Util-Filter-Styling.html +++ b/doc/Text-Pandoc-Util-Filter-Styling.html @@ -1,5 +1,5 @@ Text.Pandoc.Util.Filter.Styling

pandoc-slide-filter-0.1.0.0

Safe HaskellNone
LanguageHaskell2010

Text.Pandoc.Util.Filter.Styling

Documentation

styling :: Block -> IO [Block] Source #

Block-Styling

Special cases captured:

  • #col turns a div into a floating-div for multiple columns
  • CodeBlock gets attributes data-trim and data-noescape - automatically
  • .fragment and .frame work properly on divs

inlineStyling :: Inline -> Inline Source #

Inline-Styling

Special cases captured:

  • .fragment and .frame work properly on spans
  • .vspace inside span adds a vertical space with height=xxx
  • .hspace inside span adds a horizontal space with width=xxx
\ No newline at end of file +

pandoc-slide-filter-0.1.0.0

Safe HaskellNone
LanguageHaskell2010

Text.Pandoc.Util.Filter.Styling

Synopsis

Documentation

styling :: Block -> IO [Block] Source #

Block-Styling

Special cases captured:

  • #col turns a div into a floating-div for multiple columns
  • CodeBlock gets attributes data-trim and data-noescape + automatically
  • .fragment and .frame work properly on divs

inlineStyling :: Inline -> Inline Source #

Inline-Styling

Special cases captured:

  • .fragment and .frame work properly on spans
  • .vspace inside span adds a vertical space with height=xxx
  • .hspace inside span adds a horizontal space with width=xxx
\ No newline at end of file diff --git a/doc/Text-Pandoc-Util-Filter.html b/doc/Text-Pandoc-Util-Filter.html index a01e33c..9ead560 100644 --- a/doc/Text-Pandoc-Util-Filter.html +++ b/doc/Text-Pandoc-Util-Filter.html @@ -1,19 +1,23 @@ Text.Pandoc.Util.Filter

pandoc-slide-filter-0.1.0.0

Safe HaskellNone
LanguageHaskell2010

Text.Pandoc.Util.Filter

Documentation

attToString :: Attr -> String Source #

converts Attributes to String for usage in HTML

Also converts width=xxx and height=xxx to the - corresponding style-attributes

revealjsSpecialAttrs :: [String] Source #

revealjs has some special attributes that has to be +

pandoc-slide-filter-0.1.0.0

Safe HaskellNone
LanguageHaskell2010

Text.Pandoc.Util.Filter

Synopsis

Documentation

attToString :: Attr -> String Source #

converts Attributes to String for usage in HTML

Also converts width=xxx and height=xxx to the + corresponding style-attributes

convertToStyle :: [String] -> [(String, String)] -> [(String, String)] Source #

helper function for attToString, but can also be used + if you want to extract styles from kv-pair

revealjsSpecialAttrs :: [String] Source #

revealjs has some special attributes that has to be passed to the html, but Pandoc only allows key=value-attributes, so we have to abuse .class to rewrite them.

The classes that get rewritten are listed here.

You probably want classToRevealAttr, as that - is a wrapper for splitting the class-attribute

classToRevealAttr :: [String] -> ([String], [String]) Source #

revealjs has some special attributes that has to be + is a wrapper for splitting the class-attribute

revealjsRewriteAttr :: [String] -> [String] Source #

HTML allows for some attributes (i.e. autoplay) + for which revealjs offers a special version + (i.e. only autoplaying on active slide). + These are the things that get rewritten

classToRevealAttr :: [String] -> ([String], [String]) Source #

revealjs has some special attributes that has to be passed to the html, but Pandoc only allows key=value-attributes, so we have to abuse .class to rewrite them.

This is a wrapper-function which just splits the list - into real classes and revealjsSpecialAttrs

toHtml :: String -> Inline Source #

small wrapper around RawInline (Format "html") + into real classes and revealjsSpecialAttrs

toHtml :: String -> Inline Source #

small wrapper around RawInline (Format "html") as this is less line-noise in the filters and the - intent is more clear.

toBlockHtml :: String -> Block Source #

small wrapper around Raw (Format "html") + intent is more clear.

toBlockHtml :: String -> Block Source #

small wrapper around Raw (Format "html") as this is less line-noise in the filters and the - intent is more clear.

addToAtt :: Eq a => a -> [a] -> [a] Source #

adds a given String to the list if not in there; Does nothing if the - given String is already present.

addToStyle :: String -> [(String, String)] -> [(String, String)] Source #

adds given String to List of key-value-pairs (like in Attr) + intent is more clear.

addToAtt :: Eq a => a -> [a] -> [a] Source #

adds a given String to the list if not in there; Does nothing if the + given String is already present.

addToStyle :: String -> [(String, String)] -> [(String, String)] Source #

adds given String to List of key-value-pairs (like in Attr) in the "style"-Key.

Useful when trying to add CSS-styles directly to (generated) elements

\ No newline at end of file diff --git a/doc/doc-index.html b/doc/doc-index.html index 6cee2ff..1f5b0a3 100644 --- a/doc/doc-index.html +++ b/doc/doc-index.html @@ -1,4 +1,4 @@ pandoc-slide-filter-0.1.0.0 (Index)

pandoc-slide-filter-0.1.0.0

\ No newline at end of file +

pandoc-slide-filter-0.1.0.0

\ No newline at end of file diff --git a/doc/mini_Text-Pandoc-Util-Filter.html b/doc/mini_Text-Pandoc-Util-Filter.html index e26eafe..0753cd0 100644 --- a/doc/mini_Text-Pandoc-Util-Filter.html +++ b/doc/mini_Text-Pandoc-Util-Filter.html @@ -1,4 +1,4 @@ Text.Pandoc.Util.Filter

Text.Pandoc.Util.Filter

\ No newline at end of file +

Text.Pandoc.Util.Filter

\ No newline at end of file diff --git a/doc/pandoc-slide-filter.haddock b/doc/pandoc-slide-filter.haddock index 07b4959..9f4107e 100644 Binary files a/doc/pandoc-slide-filter.haddock and b/doc/pandoc-slide-filter.haddock differ diff --git a/doc/pandoc-slide-filter.txt b/doc/pandoc-slide-filter.txt new file mode 100644 index 0000000..7e63aca --- /dev/null +++ b/doc/pandoc-slide-filter.txt @@ -0,0 +1,146 @@ +-- Hoogle documentation, generated by Haddock +-- See Hoogle, http://www.haskell.org/hoogle/ + + +@package pandoc-slide-filter +@version 0.1.0.0 + +module Text.Pandoc.Util.Filter.Quiz +quiz :: Block -> [Block] + +module Text.Pandoc.Util.Filter + +-- | converts Attributes to String for usage in HTML +-- +-- Also converts width=xxx and height=xxx to the +-- corresponding style-attributes +attToString :: Attr -> String + +-- | helper function for attToString, but can also be used if you +-- want to extract styles from kv-pair +convertToStyle :: [String] -> [(String, String)] -> [(String, String)] + +-- | revealjs has some special attributes that has to be passed to the +-- html, but Pandoc only allows key=value-attributes, so we have +-- to abuse .class to rewrite them. +-- +-- The classes that get rewritten are listed here. +-- +-- You probably want classToRevealAttr, as that is a wrapper for +-- splitting the class-attribute +revealjsSpecialAttrs :: [String] + +-- | HTML allows for some attributes (i.e. autoplay) for which revealjs +-- offers a special version (i.e. only autoplaying on active slide). +-- These are the things that get rewritten +revealjsRewriteAttr :: [String] -> [String] + +-- | revealjs has some special attributes that has to be passed to the +-- html, but Pandoc only allows key=value-attributes, so we have +-- to abuse .class to rewrite them. +-- +-- This is a wrapper-function which just splits the list into real +-- classes and revealjsSpecialAttrs +classToRevealAttr :: [String] -> ([String], [String]) + +-- | small wrapper around RawInline (Format "html") as this is +-- less line-noise in the filters and the intent is more clear. +toHtml :: String -> Inline + +-- | small wrapper around Raw (Format "html") as this is less +-- line-noise in the filters and the intent is more clear. +toBlockHtml :: String -> Block + +-- | adds a given String to the list if not in there; Does nothing if the +-- given String is already present. +addToAtt :: Eq a => a -> [a] -> [a] + +-- | adds given String to List of key-value-pairs (like in Attr) in +-- the "style"-Key. +-- +-- Useful when trying to add CSS-styles directly to (generated) elements +addToStyle :: String -> [(String, String)] -> [(String, String)] + + +-- | Conversion of lvl-x-headings to x-column-layouts in HTML especially +-- for use in revealjs-slides +module Text.Pandoc.Util.Filter.Cols + +-- | This filter makes multi-column-layouts out of lvl-x-headings +-- +-- Syntax is +-- +--
+--   ## a b
+--   
+-- +-- yielding a 2-column-layout with aspects a:b i.e. 1:1 for 50/50-layout +-- or 8:2 for 80/20 layout +-- +-- currently works for 2 and 3-columns, but extension is +-- straight-forward. +-- +-- If you need multiple Block-Elements inside one column, just wrap them +-- with a <div>: +-- +--
+--   ## 2 5
+--   
+--   <div>
+--   multiple things
+--   ```
+--   foo
+--   ```
+--    
+--   </div>
+--   
+--   second column here with only 1 element.
+--   
+cols :: [Block] -> [Block] + +module Text.Pandoc.Util.Filter.Media + +-- | main media-plugin. +-- +-- Will convert the following syntax +-- +--
+--   ![](foo.aac){#audio}
+--   ![](foo.mp4){#video}
+--   ![](foo.png){#img}
+--   ![](foo.svg){#svg}
+--   ![](foo.html){#demo}
+--   
+-- +-- HTML-id's maybe ommitted if the file-extension is in whitelist. +-- +-- If a type is detected by extension a custom id (not matching the +-- extension) will be preserved. +media :: Inline -> IO [Inline] + +module Text.Pandoc.Util.Filter.Styling + +-- | Block-Styling +-- +-- Special cases captured: +-- +--
    +--
  • #col turns a div into a floating-div for multiple columns
  • +--
  • CodeBlock gets attributes data-trim and +-- data-noescape automatically
  • +--
  • .fragment and .frame work properly on divs
  • +--
+styling :: Block -> IO [Block] + +-- | Inline-Styling +-- +-- Special cases captured: +-- +--
    +--
  • .fragment and .frame work properly on spans
  • +--
  • .vspace inside span adds a vertical space with +-- height=xxx
  • +--
  • .hspace inside span adds a horizontal space with +-- width=xxx
  • +--
+inlineStyling :: Inline -> Inline diff --git a/doc/src/Text.Pandoc.Util.Filter.Cols.html b/doc/src/Text.Pandoc.Util.Filter.Cols.html index c052980..b251360 100644 --- a/doc/src/Text.Pandoc.Util.Filter.Cols.html +++ b/doc/src/Text.Pandoc.Util.Filter.Cols.html @@ -42,37 +42,37 @@ -- second column here with only 1 element. -- @ cols :: [Block] -> [Block] -cols (Header 2 attr [Str wa,Space,Str wb]:a:b:rest) = - outerDiv:rest +cols (Header 2 attr [Str wa,Space,Str wb]:a:b:rest) = + outerDiv:rest where - wa' = fromMaybe 1 (readMaybe wa) :: Int - wb' = fromMaybe 1 (readMaybe wb) :: Int - total = wa' + wb' - pa = (100*wa') `div` total - pb = (100*wb') `div` total - outerDiv = Div attr [ makeDiv pa a - , makeDiv pb b + wa' = fromMaybe 1 (readMaybe wa) :: Int + wb' = fromMaybe 1 (readMaybe wb) :: Int + total = wa' + wb' + pa = (100*wa') `div` total + pb = (100*wb') `div` total + outerDiv = Div attr [ makeDiv pa a + , makeDiv pb b , clearDiv ] -cols (Header 3 attr [Str wa,Space,Str wb,Space,Str wc]:a:b:c:rest) = - outerDiv:rest +cols (Header 3 attr [Str wa,Space,Str wb,Space,Str wc]:a:b:c:rest) = + outerDiv:rest where - wa' = fromMaybe 1 (readMaybe wa) :: Int - wb' = fromMaybe 1 (readMaybe wb) :: Int - wc' = fromMaybe 1 (readMaybe wc) :: Int - total = wa' + wb' + wc' - pa = (100*wa') `div` total - pb = (100*wb') `div` total - pc = (100*wc') `div` total - outerDiv = Div attr [ makeDiv pa a - , makeDiv pb b - , makeDiv pc c + wa' = fromMaybe 1 (readMaybe wa) :: Int + wb' = fromMaybe 1 (readMaybe wb) :: Int + wc' = fromMaybe 1 (readMaybe wc) :: Int + total = wa' + wb' + wc' + pa = (100*wa') `div` total + pb = (100*wb') `div` total + pc = (100*wc') `div` total + outerDiv = Div attr [ makeDiv pa a + , makeDiv pb b + , makeDiv pc c , clearDiv ] -cols x = x +cols x = x makeDiv :: Int -> Block -> Block -makeDiv width content = Div ("", [], [("style","width:" <> show width <> "%;float:left")]) [content] +makeDiv width content = Div ("", [], [("style","width:" <> show width <> "%;float:left")]) [content] clearDiv :: Block clearDiv = Div ("", [], [("style", "clear: both")]) [Plain [toHtml "&nbsp;"]] diff --git a/doc/src/Text.Pandoc.Util.Filter.Media.html b/doc/src/Text.Pandoc.Util.Filter.Media.html index 8869272..372c661 100644 --- a/doc/src/Text.Pandoc.Util.Filter.Media.html +++ b/doc/src/Text.Pandoc.Util.Filter.Media.html @@ -4,156 +4,164 @@ (media) where -import Text.Pandoc.JSON -import Control.Exception -import Data.Monoid ((<>)) -import Data.Char (toLower) +import Control.Exception +import Data.Char (toLower) +import Data.List (intercalate) +import Data.Monoid ((<>)) import System.FilePath - -import Text.Pandoc.Util.Filter - -{-# ANN module "HLint: ignore Redundant $" #-} -- supress HLint-Warnings about $ - --- | File-extensions that should be treated as audio -audioExt :: [String] -audioExt = ["mp3","aac"] - --- | File-extensions that should be treated as video -videoExt :: [String] -videoExt = [ "avi" - , "mp4" - , "mov" - ] - --- | File-extensions that should be treated as image -imgExt :: [String] -imgExt = - [ "jpg" - , "jpeg" - , "png" - , "gif" - , "tif" - , "tiff" - , "bmp" - , "svg" - ] - --- | File-extensions that should be treated as demo and will be included --- in an iframe -demoExt :: [String] -demoExt = ["html", "htm"] - --- | main media-plugin. --- --- Will convert the following syntax --- --- @ --- ![](foo.aac){#audio} --- ![](foo.mp4){#video} --- ![](foo.png){#img} --- ![](foo.svg){#svg} --- ![](foo.html){#demo} --- @ --- --- HTML-id's maybe ommitted if the file-extension is in whitelist. --- --- If a type is detected by extension a custom id (not matching the extension) --- will be preserved. --- -media :: Inline -> IO [Inline] ---audio -media (Image (id',att,att') [] (filename,_)) - | id' == "audio" || checkExtension filename audioExt - = return $ [toHtml $ "<audio " <> unwords direct <> " src=\"" <> filename <> "\"" <> attToString (idFilter "audio" id',css,att') <> "></audio>"] - where - (direct, css) = classToRevealAttr att -media (Image (id',att,att') alt (filename,_)) - | id' == "audio" || checkExtension filename audioExt - = return $ [toHtml $ "<figure><audio " <> unwords direct <> " src=\"" <> filename <> "\"" <> attToString (idFilter "audio" id',css,att') <> "></audio>"] - <> [toHtml $ "<figcaption>"] - <> alt - <> [toHtml $ "</figcaption></figure>"] - where - (direct, css) = classToRevealAttr att ---videos -media (Image (id', att, att') [] (filename,_)) - | id' == "video" || checkExtension filename videoExt - = return $ [toHtml $ "<video " <> unwords direct <> " src=\"" <> filename <> "\"" <> attToString (idFilter "video" id',css,att') <> "></video>"] - where - (direct, css) = classToRevealAttr att -media (Image (id', att, att') alt (filename,_)) - | id' == "video" || checkExtension filename videoExt - = return $ [toHtml $ "<figure>"] - <> [toHtml $ "<video " <> unwords direct <> " src=\"" <> filename <> "\"" <> attToString (idFilter "video" id',css,att') <> "></video>"] - <> [toHtml $ "<figcaption>"] - <> alt - <> [toHtml $ "</figcaption></figure>"] - where - (direct, css) = classToRevealAttr att ---images -media (Image (id', att, att') [] (filename,_)) - | id' == "img" || checkExtension filename imgExt - = return $ [toHtml $ "<figure>"] - <> [toHtml $ "<img " <> unwords direct <> " src=\"" <> filename <> "\"" <> attToString (idFilter "img" id',css,att') <> "></img>"] - <> [toHtml $ "</figure>"] - where - (direct, css) = classToRevealAttr att -media (Image (id', att, att') alt (filename,_)) - | id' == "img" || checkExtension filename imgExt - = return $ [toHtml $ "<figure>"] - <> [toHtml $ "<img " <> unwords direct <> " src=\"" <> filename <> "\"" <> attToString (idFilter "img" id',css,att') <> "></img>"] - <> [toHtml $ "<figcaption>"] - <> alt - <> [toHtml $ "</figcaption></figure>"] - where - (direct, css) = classToRevealAttr att ---load svg and dump it in -media (Image (id', att, att') [] (filename,_)) - | id' == "svg" - = handle (\(fileerror :: IOException) -> return [toHtml $ "Could not read file: " <> filename <> "<br />" <> show fileerror]) $ - do - svg <- readFile filename - return $ [toHtml $ "<figure " <> unwords direct <> " " <> attToString (idFilter "svg" id', css, att') <> ">"] -- use attributes on figure, as svg gets dumped in.. - <> [toHtml $ svg] - <> [toHtml $ "</figure>"] - where - (direct, css) = classToRevealAttr att -media (Image (id', att, att') alt (filename,_)) - | id' == "svg" - = handle (\(fileerror :: IOException) -> return [toHtml $ "Could not read file: " <> filename <> "<br />" <> show fileerror]) $ - do - svg <- readFile filename - return $ [toHtml $ "<figure " <> unwords direct <> " " <> attToString (idFilter "svg" id', css, att') <> ">"] -- use attributes on figure, as svg gets dumped in.. - <> [toHtml $ svg] - <> [toHtml $ "<figcaption>"] - <> alt - <> [toHtml $ "</figcaption></figure>"] - where - (direct, css) = classToRevealAttr att ---html-demos etc. as IFrames -media (Image (id', att, att') [] (filename,_)) - | id' == "demo" || checkExtension filename demoExt - = return [toHtml $ "<iframe " <> unwords direct <> " src=\"" <> filename <> "?plugin\"" <> attToString (idFilter "demo" id', css, att') <> "></iframe>"] - where - (direct, css) = classToRevealAttr att -media (Image (id', att, att') alt (filename,_)) - | id' == "demo" || checkExtension filename demoExt - = return $ [toHtml $ "<figure>"] - <> [toHtml $ "<iframe " <> unwords direct <> " src=\"" <> filename <> "?plugin\"" <> attToString (idFilter "demo" id', css, att') <> "></iframe>"] - <> [toHtml $ "<figcaption>"] - <> alt - <> [toHtml $ "</figcaption></figure>"] - where - (direct, css) = classToRevealAttr att --- if not matched -media x = return [x] - -checkExtension :: String -> [String] -> Bool -checkExtension fn exts = (fmap toLower . tail . takeExtension) fn `elem` exts - -idFilter :: String -> String -> String -idFilter a b - | a == b = "" - | otherwise = b - -
\ No newline at end of file +import Text.Pandoc.JSON + +import Text.Pandoc.Util.Filter + +{-# ANN module "HLint: ignore Redundant $" #-} -- supress HLint-Warnings about $ + +-- | File-extensions that should be treated as audio +audioExt :: [String] +audioExt = ["mp3","aac"] + +-- | File-extensions that should be treated as video +videoExt :: [String] +videoExt = [ "avi" + , "mp4" + , "mov" + ] + +-- | File-extensions that should be treated as image +imgExt :: [String] +imgExt = + [ "jpg" + , "jpeg" + , "png" + , "gif" + , "tif" + , "tiff" + , "bmp" + , "svg" + ] + +-- | File-extensions that should be treated as demo and will be included +-- in an iframe +demoExt :: [String] +demoExt = ["html", "htm"] + +-- | main media-plugin. +-- +-- Will convert the following syntax +-- +-- @ +-- ![](foo.aac){#audio} +-- ![](foo.mp4){#video} +-- ![](foo.png){#img} +-- ![](foo.svg){#svg} +-- ![](foo.html){#demo} +-- @ +-- +-- HTML-id's maybe ommitted if the file-extension is in whitelist. +-- +-- If a type is detected by extension a custom id (not matching the extension) +-- will be preserved. +-- +media :: Inline -> IO [Inline] +--audio +media (Image (id',att,att') [] (filename,_)) + | id' == "audio" || checkExtension filename audioExt + = return $ [toHtml $ "<audio " <> unwords direct <> " src=\"" <> filename <> "\"" <> attToString (idFilter "audio" id',css,att') <> "></audio>"] + where + (direct, css) = (classToRevealAttr . revealjsRewriteAttr) att +media (Image (id',att,att') alt (filename,_)) + | id' == "audio" || checkExtension filename audioExt + = return $ [toHtml $ "<figure " <> attToString(idFilter "audio" id', css, att') <> "><audio " <> unwords direct <> " src=\"" <> filename <> "\"></audio>"] + <> [toHtml $ "<figcaption>"] + <> alt + <> [toHtml $ "</figcaption></figure>"] + where + (direct, css) = (classToRevealAttr . revealjsRewriteAttr) att +--videos +media (Image (id', att, att') [] (filename,_)) + | id' == "video" || checkExtension filename videoExt + = return $ [toHtml $ "<video " <> unwords direct <> " src=\"" <> filename <> "\"" <> attToString (idFilter "video" id',css,att') <> "></video>"] + where + (direct, css) = (classToRevealAttr . revealjsRewriteAttr) att +media (Image (id', att, att') alt (filename,_)) + | id' == "video" || checkExtension filename videoExt + = return $ [toHtml $ "<figure " <> attToString (idFilter "video" id',css,att') <> ">"] + <> [toHtml $ "<video " <> unwords direct <> " src=\"" <> filename <> "\" style=\"" <> style <> "\"></video>"] + <> [toHtml $ "<figcaption>"] + <> alt + <> [toHtml $ "</figcaption></figure>"] + where + (direct, css) = (classToRevealAttr . revealjsRewriteAttr) att + style = filterStyle att' +--load svg and dump it in +media (Image (id', att, att') [] (filename,_)) + | id' == "svg" + = handle (\(fileerror :: IOException) -> return [toHtml $ "Could not read file: " <> filename <> "<br />" <> show fileerror]) $ + do + svg <- readFile filename + return $ [toHtml $ "<figure " <> unwords direct <> " " <> attToString (idFilter "svg" id', css, att') <> ">"] -- use attributes on figure, as svg gets dumped in.. + <> [toHtml $ svg] + <> [toHtml $ "</figure>"] + where + (direct, css) = (classToRevealAttr . revealjsRewriteAttr) att +media (Image (id', att, att') alt (filename,_)) + | id' == "svg" + = handle (\(fileerror :: IOException) -> return [toHtml $ "Could not read file: " <> filename <> "<br />" <> show fileerror]) $ + do + svg <- readFile filename + return $ [toHtml $ "<figure " <> unwords direct <> " " <> attToString (idFilter "svg" id', css, att') <> ">"] -- use attributes on figure, as svg gets dumped in.. + <> [toHtml $ svg] + <> [toHtml $ "<figcaption>"] + <> alt + <> [toHtml $ "</figcaption></figure>"] + where + (direct, css) = (classToRevealAttr . revealjsRewriteAttr) att +--images +media (Image (id', att, att') [] (filename,_)) + | id' == "img" || checkExtension filename imgExt + = return $ [toHtml $ "<figure " <> attToString (idFilter "img" id',css,att') <> ">"] + <> [toHtml $ "<img " <> unwords direct <> " src=\"" <> filename <> "\" style=\"" <> style <> "\"></img>"] + <> [toHtml $ "</figure>"] + where + (direct, css) = (classToRevealAttr . revealjsRewriteAttr) att + style = filterStyle att' +media (Image (id', att, att') alt (filename,_)) + | id' == "img" || checkExtension filename imgExt + = return $ [toHtml $ "<figure " <> attToString (idFilter "img" id',css,att') <> ">"] + <> [toHtml $ "<img " <> unwords direct <> " src=\"" <> filename <> "\" style=\"" <> style <> "\"></img>"] + <> [toHtml $ "<figcaption>"] + <> alt + <> [toHtml $ "</figcaption></figure>"] + where + (direct, css) = (classToRevealAttr . revealjsRewriteAttr) att + style = filterStyle att' +--html-demos etc. as IFrames +media (Image (id', att, att') [] (filename,_)) + | id' == "demo" || checkExtension filename demoExt + = return [toHtml $ "<iframe " <> unwords direct <> " src=\"" <> filename <> "?plugin\"" <> attToString (idFilter "demo" id', css, att') <> "></iframe>"] + where + (direct, css) = (classToRevealAttr . revealjsRewriteAttr) att +media (Image (id', att, att') alt (filename,_)) + | id' == "demo" || checkExtension filename demoExt + = return $ [toHtml $ "<figure " <> attToString (idFilter "demo" id', css, att') <> ">"] + <> [toHtml $ "<iframe " <> unwords direct <> " src=\"" <> filename <> "?plugin\"></iframe>"] + <> [toHtml $ "<figcaption>"] + <> alt + <> [toHtml $ "</figcaption></figure>"] + where + (direct, css) = (classToRevealAttr . revealjsRewriteAttr) att +-- if not matched +media x = return [x] + +checkExtension :: String -> [String] -> Bool +checkExtension fn exts = (fmap toLower . tail . takeExtension) fn `elem` exts + +idFilter :: String -> String -> String +idFilter a b + | a == b = "" + | otherwise = b + +filterStyle :: [(String,String)] -> String +filterStyle kvpairs = case filter ((== "style") . fst) (convertToStyle ["width","height"] kvpairs) of + [] -> "" + as -> intercalate ";" $ snd <$> as +
\ No newline at end of file diff --git a/doc/src/Text.Pandoc.Util.Filter.Quiz.html b/doc/src/Text.Pandoc.Util.Filter.Quiz.html index 173a581..c3b4815 100644 --- a/doc/src/Text.Pandoc.Util.Filter.Quiz.html +++ b/doc/src/Text.Pandoc.Util.Filter.Quiz.html @@ -12,29 +12,29 @@ -- Move bottom-Up through the structure, find quiz-answers and remove the -- incorrect formattet ones from the Block they came from. quiz :: Block -> [Block] -quiz pb@(Plain b) = fmap makeQuiz (query findQuiz pb) <> [Plain (filter ((==) [] . findQuiz) b)] -quiz pb@(Para b) = fmap makeQuiz (query findQuiz pb) <> [Plain (filter ((==) [] . findQuiz) b)] -quiz x = [x] +quiz pb@(Plain b) = fmap makeQuiz (query findQuiz pb) <> [Plain (filter ((==) [] . findQuiz) b)] +quiz pb@(Para b) = fmap makeQuiz (query findQuiz pb) <> [Plain (filter ((==) [] . findQuiz) b)] +quiz x = [x] -- If we have []{.answer} then we have a quiz-answer -- maybe with a tooltip findQuiz :: Inline -> [(Attr, [Inline], Maybe ([Inline],Attr))] -findQuiz (Span attributes@(_, att, _) answerText) - | "answer" `elem` att = [(attributes, answerText', tooltip)] +findQuiz (Span attributes@(_, att, _) answerText) + | "answer" `elem` att = [(attributes, answerText', tooltip)] where - answerText' = filter (isNothing . findTooltip) answerText --filter everything that is a tooltip - tooltip = listToMaybe $ mapMaybe findTooltip answerText --get the first span that is labled tooltip + answerText' = filter (isNothing . findTooltip) answerText --filter everything that is a tooltip + tooltip = listToMaybe $ mapMaybe findTooltip answerText --get the first span that is labled tooltip findQuiz _ = [] -- If we have []{.tooltip} we have a tooltip ;) -- we save the text and the attributes in a tuple findTooltip :: Inline -> Maybe ([Inline],Attr) -findTooltip (Span attr@(_,att,_) tooltipText) - | "tooltip" `elem` att = Just (tooltipText, attr) +findTooltip (Span attr@(_,att,_) tooltipText) + | "tooltip" `elem` att = Just (tooltipText, attr) findTooltip _ = Nothing -- Generate Divs for the quiz makeQuiz :: (Attr, [Inline], Maybe ([Inline],Attr)) -> Block -makeQuiz (att, answer, Nothing) = Div att [Plain answer] -makeQuiz (att, answer, Just (tooltip,a)) = Div att [Plain answer, Div a [Plain tooltip]] +makeQuiz (att, answer, Nothing) = Div att [Plain answer] +makeQuiz (att, answer, Just (tooltip,a)) = Div att [Plain answer, Div a [Plain tooltip]]
\ No newline at end of file diff --git a/doc/src/Text.Pandoc.Util.Filter.Styling.html b/doc/src/Text.Pandoc.Util.Filter.Styling.html index cb97efb..43e76d4 100644 --- a/doc/src/Text.Pandoc.Util.Filter.Styling.html +++ b/doc/src/Text.Pandoc.Util.Filter.Styling.html @@ -18,26 +18,26 @@ -- automatically -- - .fragment and .frame work properly on divs styling :: Block -> IO [Block] -styling (Div ("col",att,att') inner) = return $ [toBlockHtml $ "<div style=\"float:left; margin-bottom:10px;\"" <> unwords direct <> attToString ("",css,att') <> ">"] - ++ inner +styling (Div ("col",att,att') inner) = return $ [toBlockHtml $ "<div style=\"float:left; margin-bottom:10px;\"" <> unwords direct <> attToString ("",css,att') <> ">"] + ++ inner ++ [toBlockHtml"</div>"] where - (direct, css) = classToRevealAttr att -styling (CodeBlock (id',att,att') inner) = return - [CodeBlock (id', addToAtt "data-trim" + (direct, css) = classToRevealAttr att +styling (CodeBlock (id',att,att') inner) = return + [CodeBlock (id', addToAtt "data-trim" . addToAtt "data-noescape" - $ att - , att') - inner] -styling div@(Div (id',att,att') inner) - | "fragment" `elem` att = return [Div (id', att, addToStyle "display: block;" att') inner] - | "frame" `elem` att = return [Div (id', addToAtt "fragment" --insert fragment + $ att + , att') + inner] +styling div@(Div (id',att,att') inner) + | "fragment" `elem` att = return [Div (id', att, addToStyle "display: block;" att') inner] + | "frame" `elem` att = return [Div (id', addToAtt "fragment" --insert fragment . addToAtt "current-visible" --insert current-visible . filter (/= "frame") --remove frame - $ att - , addToStyle "display: block;" att') inner] - | otherwise = return [div] -styling x = return [x] + $ att + , addToStyle "display: block;" att') inner] + | otherwise = return [div] +styling x = return [x] -- | Inline-Styling @@ -48,18 +48,18 @@ -- - .vspace inside span adds a vertical space with @height=xxx@ -- - .hspace inside span adds a horizontal space with @width=xxx@ inlineStyling :: Inline -> Inline -inlineStyling span@(Span (id', att, att') inner) - | "fragment" `elem` att = Span (id', att, addToStyle "display: inline-block;" att') inner - | "frame" `elem` att = Span (id', addToAtt "fragment" --insert fragment +inlineStyling span@(Span (id', att, att') inner) + | "fragment" `elem` att = Span (id', att, addToStyle "display: inline-block;" att') inner + | "frame" `elem` att = Span (id', addToAtt "fragment" --insert fragment . addToAtt "current-visible" --insert current-visible . filter (/= "frame") --remove frame - $ att - , addToStyle "display: inline-block;" att') inner - | id' == "vspace" = toHtml $ "<div style=\"clear:both;\"" <> unwords direct <> attToString ("",css,att') <> "></div>" - | id' == "hspace" = toHtml $ "<span " <> unwords direct <> attToString ("",css,att') <> "></span>" - | otherwise = span + $ att + , addToStyle "display: inline-block;" att') inner + | id' == "vspace" = toHtml $ "<div style=\"clear:both;\"" <> unwords direct <> attToString ("",css,att') <> "></div>" + | id' == "hspace" = toHtml $ "<span " <> unwords direct <> attToString ("",css,att') <> "></span>" + | otherwise = span where - (direct, css) = classToRevealAttr att -inlineStyling x = x + (direct, css) = classToRevealAttr att +inlineStyling x = x \ No newline at end of file diff --git a/doc/src/Text.Pandoc.Util.Filter.html b/doc/src/Text.Pandoc.Util.Filter.html index 30aa29d..8770bb9 100644 --- a/doc/src/Text.Pandoc.Util.Filter.html +++ b/doc/src/Text.Pandoc.Util.Filter.html @@ -1,103 +1,122 @@
module Text.Pandoc.Util.Filter
     ( attToString
-    , revealjsSpecialAttrs
-    , classToRevealAttr
-    , toHtml
-    , toBlockHtml
-    , addToAtt
-    , addToStyle
-    )
-   where
-
-import Text.Pandoc.Definition
-import Data.Monoid
-import Data.List (partition, isInfixOf)
-
--- | adds a given String to the list if not in there; Does nothing if the
---   given String is already present.
-addToAtt :: Eq a => a -> [a] -> [a]
-addToAtt toAdd (a:as)
-  | a == toAdd    = toAdd:as
-  | otherwise     = a:addToAtt toAdd as
-addToAtt toAdd [] = [toAdd]
-
--- | adds given String to List of key-value-pairs (like in 'Attr')
---   in the \"style\"-Key.
---
---   Useful when trying to add CSS-styles directly to (generated) elements
-addToStyle :: String -> [(String, String)] -> [(String, String)]
--- we are looking for style and inject
-addToStyle toAdd (("style",val):as) = ("style", if toAdd `isInfixOf` val then val else val <> " " <> toAdd):as
--- if we land here the current one is not style -> skip
-addToStyle toAdd (a:as)             = a:addToStyle toAdd as
--- if we land here we have no more to skip -> add
-addToStyle toAdd []                 = [("style", toAdd)]
-
--- | converts Attributes to String for usage in HTML
---
--- Also converts @width=xxx@ and @height=xxx@ to the
--- corresponding style-attributes
-attToString :: Attr -> String
-attToString ("", classes, kvpairs) = "class=\"" <> unwords classes <> "\" " <> unwords ((\(k,v) -> k <> "=\"" <> v <> "\"") <$> kvpairs')
-  where
-    kvpairs' = convertToStyle ["width","height","transform"] kvpairs
-attToString (id', classes, kvpairs) = "id=\"" <> id'  <> "\" class=\"" <> unwords classes <> "\" " <> unwords ((\(k,v) -> k <> "=\"" <> v <> "\"") <$> kvpairs')
-  where
-    kvpairs' = convertToStyle ["width","height","transform"] kvpairs
-
-convertToStyle :: [String] -> [(String,String)] -> [(String,String)]
-convertToStyle keys kvpairs = ("style", newstyle):rest
-  where
-    oldstyle = case filter (\(k,_) -> k == "style") kvpairs of
-                 [(_,st)] -> st
-                 _        -> ""
-    stylesToAdd = filter (\(k,_) -> k    `elem` keys) kvpairs
-    rest        = filter (\(k,_) -> k `notElem` keys) kvpairs
-    newstyle = concat ((\(k,v) -> k <> ":" <> v <> ";") <$> stylesToAdd) <> oldstyle
-
--- | revealjs has some special attributes that has to be
---   passed to the html, but Pandoc only allows
---   @key=value@-attributes, so we have to abuse
---   @.class@ to rewrite them.
---
---   The classes that get rewritten are listed here.
---
---   You probably want 'classToRevealAttr', as that
---   is a wrapper for splitting the class-attribute
-revealjsSpecialAttrs :: [String]
-revealjsSpecialAttrs = 
-    [ "data-markdown"
-    , "data-timing"
-    , "data-template"
-    , "data-autoplay"
-    , "data-prevent-swipe"
-    , "data-background-interactive"
-    , "data-trim"
-    , "data-noescape"
-    , "data-ignore"
-    , "controls"
-    ]
-
--- | revealjs has some special attributes that has to be
---   passed to the html, but Pandoc only allows
---   @key=value@-attributes, so we have to abuse
---   @.class@ to rewrite them.
---
---   This is a wrapper-function which just splits the list
---   into real classes and 'revealjsSpecialAttrs'
-classToRevealAttr :: [String] -> ([String],[String])
-classToRevealAttr = partition (`elem` revealjsSpecialAttrs)
-
--- | small wrapper around @RawInline (Format "html")@
---   as this is less line-noise in the filters and the
---   intent is more clear.
-toHtml :: String -> Inline
-toHtml = RawInline (Format "html")
-
-
--- | small wrapper around @Raw (Format "html")@
---   as this is less line-noise in the filters and the
---   intent is more clear.
-toBlockHtml :: String -> Block
-toBlockHtml = RawBlock (Format "html")
-
\ No newline at end of file + , convertToStyle + , revealjsSpecialAttrs + , revealjsRewriteAttr + , classToRevealAttr + , toHtml + , toBlockHtml + , addToAtt + , addToStyle + ) + where + +import Text.Pandoc.Definition +import Data.Monoid +import Data.List (partition, isInfixOf) + +-- | adds a given String to the list if not in there; Does nothing if the +-- given String is already present. +addToAtt :: Eq a => a -> [a] -> [a] +addToAtt toAdd (a:as) + | a == toAdd = toAdd:as + | otherwise = a:addToAtt toAdd as +addToAtt toAdd [] = [toAdd] + +-- | adds given String to List of key-value-pairs (like in 'Attr') +-- in the \"style\"-Key. +-- +-- Useful when trying to add CSS-styles directly to (generated) elements +addToStyle :: String -> [(String, String)] -> [(String, String)] +-- we are looking for style and inject +addToStyle toAdd (("style",val):as) = ("style", if toAdd `isInfixOf` val then val else val <> " " <> toAdd):as +-- if we land here the current one is not style -> skip +addToStyle toAdd (a:as) = a:addToStyle toAdd as +-- if we land here we have no more to skip -> add +addToStyle toAdd [] = [("style", toAdd)] + +-- | converts Attributes to String for usage in HTML +-- +-- Also converts @width=xxx@ and @height=xxx@ to the +-- corresponding style-attributes +attToString :: Attr -> String +attToString ("", classes, kvpairs) = "class=\"" <> unwords classes <> "\" " <> unwords ((\(k,v) -> k <> "=\"" <> v <> "\"") <$> kvpairs') + where + kvpairs' = convertToStyle ["width","height","transform"] kvpairs +attToString (id', classes, kvpairs) = "id=\"" <> id' <> "\" class=\"" <> unwords classes <> "\" " <> unwords ((\(k,v) -> k <> "=\"" <> v <> "\"") <$> kvpairs') + where + kvpairs' = convertToStyle ["width","height","transform"] kvpairs + +-- | helper function for 'attToString', but can also be used +-- if you want to extract styles from kv-pair +convertToStyle :: [String] -> [(String,String)] -> [(String,String)] +convertToStyle keys kvpairs = ("style", newstyle):rest + where + oldstyle = case filter (\(k,_) -> k == "style") kvpairs of + [(_,st)] -> st + _ -> "" + stylesToAdd = filter (\(k,_) -> k `elem` keys) kvpairs + rest = filter (\(k,_) -> k `notElem` ("style":keys)) kvpairs + newstyle = concat ((\(k,v) -> k <> ":" <> v <> ";") <$> stylesToAdd) <> oldstyle + +-- | revealjs has some special attributes that has to be +-- passed to the html, but Pandoc only allows +-- @key=value@-attributes, so we have to abuse +-- @.class@ to rewrite them. +-- +-- The classes that get rewritten are listed here. +-- +-- You probably want 'classToRevealAttr', as that +-- is a wrapper for splitting the class-attribute +revealjsSpecialAttrs :: [String] +revealjsSpecialAttrs = + [ "data-markdown" + , "data-timing" + , "data-template" + , "data-autoplay" + , "data-prevent-swipe" + , "data-background-interactive" + , "data-trim" + , "data-noescape" + , "data-ignore" + , "controls" + ] + +-- | revealjs has some special attributes that has to be +-- passed to the html, but Pandoc only allows +-- @key=value@-attributes, so we have to abuse +-- @.class@ to rewrite them. +-- +-- This is a wrapper-function which just splits the list +-- into real classes and 'revealjsSpecialAttrs' +classToRevealAttr :: [String] -> ([String],[String]) +classToRevealAttr = partition (`elem` revealjsSpecialAttrs) + +-- | HTML allows for some attributes (i.e. autoplay) +-- for which revealjs offers a special version +-- (i.e. only autoplaying on active slide). +-- These are the things that get rewritten +revealjsRewriteAttr :: [String] -> [String] +revealjsRewriteAttr = fmap replace + where + replace :: String -> String + replace a = case filter ((==a) . fst) replacements of + [(_,b)] -> b + _ -> a + replacements :: [(String, String)] + replacements = [ ("autoplay", "data-autoplay") + ] + +-- | small wrapper around @RawInline (Format "html")@ +-- as this is less line-noise in the filters and the +-- intent is more clear. +toHtml :: String -> Inline +toHtml = RawInline (Format "html") + + +-- | small wrapper around @Raw (Format "html")@ +-- as this is less line-noise in the filters and the +-- intent is more clear. +toBlockHtml :: String -> Block +toBlockHtml = RawBlock (Format "html") + \ No newline at end of file