From e30e18b5dc62866d3a97b4b5dd629c9746eb72a2 Mon Sep 17 00:00:00 2001 From: Stefan Dresselhaus Date: Thu, 17 Aug 2017 15:59:04 +0200 Subject: [PATCH] fixed errors --- app/Cols.hs | 27 +++++++++++++++++++++++++++ app/Media.hs | 49 ++++++++++++++++++++++++++----------------------- stack.yaml | 7 ++++--- 3 files changed, 57 insertions(+), 26 deletions(-) diff --git a/app/Cols.hs b/app/Cols.hs index 74b4378..d44db55 100644 --- a/app/Cols.hs +++ b/app/Cols.hs @@ -15,6 +15,33 @@ import Data.Maybe (fromMaybe) 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
: +-- +-- ## 2 5 +-- +--
+-- multiple things +-- ``` +-- foo +-- ``` +-- ![image](...) +--
+-- +-- 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 diff --git a/app/Media.hs b/app/Media.hs index 5b3c337..242ac21 100644 --- a/app/Media.hs +++ b/app/Media.hs @@ -5,6 +5,7 @@ import Text.Pandoc.JSON import Control.Exception import Data.Monoid ((<>)) import Data.List (partition, elem) +import Data.Char (toLower) import System.FilePath main :: IO () @@ -12,29 +13,29 @@ main = toJSONFilter media -- | File-extensions that should be treated as audio audioExt :: [String] -audioExt = [".mp3",".aac"] +audioExt = ["mp3","aac"] -- | File-extensions that should be treated as video videoExt :: [String] -videoExt = [ ".avi" - , ".mp4" - , ".mov" +videoExt = [ "avi" + , "mp4" + , "mov" ] -- | File-extensions that should be treated as image imgExt :: [String] imgExt = - [ ".jpg" - , ".jpeg" - , ".png" - , ".gif" - , ".tif" - , ".tiff" - , ".bmp" + [ "jpg" + , "jpeg" + , "png" + , "gif" + , "tif" + , "tiff" + , "bmp" ] -- | File-extensions that should be treated as demo and will be included --- in an iframe. +-- in an iframe demoExt :: [String] demoExt = ["html", "htm"] @@ -57,12 +58,12 @@ demoExt = ["html", "htm"] media :: Inline -> IO [Inline] --audio media (Image (id',att,att') [] (filename,_)) - | id' == "audio" || (takeExtension filename `elem` audioExt) + | id' == "audio" || (checkExtension filename audioExt) = return $ [toHtml $ ""] where (direct, css) = classToPlain att media (Image (id',att,att') alt (filename,_)) - | id' == "audio" || (takeExtension filename `elem` audioExt) + | id' == "audio" || (checkExtension filename audioExt) = return $ [toHtml $ "
"] ++ [toHtml $ "
"] ++ alt @@ -71,12 +72,12 @@ media (Image (id',att,att') alt (filename,_)) (direct, css) = classToPlain att --videos media (Image (id', att, att') [] (filename,_)) - | id' == "video" || (takeExtension filename `elem` videoExt) + | id' == "video" || (checkExtension filename videoExt) = return $ [toHtml $ ""] where (direct, css) = classToPlain att media (Image (id', att, att') alt (filename,_)) - | id' == "video" || (takeExtension filename `elem` videoExt) + | id' == "video" || (checkExtension filename videoExt) = return $ [toHtml $ "
"] ++ [toHtml $ ""] ++ [toHtml $ "
"] @@ -86,14 +87,14 @@ media (Image (id', att, att') alt (filename,_)) (direct, css) = classToPlain att --images media (Image (id', att, att') [] (filename,_)) - | id' == "img" || (takeExtension filename `elem` imgExt) + | id' == "img" || (checkExtension filename imgExt) = return $ [toHtml $ "
"] ++ [toHtml $ " unwords direct <> " src=\"" <> filename <> "\"" <> attToString (idFilter "img" id',css,att') <> ">"] ++ [toHtml $ "
"] where (direct, css) = classToPlain att media (Image (id', att, att') alt (filename,_)) - | id' == "img" || (takeExtension filename `elem` imgExt) + | id' == "img" || (checkExtension filename imgExt) = return $ [toHtml $ "
"] ++ [toHtml $ " unwords direct <> " src=\"" <> filename <> "\"" <> attToString (idFilter "img" id',css,att') <> ">"] ++ [toHtml $ "
"] @@ -103,7 +104,7 @@ media (Image (id', att, att') alt (filename,_)) (direct, css) = classToPlain att --load svg and dump it in media (Image (id', att, att') [] (filename,_)) - | id' == "svg" || (takeExtension filename == ".svg") + | id' == "svg" || (checkExtension filename ["svg"]) = handle (\(fileerror :: IOException) -> return [toHtml $ "Could not read file: " <> filename <> "
" <> show fileerror]) $ do svg <- readFile filename @@ -113,7 +114,7 @@ media (Image (id', att, att') [] (filename,_)) where (direct, css) = classToPlain att media (Image (id', att, att') alt (filename,_)) - | id' == "svg" || (takeExtension filename == ".svg") + | id' == "svg" || (checkExtension filename ["svg"]) = handle (\(fileerror :: IOException) -> return $ [toHtml $ "Could not read file: " <> filename <> "
" <> show filename]) $ do svg <- readFile filename @@ -126,12 +127,12 @@ media (Image (id', att, att') alt (filename,_)) (direct, css) = classToPlain att --html-demos etc. as IFrames media (Image (id', att, att') [] (filename,_)) - | id' == "demo" || (takeExtension filename `elem` demoExt) + | id' == "demo" || (checkExtension filename demoExt) = return $ [toHtml $ ""] where (direct, css) = classToPlain att media (Image (id', att, att') alt (filename,_)) - | id' == "demo" || (takeExtension filename `elem` demoExt) + | id' == "demo" || (checkExtension filename demoExt) = return $ [toHtml $ "
"] ++ [toHtml $ ""] ++ [toHtml $ "
"] @@ -165,11 +166,13 @@ convertToStyle keys kvpairs = ("style", newstyle):rest 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 = a + | otherwise = b classToPlain :: [String] -> ([String],[String]) classToPlain = partition (`elem` [ "data-autoplay" diff --git a/stack.yaml b/stack.yaml index d66a353..257a646 100644 --- a/stack.yaml +++ b/stack.yaml @@ -15,7 +15,7 @@ # resolver: # name: custom-snapshot # location: "./custom-snapshot.yaml" -resolver: lts-8.23 +resolver: lts-9.1 # User packages to be built. # Various formats can be used as shown in the example below. @@ -39,7 +39,8 @@ packages: - '.' # Dependency packages to be pulled from upstream that are not in the resolver # (e.g., acme-missiles-0.3) -extra-deps: [] +extra-deps: +- haddock-api-2.18.1 # Override default flag values for local packages and extra-deps flags: {} @@ -63,4 +64,4 @@ extra-package-dbs: [] # extra-lib-dirs: [/path/to/dir] # # Allow a newer minor version of GHC than the snapshot specifies -# compiler-check: newer-minor \ No newline at end of file +# compiler-check: newer-minor