Split Main.hs

Replace tabs with spaces. No functional changes.

7 files changed, 358 insertions, 332 deletions

diff --git a/.gitignore b/.gitignore
index eccac6e..94cb658 100644
--- a/.gitignore
+++ b/.gitignore
@@ -2,4 +2,4 @@
 .cabal-sandbox/
 cabal.sandbox.config
 dist/
-comatose.html
+_build/
diff --git a/Main.hs b/Main.hs
deleted file mode 100644
index 06de6ef..0000000
--- a/Main.hs
+++ /dev/null
@@ -1,330 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-
-import Control.Applicative
-import Control.Monad
-import Data.Monoid
-import Data.Yaml
-import Data.List (nub, sort, sortBy, isPrefixOf)
-import Data.Function (on)
-import Data.Maybe (catMaybes)
-import qualified Data.Text as T
-import Data.Text.Encoding (decodeUtf8)
-import qualified Data.Aeson as A
-import Text.BibTeX.Parse
-import Text.BibTeX.Entry as E
-import qualified Data.Map as M
-import Text.Parsec.Error
-import Text.ParserCombinators.Parsec.Prim
-import Text.Printf (printf)
-import qualified Data.ByteString.Lazy as BS
-import System.FilePath ((<.>), splitExtension)
-import System.Directory (copyFile)
-import Network.URI (isReserved, escapeURIString)
-import Lucid
-
-import Paths_comatose
-
--- |A MAC protocol/algorithm
-data Protocol = Protocol {
-	-- |Short protocol name, usually its abbreviation
-	  pname :: String
-	-- |Long protocol name
-	, plongname :: Maybe String
-	-- |Free-text protocol description
-	, pdescription :: Maybe String
-	-- |List of publication references describing this protocol
-	, pref :: [String]
-	-- |Feature references of this protocol
-	, pfeatures :: M.Map String (Maybe String)
-	-- |List of references to other protocols, usually from the paper’s
-	-- “related work” section
-	, prelated :: [String]
-	-- |Relevance of this protocol, calculated (pun intended)
-	, prank :: Float
-	} deriving Show
-
--- |A MAC protocol feature
-data Feature = Feature {
-	-- |Referenceable name
-	  fname :: String
-	-- |Its description
-	, fdescription :: Maybe String
-	} deriving Show
-
--- |The whole database
-data Database = Database {
-	-- |Key-value pair for each protocol
-	  dalgos :: M.Map String Protocol
-	-- |Global list of available features
-	, dfeatures :: M.Map String Feature
-	-- |Global list of available publications
-	, dpublications :: [T]
-	} deriving Show
-
-instance FromJSON Protocol where
-	parseJSON (Object v) = Protocol
-		<$> v .: "name"
-		<*> v .:? "longname"
-		<*> v .:? "description"
-		<*> v .:? "ref" .!= []
-		<*> v .:? "features" .!= M.empty
-		<*> v .:? "related" .!= []
-		<*> return 0
-	parseJSON _          = mzero
-
-instance FromJSON Feature where
-	parseJSON (Object v) = Feature
-		<$> v .: "name"
-		<*> v .:? "description"
-	parseJSON _          = mzero
-
-instance FromJSON Database where
-	parseJSON (Object v) = Database
-		<$> v .: "algos"
-		<*> v .: "features"
-		<*> pure []
-	parseJSON _          = mzero
-
--- |Safe head function
-safeHead [] = Nothing
-safeHead (x:_) = Just x
-
--- |Find publication with identifier `ident`
-findPublication db ident = safeHead $ filter (\x -> ident == E.identifier x) $ dpublications db
-
--- |Get a list of all publications referenced by proto @p@
-protoPublications db p = map (findPublication db) (pref p)
-
--- |Find all referenced features’ names
-referencedFeatures db = nub $ sort $ concat $ map (M.keys . pfeatures) $ M.elems $ dalgos db
-
-filterMap filterF mapF xs = map mapF $ filter filterF xs
-
--- |Get all features at `level`, starting with 0
-getFeaturesByLevel db level = M.filterWithKey (\k v -> countDots k == level) $ dfeatures db
-	where
-		countDots = length . filter ((==) '.')
-
--- |Get features by `base` feature
-getFeaturesByBase db base = M.filterWithKey (\k v -> (base ++ ".") `isPrefixOf` k) $ dfeatures db
-
--- |Read protocol and bib database from file
-readDb :: String -> IO Database
-readDb f = do
-	yamlres <- decodeFileEither f
-	--print yamlres
-	let
-		(Right yamldb) = yamlres
-		(basename, _) = splitExtension f
-	bibres <- parseFromFile file (basename <.> "bib")
-	--print bibres
-	let (Right bibdb) = bibres
-	return $ calcRank $ yamldb { dpublications = bibdb }
-
--- |Protocol rank/popularity, uses the pagerank algorithm
-calcRank db =
-	let
-		initalgos = M.mapWithKey initial $ dalgos db
-		n = fromIntegral $ M.size $ dalgos db
-		d = 0.85
-		initial ident p = p { prank = 1.0/n }
-		-- Get all incoming references
-		pincoming algos ident = filter (\(_, x) -> ident `elem` prelated x) $ M.toList algos
-		-- Calculate new rank for p
-		modify algos ident p = p { prank = (1-d)/n + d*sum (map inrank (pincoming algos ident)) }
-		-- Incoming rank for p
-		inrank (_, p) = prank p / fromIntegral (length (prelated p))
-		absdiff :: M.Map String Protocol -> (String, Protocol) -> Float
-		absdiff b (ident, p) = abs (prank (b M.! ident) - prank p)
-		rankdiff :: M.Map String Protocol -> M.Map String Protocol -> Float
-		rankdiff a b = 1/n * M.foldlWithKey (\x ident p -> x + absdiff b (ident, p)) 0 a
-		iterateUntil fiter fcmp a = let b = fiter a in if fcmp a b then iterateUntil fiter fcmp b else b
-		run algos = M.mapWithKey (modify algos) algos
-		stop prevalgos algos = rankdiff prevalgos algos > 0.00001
-	in db { dalgos = (iterateUntil run stop initalgos) }
-
-maybeToHtml = maybe mempty toHtml
-
-scholarSearch q = "http://scholar.google.com/scholar?q=" ++ escapeURIString isReserved q
-resolveDoi :: String -> String
-resolveDoi q = "http://doi.org/" ++ q
-
--- |List of protocol features
-protofeatures :: Database -> Protocol -> Html ()
-protofeatures _ p | (M.size $ pfeatures p) == 0 = mempty
-protofeatures db p = do
-	dt_ "Features"
-	dd_ $ ul_ [class_ "features list-inline"] $ forM_ (sort $ M.keys $ pfeatures p) (\x -> li_ [data_ "id" (T.pack x), class_ "list-inline-item"] $ toHtml $ maybe ("" :: String) fname $ M.lookup x (dfeatures db))
-
--- |List of protocol publications
-protopapers :: [T] -> Html ()
-protopapers pubs | length pubs == 0 = mempty
-protopapers pubs = do
-	dt_ "Published in"
-	dd_ [class_ "ref"] $ if length pubs == 1
-		then p_ $ bibentry $ head pubs
-		else ol_ $ forM_ pubs (li_ . bibentry)
-
--- |Protocol description
-protodesc :: Protocol -> Html ()
-protodesc Protocol { pdescription = Nothing } = mempty
-protodesc Protocol { pdescription = Just desc } = p_ $ toHtml desc
-
-protorelated :: Database -> Protocol -> Html ()
-protorelated _ p | null $ prelated p = mempty
-protorelated db p =
-	let
-		algos = dalgos db
-		lookup k = M.lookup k algos >>= \y -> return (k, y)
-		rel = catMaybes $ map lookup $ prelated p
-	in do
-		dt_ "Related"
-		dd_ [class_ "related"] $ ul_ [class_ "list-inline"] $ forM_ rel $
-			\(ident, x) -> li_ [class_ "list-inline-item"] $ a_ [href_ (T.pack $ '#':ident)] $ toHtml $ pname x
-
--- |One protocol
-protoentry :: Database -> (String, Protocol) -> Html ()
-protoentry db (ident, p) =
-	let
-		pubs = catMaybes $ protoPublications db p
-		firstpub = safeHead pubs
-		field key = firstpub >>= (return . E.fields) >>= lookup key
-	in
-		section_ [
-			id_ $ T.pack ident
-			, class_ "protocol"
-			, data_ "rank" (T.pack $ show $ prank p)
-			] $ do
-			h3_ [class_ "name"] $ do
-				a_ [href_ (T.pack $ '#':ident), title_ "permalink"] $ toHtml $ pname p
-				" "
-				maybe "" (small_ [class_ "longname"] . toHtml) $ plongname p
-			protodesc p
-			dl_ $ do
-				protopapers pubs
-				protofeatures db p
-				protorelated db p
-
-extcss url = link_ [rel_ "stylesheet", type_ "text/css", href_ url]
-
-extjs :: T.Text -> Html ()
-extjs url = script_ [type_ "text/javascript", charset_ "utf8", src_ url] ("" :: T.Text)
-
--- | Try very hard to find an appropriate URL for the bibentry, DOIs are prefered
-bibentryurl bib = safeHead $ catMaybes [doi, url]
-	where
-		fields = E.fields bib
-		doi = lookup "doi" fields >>= return . resolveDoi
-		url = lookup "url" fields
-
--- | Format bibliography/references item
-bibentry :: E.T -> Html ()
-bibentry bib = do
-	let
-		fields = E.fields bib
-		htmlLookup k = maybeToHtml $ lookup k fields
-	maybe
-		(span_ [class_ "title"] $ htmlLookup "title")
-		(\x -> a_ [href_ $ T.pack $ x, class_ "title"] $ htmlLookup "title")
-		(bibentryurl bib)
-	", "
-	span_ [class_ "author"] $ htmlLookup "author"
-	", "
-	span_ [class_ "year"] $ htmlLookup "year"
-
--- | References section
-references :: [E.T] -> Html ()
-references attrib = section_ $ do
-		h2_ "References"
-		ol_ $ forM_ attrib (li_ . bibentry)
-
--- | What is this?!
-introduction :: Database -> Html ()
-introduction db =
-	let
-		algocount = M.size $ dalgos db
-		pubyears = catMaybes $ map (lookup "year" . E.fields) $ dpublications db
-		firstyear = foldr min (head pubyears) (tail pubyears)
-		lastyear = foldr max (head pubyears) (tail pubyears)
-	in section_ [class_ "container"] $ do
-		h1_ [class_ "display-3"] "comatose"
-		p_ $ do
-			"The comprehensive MAC taxonomy database (comatose) is a collection of "
-			toHtml $ show algocount
-			" wireless media/medium access protocols published between "
-			toHtml firstyear
-			" and "
-			toHtml lastyear
-			"."
-
--- |List of protocol features
-features :: Database -> Html ()
-features db =
-	section_ [id_ "features"] $ do
-		h2_ "Features"
-		p_ "This section presents so-called “features” that are assigned to each protocol."
-		forM_ (M.toList $ getFeaturesByLevel db 0) $ \(baseident, basefeature) -> do
-			let featureanchor = "feature-" ++ baseident in do
-				h3_ [id_ $ T.pack featureanchor] $ a_ [href_ $ T.pack $ '#':featureanchor] $ toHtml $ fname basefeature
-				maybe mempty (p_ . toHtml) $ fdescription basefeature
-				dl_ $ forM_ (M.toList $ getFeaturesByBase db baseident) $ \(ident, feature) -> do
-					dt_ [class_ "form-inline"] $ let i = T.pack ("filter-feature-" ++ ident) in do
-						input_ [type_ "checkbox", id_ i, class_ "filter-feature", value_ (T.pack ident)]
-						" "
-						label_ [for_ i] $ toHtml $ fname feature
-					maybe mempty (dd_ . toHtml) $ fdescription feature
-
--- | The list of protocols
-protocols :: Database -> Html ()
-protocols db = section_ [id_ "protocols"] $ do
-	h2_ "Protocols"
-	forM_ (M.toList $ dalgos db) (protoentry db)
-
--- |Page template
-page db attrib = doctypehtml_ $ do
-	head_ $ do
-		title_ "comatose"
-		meta_ [charset_ "utf-8"]
-		meta_ [name_ "viewport", content_ "width=device-width, initial-scale=1, shrink-to-fit=no"]
-		extjs "https://code.jquery.com/jquery-3.2.1.min.js"
-		extcss "https://maxcdn.bootstrapcdn.com/bootstrap/4.0.0-beta/css/bootstrap.min.css"
-		extjs "https://maxcdn.bootstrapcdn.com/bootstrap/4.0.0-beta/js/bootstrap.min.js"
-		extcss "style.css"
-	body_ $ do
-		nav_ [class_ "navbar navbar-expand-md navbar-dark bg-dark fixed-top"] $ do
-			div_ [class_ "collapse navbar-collapse"] $ do
-				span_ [class_ "navbar-brand"] "comatose"
-				ul_ [class_ "navbar-nav mr-auto"] $ do
-					li_ [class_ "nav-item" ] $ a_ [class_ "nav-link", href_ "#features"] "Features"
-					li_ [class_ "nav-item" ] $ a_ [class_ "nav-link", href_ "#protocols"] "Protocols"
-				form_ [id_ "protosort", class_ "form-inline my-2 my-lg-0"] $ do
-					input_ [id_ "filter", type_ "search", class_ "form-control mr-sm-2", placeholder_ "Filter by name"]
-					" "
-					label_ [for_ "sort"] "Sort by"
-					" "
-					select_ [id_ "sort", class_ "form-control"] $ do
-						option_ [value_ "name"] "Name"
-						option_ [value_ "year"] "Year"
-						option_ [value_ "rank"] "Rank"
-		div_ [class_ "jumbotron" ] $ introduction db
-		div_ [class_ "container"] $ do
-			features db
-			protocols db
-			references (sortBy (compare `on` lookup "year" . E.fields) attrib)
-		extjs "script.js"
-
--- |Render page
-render f db attribution = renderToFile f (page db attribution)
-
--- |Read attributions from bibtex file
-readAttributions = getDataFileName "data/attribution.bib" >>= parseFromFile file
-
-copyDataFile source dest = getDataFileName source >>= (\x -> copyFile x dest)
-
-main = do
-	db <- getDataFileName "data/db.yaml" >>= readDb
-	(Right attribution) <- readAttributions
-	render "_build/index.html" db attribution
-	copyDataFile "data/style.css" "_build/style.css"
-	copyDataFile "data/script.js" "_build/script.js"
-
diff --git a/comatose.cabal b/comatose.cabal
index 6112b16..e618489 100644
--- a/comatose.cabal
+++ b/comatose.cabal
@@ -20,6 +20,6 @@ executable comatose
   -- other-modules:       
   -- other-extensions:    
   build-depends:       base >=4.6 && <4.10, bibtex, yaml, containers, parsec, lucid, bytestring, text, filepath, network-uri, aeson, directory
