initial
This commit is contained in:
Stefan Dresselhaus
91
app/Media.hs
Normal file
91
app/Media.hs
Normal file
@ -0,0 +1,91 @@
|
||||
#!/usr/bin/env runhaskell
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
|
||||
import Text.Pandoc.JSON
|
||||
import Control.Exception
|
||||
import Data.Monoid ((<>))
|
||||
import Data.List (partition)
|
||||
|
||||
main :: IO ()
|
||||
main = toJSONFilter media
|
||||
|
||||
media :: Inline -> IO [Inline]
|
||||
media (Image ("audio",att,att') [] (filename,_)) = return $ [toHtml $ "<audio " <> unwords direct <> " src=\"" <> filename <> "\"" <> attToString ("",css,att') <> ">"]
|
||||
++ [toHtml"</audio>"]
|
||||
where
|
||||
(direct, css) = classToPlain att
|
||||
media (Image ("audio",att,att') alt (filename,_)) = return $ [toHtml $ "<figure><audio " <> unwords direct <> " src=\"" <> filename <> "\"" <> attToString ("",css,att') <> "></audio>"]
|
||||
++ [toHtml $ "<figcaption>"]
|
||||
++ alt
|
||||
++ [toHtml $ "</figcaption></figure>"]
|
||||
where
|
||||
(direct, css) = classToPlain att
|
||||
--no description of video
|
||||
media (Image ("video", att, att') [] (filename,_)) = return $ [toHtml $ "<video " <> unwords direct <> " src=\"" <> filename <> "\"" <> attToString ("",css,att') <> "></video>"]
|
||||
where
|
||||
(direct, css) = classToPlain att
|
||||
--with description of video
|
||||
media (Image ("video", att, att') alt (filename,_)) = return $ [toHtml $ "<figure>"]
|
||||
++ [toHtml $ "<video " <> unwords direct <> " src=\"" <> filename <> "\"" <> attToString ("",css,att') <> "></video>"]
|
||||
++ [toHtml $ "<figcaption>"]
|
||||
++ alt
|
||||
++ [toHtml $ "</figcaption></figure>"]
|
||||
where
|
||||
(direct, css) = classToPlain att
|
||||
--no description of image
|
||||
media (Image ("img", att, att') [] (filename,_)) = return $ [toHtml $ "<figure>"]
|
||||
++ [toHtml $ "<img " <> unwords direct <> " src=\"" <> filename <> "\"" <> attToString ("",css,att') <> "></img>"]
|
||||
++ [toHtml $ "</figure>"]
|
||||
where
|
||||
(direct, css) = classToPlain att
|
||||
--with description of image
|
||||
media (Image ("img", att, att') alt (filename,_)) = return $ [toHtml $ "<figure>"]
|
||||
++ [toHtml $ "<img " <> unwords direct <> " src=\"" <> filename <> "\"" <> attToString ("",css,att') <> "></img>"]
|
||||
++ [toHtml $ "<figcaption>"]
|
||||
++ alt
|
||||
++ [toHtml $ "</figcaption></figure>"]
|
||||
where
|
||||
(direct, css) = classToPlain att
|
||||
media (Image ("svg", att, att') [] (filename,_)) = handle (\(fileerror :: IOException) -> return [toHtml $ "Could not read file: " <> filename <> "<br />" <> show fileerror]) $
|
||||
do
|
||||
svg <- readFile filename
|
||||
return $ [toHtml $ "<figure " <> unwords direct <> " " <> attToString ("", css, att') <> ">"] -- use attributes on figure, as svg gets dumped in..
|
||||
++ [toHtml $ svg]
|
||||
++ [toHtml $ "</figure>"]
|
||||
where
|
||||
(direct, css) = classToPlain att
|
||||
media (Image ("svg", att, att') alt (filename,_)) = handle (\(fileerror :: IOException) -> return $ [toHtml $ "Could not read file: " <> filename <> "<br />" <> show filename]) $
|
||||
do
|
||||
svg <- readFile filename
|
||||
return $ [toHtml $ "<figure " <> unwords direct <> " " <> attToString ("", css, att') <> ">"] -- use attributes on figure, as svg gets dumped in..
|
||||
++ [toHtml $ svg]
|
||||
++ [toHtml $ "<figcaption>"]
|
||||
++ alt
|
||||
++ [toHtml $ "</figcaption></figure>"]
|
||||
where
|
||||
(direct, css) = classToPlain att
|
||||
media (Image ("demo", att, att') [] (filename,_)) = return $ [toHtml $ "<iframe " <> unwords direct <> " src=\"" <> filename <> "?plugin\"" <> attToString ("", css, att') <> "></iframe>"]
|
||||
where
|
||||
(direct, css) = classToPlain att
|
||||
media (Image ("demo", att, att') alt (filename,_)) = return $ [toHtml $ "<figure>"]
|
||||
++ [toHtml $ "<iframe " <> unwords direct <> " src=\"" <> filename <> "?plugin\"" <> attToString ("", css, att') <> "></iframe>"]
|
||||
++ [toHtml $ "<figcaption>"]
|
||||
++ alt
|
||||
++ [toHtml $ "</figcaption></figure>"]
|
||||
where
|
||||
(direct, css) = classToPlain att
|
||||
|
||||
media x = return [x]
|
||||
|
||||
|
||||
attToString :: Attr -> String
|
||||
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 -> Inline
|
||||
toHtml = RawInline (Format "html")
|
||||
91
app/Quiz.hs
Normal file
91
app/Quiz.hs
Normal file
@ -0,0 +1,91 @@
|
||||
#!/usr/bin/env runhaskell
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
|
||||
import Text.Pandoc.JSON
|
||||
import Control.Exception
|
||||
import Data.Monoid ((<>))
|
||||
import Data.List (partition)
|
||||
|
||||
main :: IO ()
|
||||
main = toJSONFilter media
|
||||
|
||||
media :: Inline -> IO [Inline]
|
||||
media (Image ("audio",att,att') [] (filename,_)) = return $ [toHtml $ "<audio " <> unwords direct <> " src=\"" <> filename <> "\"" <> attToString ("",css,att') <> ">"]
|
||||
++ [toHtml"</audio>"]
|
||||
where
|
||||
(direct, css) = classToPlain att
|
||||
media (Image ("audio",att,att') alt (filename,_)) = return $ [toHtml $ "<figure><audio " <> unwords direct <> " src=\"" <> filename <> "\"" <> attToString ("",css,att') <> "></audio>"]
|
||||
++ [toHtml $ "<figcaption>"]
|
||||
++ alt
|
||||
++ [toHtml $ "</figcaption></figure>"]
|
||||
where
|
||||
(direct, css) = classToPlain att
|
||||
--no description of video
|
||||
media (Image ("video", att, att') [] (filename,_)) = return $ [toHtml $ "<video " <> unwords direct <> " src=\"" <> filename <> "\"" <> attToString ("",css,att') <> "></video>"]
|
||||
where
|
||||
(direct, css) = classToPlain att
|
||||
--with description of video
|
||||
media (Image ("video", att, att') alt (filename,_)) = return $ [toHtml $ "<figure>"]
|
||||
++ [toHtml $ "<video " <> unwords direct <> " src=\"" <> filename <> "\"" <> attToString ("",css,att') <> "></video>"]
|
||||
++ [toHtml $ "<figcaption>"]
|
||||
++ alt
|
||||
++ [toHtml $ "</figcaption></figure>"]
|
||||
where
|
||||
(direct, css) = classToPlain att
|
||||
--no description of image
|
||||
media (Image ("img", att, att') [] (filename,_)) = return $ [toHtml $ "<figure>"]
|
||||
++ [toHtml $ "<img " <> unwords direct <> " src=\"" <> filename <> "\"" <> attToString ("",css,att') <> "></img>"]
|
||||
++ [toHtml $ "</figure>"]
|
||||
where
|
||||
(direct, css) = classToPlain att
|
||||
--with description of image
|
||||
media (Image ("img", att, att') alt (filename,_)) = return $ [toHtml $ "<figure>"]
|
||||
++ [toHtml $ "<img " <> unwords direct <> " src=\"" <> filename <> "\"" <> attToString ("",css,att') <> "></img>"]
|
||||
++ [toHtml $ "<figcaption>"]
|
||||
++ alt
|
||||
++ [toHtml $ "</figcaption></figure>"]
|
||||
where
|
||||
(direct, css) = classToPlain att
|
||||
media (Image ("svg", att, att') [] (filename,_)) = handle (\(fileerror :: IOException) -> return [toHtml $ "Could not read file: " <> filename <> "<br />" <> show fileerror]) $
|
||||
do
|
||||
svg <- readFile filename
|
||||
return $ [toHtml $ "<figure " <> unwords direct <> " " <> attToString ("", css, att') <> ">"] -- use attributes on figure, as svg gets dumped in..
|
||||
++ [toHtml $ svg]
|
||||
++ [toHtml $ "</figure>"]
|
||||
where
|
||||
(direct, css) = classToPlain att
|
||||
media (Image ("svg", att, att') alt (filename,_)) = handle (\(fileerror :: IOException) -> return $ [toHtml $ "Could not read file: " <> filename <> "<br />" <> show filename]) $
|
||||
do
|
||||
svg <- readFile filename
|
||||
return $ [toHtml $ "<figure " <> unwords direct <> " " <> attToString ("", css, att') <> ">"] -- use attributes on figure, as svg gets dumped in..
|
||||
++ [toHtml $ svg]
|
||||
++ [toHtml $ "<figcaption>"]
|
||||
++ alt
|
||||
++ [toHtml $ "</figcaption></figure>"]
|
||||
where
|
||||
(direct, css) = classToPlain att
|
||||
media (Image ("demo", att, att') [] (filename,_)) = return $ [toHtml $ "<iframe " <> unwords direct <> " src=\"" <> filename <> "?plugin\"" <> attToString ("", css, att') <> "></iframe>"]
|
||||
where
|
||||
(direct, css) = classToPlain att
|
||||
media (Image ("demo", att, att') alt (filename,_)) = return $ [toHtml $ "<figure>"]
|
||||
++ [toHtml $ "<iframe " <> unwords direct <> " src=\"" <> filename <> "?plugin\"" <> attToString ("", css, att') <> "></iframe>"]
|
||||
++ [toHtml $ "<figcaption>"]
|
||||
++ alt
|
||||
++ [toHtml $ "</figcaption></figure>"]
|
||||
where
|
||||
(direct, css) = classToPlain att
|
||||
|
||||
media x = return [x]
|
||||
|
||||
|
||||
attToString :: Attr -> String
|
||||
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 -> Inline
|
||||
toHtml = RawInline (Format "html")
|
||||
77
app/Styling.hs
Normal file
77
app/Styling.hs
Normal file
@ -0,0 +1,77 @@
|
||||
#!/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)
|
||||
|
||||
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")
|
||||
Reference in New Issue
Block a user