first commmit after cleanup and switching to stack

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
+
+                 -}