diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/WWWStaticus.hs | 70 | ||||
| -rw-r--r-- | src/WWWStaticusPlugins.hs | 115 |
2 files changed, 185 insertions, 0 deletions
diff --git a/src/WWWStaticus.hs b/src/WWWStaticus.hs new file mode 100644 index 0000000..01485e4 --- /dev/null +++ b/src/WWWStaticus.hs @@ -0,0 +1,70 @@ +{-| + WWWStaticus is a minimalistic yet modular static website generator + first coded in April 2018 by Michal Idziorek <m.i@gmx.at>. + Last Update: Jan 29, 2019 +-} + +module WWWStaticus + ( runStaticus + ,staticusPluginDummy + ,getDirList + ,StaticusPlugin(..) + ) where + +import qualified Data.Map.Strict as M +import Data.Foldable +import System.Directory +import Control.Monad +import Data.Tree +import Data.Maybe + +-- |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) + +-- |The following structure represents a single WWWStaticus plugin. +-- A plugin is defined by a Name and two functions one pure and one that +-- can do IO. The functions have to return a new map based on the input +-- map. Initially only "path" (current in path) and +-- "dir_in" (top directory) and "dir_out" are set. +-- "log" can be used for logging. +data StaticusPlugin = + StaticusPlugin String + (M.Map String String->M.Map String String) + (M.Map String String->IO (M.Map String String)) + +-- |Example dummy plugin +staticusPluginDummy = + StaticusPlugin "Staticus Dummy Plugin" run runIO + where run m = M.union + (M.fromList [("log",(fromJust$M.lookup "log" m) + ++"dummy was here!\n")]) m + runIO m = do + print $ "I can do IO!" + return m + + +-- |sequence the IO Action 'f' for each subdirectory of 'fp' recursively. +-- 'f' is passed 'fp' and the currently processed path as well. +trvDirTree :: FilePath -> (FilePath ->FilePath->IO()) ->IO () +trvDirTree fp f = unfoldTreeM unf fp >>= sequence_ + where unf p = getDirList p >>= \s -> f fp p >>= \l -> + return (return l, s) + +-- |get list of subdirectories +getDirList :: FilePath -> IO [FilePath] +getDirList d = map ((d++"/")++) <$> listDirectory d + >>= filterM doesDirectoryExist + +-- |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 () + where f m (StaticusPlugin name run runIO) = runIO m >>= return.run + init= M.fromList [("path",path) + ,("dir_in",dir_in) + ,("dir_out",dir_out) + ,("log","run plugins at: "++path++"\n")] diff --git a/src/WWWStaticusPlugins.hs b/src/WWWStaticusPlugins.hs new file mode 100644 index 0000000..fe17583 --- /dev/null +++ b/src/WWWStaticusPlugins.hs @@ -0,0 +1,115 @@ +module WWWStaticusPlugins + ( staticusPluginsDefault + ,staticusPluginInit + ,staticusPluginCopy + ,staticusPluginPandoc + ,staticusPluginFill + ,staticusPluginWrite + ) where + +import WWWStaticus +import qualified Data.Map.Strict as M +import qualified Data.Text as T +import System.Directory +import Control.Monad +import Data.Maybe +import Data.Either +import Data.List +import Data.List.Split +import Data.List.Utils +import Text.Pandoc + +-- +-- TODOS: +-- +-- timestamp plugin/ do not refresh if md did not change? dir timestamp? +-- +-- 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 +-- +-- contact form? (use nginx log? save post request??) +-- +-- pdf plugin +-- autotranslate plugin :P +-- + +-- |little helper to get values out of a map easily +par k m = case M.lookup k m of + Just x -> x + Nothing -> error $ "key not found: "++k + +-- |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"] + ,staticusPluginPandoc + ,staticusPluginFill + ,staticusPluginWrite + ] + +-- |Creates target directory and sets basic params in map: +-- outdir +staticusPluginInit::StaticusPlugin +staticusPluginInit = StaticusPlugin "init" id runIO + where runIO m = + do 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 brc + let breadcrumbs="" + --TODO: check top dirs until file found! add ./config + md <- readFile $ par "path" m++"/"++"index.md" + tmpl <- readFile $ par "dir_in" m++"/"++"template.html" + return $ M.union (M.fromList [ ("outdir",outdir) + ,("index.md",md) + ,("template.html",tmpl) + ,("menutop",menutop) + ,("submenu",submenu) + ,("breadcrumbs",breadcrumbs) + ]) m + where outdir = par "dir_out" m ++ "/" ++ intercalate "/" brc + brc = remUnder $ splitOn "/" (drop (length (par "dir_in" m)) (par "path" m)) + 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 + +-- |This plugin will simply copy files of given extension from source +-- to the target directory. give it a list of extensions. +staticusPluginCopy::[String]->StaticusPlugin +staticusPluginCopy ext = StaticusPlugin "copy by extension" id runIO + where runIO m = do + let tst x=or $ map ($x) (map isSuffixOf ext) + dl <- filter tst <$> listDirectory (par "path" m) + mapM_ (\x->copyFile (par "path" m++"/"++x) (par "outdir" m++"/"++x)) dl + return m + +-- |pipes 'index.md' value through pandoc and saves in 'content' +staticusPluginPandoc::StaticusPlugin +staticusPluginPandoc = StaticusPlugin "pandoc" run return + where run m = let f = runPure $ do doc <- readMarkdown def{readerExtensions=(enableExtension Ext_raw_html pandocExtensions )} $ T.pack (par "index.md" m) + writeHtml5String def doc + in M.union (M.fromList [("content",T.unpack (fromRight (T.pack "err") f))]) m + +-- |Plugin for filling the 'template.html' value with 'content' +-- and storing in 'final' +staticusPluginFill::StaticusPlugin +staticusPluginFill = StaticusPlugin "fill template" run return + where run m = M.union (M.fromList [("final", + replace "###BREADCRUMBS###" (par "breadcrumbs" m) $ replace "###SUBMENU###" (par "submenu" m) $ replace "###MENU###" (par "menutop" m) (replace "###CONTENT###" (par "content" m) (par "template.html" m)))]) m + + +-- |write final index.html file +staticusPluginWrite::StaticusPlugin +staticusPluginWrite = StaticusPlugin "writer" id runIO + where runIO m = do + writeFile ((par "outdir" m)++"/index.html") (par "final" m) + return m |