From 3366fb07342249ccd9037ac487205058c88fabc4 Mon Sep 17 00:00:00 2001 From: Miguel Date: Mon, 18 Feb 2019 17:35:09 +0100 Subject: something useful --- app/Main.hs | 144 +++--------------------------------------------------------- 1 file changed, 7 insertions(+), 137 deletions(-) (limited to 'app/Main.hs') 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=""++replace "-" " " title++"" - --- 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 = "
  • "++(htmlLink (concat (replicate (length b-c-1) "../")) (v) "")++"
    • " - htmlCurrent v = "
  • "++replace "-" " " v++"
    • " - htmlHome = "
  • "++(htmlLink "/" "home" "")++"
    • " - --- 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) = "
  • "++htmlLink (p++s++"/") s "nav-link"++"
    • "++a - | otherwise = "
  • "++htmlLink (p++s++"/") s "nav-link"++"
    • "++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", "
    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++"
    "++a) - $ replace "###TEXT###" (unlines $ map spans xs) tmpl - where tmpl ="
    " - ++"
    " - ++"" - ++"
    " - ++"
    ###TITLE###
    " - ++"

    " - ++"###TEXT###" - ++"

    " - ++"
    " - ++"
    ###FOOTER###
    " - ++"
    " - spans ('-':vv)=let (x:xs)=words vv in ""++unwords xs++"" - 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 -- cgit v1.2.3