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
|
module WWWStaticusPlugins
( staticusPluginsDefault
,staticusPluginInit
,staticusPluginCfg
,staticusPluginCopy
,staticusPluginPandoc
,staticusPluginFill
,staticusPluginWrite
) 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
--
-- 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
--
-- scale images
--
-- asciinema, git, videos
--
-- contact form? (use nginx log? save post request??)
--
-- pdf plugin
--
-- autotranslate plugin :P
--
-- |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"]
,staticusPluginPandoc
,staticusPluginFill
,staticusPluginWrite
]
-- |Creates target directory and sets basic params in map:
staticusPluginInit::StaticusPlugin
staticusPluginInit = StaticusPlugin "init" id runIO
where runIO m =
do print $ 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",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###" (par "title" m) $
replace "###DESCRIPTION###" (par' "###>>>DSC" m) $
replace "###KEYWORDS###" (par' "###>>>KWD" m) $
(par "template.html" m))]) m
-- |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
|
