ドキュメントの無いコードで生成器が落ちるのを直す

fixtures/test_code_territorycodelist_undocumented.xsd

@@ -0,0 +1,17 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<xs:schema xmlns="http://www.editeur.org/onix/2.1/reference" xmlns:xs="http://www.w3.org/2001/XMLSchema" targetNamespace="http://www.editeur.org/onix/2.1/reference" elementFormDefault="qualified" attributeFormDefault="unqualified">
+  <xs:include schemaLocation="test_code_territorycodelist_undocumented_codelists.xsd" />
+  <xs:element name="RightsTerritory">
+    <xs:complexType>
+      <xs:simpleContent>
+        <xs:extension base="TerritoryCodeList">
+          <xs:attribute name="refname" type="xs:NMTOKEN" fixed="RightsTerritory" />
+          <xs:attribute name="shortname" type="xs:NMTOKEN" fixed="b388" />
+        </xs:extension>
+      </xs:simpleContent>
+    </xs:complexType>
+  </xs:element>
+  <xs:simpleType name="TerritoryCodeList">
+    <xs:list itemType="List1" />
+  </xs:simpleType>
+</xs:schema>

fixtures/test_code_territorycodelist_undocumented_codelists.xsd

@@ -0,0 +1,19 @@
+<?xml version="1.0" encoding="utf-8"?>
+<xs:schema xmlns:xs="http://www.w3.org/2001/XMLSchema">
+  <xs:simpleType name="List1">
+    <xs:annotation>
+      <xs:documentation source="ONIX Code List 44">Name code type</xs:documentation>
+    </xs:annotation>
+    <xs:restriction base="xs:string">
+      <xs:enumeration value="01">
+        <xs:annotation>
+          <xs:documentation>Proprietary</xs:documentation>
+          <xs:documentation>Note that &lt;IDTypeName&gt; is required with proprietary identifiers</xs:documentation>
+        </xs:annotation>
+      </xs:enumeration>
+      <!-- No xs:annotation at all. This one reaches the ListType branch of
+           topLevelTypeToCode, which used to call `head` on the empty list. -->
+      <xs:enumeration value="02" />
+    </xs:restriction>
+  </xs:simpleType>
+</xs:schema>

fixtures/test_code_undocumented.xsd

@@ -0,0 +1,14 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<xs:schema xmlns="http://www.editeur.org/onix/2.1/reference" xmlns:xs="http://www.w3.org/2001/XMLSchema" targetNamespace="http://www.editeur.org/onix/2.1/reference" elementFormDefault="qualified" attributeFormDefault="unqualified">
+  <xs:include schemaLocation="test_code_undocumented_codelists.xsd" />
+  <xs:element name="AddresseeIDType">
+    <xs:complexType>
+      <xs:simpleContent>
+        <xs:extension base="List44">
+          <xs:attribute name="refname" type="xs:NMTOKEN" fixed="AddresseeIDType" />
+          <xs:attribute name="shortname" type="xs:NMTOKEN" fixed="m380" />
+        </xs:extension>
+      </xs:simpleContent>
+    </xs:complexType>
+  </xs:element>
+</xs:schema>

fixtures/test_code_undocumented_codelists.xsd

@@ -0,0 +1,20 @@
+<?xml version="1.0" encoding="utf-8"?>
+<xs:schema xmlns:xs="http://www.w3.org/2001/XMLSchema">
+  <xs:simpleType name="List44">
+    <xs:annotation>
+      <xs:documentation source="ONIX Code List 44">Name code type</xs:documentation>
+    </xs:annotation>
+    <xs:restriction base="xs:string">
+      <xs:enumeration value="01">
+        <xs:annotation>
+          <xs:documentation>Proprietary</xs:documentation>
+          <xs:documentation>Note that &lt;IDTypeName&gt; is required with proprietary identifiers</xs:documentation>
+        </xs:annotation>
+      </xs:enumeration>
+      <!-- No xs:annotation at all. EDItEUR ships enumerations like this, and
+           every code path that reaches them used to call `head` on the empty
+           list of documentation strings. -->
+      <xs:enumeration value="02" />
+    </xs:restriction>
+  </xs:simpleType>
+</xs:schema>

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 =

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 <IDTypeName> 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 <IDTypeName> 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"