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
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
|
module WWWStaticusPlugins
( staticusPluginsDefault
,staticusPluginTimestamp
,staticusPluginInit
,staticusPluginCfg
,staticusPluginCopy
,staticusPluginPandoc
,staticusPluginFill
,staticusPluginWrite
,staticusPluginCards
,staticusDownloadEmbed
) where
import WWWStaticus
import System.Process
import System.Directory as D
import System.IO.Error
import Data.Time.Clock as C
import Data.Time.Calendar
import qualified Data.Map.Strict as M
import qualified Data.Text as T
import Control.Monad
import Data.Char
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
import Network.HTTP.Simple
import qualified Data.ByteString.Lazy as BL
import qualified Data.ByteString.Lazy.Char8 as Char8
-- IDEAS
--
-- * generate mp4 from ogg/ogv
--
-- * tags
-- * search function
-- * generate sitemap
-- * pdf output
-- * asciinema autorecorder
-- * links checker
-- * multiple templates
-- * contact form (via nginx log?)
-- * autotranslate
-- |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
,staticusPluginTimestamp
,staticusPluginCfg
,staticusPluginCopy [".jpg",".png",".zip",".css",".js",".ico",".mp4",".ogv",".hs",".glade",".cast",".pdf"] "640x480"
,staticusPluginCards
,staticusDownloadEmbed
,staticusPluginPandoc
,staticusPluginFill
,staticusPluginWrite
]
-- |Check if result is younger than source index.md, otherwise set "abort"
staticusPluginTimestamp::StaticusPlugin
staticusPluginTimestamp = StaticusPlugin "init" id runIO
where runIO m =
do t0 <- getT $ par "path" m
t1 <- getT $ par "path" m++"/"++"index.md"
t2 <- getT $ par "outdir" m++"/"++"index.html"
let abort = if(max t0 t1<t2) then [("abort","yes")] else []
return $ M.union (M.fromList abort) m
getT v = catchIOError (D.getModificationTime $ v) handler
handler e = return $ UTCTime (ModifiedJulianDay 0) 1
-- |Creates target directory and sets basic params in map.
staticusPluginInit::StaticusPlugin
staticusPluginInit = StaticusPlugin "init" id runIO
where runIO m =
do putStrLn $ "processing: " ++ par "path" m ++ " ..."
when (not isHome) (createDirectoryIfMissing False 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=\""++htmlroot++"/"++x++"/index.html\">"++x++"</a></li>") (menu t)
let submenu= if isHome then "" else concat $ map (\x->"<li><a href=\""++htmlroot_dir++"/"++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..])
mdex <- doesFileExist $ par "path" m++"/"++"index.md"
md <- if mdex then readFile $ par "path" m++"/"++"index.md" else return ""
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
htmlroot_dir = htmlroot ++ "/" ++ intercalate "/" brc
htmlroot = par "html_root" m
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.
-- It will also scale all .png and .jpg files to fit in the given dims
-- example [".png",".zip",".css"] "640x480"
staticusPluginCopy::[String]->String->StaticusPlugin
staticusPluginCopy ext dims = StaticusPlugin "copy by extension" id runIO
where runIO m = do
let tst x=or $ map ($x) (map isSuffixOf ext)
let tst_img x=or $ map ($x) (map isSuffixOf [".jpg",".png"])
let tst_vid x=or $ map ($x) (map isSuffixOf [".ogv",".ogg"])
dl <- filter tst <$> listDirectory (par "path" m)
mapM_ (\x->copyFile (par "path" m++"/"++x) (par "outdir" m++"/"++x)) dl
mapM_ (\x->scaleFile (par "path" m++"/"++x) (par "outdir" m++"/"++x)) $ filter tst_img dl
return m
where scaleFile fin fout = do let conv_cmd = "convert \""++fin++"\" -resize "++dims++" \""++renameImg fout++"\""
putStrLn conv_cmd
system conv_cmd
renameImg = uncurry (++) . first (("/"++).intercalate "/". init) . second (("/scale_"++).last) . dupe . splitOn "/"
-- |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
-- |Todo: abstract some chucker for this plugin and others!
-- |Embed data fetched via http/https
staticusDownloadEmbed::StaticusPlugin
staticusDownloadEmbed=StaticusPlugin "download and embed" id runIO
where runIO m = do m'<-makeEmbed $ par "index.md" m
return $ M.union (M.fromList[("index.md",concat m')]) m
makeEmbed x = evr2 $ splitRegex (mkRegex "^\\{BEGIN:EMBED\\}.*$|^\\{END:EMBED\\}.*$") x
evr2 (x:y:xs) = do doc<-httpLBS $ parseRequest_ (filter (not.isControl) y)
rest<-evr2 xs
return $ x:(Char8.unpack $ getResponseBody doc):rest
evr2 x = return x
-- |Todo: some generalized snipmate instead
-- |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
|