-  -- hs-source-dirs:      
+  hs-source-dirs:      src
   default-language:    Haskell2010
 
diff --git a/src/Db.hs b/src/Db.hs
new file mode 100644
index 0000000..8f6fdba
--- /dev/null
+++ b/src/Db.hs
@@ -0,0 +1,129 @@
+{-# LANGUAGE OverloadedStrings #-}
+module Db where
+
+import System.FilePath ((<.>), splitExtension)
+import Data.List (nub, sort, sortBy, isPrefixOf)
+import Control.Monad
+import Data.Yaml
+import Text.Parsec.Error
+import Text.ParserCombinators.Parsec.Prim
+import Text.BibTeX.Parse
+import Text.BibTeX.Entry as E
+import qualified Data.Aeson as A
+import qualified Data.Map as M
+
+import Util
+
+-- |A MAC protocol/algorithm
+data Protocol = Protocol {
+    -- |Short protocol name, usually its abbreviation
+      pname :: String
+    -- |Long protocol name
+    , plongname :: Maybe String
+    -- |Free-text protocol description
+    , pdescription :: Maybe String
+    -- |List of publication references describing this protocol
+    , pref :: [String]
+    -- |Feature references of this protocol
+    , pfeatures :: M.Map String (Maybe String)
+    -- |List of references to other protocols, usually from the paper’s
+    -- “related work” section
+    , prelated :: [String]
+    -- |Relevance of this protocol, calculated (pun intended)
+    , prank :: Float
+    } deriving Show
+
+-- |A MAC protocol feature
+data Feature = Feature {
+    -- |Referenceable name
+      fname :: String
+    -- |Its description
+    , fdescription :: Maybe String
+    } deriving Show
+
+-- |The whole database
+data Database = Database {
+    -- |Key-value pair for each protocol
+      dalgos :: M.Map String Protocol
+    -- |Global list of available features
+    , dfeatures :: M.Map String Feature
+    -- |Global list of available publications
+    , dpublications :: [T]
+    } deriving Show
+
+instance FromJSON Protocol where
+    parseJSON (Object v) = Protocol
+        <$> v .: "name"
+        <*> v .:? "longname"
+        <*> v .:? "description"
+        <*> v .:? "ref" .!= []
+        <*> v .:? "features" .!= M.empty
+        <*> v .:? "related" .!= []
+        <*> return 0
+    parseJSON _          = mzero
+
+instance FromJSON Feature where
+    parseJSON (Object v) = Feature
+        <$> v .: "name"
+        <*> v .:? "description"
+    parseJSON _          = mzero
+
+instance FromJSON Database where
+    parseJSON (Object v) = Database
+        <$> v .: "algos"
+        <*> v .: "features"
+        <*> pure []
+    parseJSON _          = mzero
+
+-- |Find publication with identifier `ident`
+findPublication db ident = safeHead $ filter (\x -> ident == E.identifier x) $ dpublications db
+
+-- |Get a list of all publications referenced by proto @p@
+protoPublications db p = map (findPublication db) (pref p)
+
+-- |Find all referenced features’ names
+referencedFeatures db = nub $ sort $ concat $ map (M.keys . pfeatures) $ M.elems $ dalgos db
+
+-- |Get all features at `level`, starting with 0
+getFeaturesByLevel db level = M.filterWithKey (\k v -> countDots k == level) $ dfeatures db
+    where
+        countDots = length . filter ((==) '.')
+
+-- |Get features by `base` feature
+getFeaturesByBase db base = M.filterWithKey (\k v -> (base ++ ".") `isPrefixOf` k) $ dfeatures db
+
+-- |Read protocol and bib database from file
+readDb :: String -> IO Database
+readDb f = do
+    yamlres <- decodeFileEither f
+    --print yamlres
+    let
+        (Right yamldb) = yamlres
+        (basename, _) = splitExtension f
+    bibres <- parseFromFile file (basename <.> "bib")
+    --print bibres
+    let (Right bibdb) = bibres
+    return $ calcRank $ yamldb { dpublications = bibdb }
+
+-- |Protocol rank/popularity, uses the pagerank algorithm
+calcRank db =
+    let
+        initalgos = M.mapWithKey initial $ dalgos db
+        n = fromIntegral $ M.size $ dalgos db
+        d = 0.85
+        initial ident p = p { prank = 1.0/n }
+        -- Get all incoming references
+        pincoming algos ident = filter (\(_, x) -> ident `elem` prelated x) $ M.toList algos
+        -- Calculate new rank for p
+        modify algos ident p = p { prank = (1-d)/n + d*sum (map inrank (pincoming algos ident)) }
+        -- Incoming rank for p
+        inrank (_, p) = prank p / fromIntegral (length (prelated p))
+        absdiff :: M.Map String Protocol -> (String, Protocol) -> Float
+        absdiff b (ident, p) = abs (prank (b M.! ident) - prank p)
+        rankdiff :: M.Map String Protocol -> M.Map String Protocol -> Float
+        rankdiff a b = 1/n * M.foldlWithKey (\x ident p -> x + absdiff b (ident, p)) 0 a
+        iterateUntil fiter fcmp a = let b = fiter a in if fcmp a b then iterateUntil fiter fcmp b else b
+        run algos = M.mapWithKey (modify algos) algos
+        stop prevalgos algos = rankdiff prevalgos algos > 0.00001
+    in db { dalgos = (iterateUntil run stop initalgos) }
+
diff --git a/src/Main.hs b/src/Main.hs
new file mode 100644
index 0000000..1521382
--- /dev/null
+++ b/src/Main.hs
@@ -0,0 +1,23 @@
+module Main (main) where
+
+import Text.ParserCombinators.Parsec.Prim
+import Text.BibTeX.Parse
+import System.Directory (copyFile)
+
+import Render (render)
+import Db (readDb)
+
+import Paths_comatose
+
+-- |Read attributions from bibtex file
+readAttributions = getDataFileName "data/attribution.bib" >>= parseFromFile file
+
+copyDataFile source dest = getDataFileName source >>= (\x -> copyFile x dest)
+
+main = do
+    db <- getDataFileName "data/db.yaml" >>= readDb
+    (Right attribution) <- readAttributions
+    render "_build/index.html" db attribution
+    copyDataFile "data/style.css" "_build/style.css"
+    copyDataFile "data/script.js" "_build/script.js"
+
diff --git a/src/Render.hs b/src/Render.hs
new file mode 100644
index 0000000..d48a567
--- /dev/null
+++ b/src/Render.hs
@@ -0,0 +1,197 @@
+{-# LANGUAGE OverloadedStrings #-}
+module Render (render) where
+
+import Control.Applicative
+import Control.Monad
+import Data.Monoid
+import Data.List (nub, sort, sortBy, isPrefixOf)
+import Data.Function (on)
+import Data.Maybe (catMaybes)
+import qualified Data.Text as T
+import Data.Text.Encoding (decodeUtf8)
+import Text.BibTeX.Entry as E
+import qualified Data.Map as M
+import Text.Parsec.Error
+import Text.ParserCombinators.Parsec.Prim
+import Text.Printf (printf)
+import qualified Data.ByteString.Lazy as BS
+import Network.URI (isReserved, escapeURIString)
+import Lucid
+
+import Util
+import Db
+
+maybeToHtml = maybe mempty toHtml
+
+scholarSearch q = "http://scholar.google.com/scholar?q=" ++ escapeURIString isReserved q
+
+resolveDoi :: String -> String
+resolveDoi q = "http://doi.org/" ++ q
+
+-- |List of protocol features
+protofeatures :: Database -> Protocol -> Html ()
+protofeatures _ p | (M.size $ pfeatures p) == 0 = mempty
+protofeatures db p = do
+    dt_ "Features"
+    dd_ $ ul_ [class_ "features list-inline"] $ forM_ (sort $ M.keys $ pfeatures p) (\x -> li_ [data_ "id" (T.pack x), class_ "list-inline-item"] $ toHtml $ maybe ("" :: String) fname $ M.lookup x (dfeatures db))
+
+-- |List of protocol publications
+protopapers :: [T] -> Html ()
+protopapers pubs | length pubs == 0 = mempty
+protopapers pubs = do
+    dt_ "Published in"
+    dd_ [class_ "ref"] $ if length pubs == 1
+        then p_ $ bibentry $ head pubs
+        else ol_ $ forM_ pubs (li_ . bibentry)
+
+-- |Protocol description
+protodesc :: Protocol -> Html ()
+protodesc Protocol { pdescription = Nothing } = mempty
+protodesc Protocol { pdescription = Just desc } = p_ $ toHtml desc
+
+protorelated :: Database -> Protocol -> Html ()
+protorelated _ p | null $ prelated p = mempty
+protorelated db p =
+    let
+        algos = dalgos db
+        lookup k = M.lookup k algos >>= \y -> return (k, y)
+        rel = catMaybes $ map lookup $ prelated p
+    in do
+        dt_ "Related"
+        dd_ [class_ "related"] $ ul_ [class_ "list-inline"] $ forM_ rel $
+            \(ident, x) -> li_ [class_ "list-inline-item"] $ a_ [href_ (T.pack $ '#':ident)] $ toHtml $ pname x
+
+-- |One protocol
+protoentry :: Database -> (String, Protocol) -> Html ()
+protoentry db (ident, p) =
+    let
+        pubs = catMaybes $ protoPublications db p
+        firstpub = safeHead pubs
+        field key = firstpub >>= (return . E.fields) >>= lookup key
+    in
+        section_ [
+            id_ $ T.pack ident
+            , class_ "protocol"
+            , data_ "rank" (T.pack $ show $ prank p)
+            ] $ do
+            h3_ [class_ "name"] $ do
+                a_ [href_ (T.pack $ '#':ident), title_ "permalink"] $ toHtml $ pname p
+                " "
+                maybe "" (small_ [class_ "longname"] . toHtml) $ plongname p
+            protodesc p
+            dl_ $ do
+                protopapers pubs
+                protofeatures db p
+                protorelated db p
+
+extcss url = link_ [rel_ "stylesheet", type_ "text/css", href_ url]
+
+extjs :: T.Text -> Html ()
+extjs url = script_ [type_ "text/javascript", charset_ "utf8", src_ url] ("" :: T.Text)
+
+-- | Try very hard to find an appropriate URL for the bibentry, DOIs are prefered
+bibentryurl bib = safeHead $ catMaybes [doi, url]
+    where
+        fields = E.fields bib
+        doi = lookup "doi" fields >>= return . resolveDoi
+        url = lookup "url" fields
+
+-- | Format bibliography/references item
+bibentry :: E.T -> Html ()
+bibentry bib = do
+    let
+        fields = E.fields bib
+        htmlLookup k = maybeToHtml $ lookup k fields
+    maybe
+        (span_ [class_ "title"] $ htmlLookup "title")
+        (\x -> a_ [href_ $ T.pack $ x, class_ "title"] $ htmlLookup "title")
+        (bibentryurl bib)
+    ", "
+    span_ [class_ "author"] $ htmlLookup "author"
+    ", "
+    span_ [class_ "year"] $ htmlLookup "year"
+
+-- | References section
+references :: [E.T] -> Html ()
+references attrib = section_ $ do
+        h2_ "References"
+        ol_ $ forM_ attrib (li_ . bibentry)
+
+-- | What is this?!
+introduction :: Database -> Html ()
+introduction db =
+    let
+        algocount = M.size $ dalgos db
+        pubyears = catMaybes $ map (lookup "year" . E.fields) $ dpublications db
+        firstyear = foldr min (head pubyears) (tail pubyears)
+        lastyear = foldr max (head pubyears) (tail pubyears)
+    in section_ [class_ "container"] $ do
+        h1_ [class_ "display-3"] "comatose"
+        p_ $ do
+            "The comprehensive MAC taxonomy database (comatose) is a collection of "
+            toHtml $ show algocount
+            " wireless media/medium access protocols published between "
+            toHtml firstyear
+            " and "
+            toHtml lastyear
+            "."
+
+-- |List of protocol features
+features :: Database -> Html ()
+features db =
+    section_ [id_ "features"] $ do
+        h2_ "Features"
+        p_ "This section presents so-called “features” that are assigned to each protocol."
+        forM_ (M.toList $ getFeaturesByLevel db 0) $ \(baseident, basefeature) -> do
+            let featureanchor = "feature-" ++ baseident in do
+                h3_ [id_ $ T.pack featureanchor] $ a_ [href_ $ T.pack $ '#':featureanchor] $ toHtml $ fname basefeature
+                maybe mempty (p_ . toHtml) $ fdescription basefeature
+                dl_ $ forM_ (M.toList $ getFeaturesByBase db baseident) $ \(ident, feature) -> do
+                    dt_ [class_ "form-inline"] $ let i = T.pack ("filter-feature-" ++ ident) in do
+                        input_ [type_ "checkbox", id_ i, class_ "filter-feature", value_ (T.pack ident)]
+                        " "
+                        label_ [for_ i] $ toHtml $ fname feature
+                    maybe mempty (dd_ . toHtml) $ fdescription feature
+
+-- | The list of protocols
+protocols :: Database -> Html ()
+protocols db = section_ [id_ "protocols"] $ do
+    h2_ "Protocols"
+    forM_ (M.toList $ dalgos db) (protoentry db)
+
+-- |Page template
+page db attrib = doctypehtml_ $ do
+    head_ $ do
+        title_ "comatose"
+        meta_ [charset_ "utf-8"]
+        meta_ [name_ "viewport", content_ "width=device-width, initial-scale=1, shrink-to-fit=no"]
+        extjs "https://code.jquery.com/jquery-3.2.1.min.js"
+        extcss "https://maxcdn.bootstrapcdn.com/bootstrap/4.0.0-beta/css/bootstrap.min.css"
+        extjs "https://maxcdn.bootstrapcdn.com/bootstrap/4.0.0-beta/js/bootstrap.min.js"
+        extcss "style.css"
+    body_ $ do
+        nav_ [class_ "navbar navbar-expand-md navbar-dark bg-dark fixed-top"] $ do
+            div_ [class_ "collapse navbar-collapse"] $ do
+                span_ [class_ "navbar-brand"] "comatose"
+                ul_ [class_ "navbar-nav mr-auto"] $ do
+                    li_ [class_ "nav-item" ] $ a_ [class_ "nav-link", href_ "#features"] "Features"
+                    li_ [class_ "nav-item" ] $ a_ [class_ "nav-link", href_ "#protocols"] "Protocols"
+                form_ [id_ "protosort", class_ "form-inline my-2 my-lg-0"] $ do
+                    input_ [id_ "filter", type_ "search", class_ "form-control mr-sm-2", placeholder_ "Filter by name"]
+                    " "
+                    label_ [for_ "sort"] "Sort by"
+                    " "
+                    select_ [id_ "sort", class_ "form-control"] $ do
+                        option_ [value_ "name"] "Name"
+                        option_ [value_ "year"] "Year"
+                        option_ [value_ "rank"] "Rank"
+        div_ [class_ "jumbotron" ] $ introduction db
+        div_ [class_ "container"] $ do
+            features db
+            protocols db
+            references (sortBy (compare `on` lookup "year" . E.fields) attrib)
+        extjs "script.js"
+
+-- |Render page
+render f db attribution = renderToFile f (page db attribution)
+
diff --git a/src/Util.hs b/src/Util.hs
new file mode 100644
index 0000000..15ca593
--- /dev/null
+++ b/src/Util.hs
@@ -0,0 +1,7 @@
+module Util (safeHead) where
+
+-- |Safe head function
+safeHead [] = Nothing
+safeHead (x:_) = Just x
+
+