diff options
Diffstat (limited to 'app/Main.hs')
| -rw-r--r-- | app/Main.hs | 146 |
1 files changed, 146 insertions, 0 deletions
diff --git a/app/Main.hs b/app/Main.hs new file mode 100644 index 0000000..9727c8c --- /dev/null +++ b/app/Main.hs @@ -0,0 +1,146 @@ +module Main where + +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. +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 + + -} |