From 25c120d01c8d133ad8b481941de2ebbadf373f4e Mon Sep 17 00:00:00 2001 From: Lars-Dominik Braun Date: Thu, 2 Nov 2017 13:46:31 +0100 Subject: Show feature category Just the feature name is not enough information in some cases. --- src/Db.hs | 7 +++++++ src/Render.hs | 11 +++++++++-- 2 files changed, 16 insertions(+), 2 deletions(-) (limited to 'src') 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 () -- cgit v1.2.3