1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
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
-}
|
