Make two tests use the fixture they load

[kogai]

#66 でテストスイートに -Wall を足したことで見つかった問題です。base は #66。

2 つのテストが、読み込んだフィクスチャを使っていませんでした

scm <- getSchema "./fixtures/test_model_atomic.xsd"
let actual = typeToText expected1        -- ← scm ではなく、ファイル冒頭の手書きリテラル
assertEqual "can derive string type" "string" actual

expected1 / expected4 は test/TestModel.hs の先頭で手書きされた AST リテラルです。つまりこの 2 つはフィクスチャを読んで捨てており、typeToText の単体テストとしてしか機能していませんでした。-Wall が「scm が束縛されて使われていない」と指摘したことで発覚しました。警告を入れた目的がそのまま回収された形です。

修正

typeToText にパース結果を渡します。

let actual = (typeToText . unwrap . M.lookup (makeTargetQName "NonEmptyString") . schemaTypes) scm

表明の内容は変えていません。 そのうえで成立します。

• typeToText は制約を見ずに restriction の base 名だけを返すので、NonEmptyString の minLength は結果に影響しません
• nameForTest は List82 を simpleContent extension しており、refname が BibleContents に固定されています。typeToText はこの分岐で refname を返します

あわせて、mixed-HTML のケースにあった死んだ key 束縛も削除しました。-Wall が指摘した 3 つ目です。

この PR で増えないもの: 回帰検出能力

当初の本文では「パーサが壊れてもこれらは落ちません」と書いていましたが、これは言い過ぎでした。訂正します。

TestModel.hs の数ケース手前（93-98 行目、139-144 行目）に、同じ 2 つのフィクスチャを expected1 / expected4 と突き合わせるテストが既にあります。各フィクスチャは型を 1 つしか宣言していないので、M.lookup が返すものが expected1 / expected4 と一致することは既に担保されており、修正の前後は論理的に等価です。パーサが壊れれば、どちらにせよ先行するケースが落ちます。

したがって実際の価値は衛生面です。

• フィクスチャを読んで捨てている、という誤読を招く状態の解消
• -Wall の警告 3 件（scm 2 件 + key 1 件）の解消

確認

• typeToText の実装（src/Model.hs:155-175）を読み、両ケースで同じ結果になることを確認
• 使用する識別子（unwrap / M.lookup / makeTargetQName / schemaTypes / typeToText）がすべて TestModel.hs の import に含まれていることを確認
• ビルドは未検証（この環境に GHC / stack が無いため）。この PR の CI が唯一の検証手段です

なお test/ にはまだ -Wall の警告が残っています（未使用 import と型シグネチャ欠落）。これは「空振りテストの修正」という単位が崩れるため、別の警告整理 PR で片付けます。

🤖 Generated with Claude Code

https://claude.ai/code/session_01P8rZakwAiz1jpViUX34x1Z

---

Generated by Claude Code

[kogai]

総評

差分そのものは正しいです。ソースを追った限りコンパイルは通り、2 つの assert も通ります。新しい式に出てくる識別子（unwrap / M.lookup / makeTargetQName / schemaTypes / typeToText）はすべて test/TestModel.hs の既存 import で scope に入っており、しかも同じファイルの他ケースで既に同じ形で使われているので、型の繋がりも実証済みです。QName のキーもパーサ側の実装と一致しており lookup は成功します。typeToText の分岐も両ケースとも期待どおりです。必須の指摘はありません。ただしレビュー開始時点でこの PR の CI は落ちていました（テストがコンパイルされる前に hpack が死んでいた）。原因は base から継承した package.yaml の壊れた YAML で、レビュー中に e51b871 のマージで解消されています。以下、経緯を含めて記録しておきます。

---

指摘

推奨 1 — CI は一度「テストが 1 行もコンパイルされないまま」落ちていた（解消済み・確認のみ）

• 対象: package.yaml:52-53（この PR の変更ではなく base 由来）

• 問題: 元の head 7a6d61b 時点の package.yaml は

      ghc-options:
        - -threaded
        - -rtsopts
        - -with-rtsopts=-N
        - -Wall
          dependencies:        # ← インデントが崩れている
        - onix

  で、run 34799254380 の "Test haskell codes" は

  Error: [S-305]
         Failed to generate a Cabal file using the Hpack library on file:
         .../package.yaml. The error encountered was:
         YAML parse exception at line 52, column 20:
         mapping values are not allowed in this context
  

  で stack test に到達せず終了していました。

