From d0a2a6ed5ed787fc613f73ba74439d1beba0d1c1 Mon Sep 17 00:00:00 2001 From: Miguel Date: Fri, 1 Feb 2019 12:24:16 +0100 Subject: first commmit after cleanup and switching to stack --- app/Main.hs | 146 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 146 insertions(+) create mode 100644 app/Main.hs (limited to 'app') 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=""++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 + + -} -- cgit v1.2.3