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
|
# Static Haskell Website Creator - Miguel's Lair
April 12, 2018
About two weeks ago, for personal reasons, I decided to switch my homepage
from a well known PHP driven CMS solution, to a light and static set
of html pages.
I used this fact as a pretence to write my own simple static website
generator. And, Yes.. I know there are already hundereds of such genertors
out there, but I wanted to practice haskell and my masturbatory solution
fits in under 100 lines of code. (Including comments and type signatures)
I use pandoc for all the heavy work, as syntax highlighting and conversion of
markdown to html, anyway.
## Features
* No Documentation
* No Database
* Sitemap derived from Directory Tree
* Simple Markdown Files for Content
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ {.haskell .numberLines}
--
-- Staticus WWW - A minimalistic yet undocumented static website generator
-- coded in April 2018 by Michal Idziorek <m.i@gmx.at>
--
module StaticusWWW where
import Control.Exception
import Control.Monad.Reader
import Data.List
import Data.List.Split
import Data.List.Utils
import Data.Maybe
import Data.Text(pack,unpack)
import Data.Tree
import System.Directory
import Text.Pandoc
-- generate a HTML link from a href & title
htmlLink :: String -> String -> String
htmlLink href title="<a href='"++href++"'>"++replace "_" " " title++"</a>"
-- generate HTML breadcrumbs from a list of page titles
genBrc :: [String] -> String
genBrc b | length b < 2 = ""
| otherwise = fst $ foldl lnk ("",0) b
where lnk (a,c) v = (a++" / "++html c v,c+1)
html c = htmlLink (concat (replicate (length b-c-1) "../"))
-- 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
genPage tmpl dsc kw brc top chld md =
foldr rplc tmpl (replacers content (menu "/" top) (menu "./" chld) (genBrc brc) title dsc kw)
where content = either (const "error") unpack res
where res = runPure $ do doc <- readMarkdown def{readerExtensions=(enableExtension Ext_raw_html pandocExtensions )} $ pack md
writeHtml5String def doc
rplc v = replace ("##" ++ fst v ++ "##") (snd v)
title = if null brc then "Home" else replace "_" " " $ last brc
menu p = foldr (fm p) ""
fm p s a = "<li>"++htmlLink (p++s) s ++"</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) by Miguel 2018")]
-- get list of subdirectories in given directory, with full relative path
getDirList :: FilePath -> IO [FilePath]
getDirList d = map ((d++"/")++) <$> listDirectory d
>>= filterM doesDirectoryExist
-- sequence IO Action 'f' for each subdirectory of 'fp' recursively
trvDirTree :: FilePath -> (FilePath -> [FilePath] -> IO()) -> IO ()
trvDirTree fp f = unfoldTreeM unf fp >>= sequence_
where unf p = getDirList p >>= \s -> f p s >>= \l ->
return (return l, s)
-- write the HTML page generated from current diectory by 'genPage'
wrtPage :: FilePath -> FilePath -> String -> [FilePath] -> FilePath -> [FilePath] -> IO ()
wrtPage idx out tmpl top p chld = do
when (not home) (createDirectory outdir)
md <- readFile $ p ++ "/index.md"
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")
brc (menu top) (if home then [] else menu chld) 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 "/") . sort
outdir = out ++ "/" ++ intercalate "/" brc
brc = remUnder $ splitOn "/" (drop (length idx) p)
-- Main IO action: traverses index recursively and calls wrtPage in each
-- subdir, which in turn generates the output directories and html pages
main :: IO ()
main = do tmpl <- readFile "./DATA/template.html"
top <- getDirList "./INDEX"
trvDirTree "./INDEX" (wrtPage "./INDEX" "./OUT" tmpl top)
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
