diff --git a/fixtures/test_code_territorycodelist_undocumented.xsd b/fixtures/test_code_territorycodelist_undocumented.xsd
new file mode 100644
index 0000000..94c3d7e
--- /dev/null
+++ b/fixtures/test_code_territorycodelist_undocumented.xsd
@@ -0,0 +1,17 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/fixtures/test_code_territorycodelist_undocumented_codelists.xsd b/fixtures/test_code_territorycodelist_undocumented_codelists.xsd
new file mode 100644
index 0000000..f3ceb05
--- /dev/null
+++ b/fixtures/test_code_territorycodelist_undocumented_codelists.xsd
@@ -0,0 +1,19 @@
+
+
+
+
+ Name code type
+
+
+
+
+ Proprietary
+ Note that <IDTypeName> is required with proprietary identifiers
+
+
+
+
+
+
+
diff --git a/fixtures/test_code_undocumented.xsd b/fixtures/test_code_undocumented.xsd
new file mode 100644
index 0000000..83dff56
--- /dev/null
+++ b/fixtures/test_code_undocumented.xsd
@@ -0,0 +1,14 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/fixtures/test_code_undocumented_codelists.xsd b/fixtures/test_code_undocumented_codelists.xsd
new file mode 100644
index 0000000..c3a88f2
--- /dev/null
+++ b/fixtures/test_code_undocumented_codelists.xsd
@@ -0,0 +1,20 @@
+
+
+
+
+ Name code type
+
+
+
+
+ Proprietary
+ Note that <IDTypeName> is required with proprietary identifiers
+
+
+
+
+
+
+
diff --git a/src/Code.hs b/src/Code.hs
index fb27053..35b0ddb 100644
--- a/src/Code.hs
+++ b/src/Code.hs
@@ -101,15 +101,7 @@ topLevelTypeToCode _scm (ref, X.TypeSimple (X.AtomicType restriction annotations
where
description = T.intercalate ". " . map (\(X.Documentation x) -> x) $ annotations
constraints = X.simpleRestrictionConstraints restriction
- codes =
- map
- ( \(X.Enumeration v docs) ->
- let docs_ = map (\(X.Documentation d) -> d) docs
- codeDescription = if not (null docs_) then head docs_ else ""
- notes = if not (null docs_) then last docs_ else ""
- in Code {value = v, codeDescription = codeDescription, notes = notes}
- )
- constraints
+ codes = map constraintToCode constraints
topLevelTypeToCode scm (ref, X.TypeSimple (X.ListType ty _)) =
case ty of
X.Ref key_ ->
@@ -122,13 +114,7 @@ topLevelTypeToCode scm (ref, X.TypeSimple (X.ListType ty _)) =
_ -> False
desc = (T.intercalate ". " . map (\(X.Documentation x) -> x) . typeAnnotations) t
constraints = typeConstraints t
- codes_ =
- map
- ( \(X.Enumeration v docs) ->
- let docs_ = map (\(X.Documentation d) -> d) docs
- in Code {value = v, codeDescription = head docs_, notes = last docs_}
- )
- constraints
+ codes_ = map constraintToCode constraints
refname = X.qnName ref
in CodeType
{ xmlReferenceName = refname,
@@ -170,15 +156,7 @@ topLevelElementToCode scm elm =
Nothing -> pack ""
codes_ = case ty of
Just t ->
- let constraints = typeConstraints t
- enums =
- map
- ( \(X.Enumeration v docs) ->
- let docs_ = map (\(X.Documentation d) -> d) docs
- in Code {value = v, codeDescription = head docs_, notes = last docs_}
- )
- constraints
- in enums
+ map constraintToCode (typeConstraints t)
Nothing -> []
refname = unwrap $ findFixedOf "refname" plainContentAttributes
elements =
diff --git a/test/TestCode.hs b/test/TestCode.hs
index 52586dc..871ccaa 100644
--- a/test/TestCode.hs
+++ b/test/TestCode.hs
@@ -37,6 +37,23 @@ tests =
[]
assertEqual "can derive description from type" expected actual
),
+ TestCase
+ ( do
+ scm <- getSchema "./fixtures/test_code_undocumented.xsd"
+ let actual = (topLevelElementToCode scm . head . collectCodes) scm
+ expected =
+ CodeType
+ "AddresseeIDType"
+ "Name code type"
+ ( V.fromList
+ [ Code "01" "Proprietary" "Note that is required with proprietary identifiers",
+ Code "02" "" ""
+ ]
+ )
+ False
+ []
+ assertEqual "codes without documentation do not crash the generator" expected actual
+ ),
TestCase
( do
scm <- getSchema "./fixtures/test_code_territorycodelist.xsd"
@@ -54,6 +71,23 @@ tests =
[]
assertEqual "can parse territory code list" expected actual
),
+ TestCase
+ ( do
+ scm <- getSchema "./fixtures/test_code_territorycodelist_undocumented.xsd"
+ let actual = (topLevelTypeToCode scm . head . collectTypes) scm
+ expected =
+ CodeType
+ "TerritoryCodeList"
+ "Name code type"
+ ( V.fromList
+ [ Code "01" "Proprietary" "Note that is required with proprietary identifiers",
+ Code "02" "" ""
+ ]
+ )
+ False
+ []
+ assertEqual "codes without documentation do not crash the list-type branch" expected actual
+ ),
TestCase
( do
scm <- getSchema "./fixtures/test_code_space_separated.xsd"