diff options
| -rw-r--r-- | data/script.js | 25 | ||||
| -rw-r--r-- | src/Db.hs | 10 | ||||
| -rw-r--r-- | src/Render.hs | 136 |
3 files changed, 117 insertions, 54 deletions
diff --git a/data/script.js b/data/script.js index a4d1508..43cb45e 100644 --- a/data/script.js +++ b/data/script.js @@ -17,7 +17,7 @@ $(document).ready (function () { return e; } e = { - 'name': n.children ('.name').first ().text (), + 'name': n.find ('.name').first ().text (), 'rank': parseFloat (n.data ('rank')), } var year = n.find ('dl dd.ref * .year').first (); @@ -76,7 +76,7 @@ $(document).ready (function () { } function selectedfeatures () { - var sel = $('.filter-feature'); + var sel = $('#filter-feature option'); var features = []; for (i = 0; i < sel.length; i++) { if ($(sel[i]).is (':checked')) { @@ -92,11 +92,28 @@ $(document).ready (function () { $('#filter').keyup ($.debounce (100, function () { filterproto ($(this).val (), selectedfeatures ()); })); - $('.filter-feature').change (function () { + $('#filter-feature').change (function () { filterproto ($('#filter').val (), selectedfeatures ()); }); $('#protosort').show (); - $('.filter-feature').show (); + $('#filter-feature').show (); sortproto ($('#sort').val ()); filterproto ($('#filter').val (), selectedfeatures ()); + + /* see https://stackoverflow.com/a/38691517 */ + $('.keep-open').on({ + "shown.bs.dropdown": function() { $(this).attr('closable', false); }, + //"click": function() { }, // For some reason a click() is sent when Bootstrap tries and fails hide.bs.dropdown + "hide.bs.dropdown": function() { return $(this).attr('closable') == 'true'; } + }); + + $('.keep-open').children().first().on({ + "click": function() { + $(this).parent().attr('closable', true ); + } + }) + + /* hide button “learn more” */ + $('#about').on ({'shown.bs.collapse': function () { $('#learnmore').hide (); }, + 'hidden.bs.collapse': function () { $('#learnmore').show (); }}); }); @@ -4,6 +4,7 @@ module Db where import System.FilePath ((<.>), splitExtension) import Data.List (nub, sort, sortBy, isPrefixOf) import Control.Monad +import Data.Maybe (catMaybes) import Data.Yaml import Text.Parsec.Error import Text.ParserCombinators.Parsec.Prim @@ -92,6 +93,15 @@ getFeaturesByLevel db level = M.filterWithKey (\k v -> countDots k == level) $ d -- |Get features by `base` feature getFeaturesByBase db base = M.filterWithKey (\k v -> (base ++ ".") `isPrefixOf` k) $ dfeatures db +-- |Get number of algorithms in database +algorithmCount db = M.size $ dalgos db + +minMaxPublicationYears db = (firstyear, lastyear) + where + pubyears = catMaybes $ map (lookup "year" . E.fields) $ dpublications db + firstyear = foldr min (head pubyears) (tail pubyears) + lastyear = foldr max (head pubyears) (tail pubyears) + -- |Read protocol and bib database from file readDb :: String -> IO Database readDb f = do diff --git a/src/Render.hs b/src/Render.hs index d48a567..146b68d 100644 --- a/src/Render.hs +++ b/src/Render.hs @@ -68,21 +68,25 @@ protoentry db (ident, p) = pubs = catMaybes $ protoPublications db p firstpub = safeHead pubs field key = firstpub >>= (return . E.fields) >>= lookup key + bodyIdent = concat [ident, "-body"] in section_ [ id_ $ T.pack ident - , class_ "protocol" + , class_ "protocol card" , 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 + div_ [class_ "card-header", role_ "tab"] $ do + h3_ [class_ "name"] $ do + a_ [href_ $ T.pack $ '#':ident, title_ "permalink", data_ "toggle" "collapse", data_ "parent" "#protocols", data_ "target" $ T.pack $ '#':bodyIdent, class_ "collapsed"] $ toHtml $ pname p + " " + maybe "" (small_ [class_ "longname text-muted"] . toHtml) $ plongname p + div_ [class_ "collapse", id_ $ T.pack bodyIdent, role_ "tabpanel"] $ do + div_ [class_ "card-body"] $ do + protodesc p + dl_ $ do + protopapers pubs + protofeatures db p + protorelated db p extcss url = link_ [rel_ "stylesheet", type_ "text/css", href_ url] @@ -113,51 +117,78 @@ bibentry bib = do -- | References section references :: [E.T] -> Html () -references attrib = section_ $ do - h2_ "References" +references attrib = div_ $ do + h2_ [id_ "references"] "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 +introduction db = let + (firstyear, lastyear) = minMaxPublicationYears db + in div_ $ do h1_ [class_ "display-3"] "comatose" - p_ $ do + p_ [class_ "lead"] $ do "The comprehensive MAC taxonomy database (comatose) is a collection of " - toHtml $ show algocount + toHtml $ show $ algorithmCount db " wireless media/medium access protocols published between " toHtml firstyear " and " toHtml lastyear "." + p_ [class_ "lead"] $ a_ [class_ "btn btn-primary btn-lg", href_ "#about", role_ "button", data_ "toggle" "collapse", id_ "learnmore"] "Learn more" + +featuresFilter :: Database -> Html () +featuresFilter db = select_ [multiple_ "", size_ "10", id_ "filter-feature"] $ forM_ (M.toList $ getFeaturesByLevel db 0) $ \(baseident, basefeature) -> do + optgroup_ [label_ $ T.pack $ fname basefeature] $ do + forM_ (M.toList $ getFeaturesByBase db baseident) $ \(ident, feature) -> do + option_ [value_ $ T.pack ident] $ toHtml $ fname feature -- |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 - +features db = dl_ [class_ "row"] $ forM_ (M.toList $ getFeaturesByLevel db 0) $ \(baseident, basefeature) -> do + dt_ [class_ "col-sm-3"] $ toHtml $ fname basefeature + dd_ [class_ "col-sm-9"] $ do + maybe mempty (p_ . toHtml) $ fdescription basefeature + dl_ $ forM_ (M.toList $ getFeaturesByBase db baseident) $ \(ident, feature) -> do + dt_ $ toHtml $ fname feature + maybe mempty (dd_ . toHtml) $ fdescription feature + +about :: Database -> Html () +about db = let + (firstyear, lastyear) = minMaxPublicationYears db + categoryCount = M.size $ getFeaturesByLevel db 0 + in do + h2_ "Motivation" + p_ "In recent years the scientific community has proposed a surprisingly large number of wireless medium access (MAC) protocols. That number is still climbing year by year, rendering classic surveys outdated rather quick. Additionally the sheer number of protocols results in name collisions, often making it harder than necessary to identify which protocol exactly is referenced by just looking at its name. Ordinary surveys also cannot provide interactivity like feature-based filtering and searching. Its results are not reusable easily since they are not machine-readable." + p_ $ do + "This comprehensive MAC taxonomy database (comatose), aims to fix most of these problems. It lists most known scientific MAC protocol proposals and is not limited to a subset with specific properties. The list includes the protocol’s short and long name, a description, as well as references to the publication it originated from. It also introduces a taxonomy. Some of its terminology is based on or inspired by " + a_ [href_ "#references"] "existing surveys" + ". Features are grouped into " + toHtml $ show categoryCount + " categories and those within the same category can be mutually exclusive. Below is a list of all features in use." + features db + h2_ "Implementation" + p_ $ do + "comatose uses two databases. The first one contains features and protocols in a " + a_ [href_ "http://yaml.org/"] "YAML" + " file. It is human and machine-readable at the same time and thus easy to edit. Also it does not require additional software like a SQL database server. This first database links protocols to publications with a second database. That one is just a standard BibTeX file. Since TeX is used for a lot of scientific publications these records usually exist already and can be copied, as well as reused for new publications. Therefore both should databases provide value beyond the scope of this project." + p_ "This very page is generated with a HTML renderer written in Haskell. It reads both databases and transforms them into a single-page HTML document. Additional JavaScript code provides client-side filtering and searching." + h2_ "Contributing" + p_ $ do + "As mentioned above this database is not complete yet and will never be, as long as new protocols are invented. Descriptions and feature tags are missing for a lot of protocols due to lack of time. If you want to help send an email with your suggestions to " + a_ [href_ "mailto:lars+comatose@6xq.net"] "lars+comatose@6xq.net" + " or clone the repository from " + a_ [href_ "https://github.com/PromyLOPh/comatose"] "GitHub" + ", edit the database and create a pull request." + h2_ "Acknowledgements" + p_ $ do + "This database is part of a project funded by the " + a_ [href_ "https://www.bmbf.de/en/index.html"] "Federal Ministry of Education and Research" + " from 2015 to 2017." + -- | The list of protocols protocols :: Database -> Html () -protocols db = section_ [id_ "protocols"] $ do - h2_ "Protocols" - forM_ (M.toList $ dalgos db) (protoentry db) +protocols db = section_ [id_ "protocols", role_ "tablist"] $ forM_ (M.toList $ dalgos db) (protoentry db) -- |Page template page db attrib = doctypehtml_ $ do @@ -166,30 +197,35 @@ page db attrib = doctypehtml_ $ do 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://cdnjs.cloudflare.com/ajax/libs/popper.js/1.12.3/umd/popper.min.js" extjs "https://maxcdn.bootstrapcdn.com/bootstrap/4.0.0-beta/js/bootstrap.min.js" + extcss "https://maxcdn.bootstrapcdn.com/bootstrap/4.0.0-beta/css/bootstrap.min.css" 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 + ul_ [class_ "navbar-nav mr-auto"] mempty + form_ [id_ "protosort", class_ "navbar-nav 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" + div_ [class_ "nav-item dropdown keep-open"] $ do + a_ [class_ "nav-link dropdown-toggle", data_ "toggle" "dropdown", href_ "#"] "Features" + div_ [class_ "dropdown-menu"] $ featuresFilter db + " " + label_ [for_ "sort", class_ "navbar-text"] "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) + div_ [class_ "jumbotron" ] $ section_ [class_ "container"] $ do + introduction db + div_ [class_ "about collapse", id_ "about"] $ do + about db + references (sortBy (compare `on` lookup "year" . E.fields) attrib) + p_ $ a_ [class_ "btn btn-secondary", data_ "toggle" "collapse", data_ "target" "#about", href_ "#"] "Close" + div_ [class_ "container"] $ protocols db extjs "script.js" -- |Render page |