From b6101769a270f4c34c30f3108ecc29eb9c1cdec5 Mon Sep 17 00:00:00 2001 From: Stephane Bortzmeyer Date: Wed, 6 Sep 2023 18:25:16 +0200 Subject: [PATCH] Comments in the registry added to the HTML output. Closes #2 --- Registry/Grammar.hs | 12 ++++++++---- Registry/Types.hs | 13 +++++++------ Registry/Utils.hs | 15 +++++++++++---- 3 files changed, 26 insertions(+), 14 deletions(-) diff --git a/Registry/Grammar.hs b/Registry/Grammar.hs index 454d110..6d9cdc0 100644 --- a/Registry/Grammar.hs +++ b/Registry/Grammar.hs @@ -67,6 +67,7 @@ recordFactory r = (lookup "Macrolanguage" r) (lookup "Deprecated" r) (lookup "Scope" r) + (lookup "Comments" r) )) "extlang" -> Right (Extl (Extlang (fromJust (lookup "Subtag" r)) @@ -81,16 +82,19 @@ recordFactory r = "script" -> Right (Scr (Script (fromJust (lookup "Subtag" r)) (lookups "Description" r) - (fromJust (lookup "Added" r)))) + (fromJust (lookup "Added" r)) + (lookup "Comments" r))) "region" -> Right (Reg (Region (fromJust (lookup "Subtag" r)) (lookups "Description" r) - (fromJust (lookup "Added" r)))) + (fromJust (lookup "Added" r)) + (lookup "Comments" r))) "variant" -> Right (Var (Variant (fromJust (lookup "Subtag" r)) (lookups "Description" r) (fromJust (lookup "Added" r)) - (lookups "Prefix" r))) + (lookups "Prefix" r) + (lookup "Comments" r))) "redundant" -> Right (Red (Redundant (fromJust (lookup "Tag" r)) (lookups "Description" r) @@ -161,4 +165,4 @@ parse input = let firstErr = (filter isLeft reg) !! 0 in SyntaxError ("Registry is not legal: " ++ fromLeft firstErr) - -- TODO: the line number \ No newline at end of file + -- TODO: the line number diff --git a/Registry/Types.hs b/Registry/Types.hs index a88faf4..fa3cd3b 100644 --- a/Registry/Types.hs +++ b/Registry/Types.hs @@ -3,14 +3,14 @@ module Registry.Types where -- TODO: import Time and use CalendarTime type DateTime = String --- TODO for all: Comments - data Language = Language {lang'subtag::String, lang'descr::[String], lang'added::DateTime, lang'script::Maybe String, lang'preferredValue::Maybe String, lang'macroLanguage::Maybe String, lang'deprecated::Maybe DateTime, - lang'scope::Maybe String} + lang'scope::Maybe String, + lang'comment::Maybe String + } deriving Show data Extlang = Extlang {extlang'subtag::String, extlang'descr::[String], @@ -22,14 +22,15 @@ data Extlang = Extlang {extlang'subtag::String, extlang'descr::[String], deriving Show data Script = Script {script'subtag::String, script'descr::[String], - script'added::DateTime} deriving Show + script'added::DateTime, script'comment::Maybe String} deriving Show data Region = Region {region'subtag::String, region'descr::[String], - region'added::DateTime} deriving Show + region'added::DateTime, region'comment::Maybe String} deriving Show -- TODO: Deprecated and preferredValue data Variant = Variant {variant'subtag::String, variant'descr::[String], - variant'added::DateTime, variant'prefix::[String]} deriving Show + variant'added::DateTime, variant'prefix::[String], + variant'comment::Maybe String} deriving Show data Redundant = Redundant {redundant'tag::String, redundant'descr::[String], redundant'added::DateTime} deriving Show diff --git a/Registry/Utils.hs b/Registry/Utils.hs index 8b265d5..caf6ee2 100644 --- a/Registry/Utils.hs +++ b/Registry/Utils.hs @@ -184,31 +184,38 @@ descrToHTML a = concat (List.intersperse " / " (map onedescrToHTML a)) -- TODO: a prefix is not always a simple language, it can be composed of several subtags oneprefixToHTML s = " Possible prefix: " ++ s ++ "" prefixesToHTML a = concat (map oneprefixToHTML a) +commentToHTML Nothing = "" +commentToHTML (Just s) = " Comment: " ++ s + toHTML (Date d) = "

Date: " ++ dateToHTML d ++ "

" toHTML (Lang l) = (html_head ((lang'descr l) !! 0)) ++ "

Code " ++ (lang'subtag l) ++ ". " ++ addedToHTML (lang'added l) ++ ". Description: " ++ descrToHTML (lang'descr l) ++ ". " ++ linkLanguage (lang'subtag l) ++ - (sscriptToHTML (lang'script l)) ++ "

" ++ html_tail ++ "\n" + (sscriptToHTML (lang'script l)) ++ + commentToHTML (lang'comment l) ++ "

" ++ html_tail ++ "\n" toHTML (GF t) = "

Code " ++ (gf'tag t) ++ ". " ++ addedToHTML (gf'added t) ++ ". " ++ descrToHTML (gf'descr t) ++ "

\n" toHTML (Scr s) = (html_head ((script'descr s) !! 0)) ++ "

Code " ++ (script'subtag s) ++ ". " ++ addedToHTML (script'added s) ++ ". Description: " ++ - descrToHTML (script'descr s) ++ "

" ++ html_tail ++ "\n" + descrToHTML (script'descr s) ++ + commentToHTML (script'comment s) ++ "

" ++ html_tail ++ "\n" toHTML (Reg r) = (html_head ((region'descr r) !! 0)) ++ "

Code " ++ (region'subtag r) ++ ". " ++ addedToHTML (region'added r) ++ ". Description: " ++ - descrToHTML (region'descr r) ++ "

" ++ + descrToHTML (region'descr r) ++ + commentToHTML (region'comment r) ++ "

" ++ html_tail ++ "\n" toHTML (Var v) = (html_head ((variant'descr v) !! 0)) ++ "

Code " ++ (variant'subtag v) ++ ". " ++ addedToHTML (variant'added v) ++ ". Description: " ++ descrToHTML (variant'descr v) ++ ". " ++ - prefixesToHTML (variant'prefix v) ++ "

" ++ html_tail ++ "\n" + prefixesToHTML (variant'prefix v) ++ + commentToHTML (variant'comment v) ++ "

" ++ html_tail ++ "\n" toHTML (Red r) = (html_head ((redundant'descr r) !! 0)) ++ "

Code " ++ (redundant'tag r) ++ ". " ++ addedToHTML (redundant'added r) ++ ". " ++