Show feature category

Just the feature name is not enough information in some cases.

2 files changed, 16 insertions, 2 deletions

diff --git a/src/Db.hs b/src/Db.hs
index fa38db3..caeaf77 100644
--- a/src/Db.hs
+++ b/src/Db.hs
@@ -96,6 +96,13 @@ getFeaturesByBase db base = M.filterWithKey (\k v -> (base ++ ".") `isPrefixOf`
 -- |Get number of algorithms in database
 algorithmCount db = M.size $ dalgos db
 
+split :: (Eq a) => a -> [a] -> [[a]]
+split delim s = let (a, b:bs) = span (/= delim) s in a:split delim bs
+
+-- |Get base of feature
+getFeatureBase :: String -> String
+getFeatureBase feature = head $ split '.' feature
+
 minMaxPublicationYears db = (firstyear, lastyear)
     where
         pubyears = catMaybes $ map (lookup "year" . E.fields) $ dpublications db
diff --git a/src/Render.hs b/src/Render.hs
index 7b8bab2..1b22270 100644
--- a/src/Render.hs
+++ b/src/Render.hs
@@ -33,8 +33,15 @@ resolveDoi q = "http://doi.org/" ++ q
 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))
+        dt_ "Features"
+        dd_ $ ul_ [class_ "features"] $ forM_ (sort $ M.keys $ pfeatures p) item
+    where
+        item :: String -> Html ()
+        item name = li_ [data_ "id" (T.pack name)] $ do
+            toHtml $ maybeLookup $ getFeatureBase name
+            ": "
+            toHtml $ maybeLookup name
+        maybeLookup name = maybe ("" :: String) fname $ M.lookup name (dfeatures db)
 
 -- |List of protocol publications
 protopapers :: [T] -> Html ()