• なぜ重要か: PR 本文は「ビルドは未検証。この PR の CI が唯一の検証手段です」と書いていますが、その唯一の検証手段がこの変更に一切触れずに落ちていたため、マージ判断の根拠がゼロだった状態です。

• 対処: base Un-fold the executable's ghc-options and warn on the test suite too #66 側の 903f72f（"Repair package.yaml"）を e51b871 で取り込み済みで、現在の package.yaml:52-53 は - -Wall / dependencies: に直っています。現 head での "Test haskell codes" はこのコメント執筆時点で in_progress (run 34799483898) なので、グリーンを目視してからマージしてください。あわせて PR 本文の「ビルドは未検証」の段落に、CI が一度 YAML で落ちて base のマージで直した旨を追記しておくと履歴が読めます。

推奨 2 — -Wall の回収が同一ファイル内で中途半端

• 対象: test/TestModel.hs:6,9,11
• 問題: この PR は Un-fold the executable's ghc-options and warn on the test suite too #66 で入れた -Wall が指摘した 3 件を潰していますが、同じファイルに未使用 import が 7 個残ります。Text / pack / unpack（Data.Text）、def / parseText / readFile（Text.XML、この import 行ごと未使用）、TestList（Test.HUnit）——いずれも import 行以外に出現がありません（grep -n "Text" の結果は 6・11 行目の import と、124/148/154/160 行の typeToText だけ）。加えて expected1〜expected4 と tests にトップレベルの型シグネチャが無いため -Wmissing-signatures も鳴ります。TestUtils.hs も pack / unpack / Model(..) / Test.HUnit(..) が丸ごと未使用です。
• なぜ重要か: -Werror は付いていない（Makefile:25 は stack test --trace --fast、package.yaml の test ghc-options にも無い）のでビルドは壊れませんが、「-Wall を入れた目的がそのまま回収された」という PR の物語に対して、同じファイルの警告が残っているとノイズの中に次の本物が埋もれます。
• 対処: 別 PR で構いませんが、少なくとも PR 本文に「残りの未使用 import は別途」と一言書いて、-Wall がまだ赤いことを明示してください。

任意 3 — 「パーサが壊れても落ちない」はケース単体としては正しいが、スイート全体では言い過ぎ

• 対象: PR 本文 / test/TestModel.hs:93-98, 121-126
• 問題: 変更前は「parse == expected1」＋「typeToText expected1 == "string"」、変更後は「parse == expected1」＋「typeToText parse == "string"」で、2 本セットで見ると互いに含意し合うためカバレッジは実質同値です。パーサが壊れた場合、変更前でも 93-98 行のケースが落ちるので、スイートとしては検出できていました。
• なぜ重要か: 実利は「読み込んだフィクスチャを捨てる紛らわしいコードが消えた」「-Wall の警告が 3 件減った」という可読性・衛生面であって、検出力の向上ではありません。本文の主張を控えめにしたほうが正確です（変更自体は賛成です）。

任意 4 — 同ファイルの既存スタイルと揃っていない

• 対象: test/TestModel.hs:124,148

• 問題: 他のケース（166, 184, 209, 225, 234, 259, 279 行）はすべて let key = makeTargetQName "..." を挟んでから M.lookup key していますが、新しい 2 行だけ inline された 100 桁超の一行になっています。

• 対処:

  let key = makeTargetQName "NonEmptyString"
      actual = (typeToText . unwrap . M.lookup key . schemaTypes) scm

  ちょうど key を消した PR で key パターンから外れるのが惜しいです。

任意 5 — mixed-HTML ケースは key を消すと意図がさらに読めなくなる

• 対象: test/TestModel.hs:200-205
• 問題: key の削除自体は安全です（当該 let 内で参照ゼロ、残る 7 箇所の let key はすべて直後で使用）。ただしこのケースは collectElements scm == [] を assert するだけで、テスト名「can parse choice of html string」に対して「何も集まらないこと」しか見ていません。実際 fixtures/test_mixed_html.xsd の Annotation は mixed="true" なので src/Model.hs の collectElements の filter（complexMixed = False を要求）から外れて [] になります。key = makeTargetQName "Annotation" は「本当は Annotation を引きたかった」という唯一の痕跡でした。
• 対処: 別 PR で構いませんが、-- mixed=true の要素は collectElements の対象外 といったコメントか、M.lookup key (schemaElements scm) が Just であることを併せて assert して「要素は在るが収集対象外」と言えるようにすると、名前と中身が噛み合います。

