From a2618d9d5c488c6b20208227b04800df1a09e211 Mon Sep 17 00:00:00 2001 From: Lars-Dominik Braun Date: Mon, 4 May 2015 11:01:54 +0200 Subject: Show related field --- Main.hs | 17 +++++++++++++++++ data/style.css | 12 ++++++++++++ 2 files changed, 29 insertions(+) diff --git a/Main.hs b/Main.hs index e96f7ea..b99b78d 100644 --- a/Main.hs +++ b/Main.hs @@ -35,6 +35,9 @@ data Protocol = 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] } deriving Show -- |A MAC protocol feature @@ -62,6 +65,7 @@ instance FromJSON Protocol where <*> v .:? "description" <*> v .:? "ref" .!= [] <*> v .:? "features" .!= M.empty + <*> v .:? "related" .!= [] parseJSON _ = mzero instance FromJSON Feature where @@ -131,6 +135,18 @@ protodesc Protocol { pdescription = Just desc } = do dt_ "Description" dd_ $ 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_ $ forM_ rel $ + \(ident, x) -> li_ $ a_ [href_ (T.pack $ '#':ident)] $ toHtml $ pname x + -- |One protocol protoentry :: Database -> (String, Protocol) -> Html () protoentry db (ident, p) = @@ -155,6 +171,7 @@ protoentry db (ident, p) = protopapers pubs protodesc p protofeatures db p + protorelated db p extcss url = link_ [rel_ "stylesheet", type_ "text/css", href_ url] diff --git a/data/style.css b/data/style.css index 41b24dd..5172d25 100644 --- a/data/style.css +++ b/data/style.css @@ -9,3 +9,15 @@ .protocol dt:after { content: ":"; } + +.protocol .related ul { + list-style-type: none; + margin: 0; + padding 0; +} +.protocol .related li { + display: inline; + margin: 0; + margin-right: 1em; + padding 0; +} -- cgit v1.2.3