Created library instead of binaries. Added doc.

- Split things into Library and Binary
  - Library has all functionality
  - Binarys are just wrapper like "main = toJsonFilter foo"
- Documented most things
- Created haddock-documentation
- added documentation to repository

app/Clean.hs

@@ -2,9 +2,6 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 
 import Text.Pandoc.JSON
-import Control.Exception
-import Data.Monoid ((<>))
-import Data.List (partition, isInfixOf)
 
 main :: IO ()
 main = toJSONFilter clean

app/Cols.hs

@@ -1,82 +1,9 @@
 #!/usr/bin/env runhaskell
-{-# LANGUAGE ScopedTypeVariables #-}
 
 import Text.Pandoc.JSON
-import Text.Pandoc.Definition
 import Text.Pandoc.Generic (topDown)
-import Control.Exception
-import Data.Monoid ((<>))
-import Data.List (partition, elem)
-import System.FilePath
-import Debug.Trace (trace)
-import Text.Read (readMaybe)
-import Data.Maybe (fromMaybe)
+
+import Text.Pandoc.Util.Filter.Cols
 
 main :: IO ()
 main = toJSONFilter (topDown cols :: Pandoc -> Pandoc)
-
-
--- | 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
---     ```
---     ![image](...)
---     </div>
---
---     second column here with only 1 element.
---
-cols :: [Block] -> [Block]
-cols (h@(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
-                          , clearDiv
-                          ]
-cols (h@(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
-                          , clearDiv
-                          ]
-cols x = x
-
-makeDiv :: Int -> Block -> Block
-makeDiv width content = Div ("", [], [("style","width:" <> show width <> "%;float:left")]) [content]
-
-clearDiv :: Block
-clearDiv = Div ("", [], [("style", "clear: both")]) [Plain [toHtml "&nbsp;"]]
-
-toHtml :: String -> Inline
-toHtml = RawInline (Format "html")

app/Media.hs

@@ -1,184 +1,6 @@
 #!/usr/bin/env runhaskell
-{-# LANGUAGE ScopedTypeVariables #-}
-
+import Text.Pandoc.Util.Filter.Media
 import Text.Pandoc.JSON
-import Control.Exception
-import Data.Monoid ((<>))
-import Data.List (partition, elem)
-import Data.Char (toLower)
-import System.FilePath
 
 main :: IO ()
 main = toJSONFilter media
-
--- | 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"
-  ]
-
--- | 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) = classToPlain 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) = classToPlain 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) = classToPlain 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) = classToPlain 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) = classToPlain 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) = classToPlain att
---load svg and dump it in
-media (Image (id', att, att') [] (filename,_))
-  | id' == "svg" || (checkExtension filename ["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) = classToPlain att
-media (Image (id', att, att') alt (filename,_))
-  | id' == "svg" || (checkExtension filename ["svg"])
-    = handle (\(fileerror :: IOException) -> return $ [toHtml $ "Could not read file: " <> filename <> "<br />" <> show filename]) $
-                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) = classToPlain 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) = classToPlain 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) = classToPlain att
--- if not matched
-media x = return [x]
-
-
--- | 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,v) -> k == "style") kvpairs of
-                 []       -> ""
-                 [(_,st)] -> st
-    stylesToAdd = filter (\(k,v) -> k       `elem` keys) kvpairs
-    rest        = filter (\(k,v) -> not $ k `elem` keys) kvpairs
-    newstyle = concat ((\(k,v) -> k <> ":" <> v <> ";") <$> stylesToAdd) <> oldstyle
-
-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
-
-classToPlain :: [String] -> ([String],[String])
-classToPlain = partition (`elem` [ "data-autoplay"
-                                 , "controls"
-                                 ]
-                         )
-
-toHtml :: String -> Inline
-toHtml = RawInline (Format "html")

app/Quiz.hs

@@ -2,40 +2,7 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 
 import Text.Pandoc.JSON
-import Text.Pandoc.Walk
-import Control.Exception
-import Data.Monoid ((<>))
-import Data.List (partition)
-import Data.Maybe (isNothing, mapMaybe, listToMaybe)
+import Text.Pandoc.Util.Filter.Quiz
 
 main :: IO ()
-main = toJSONFilter quizLift
-
--- Move bottom-Up through the structure, find quiz-answers and remove the
--- incorrect formattet ones from the Block they came from.
-quizLift :: Block -> [Block]
-quizLift pb@(Plain b) = fmap makeQuiz (query findQuiz pb) ++ [Plain (filter ((==) [] . findQuiz) b)]
-quizLift pb@(Para  b) = fmap makeQuiz (query findQuiz pb) ++ [Plain (filter ((==) [] . findQuiz) b)]
-quizLift 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@(id, att, 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
-findQuiz x = []
-
--- 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 _ = 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]]
+main = toJSONFilter quiz

app/Styling.hs

@@ -1,77 +1,8 @@
 #!/usr/bin/env runhaskell
-{-# LANGUAGE ScopedTypeVariables #-}
 
 import Text.Pandoc.JSON
 import Text.Pandoc.Walk
-import Control.Exception
-import Data.Monoid ((<>))
-import Data.List (partition, isInfixOf)
+import Text.Pandoc.Util.Filter.Styling
 
 main :: IO ()
 main = toJSONFilter $ styling . walk inlineStyling
-
-styling :: Block -> IO [Block]
-styling (Div ("col",att,att') inner)   = return $ [toHtml $ "<div style=\"float:left; margin-bottom:10px;\"" <> unwords direct <> attToString ("",css,att') <> ">"]
-                                                        ++ inner
-                                                        ++ [toHtml"</div>"]
-                                        where
-                                                        (direct, css) = classToPlain 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
-                                           . addToAtt "current-visible" --insert current-visible
-                                           . filter (/= "frame")        --remove frame
-                                           $ att
-                                             , addToStyle "display: block;" att') inner]
-  | otherwise             = return [div]
-styling x = return [x]
-
-
-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
-                                    . addToAtt "current-visible" --insert current-visible
-                                    . filter (/= "frame")        --remove frame
-                                    $ att
-                                      , addToStyle "display: inline-block;" att') inner
-  | id == "vspace"        = toInlineHtml $ "<div style=\"clear:both;\"" <> unwords direct <> attToString ("",css,att') <> "></div>"
-  | id == "hspace"        = toInlineHtml $ "<span " <> unwords direct <> attToString ("",css,att') <> "></span>"
-  | otherwise             = span
-                                where
-                                        (direct, css) = classToPlain att
-inlineStyling x = x
-
-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)]
-
-addToAtt :: String -> [String] -> [String]
-addToAtt toAdd (a:as)
-  | a == toAdd    = toAdd:as
-  | otherwise     = a:addToAtt toAdd as
-addToAtt toAdd []           = [toAdd]
-
-attToString :: Attr -> String
-attToString (ident, [], kvpairs) = ident <> " " <> unwords ((\(k,v) -> k <> "=\"" <> v <> "\"") <$> kvpairs)
-attToString (ident, classes, kvpairs) = ident <> " class=\"" <> unwords classes <> "\" " <> unwords ((\(k,v) -> k <> "=\"" <> v <> "\"") <$> kvpairs)
-
-classToPlain :: [String] -> ([String],[String])
-classToPlain = partition (`elem` [ "data-autoplay"
-                                 , "controls"
-                                 ]
-                         )
-
-toHtml :: String -> Block
-toHtml = RawBlock (Format "html")
-
-toInlineHtml :: String -> Inline
-toInlineHtml = RawInline (Format "html")