---

検証したこと

差分の範囲

$ git diff origin/claude/fix-ghc-options...origin/claude/tests-actually-use-fixtures --stat
 test/TestModel.hs | 7 +++----
$ git diff 7a6d61b e51b871 --stat
 package.yaml | 2 +-

base に対する正味の変更は test/TestModel.hs のみ（e51b871 は package.yaml 修復の取り込みだけ）。

コンパイル可否 — 識別子と型

識別子	供給元	import	型
unwrap	src/Util.hs	import Util（無修飾・export list に記載）	Maybe a -> a
M.lookup	Data.Map	import qualified Data.Map as M	QName -> Map QName Type -> Maybe Type
makeTargetQName	test/TestUtils.hs	import TestUtils (makeTargetQName)	Text -> QName
schemaTypes	src/Xsd.hs:28	import Xsd（Schema (..) で export）	Schema -> Map QName Type
typeToText	src/Model.hs:14	import Model（無修飾）	X.Type -> Text

合成 typeToText . unwrap . M.lookup k . schemaTypes は Schema -> Map QName Type -> Maybe Type -> Type -> Text で繋がります。assertEqual "..." "string" actual は OverloadedStrings（1 行目）で Text に解決。

名前衝突の懸念を 1 件潰しました: src/Xsd/Parser.hs:655 にも同名の makeTargetQName :: Text -> P Xsd.QName がありますが、

module Xsd.Parser
  ( parse, parseFile, parseLazyByteString, ParseError (..), Config (..), defaultConfig )
where

と export list が明示されていて Xsd 経由で再 export されないため、import Xsd と import TestUtils (makeTargetQName) は曖昧になりません（既存の 166 行等が現に通っていることとも整合）。

QName キーの一致

src/Xsd/Parser.hs:165-176:

parseTopSimpleType c = do
  name <- theAttribute "name" c >>= makeTargetQName
  ...
parseTopComplexType c = do
  name <- theAttribute "name" c >>= makeTargetQName

src/Xsd/Parser.hs:655-662:

makeTargetQName name = do
  tns <- asks envTargetNamespace
  return Xsd.QName { Xsd.qnNamespace = tns, Xsd.qnName = name }

envTargetNamespace は parseSchema（同 30-33 行）で targetNamespace 属性から設定され、src/Xsd.hs:70-74 の xsdToSchema が ChildType n t -> (n, t) : ts でそのまま Map のキーにします。両フィクスチャの targetNamespace="http://www.editeur.org/onix/2.1/reference" は test/TestUtils.hs の makeTargetQName が作る namespace と一致するので lookup は Just を返します（unwrap が Unreachable を投げることはありません）。

(a) NonEmptyString — 取る分岐

fixtures/test_model_atomic.xsd は xs:string を minLength で restriction。パーサの parseConstrains（src/Xsd/Parser.hs:219-225）は

parseConstrains c = do
  enumerationAxis <- makeElemAxis "enumeration"
  forM (c $/ enumerationAxis) $ \e -> do ...

と enumeration 子要素しか拾わず、Constraint 型も = Enumeration Text [Annotation] の 1 コンストラクタのみ（src/Xsd/Types.hs:236-238）。つまり minLength はパース時に捨てられ simpleRestrictionConstraints = [] になります（ファイル 15-23 行の expected1 がまさにそれを示しています）。

取る分岐は src/Model.hs:156-159:

typeToText (X.TypeSimple (X.AtomicType X.SimpleRestriction {X.simpleRestrictionBase} _annotations)) =
  case simpleRestrictionBase of
    X.Ref n -> X.qnName n

NamedFieldPuns で simpleRestrictionBase だけを見て constraints を一切参照しないので、facet が残っていようがいまいが結果は "string"。assert は通ります。

(b) nameForTest — 取る分岐

TypeComplex → ContentSimple (SimpleContentExtension ...) で src/Model.hs:162-170:

typeToText (X.TypeComplex X.ComplexType {X.complexContent}) = case complexContent of
  X.ContentSimple (X.SimpleContentExtension X.SimpleExtension {X.simpleExtensionBase, X.simpleExtensionAttributes}) ->
    if T.isPrefixOf "List" qnName
      then unwrap $ findFixedOf "refname" simpleExtensionAttributes
      else ...
    where
      qnName = X.qnName simpleExtensionBase

