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
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
|
module WWWStaticusPlugins
( staticusPluginsDefault
,staticusPluginInit
,staticusPluginCfg
,staticusPluginCopy
,staticusPluginPandoc
,staticusPluginFill
,staticusPluginWrite
,staticusPluginCards
) where
import WWWStaticus
import qualified Data.Map.Strict as M
import qualified Data.Text as T
import System.Directory
import Control.Monad
import Data.Maybe
import Data.Either
import Data.List
import Data.List.Split
import Data.List.Utils
import Data.Tuple.Extra
import Text.Pandoc
import Text.Regex
--
-- PLUGIN IDEAS
--
-- timestamp plugin/ do not refresh if md did not change? dir timestamp?
-- but check if depends on upstream stuff as git
--
-- super `gallery and everythin` plugin, just throw images,videos,
-- zips,tars,source files,mds etc inside a folder-> gen page!
--
-- flexible layout, main pic, secondary pics, multiple templates 1 2 3
--
-- scale images
--
-- asciinema, git, videos (generate both from single one)
--
-- contact form? (use nginx log? save post request??)
--
-- pdf plugin
--
-- autotranslate/ multilang
--
-- |little helper to get values out of a map easily
-- error if not found.
par k m = case M.lookup k m of
Just x -> x
Nothing -> error $ "key not found: "++k
-- |little helper to get values out of a map easily
-- defaulting to empty string.
par' k m = case M.lookup k m of
Just x -> x
Nothing -> ""
-- |A default set of plugins that you can use to kickstart your page
-- Use now, Adapt later.
staticusPluginsDefault::[StaticusPlugin]
staticusPluginsDefault=[ staticusPluginInit
,staticusPluginCfg
,staticusPluginCopy [".jpg",".png",".zip",".css",".js",".ico",".mp4",".ogv",".hs",".glade"]
,staticusPluginCards
,staticusPluginPandoc
,staticusPluginFill
,staticusPluginWrite
]
-- |Creates target directory and sets basic params in map:
-- TODO: cleanup!
staticusPluginInit::StaticusPlugin
staticusPluginInit = StaticusPlugin "init" id runIO
where runIO m =
do putStrLn $ "processing: " ++ par "path" m ++ " ..."
when (not isHome) (createDirectory outdir)
c <- getDirList (par "path" m)
t <- getDirList (par "dir_in" m)
let menutop= concat $ map (\x->"<li class=\"nav-item"++(if length brc>=1 && brc!!0==x then " active" else "")++"\"><a class=\"nav-link\" href=\""++par "dir_out" m++"/"++x++"/index.html\">"++x++"</a></li>") (menu t)
let submenu= if isHome then "" else concat $ map (\x->"<li><a href=\""++outdir++"/"++x++"/index.html\">"++cln x++"</a></li>") (menu c)
let breadcrumbs=concat $ map (\(x,d)->"<li class=\"breadcrumb-item"++(if d==0 then " active" else "")++"\">"++(if d==0 then "" else "<a href=."++concat(take d (repeat "/.."))++"/index.html>")++cln x++(if d==0 then "" else "</a>")++"</li>") (zip ("home":brc) [brcl,brcl-1..])
md <- readFile $ par "path" m++"/"++"index.md"
tmpl <- readFile $ par "dir_in" m++"/"++"template.html"
return $ M.union (M.fromList [ ("outdir",outdir)
,("index.md",md)
,("template.html",tmpl)
,("menutop",menutop)
,("submenu",submenu)
,("breadcrumbs",if isHome then "" else breadcrumbs)
,("title",if null brc then "Home" else cln $ last brc)
]) m
where outdir = par "dir_out" m ++ "/" ++ intercalate "/" brc
brc = remUnder $ splitOn "/" (drop (length (par "dir_in" m)) (par "path" m))
brcl = length brc
remUnder = filter (not.null) . map (dropWhile(=='_').dropWhile(/='_'))
menu = remUnder . filter (not . isPrefixOf "00_") . map (last.splitOn "/") . sortBy (flip compare)
isHome = par "path" m==par "dir_in" m
cln x = replace "-" " " x
-- |This plugin will simply copy files of given extension from source
-- to the target directory. give it a list of file extensions.
-- example [".png",".zip",".css"]
staticusPluginCopy::[String]->StaticusPlugin
staticusPluginCopy ext = StaticusPlugin "copy by extension" id runIO
where runIO m = do
let tst x=or $ map ($x) (map isSuffixOf ext)
dl <- filter tst <$> listDirectory (par "path" m)
mapM_ (\x->copyFile (par "path" m++"/"++x) (par "outdir" m++"/"++x)) dl
return m
-- |extracts config lines (###>>>) from 'index.md'
staticusPluginCfg::StaticusPlugin
staticusPluginCfg = StaticusPlugin "extract config lines" run return
where run m = M.union (M.fromList (("index.md",indexmd):conf)) m
where indexmd=unlines . filter (not.isPrefixOf "###>>>") . lines $ par "index.md" m
conf= map (first head.second (unwords.tail).dupe.words) . filter (isPrefixOf "###>>>") . lines $ par "index.md" m
-- |pipes 'index.md' value through pandoc and saves in 'content'
staticusPluginPandoc::StaticusPlugin
staticusPluginPandoc = StaticusPlugin "pandoc" run return
where run m = let f = runPure $ do doc <- readMarkdown def{readerExtensions=(enableExtension Ext_raw_html pandocExtensions )} $ T.pack (par "index.md" m)
writeHtml5String def doc
in M.union (M.fromList [("content",T.unpack (fromRight (T.pack "err") f))]) m
-- |Plugin for filling the 'template.html' value with 'content', 'menu',
-- etc and storing in 'final'
staticusPluginFill::StaticusPlugin
staticusPluginFill = StaticusPlugin "fill template" run return
where run m = M.union (M.fromList [("final",
replace "###BREADCRUMBS###" (par "breadcrumbs" m) $
replace "###SUBMENU###" (par "submenu" m) $
replace "###MENU###" (par "menutop" m) $
replace "###CONTENT###" (par "content" m) $
replace "###ROOT###" (par "html_root" m) $
replace "###TITLE###" (t (par' "###>>>TITLE" m,par "title" m)) $
replace "###DESCRIPTION###" (par' "###>>>DSC" m) $
replace "###KEYWORDS###" (par' "###>>>KWD" m) $
(par "template.html" m))]) m
t (a,b) = if a=="" then b else a
-- |write final index.html file
staticusPluginWrite::StaticusPlugin
staticusPluginWrite = StaticusPlugin "writer" id runIO
where runIO m = do
writeFile ((par "outdir" m)++"/index.html") (par "final" m)
return m
-- |simple bootstrap cards
staticusPluginCards::StaticusPlugin
staticusPluginCards = StaticusPlugin "bootstrap cards" run return
where run m = M.union (M.fromList[("index.md",makeCards $ par "index.md" m)]) m
makeCards x = concat $ evr2 $ splitRegex (mkRegex "^\\{BEGIN:CARD\\}.*$|^\\{END:CARD\\}.*$") x
evr2 (x:y:xs) = x:createCard y:evr2 xs
evr2 x = x
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
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
|
