# 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)
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~