diff options
| -rw-r--r-- | Makefile | 3 | ||||
| -rw-r--r-- | app/Main.hs | 144 | ||||
| -rw-r--r-- | src/WWWStaticus.hs | 12 | ||||
| -rw-r--r-- | src/WWWStaticusPlugins.hs | 41 | ||||
| -rw-r--r-- | staticus.cabal | 6 |
5 files changed, 51 insertions, 155 deletions
@@ -1,8 +1,9 @@ INDIR=/home/miguel/git/idziorek_net OUTDIR=/tmp/idziorek_net +HTMLROOT=/tmp/idziorek_net run: build clean - stack run staticus-exe -- ${INDIR} ${OUTDIR} + stack run staticus-exe -- ${INDIR} ${OUTDIR} ${HTMLROOT} build: stack build clean: diff --git a/app/Main.hs b/app/Main.hs index 9727c8c..0709f35 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -4,143 +4,13 @@ import WWWStaticus import WWWStaticusPlugins import System.Environment --- |The main IO action just feed the 2 command line parameters for --- input and output directories to WWWStaticus.runStaticus. +-- |The main IO action just feeds the 3 command line parameters to +-- WWWStaticus.runStaticus: input path, output path, html root main :: IO () main = do args<-getArgs prog<-getProgName - if length args /= 2 - then putStrLn $ "usage: " ++ prog ++ " [in_path] [out_path]" - else runStaticus (args!!0) (args!!1) staticusPluginsDefault - --- Only legacy stuff below this line -- -{- ---import Data.List.Utils ---import Control.Monad.Reader ---import Text.Pandoc - -{- -import Control.Exception -import Control.Monad - -import Data.List -import Data.List.Split -import Data.Maybe -import qualified Data.Map as M -import Data.Text(pack,unpack) -import Data.Tree - -import System.Directory - -import Text.Regex --} --- TODO!!! -replace seek replace txt = txt - --- |'htmlLink' generates a HTML link from a href & title -htmlLink :: String -> String -> String -> String -htmlLink href title cl="<a class= '"++cl++"' href='"++href++"'>"++replace "-" " " title++"</a>" - --- generate HTML breadcrumbs from a list of page titles -genBrc :: [String] -> String -genBrc b | length b == 0 = htmlCurrent "home" - | otherwise = htmlHome ++ (fst $ foldl lnk ("",0) b) - where lnk (a,c) v | length b-c-1==0 = (a++htmlCurrent v,c+1) - | otherwise = (a++htmlCrumb c v ,c+1) - htmlCrumb c v = "<li class=\"breadcrumb-item\">"++(htmlLink (concat (replicate (length b-c-1) "../")) (v) "")++"</li>" - htmlCurrent v = "<li class=\"breadcrumb-item active\" aria-current=\"page\">"++replace "-" " " v++"</li>" - htmlHome = "<li class=\"breadcrumb-item\">"++(htmlLink "/" "home" "")++"</li>" - --- pure function that generates a single HTML page from: --- a html template, description, keywords, breadcrumbs, topMenue & submenue -genPage :: String->String->String->String->[String]->[String]->[String]->String->String -genPage tmpl dsc kw ttl brc top chld md = - foldr rplc tmpl (replacers content (menu "/" top) (menu "./" chld) (genBrc brc) title dsc kw) - where content = "content" -- either (const "error") unpack res - where res = pack "content" -- runPure $ do doc <- readMarkdown def{readerExtensions=(enableExtension Ext_raw_html pandocExtensions )} $ pack md - --writeHtml5String def doc - rplc v = replace ("##" ++ fst v ++ "##") (snd v) - title | null ttl = if null brc then "Home" else replace "-" " " $ last brc - | otherwise = ttl - menu p = foldr (fm p) "" - fm p s a | (not (null brc)) && (s == head brc) = "<li class=\"nav-item active\">"++htmlLink (p++s++"/") s "nav-link"++"</li>"++a - | otherwise = "<li class=\"nav-item\">"++htmlLink (p++s++"/") s "nav-link"++"</li>"++a - replacers c m m2 b t d k= - [("CONTENT", c) - ,("LOGO", "/DATA/logo.png") - ,("STYLESHEET", "/DATA/style.css") - ,("SITE_TITLE", "Miguel's Lair") - ,("SITE_SUBTITLE", "<br />where information sleepzzZZZzz ...") - ,("TITLE", t) - ,("DESCRIPTION", d) - ,("KEYWORDS", k) - ,("AUTHOR", "Michal Idziorek") - ,("MENU", m) - ,("SUB_MENU", m2) - ,("BREADCRUMBS", b) - ,("FOOTER", "(c) 1994-2018")] - - --- write the HTML page generated from current diectory by 'genPage' -wrtPage2 :: FilePath -> FilePath -> String -> [FilePath] -> FilePath -> [FilePath] -> IO () -wrtPage2 idx out tmpl top p chld = do - - when (not home) (createDirectory outdir) - - mdd <- readFile $ p ++ "/index.md" - md <- customFiltersIO mdd - cfg <- (map ((\(x:xs) -> (x,unwords xs)).words).lines) - <$> catch (readFile $ p++"/config") - ((\_ -> return "") :: IOException -> IO String) - - writeFile (outdir++"/index.html") - (genPage tmpl (lkp cfg "dsc") (lkp cfg "kwd") (lkp cfg "ttl") - brc (menu top) (if home then [] else menu chld) (customFilters md)) - - where home = outdir==out++"/" - remUnder = filter (not.null) . map (dropWhile(=='_').dropWhile(/='_')) - lkp cfg k = fromMaybe "" (lookup k cfg) - menu = remUnder . filter (not . isPrefixOf "00_") . map (last.splitOn "/") . sortBy (flip compare) - outdir = out ++ "/" ++ intercalate "/" brc - brc = remUnder $ splitOn "/" (drop (length idx) p) - - - - --- TODO: plugins! -- --- apply some customIO filters before passed to pandoc -customFiltersIO :: String -> IO String -customFiltersIO a = do let x = splitRegex (mkRegex "^\\{BEGIN:SOURCE\\}.*$|^\\{END:SOURCE\\}.*$") a - concat <$> evr2 x - where evr2 (x:y:xs) = do putStrLn $ ">>"++y++"<<" - src <- readFile $ replace "\n" "" y - rest <- evr2 xs - return $ x:src:rest - evr2 x = return x - --- apply some custom filters before passed to pandoc -customFilters :: String -> String -customFilters a = concat $ evr2 $ splitRegex (mkRegex "^\\{BEGIN:CARD\\}$|^\\{END:CARD\\}$") a - where evr2 (x:y:xs) = x:createCard y:evr2 xs - evr2 x = x - -createCard:: String -> String -createCard v = let (_:x:y:z:_:xs)=lines v in replace "###IMG###" x - $ replace "###TITLE###" y - $ replace "###FOOTER###" z -- (z++"<br />"++a) - $ replace "###TEXT###" (unlines $ map spans xs) tmpl - where tmpl ="<div class ='col-sm-6 col-md-4 col-xl-3 mb-4'>" - ++"<div class='card h-100'>" - ++"<img class='border-bottom card-img-top' src='###IMG###' >" - ++"<div class='card-body'>" - ++"<h5 class='card-title'>###TITLE###</h5>" - ++"<p class='card-text'>" - ++"###TEXT###" - ++"</p>" - ++"</div>" - ++"<div class='text-center card-footer text-muted'>###FOOTER###</div>" - ++"</div></div>" - spans ('-':vv)=let (x:xs)=words vv in "<span class='badge "++x++"'>"++unwords xs++"</span>" - spans xx = xx - - -} + if length args /= 3 + then putStrLn $ "usage: " ++ prog ++ + " [in_path] [out_path] [root]" + else runStaticus (args!!0) (args!!1) (args!!2) + staticusPluginsDefault diff --git a/src/WWWStaticus.hs b/src/WWWStaticus.hs index 2144fe0..d5205f5 100644 --- a/src/WWWStaticus.hs +++ b/src/WWWStaticus.hs @@ -21,9 +21,10 @@ import Data.List -- |Runs WWWStaticus given an input and an output directory and a list of -- plugins. This traverses 'inp' recursively and runs all the plugins --- 'one by one' in each subdirectory recursively. -runStaticus :: FilePath->FilePath->[StaticusPlugin]->IO() -runStaticus inp outp plug= trvDirTree inp (runPlugins plug outp) +-- 'one by one' in each subdirectory recursively. 'root' is the html root +-- directory used in links etc. +runStaticus :: FilePath->FilePath->FilePath->[StaticusPlugin]->IO() +runStaticus inp outp root plug= trvDirTree inp (runPlugins plug root outp) -- |The following structure represents a single WWWStaticus plugin. -- A plugin is defined by a Name and two functions one pure and one that @@ -62,10 +63,11 @@ getDirList d = map ((d++"/")++) <$> filter (not.isPrefixOf ".") <$> listDirector -- |run plugins in a single directory 'path'. -- 'dir_in' and 'dir_out' have to be provided as well, since plugins -- might rely on this -runPlugins::[StaticusPlugin]->FilePath->FilePath->FilePath->IO() -runPlugins plug dir_out dir_in path = foldlM f init plug >> return () +runPlugins::[StaticusPlugin]->FilePath->FilePath->FilePath->FilePath->IO() +runPlugins plug root dir_out dir_in path = foldlM f init plug >> return () where f m (StaticusPlugin name run runIO) = runIO m >>= return.run init= M.fromList [("path",path) ,("dir_in",dir_in) ,("dir_out",dir_out) + ,("html_root",root) ,("log","run plugins at: "++path++"\n")] diff --git a/src/WWWStaticusPlugins.hs b/src/WWWStaticusPlugins.hs index ccf82bc..33916ef 100644 --- a/src/WWWStaticusPlugins.hs +++ b/src/WWWStaticusPlugins.hs @@ -1,6 +1,7 @@ module WWWStaticusPlugins ( staticusPluginsDefault ,staticusPluginInit + ,staticusPluginCfg ,staticusPluginCopy ,staticusPluginPandoc ,staticusPluginFill @@ -17,18 +18,20 @@ import Data.Either import Data.List import Data.List.Split import Data.List.Utils +import Data.Tuple.Extra import Text.Pandoc -- --- TODOS: +-- PLUGIN IDEAS -- -- timestamp plugin/ do not refresh if md did not change? dir timestamp? +-- but check if depends on upstream stuff as git -- -- super `gallery and everythin` plugin, just throw images,videos, -- zips,tars,source files,mds etc inside a folder-> gen page! -- -- flexible layout, main pic, secondary pics --- +-- -- scale images -- -- asciinema, git, videos @@ -36,19 +39,28 @@ import Text.Pandoc -- contact form? (use nginx log? save post request??) -- -- pdf plugin +-- -- autotranslate plugin :P -- -- |little helper to get values out of a map easily +-- error if not found. par k m = case M.lookup k m of Just x -> x Nothing -> error $ "key not found: "++k +-- |little helper to get values out of a map easily +-- defaulting to empty string. +par' k m = case M.lookup k m of + Just x -> x + Nothing -> "" + -- |A default set of plugins that you can use to kickstart your page -- Use now, Adapt later. staticusPluginsDefault::[StaticusPlugin] staticusPluginsDefault=[ staticusPluginInit - ,staticusPluginCopy [".jpg",".png",".zip",".css",".js"] + ,staticusPluginCfg + ,staticusPluginCopy [".jpg",".png",".zip",".css",".js",".ico",".mp4",".ogv"] ,staticusPluginPandoc ,staticusPluginFill ,staticusPluginWrite @@ -62,10 +74,10 @@ staticusPluginInit = StaticusPlugin "init" id runIO when (not isHome) (createDirectory outdir) c <- getDirList (par "path" m) t <- getDirList (par "dir_in" m) - let menutop= concat $ map (\x->"<li class=\"navitem\"><a class=\"nav-link\" href=\""++par "dir_out" m++"/"++x++"/index.html\">"++x++"</a></li>") (menu t) - let submenu= if isHome then "" else concat $ map (\x->"<li><a href=\""++outdir++"/"++x++"/index.html\">"++x++"</a></li>") (menu c) - let breadcrumbs=concat $ map (\x->x) brc - let breadcrumbs="" + let menutop= concat $ map (\x->"<li class=\"nav-item"++(if length brc>=1 && brc!!0==x then " active" else "")++"\"><a class=\"nav-link\" href=\""++par "dir_out" m++"/"++x++"/index.html\">"++x++"</a></li>") (menu t) + let submenu= if isHome then "" else concat $ map (\x->"<li><a href=\""++outdir++"/"++x++"/index.html\">"++cln x++"</a></li>") (menu c) + let breadcrumbs=concat $ map (\(x,d)->"<li class=\"breadcrumb-item"++(if d==0 then " active" else "")++"\">"++(if d==0 then "" else "<a href=."++concat(take d (repeat "/.."))++"/index.html>")++cln x++(if d==0 then "" else "</a>")++"</li>") (zip ("home":brc) [brcl,brcl-1..]) + md <- readFile $ par "path" m++"/"++"index.md" tmpl <- readFile $ par "dir_in" m++"/"++"template.html" return $ M.union (M.fromList [ ("outdir",outdir) @@ -74,12 +86,15 @@ staticusPluginInit = StaticusPlugin "init" id runIO ,("menutop",menutop) ,("submenu",submenu) ,("breadcrumbs",breadcrumbs) + ,("title",if null brc then "Home" else cln $ last brc) ]) m where outdir = par "dir_out" m ++ "/" ++ intercalate "/" brc brc = remUnder $ splitOn "/" (drop (length (par "dir_in" m)) (par "path" m)) + brcl = length brc remUnder = filter (not.null) . map (dropWhile(=='_').dropWhile(/='_')) menu = remUnder . filter (not . isPrefixOf "00_") . map (last.splitOn "/") . sortBy (flip compare) isHome = par "path" m==par "dir_in" m + cln x = replace "-" " " x -- |This plugin will simply copy files of given extension from source -- to the target directory. give it a list of file extensions. @@ -92,6 +107,13 @@ staticusPluginCopy ext = StaticusPlugin "copy by extension" id runIO mapM_ (\x->copyFile (par "path" m++"/"++x) (par "outdir" m++"/"++x)) dl return m +-- |extracts config lines (###>>>) from 'index.md' +staticusPluginCfg::StaticusPlugin +staticusPluginCfg = StaticusPlugin "extract config lines" run return + where run m = M.union (M.fromList (("index.md",indexmd):conf)) m + where indexmd=unlines . filter (not.isPrefixOf "###>>>") . lines $ par "index.md" m + conf= map (first head.second (unwords.tail).dupe.words) . filter (isPrefixOf "###>>>") . lines $ par "index.md" m + -- |pipes 'index.md' value through pandoc and saves in 'content' staticusPluginPandoc::StaticusPlugin staticusPluginPandoc = StaticusPlugin "pandoc" run return @@ -108,6 +130,10 @@ staticusPluginFill = StaticusPlugin "fill template" run return replace "###SUBMENU###" (par "submenu" m) $ replace "###MENU###" (par "menutop" m) $ replace "###CONTENT###" (par "content" m) $ + replace "###ROOT###" (par "html_root" m) $ + replace "###TITLE###" (par "title" m) $ + replace "###DESCRIPTION###" (par' "###>>>DSC" m) $ + replace "###KEYWORDS###" (par' "###>>>KWD" m) $ (par "template.html" m))]) m -- |write final index.html file @@ -116,3 +142,4 @@ staticusPluginWrite = StaticusPlugin "writer" id runIO where runIO m = do writeFile ((par "outdir" m)++"/index.html") (par "final" m) return m + diff --git a/staticus.cabal b/staticus.cabal index e2145f6..b8a8f67 100644 --- a/staticus.cabal +++ b/staticus.cabal @@ -28,6 +28,7 @@ library , directory , text , pandoc + , extra , MissingH default-language: Haskell2010 @@ -40,10 +41,5 @@ executable staticus-exe ghc-options: -threaded -rtsopts -with-rtsopts=-N build-depends: base >=4.7 && <5 - , directory - , split - , text - , regex-compat - , containers , staticus default-language: Haskell2010 |