simpleExtensionBase は base="List82" 由来なので qnName = "List82" → T.isPrefixOf "List" が True → then 節。findFixedOf "refname"（src/Model.hs:114-135）は属性リストから attributeInlineName.qnName == "refname" の InlineAttribute を find し、attributeInlineFixed = Just name なら Just name を返します。フィクスチャの第 1 属性が <xs:attribute name="refname" type="xs:NMTOKEN" fixed="BibleContents" /> なので "BibleContents"。assert は通ります。

「重複 assert は不要」という主張

正しいです。test/TestModel.hs:93-98 が test_model_atomic.xsd を expected1 と、139-144 が test_model_atom_ref_bylist.xsd を expected4 と突き合わせています。どちらのフィクスチャも型定義が 1 つだけなので、そこで使われている head . map snd . M.toList . schemaTypes は今回 lookup する型と同一物です。

リテラルの未使用化

expected1 は 97 行、expected2 は 131 行、expected3 は 137 行、expected4 は 143 行で今も使われているため、-Wall の -Wunused-top-binds は鳴りません。key を消した箇所も当該 let 内で参照ゼロだったので削除は安全で、残る 7 箇所の let key（166/184/209/225/234/259/279 行）はすべて直後で使われています。

検証できなかったこと

• 実ビルド・実行はしていません。 このレビュー環境に GHC / stack がないため、上記はすべてソース読みによる推論です。
• 現 head（e51b871）の "Test haskell codes" の最終結果を確認できていません（執筆時点で in_progress）。-Wall 由来の警告が実際に何本出るかも、この目では数えていません。
• editeur.org への egress が塞がれているため、フィクスチャが参照しうる外部スキーマの解決挙動は確認していません（今回の 2 フィクスチャは自己完結しており include / import を持たないので、この制約は結論に影響しません）。

---

Generated by Claude Code

[kogai]

レビューありがとうございます。任意 3 の指摘が正しく、PR 本文の主張が誇張でした。 訂正します。

任意 3: 「パーサが壊れてもこれらは落ちません」は言い過ぎでした

ご指摘のとおりです。93-98 行と 139-144 行に同じフィクスチャをパースして expected1 / expected4 と突き合わせるテストが既にあり、しかも両フィクスチャは型を 1 つしか宣言していないので、head . map snd . M.toList と今回の M.lookup は同じ値を返します。つまり変更前後でテスト集合としては論理的に等価で、カバレッジは変わっていません。

実際の価値は衛生面（フィクスチャを読んで捨てていた状態の解消と、-Wall の警告 3 件の解消）であって、回帰検出能力の向上ではありません。PR 本文を訂正します。

推奨 1: CI が赤だった件

そのとおりで、私が base の #66 で package.yaml を壊していました。置換パターンの 4 スペース版が 6 スペース版の部分文字列だったため、- -Wall の後に dependencies: が生成されていました。この PR の「CI が唯一の検証手段」は、その run では何も検証していなかったことになります。ご指摘のとおりです。

903f72f で修正し、この PR にも e51b871 でマージ済みです。マージ前に緑を目視確認します。

推奨 2: 同ファイルの -Wall 対応が中途半端

そのとおりです。test/TestModel.hs には未使用 import が 7 件（Text/pack/unpack、Text.XML 行の def/parseText/readFile、TestList）と -Wmissing-signatures が残っています。

これは #66 のレビューで約束した警告整理の PR で片付けます（30 件の内訳をそちらで実測いただいています）。この PR に混ぜると「空振りテストの修正」という単位が崩れるためです。-Werror はどこにも無いのでビルドは通り続けます。

検証について

src/Xsd/Parser.hs:655 にも makeTargetQName があるが Xsd.Parser の export リストに含まれていないので import Xsd と衝突しない、という確認は、こちらでは気づいていなかった実際のリスクでした。

minLength が parseConstrains (src/Xsd/Parser.hs:219-225) で黙って落ちる（enumeration しか集めない）ことまで追っていただけたので、「制約の有無は typeToText に影響しない」という私の推論の根拠が実装レベルで裏付けられました。

任意 4（他 7 ケースは let key = … 形式なのに新しい 2 行だけインライン）は、警告整理の PR でスタイルを揃えます。

---

Generated by Claude Code