packages feed

nirum 0.3.3 → 0.4.0

raw patch · 50 files changed

+5205/−2621 lines, 50 filesdep +hxtdep ~basedep ~megaparsecdep ~optparse-applicative

Dependencies added: hxt

Dependency ranges changed: base, megaparsec, optparse-applicative

Files

CHANGES.md view
@@ -1,6 +1,347 @@ Nirum changelog =============== +Version 0.4.0+-------------++Released on May 25, 2018.++### Language++ -  Union tags became possible to have `default` keyword.  It's useful+    for migrating a record type to a union type.  [[#13], [#227]]++ -  Enum members and union tags became disallowed to shadow an other type name+    in a module.  It's because in some target languages we compile both types+    and members/tags into objects that share the same namespace.  In Python,+    both types and union tags are compiled into classes.++    For example, the following definitions had been allowed, but now became+    disallowed:++    ~~~~~~~~ nirum+    unboxed foo (text);+    //      ^~~+    enum bar = foo | baz;+    //         ^~~+    ~~~~~~~~++    ~~~~~~~~ nirum+    record foo (text a);+    //     ^~~+    union bar = foo (text b) | baz (text c);+    //          ^~~+    ~~~~~~~~++    This rule is applied even between a member/tag and its belonging enum/union+    type as well.  The following definitions are disallowed:++    ~~~~~~~~ nirum+    enum foo = foo | bar;+         ^~~   ^~~+    ~~~~~~~~++    ~~~~~~~~ nirum+    union bar = foo (text a) | bar (text b);+          ^~~                  ^~~+    ~~~~~~~~++    If you already have used the same name for a type and a tag, you can avoid+    breaking backward compatibility of serialization by specifying a different+    behind name.  For example, if you've had a definition like:++    ~~~~~~~~ nirum+    enum foo = foo | bar;+    //   ^~~   ^~~+    ~~~~~~~~++    It can be changed like the following:++    ~~~~~~~~ nirum+    enum foo = foo-renamed/foo | bar;+    //         ^~~~~~~~~~~ ^~~+    ~~~~~~~~++    [[#254], [#255]]++ -  Enum members and union tags became disallowed to shadow other enum members+    and union tags even if they belong to an other type.  It's because in some+    target language we compile them into objects that share the same namespace,+    regardless of their belonging type.++    For example, the following definitions had been allowed, but now became+    disallowed:++    ~~~~~~~~ nirum+    enum foo = bar | baz;+    //         ^~~+    enum qux = quux | bar;+    //                ^~~+    ~~~~~~~~++    ~~~~~~~~ nirum+    union foo = bar (text a) | baz (text b);+    //          ^~~+    enum qux = quux | bar;+    //                ^~~+    ~~~~~~~~++    ~~~~~~~~ nirum+    union foo = bar (text a) | baz (text b);+    //                         ^~~+    union qux = quux (text c) | baz (text d);+    //                          ^~~+    ~~~~~~~~++    If you already have used the same name for members/tags of different+    enum/union types, you can avoid breaking backward compatibility of+    serialization by specifying a different behind name.+    For example, if you've had a definition like:++    ~~~~~~~~ nirum+    enum foo = bar | baz;+    //         ^~~+    union qux = bar (text a) | quux (text b);+    //          ^~~+    ~~~~~~~~++    It can be changed like the following:++    ~~~~~~~~ nirum+    enum foo = bar-renamed/bar | baz;+    //         ^~~~~~~~~~~ ^~~+    union qux = bar (text a) | quux (text b);+    ~~~~~~~~++    [[#254], [#255]]++ -  Fixed a compiler bug that an error message on name duplicates had referred+    to a wrong line/column number.  [[#255]]++ -  Added aliased import.  It's handy to avoid a name shadowing.+    [[#217], [#258]]++    ~~~~~~~~ nirum+    import iso (country as iso-country);+    import types (country);+    ~~~~~~~~++ -  Added support for integer type annotation argument.  [[#178], [#267]]++    ~~~~~~~~ nirum+    service foo-service (+        @bar(baz=1)+        int32 qux (int32 quux),+    );+    ~~~~~~~~++ -  Deprecated `uri` and `url` type is added.  [[#126], [#277] by Jonghun Park]++### Docs target++ -  A new required configuration `targets.docs.title` was added.+    It's rendered in generated HTML documents' `<title>` element.+    [[#253]]++ -  Docs now have a sidebar which contains table of contents.  [[#257]]++ -  Fixed a bug that a module-level docs hadn't been rendered.+    Now it's shown in the right below the module name.  [[#259]]++### Python target++ -  Generated Python packages became to have two [entry points] (a feature+    provided by *setuptools*):+     -  `nirum.modules`: It maps Nirum modules to Python modules.+        Nirum module paths are normalized to avoid underscores and upper letters+        and use hyphens and lower letters instead, e.g., `foo-bar.baz`.+        The table works well with `renames` settings as well.+     -  `nirum.classes`: It maps Nirum types (including services) to Python+        classes.  Nirum type names are qualified and their leading module paths+        are also normalized (the same rule to `nirum.modules` applies here).++ -  Generated deserializers became independent from *nirum-python* runtime+    library.  [[#160], [#272]]++     -  Error messages made during deserialization became more standardized.+        Every error now consists of two fields: one represents a path to the+        value having an error, and other one is a human-readable message.++        For example, suppose there's types like:++        ~~~~~~~~ nirum+        record user (dob date);+        record user-group ([user] users);+        ~~~~~~~~++        and the following payload for `user-group` type is given:++        ~~~~~~~~ json+        [+          {"_type": "user", "dob": "2000-06-30"},+          {"_type": "user", "dob": "2000-13-32"}+        ]+        ~~~~~~~~++        An error is reported with a path like `[1].dob`.++     -  Added an optional `on_error` callback parameter to generated+        `__nirum_deserialize__()` methods.++        It has to be a callable which has two parameters (and no return value).+        An `on_error` callback is called every time any validation/parsing error+        happens during deserialization, and it can be called multiple times+        at a single call of `__nirum_deserialize__()`.++        The callback function's first parameter takes a string referring+        a path to the value having an error (e.g., `'.users[0].dob'`).+        The second parameter takes an error message string (e.g.,+        `'Expected a string of RFC 3339 date, but the date is invalid.'`).++        When it's omitted or `None`, a `ValueError` is raised with a multiline+        message that consists of all error messages made during deserialization,+        as it has been.++ -  Fixed a bug that record/union deserializers refuses payloads without+    `"_type"` field.  It is only for humans and can be omitted according to+    the [specification](./docs/serialization.md).++ -  All integral types (`int32`, `int64`, and `bigint`) became represented+    as [`numbers.Integral`][python2-numbers-integral] instead of+    [`int`][python2-int].++    There's no change to Python 3.++ -  The `uri` type became represented as [`basestring`][python2-basestring]+    instead of [`unicode`][python2-unicode] in Python 2, since URI (unlike IRI)+    is limited to a subset of ASCII character set.++    There's no change to Python 3.++ -  Generated type constructors became to validate field value's range or format+    besides class checks: range checks for `int32`/`int64`, time zone+    (``tzinfo``) awareness check for `datetime`, and basic format check for+    `uri`.++ -  Generated service methods became to have its own serialization and+    deserialization functions.  Each method object now has these attributes:++     -  `__nirum_serialize_arguments__` takes the same keywords to the method+        parameters and serialize them into a mapping object (which can be+        directly translated to a JSON object).  It can raise a `TypeError` or+        `ValueError` if any invalid values are passed.++     -  `__nirum_deserialize_arguments__` takes a mapping object returned by+        `json.load()`/`json.loads()` (and an optional `on_error` callable)+        and deserialize it into a mapping object of pairs from parameter's+        facial name string to its corresponding Python object.++     -  `__nirum_argument_serializers__` is a mapping object that keys are+        a string of method's parameter facial name and values are its+        serializer.++        A serializer function takes an argument value and returns+        its corresponding value which can be passed to+        `json.dump()`/`json.dumps()`.  It can raise a `TypeError` or+        `ValueError` if an argument is invalid.++     -  `__nirum_argument_deserializers__` is a mapping object that keys are+        a string of method's parameter behind name and values are its+        deserializer.++        A deserializer function takes an argument value preprocessed by+        `json.load()`/`json.loads()` with an optional `on_error` callback,+        and returns its corresponding Python object.++     -  `__nirum_serialize_result__` takes a method's return value and serialize+        it into a corresponding value which can be passed to+        `json.dump()`/`json.dumps()`.++        If the given value does not match to method's return type it raises+        `TypeError`, or `ValueError` if the value is invalid.++        This attribute is `None` if the method has no return type.++     -  `__nirum_deserialize_result__` takes a result value preprocessed by+        `json.load()`/`json.loads()` with an optional `on_error` callback,+        and deserialize it into its corresponding Python object.++        This attribute is `None` if the method has no return type.++     -  `__nirum_serialize_error__` takes a method's error object and serialize+        it into a corresponding value which can be passed to+        `json.dump()`/`json.dumps()`.++        If the given error object does not match to method's return type+        it raises `TypeError`, or `ValueError` if the error object is invalid.++        This attribute is `None` if the method has no error type.++     -  `__nirum_deserialize_error__` takes an error value preprocessed by+        `json.load()`/`json.loads()` with an optional `on_error` callback,+        and deserialize it into its corresponding Python object.++        This attribute is `None` if the method has no error type.++ -  Removed `__nirum_get_inner_type__()` class methods from generated unboxed+    type classes.++ -  Removed `__nirum_record_behind_name__` static fields and+    `__nirum_field_types__()` class methods from generated record type classes.++ -  Removed `__nirum_tag_names__`, `__nirum_union_behind_name__`, and+    `__nirum_field_names__` static fields from generated union type classes.++ -  Removed `__nirum_tag_types__` static fields from generated union tag+    classes.++ -  Removed `__nirum_schema_version__` static field from generated service+    classes.++ -  Fixed a bug that generated service methods hadn't checked its arguments+    before its transport sends a payload.  [[#220]]++ -  Fixed a bug that field/parameter names that use a module name of the Python+    standard library cause runtime `TypeError`s (due to name shadowing).+    Under the hood, all generated `import`s are now aliased with a name prefixed+    an underscore.++ -  Added Python classifier metadata field.  [[#100], [#269]]++### Et cetera++ -  The officially distributed executable binaries for Linux became+    dependent on [glibc] again.+ -  The official Docker images became based on Debian ([minideb]) instead of+    Alpine Linux.  It's because Alpine Linux doesn't provide GHC 8.2 as of+    March 2018.++[#13]: https://github.com/spoqa/nirum/issues/13+[#100]: https://github.com/spoqa/nirum/issues/100+[#126]: https://github.com/spoqa/nirum/issues/126+[#178]: https://github.com/spoqa/nirum/issues/178+[#217]: https://github.com/spoqa/nirum/issues/217+[#220]: https://github.com/spoqa/nirum/issues/220+[#227]: https://github.com/spoqa/nirum/pull/227+[#253]: https://github.com/spoqa/nirum/pull/253+[#254]: https://github.com/spoqa/nirum/pull/254+[#255]: https://github.com/spoqa/nirum/pull/255+[#257]: https://github.com/spoqa/nirum/pull/257+[#258]: https://github.com/spoqa/nirum/pull/258+[#259]: https://github.com/spoqa/nirum/pull/259+[#267]: https://github.com/spoqa/nirum/pull/267+[#269]: https://github.com/spoqa/nirum/pull/269+[#272]: https://github.com/spoqa/nirum/pull/272+[#277]: https://github.com/spoqa/nirum/pull/277+[entry points]: https://setuptools.readthedocs.io/en/latest/pkg_resources.html#entry-points+[python2-numbers-integral]: https://docs.python.org/2/library/numbers.html#numbers.Integral+[python2-int]: https://docs.python.org/2/library/functions.html#int+[python2-basestring]: https://docs.python.org/2/library/functions.html#basestring+[python2-unicode]: https://docs.python.org/2/library/functions.html#unicode+[glibc]: https://www.gnu.org/software/libc/+[minideb]: https://hub.docker.com/r/bitnami/minideb/++ Version 0.3.3 ------------- @@ -29,7 +370,7 @@ ### Python target   -  Fixed record/union deserializers to ignore unknown fields in data payload.-    Deserializers had raised `KeyError` before.  [#232]+    Deserializers had raised `KeyError` before.  [[#232]]  [#232]: https://github.com/spoqa/nirum/issues/232 @@ -129,7 +470,7 @@  ### Et cetera - -  The officialy distributed executable binaries for Linux became+ -  The officially distributed executable binaries for Linux became     independent from [glibc]; instead statically linked to [musl].  [#216]  -  The Docker image now has `nirum` command in `PATH`.  [[#155]]  -  The Docker image became based and built on [Alpine Linux][] so that
README.md view
@@ -93,7 +93,7 @@     Nirum: The IDL compiler and RPC/distributed object framework      Usage: nirum [-v|--version] (-o|--output-dir DIR) (-t|--target TARGET) DIR-      Nirum compiler 0.3.3+      Nirum compiler 0.4.0      Available options:       -h,--help                Show this help text@@ -148,6 +148,8 @@      Vim/Neovim.  -   [sublime-nirum](https://github.com/spoqa/sublime-nirum): Nirum package for      Sublime Text 3.+ -   [nirum-syntax-highlighting](https://marketplace.visualstudio.com/items?itemName=Nirum.nirum-syntax-highlighting)+     for VS Code: Nirum syntax highlighter for VS Code.  [related-projects]: https://github.com/search?q=topic:nirum+fork:false [github-topic]: https://github.com/blog/2309-introducing-topics
+ lint.hs view
@@ -0,0 +1,12 @@+import Language.Haskell.HLint (hlint)+import System.Exit (exitFailure, exitSuccess)++arguments :: [String]+arguments = ["app", "src", "test", "lint.hs"]++main :: IO ()+main = do+    hlints <- hlint arguments+    case hlints of+        [] -> exitSuccess+        _ -> exitFailure
nirum.cabal view
@@ -1,11 +1,11 @@--- This file has been generated from package.yaml by hpack version 0.20.0.+-- This file has been generated from package.yaml by hpack version 0.28.2. -- -- see: https://github.com/sol/hpack ----- hash: d59f8a8440f6937b61d778b1d1948ecbb9599c387dad494b937ea72152fdeea6+-- hash: adf3c64bc426501fc8eee60800cc027bf7bff5dad57aa6572ab779df33fd557b  name:           nirum-version:        0.3.3+version:        0.4.0 synopsis:       IDL compiler and RPC/distributed object framework for microservices  description:    Nirum is an IDL compiler and RPC/distributed object framework for microservices, built on top of the modern Web server technologies such as RESTful HTTP and JSON.@@ -22,7 +22,6 @@ license-file:   LICENSE build-type:     Simple cabal-version:  >= 1.10- extra-source-files:     CHANGES.md     README.md@@ -37,36 +36,6 @@   default: False  library-  hs-source-dirs:-      src-  default-extensions: OverloadedStrings-  ghc-options: -Wall -fwarn-incomplete-uni-patterns -fprint-explicit-kinds-  build-depends:-      base >=4.7 && <5-    , blaze-html >=0.9.0.1 && <0.10-    , blaze-markup >=0.8.0.0 && <0.9-    , bytestring-    , cmark >=0.5 && <0.6-    , containers >=0.5.6.2 && <0.6-    , directory >=1.2.5 && <1.4-    , email-validate >=2.0.0 && <3.0.0-    , filepath >=1.4 && <1.5-    , fsnotify >=0.2.1 && <0.3.0-    , heterocephalus >=1.0.5 && <1.1.0-    , htoml >=1.0.0.0 && <1.1.0.0-    , interpolatedstring-perl6 >=1.0.0 && <1.1.0-    , megaparsec >=5 && <5.4-    , mtl >=2.2.1 && <3-    , optparse-applicative >=0.13.1 && <0.14-    , parsec-    , pretty >=1.1.3 && <2-    , semver >=0.3.0 && <1.0-    , shakespeare >=2.0.12 && <2.1-    , stm >=2.4.4.1-    , template-haskell >=2.11 && <3-    , text >=0.9.1.0 && <1.3-    , unordered-containers-    , uri >=0.1 && <1.0   exposed-modules:       Nirum.Cli       Nirum.CodeBuilder@@ -95,20 +64,60 @@       Nirum.Targets.Docs       Nirum.Targets.List       Nirum.Targets.Python+      Nirum.Targets.Python.CodeGen+      Nirum.Targets.Python.Deserializers+      Nirum.Targets.Python.Serializers+      Nirum.Targets.Python.TypeExpression+      Nirum.Targets.Python.Validators       Nirum.TypeInstance.BoundModule       Nirum.Version   other-modules:       Paths_nirum+  hs-source-dirs:+      src+  default-extensions: OverloadedStrings+  ghc-options: -Wall -fwarn-incomplete-uni-patterns -fprint-explicit-kinds+  build-depends:+      base >=4.7 && <5+    , blaze-html >=0.9.0.1 && <0.10+    , blaze-markup >=0.8.0.0 && <0.9+    , bytestring+    , cmark >=0.5 && <0.6+    , containers >=0.5.6.2 && <0.6+    , directory >=1.2.5 && <1.4+    , email-validate >=2.0.0 && <3.0.0+    , filepath >=1.4 && <1.5+    , fsnotify >=0.2.1 && <0.3.0+    , heterocephalus >=1.0.5 && <1.1.0+    , htoml >=1.0.0.0 && <1.1.0.0+    , interpolatedstring-perl6 >=1.0.0 && <1.1.0+    , megaparsec >=6.3 && <6.4+    , mtl >=2.2.1 && <3+    , optparse-applicative >=0.14 && <0.15+    , parsec+    , pretty >=1.1.3 && <2+    , semver >=0.3.0 && <1.0+    , shakespeare >=2.0.12 && <2.1+    , stm >=2.4.4.1+    , template-haskell >=2.11 && <3+    , text >=0.9.1.0 && <1.3+    , unordered-containers+    , uri >=0.1 && <1.0+  if os(darwin)+    ghc-options: -Wwarn -optP-Wno-nonportable-include-path+  else+    ghc-options: -Wwarn   default-language: Haskell2010  executable nirum   main-is: nirum.hs+  other-modules:+      Paths_nirum   hs-source-dirs:       app   default-extensions: OverloadedStrings-  ghc-options: -Wall   build-depends:-      base >=4.7 && <5+      base     , blaze-html >=0.9.0.1 && <0.10     , bytestring     , containers >=0.5.6.2 && <0.6@@ -117,7 +126,7 @@     , filepath >=1.4 && <1.5     , htoml >=1.0.0.0 && <1.1.0.0     , interpolatedstring-perl6 >=1.0.0 && <1.1.0-    , megaparsec >=5 && <5.4+    , megaparsec >=6.3 && <6.4     , mtl >=2.2.1 && <3     , nirum     , parsec@@ -125,24 +134,25 @@     , semver >=0.3.0 && <1.0     , text >=0.9.1.0 && <1.3     , unordered-containers+  if os(darwin)+    ghc-options: -Wwarn -optP-Wno-nonportable-include-path+  else+    ghc-options: -Wwarn   if flag(static)     if os(darwin) || os(windows)-      ghc-options: -fwarn-incomplete-uni-patterns -threaded -with-rtsopts=-N -static -optc-Os+      ghc-options: -Wall -fwarn-incomplete-uni-patterns -threaded -with-rtsopts=-N -static -optc-Os     else-      ghc-options: -fwarn-incomplete-uni-patterns -threaded -with-rtsopts=-N -static -optl-static -optl-pthread -optc-Os -fPIC+      ghc-options: -Wall -fwarn-incomplete-uni-patterns -threaded -with-rtsopts=-N -static -optl-static -optl-pthread -optc-Os -fPIC   else-    ghc-options: -fwarn-incomplete-uni-patterns -threaded -with-rtsopts=-N-  other-modules:-      Paths_nirum+    ghc-options: -Wall -fwarn-incomplete-uni-patterns -threaded -with-rtsopts=-N   default-language: Haskell2010  test-suite hlint   type: exitcode-stdio-1.0-  main-is: HLint.hs-  hs-source-dirs:-      test+  main-is: lint.hs+  other-modules:+      Paths_nirum   default-extensions: OverloadedStrings-  ghc-options: -Wall   build-depends:       base >=4.7 && <5     , blaze-html >=0.9.0.1 && <0.10@@ -154,13 +164,22 @@     , hlint >=2.0.9 && <2.1     , htoml >=1.0.0.0 && <1.1.0.0     , interpolatedstring-perl6 >=1.0.0 && <1.1.0-    , megaparsec >=5 && <5.4+    , megaparsec >=6.3 && <6.4     , mtl >=2.2.1 && <3     , parsec     , pretty >=1.1.3 && <2     , semver >=0.3.0 && <1.0     , text >=0.9.1.0 && <1.3     , unordered-containers+  if os(darwin)+    ghc-options: -Wwarn -optP-Wno-nonportable-include-path+  else+    ghc-options: -Wwarn+  default-language: Haskell2010++test-suite spec+  type: exitcode-stdio-1.0+  main-is: Main.hs   other-modules:       Nirum.CliSpec       Nirum.CodeBuilderSpec@@ -183,22 +202,19 @@       Nirum.PackageSpec       Nirum.ParserSpec       Nirum.Targets.DocsSpec+      Nirum.Targets.Python.CodeGenSpec+      Nirum.Targets.Python.TypeExpressionSpec       Nirum.Targets.PythonSpec       Nirum.TargetsSpec+      Nirum.TestFixtures       Nirum.TypeInstance.BoundModuleSpec       Nirum.VersionSpec-      Spec       Util       Paths_nirum-  default-language: Haskell2010--test-suite spec-  type: exitcode-stdio-1.0-  main-is: Spec.hs   hs-source-dirs:       test   default-extensions: OverloadedStrings-  ghc-options: -Wall -fno-warn-incomplete-uni-patterns -fno-warn-missing-signatures -threaded -with-rtsopts=-N+  ghc-options: -Wall -fno-warn-incomplete-uni-patterns -fno-warn-missing-signatures -Wno-missing-signatures -threaded -with-rtsopts=-N   build-depends:       base >=4.7 && <5     , blaze-html >=0.9.0.1 && <0.10@@ -211,8 +227,9 @@     , hspec-core     , hspec-meta     , htoml >=1.0.0.0 && <1.1.0.0+    , hxt >=9.3.1.16 && <9.4.0.0     , interpolatedstring-perl6 >=1.0.0 && <1.1.0-    , megaparsec >=5 && <5.4+    , megaparsec >=6.3 && <6.4     , mtl >=2.2.1 && <3     , nirum     , parsec@@ -224,44 +241,20 @@     , temporary >=1.2 && <1.3     , text >=0.9.1.0 && <1.3     , unordered-containers-  other-modules:-      HLint-      Nirum.CliSpec-      Nirum.CodeBuilderSpec-      Nirum.CodeGenSpec-      Nirum.Constructs.AnnotationSpec-      Nirum.Constructs.DeclarationSetSpec-      Nirum.Constructs.DocsSpec-      Nirum.Constructs.IdentifierSpec-      Nirum.Constructs.ModulePathSpec-      Nirum.Constructs.ModuleSpec-      Nirum.Constructs.NameSpec-      Nirum.Constructs.ServiceSpec-      Nirum.Constructs.TypeDeclarationSpec-      Nirum.Constructs.TypeExpressionSpec-      Nirum.Docs.HtmlSpec-      Nirum.Docs.ReStructuredTextSpec-      Nirum.DocsSpec-      Nirum.Package.MetadataSpec-      Nirum.Package.ModuleSetSpec-      Nirum.PackageSpec-      Nirum.ParserSpec-      Nirum.Targets.DocsSpec-      Nirum.Targets.PythonSpec-      Nirum.TargetsSpec-      Nirum.TypeInstance.BoundModuleSpec-      Nirum.VersionSpec-      Util-      Paths_nirum+  if os(darwin)+    ghc-options: -Wwarn -optP-Wno-nonportable-include-path+  else+    ghc-options: -Wwarn   default-language: Haskell2010  test-suite targets   type: exitcode-stdio-1.0   main-is: test-targets.hs+  other-modules:+      Paths_nirum   hs-source-dirs:       app   default-extensions: OverloadedStrings-  ghc-options: -Wall   build-depends:       base >=4.7 && <5     , blaze-html >=0.9.0.1 && <0.10@@ -272,7 +265,7 @@     , filepath >=1.4 && <1.5     , htoml >=1.0.0.0 && <1.1.0.0     , interpolatedstring-perl6 >=1.0.0 && <1.1.0-    , megaparsec >=5 && <5.4+    , megaparsec >=6.3 && <6.4     , mtl >=2.2.1 && <3     , parsec     , pretty >=1.1.3 && <2@@ -280,6 +273,8 @@     , text >=0.9.1.0 && <1.3     , turtle     , unordered-containers-  other-modules:-      Paths_nirum+  if os(darwin)+    ghc-options: -Wwarn -optP-Wno-nonportable-include-path+  else+    ghc-options: -Wwarn   default-language: Haskell2010
src/Nirum/Cli.hs view
@@ -18,11 +18,7 @@ import System.FilePath (takeDirectory, takeExtension, (</>)) import System.FSNotify import Text.InterpolatedString.Perl6 (qq)-import Text.Megaparsec (Token)-import Text.Megaparsec.Error ( Dec-                             , ParseError (errorPos)-                             , parseErrorPretty-                             )+import Text.Megaparsec.Error (errorPos, parseErrorPretty) import Text.Megaparsec.Pos (SourcePos (sourceLine, sourceColumn), unPos)  import Nirum.Constructs (Construct (toCode))@@ -33,6 +29,7 @@                                     , ParseError                                     , ScanError                                     )+                     , ParseError                      , scanModules                      ) import Nirum.Package.ModuleSet ( ImportError ( CircularImportError@@ -67,9 +64,7 @@ debounceDelay :: Nanosecond debounceDelay = 1 * 1000 * 1000 -parseErrortoPrettyMessage :: ParseError (Token T.Text) Dec-                          -> FilePath-                          -> IO String+parseErrortoPrettyMessage :: ParseError -> FilePath -> IO String parseErrortoPrettyMessage parseError' filePath' = do     sourceCode <- readFile filePath'     let sourceLines = lines sourceCode
src/Nirum/Constructs/Annotation.hs view
@@ -27,10 +27,10 @@ import Nirum.Constructs.Docs import Nirum.Constructs.Identifier (Identifier) - docs :: Docs -> Annotation docs (Docs d) = Annotation { name = docsAnnotationName-                           , arguments = M.singleton docsAnnotationParameter d+                           , arguments =+                                 M.singleton docsAnnotationParameter $ Text d                            }  newtype NameDuplication = AnnotationNameDuplication Identifier@@ -79,7 +79,9 @@ lookupDocs annotationSet = do     Annotation _ args <- lookup docsAnnotationName annotationSet     d <- M.lookup docsAnnotationParameter args-    return $ Docs d+    case d of+        Text d' -> Just $ Docs d'+        _ -> Nothing  insertDocs :: (Monad m) => Docs -> AnnotationSet -> m AnnotationSet insertDocs docs' (AnnotationSet anno) =@@ -90,4 +92,4 @@     insertLookup :: Ord k => k -> a -> M.Map k a -> (Maybe a, M.Map k a)     insertLookup = M.insertLookupWithKey $ \ _ a _ -> a     args :: AnnotationArgumentSet-    args = M.singleton docsAnnotationParameter $ toText docs'+    args = M.singleton docsAnnotationParameter $ Text $ toText docs'
src/Nirum/Constructs/Annotation/Internal.hs view
@@ -4,6 +4,9 @@                  , arguments                  , name                  )+    , AnnotationArgument ( Text+                         , Integer+                         )     , AnnotationArgumentSet     , AnnotationSet ( AnnotationSet                     , annotations@@ -20,8 +23,12 @@ import Nirum.Constructs.Docs import Nirum.Constructs.Identifier (Identifier) -type AnnotationArgumentSet = M.Map Identifier T.Text+data AnnotationArgument = Text T.Text+                        | Integer Integer+                        deriving (Eq, Ord, Show) +type AnnotationArgumentSet = M.Map Identifier AnnotationArgument+ -- | Annotation for 'Declaration'. data Annotation = Annotation { name :: Identifier                              , arguments :: AnnotationArgumentSet@@ -32,10 +39,13 @@       | M.null args = '@' `T.cons` toCode n       | otherwise = [qq|@{toCode n}({showArgs $ M.toList args})|]       where-        showArgs :: [(Identifier, T.Text)] -> T.Text+        showArgs :: [(Identifier, AnnotationArgument)] -> T.Text         showArgs args' = T.intercalate ", " $ map showArg args'-        showArg :: (Identifier, T.Text) -> T.Text-        showArg (key, value) = [qq|{toCode key} = {literal value}|]+        showArg :: (Identifier, AnnotationArgument) -> T.Text+        showArg (key, value) = [qq|{toCode key} = {argToText value}|]+        argToText :: AnnotationArgument -> T.Text+        argToText (Text t) = literal t+        argToText (Integer i) = T.pack $ show i         literal :: T.Text -> T.Text         literal s = [qq|"{(showLitString $ T.unpack s) ""}"|]         showLitString :: String -> ShowS
src/Nirum/Constructs/Declaration.hs view
@@ -1,12 +1,15 @@ {-# LANGUAGE DefaultSignatures #-}-module Nirum.Constructs.Declaration ( Declaration (annotations, name)+module Nirum.Constructs.Declaration ( Declaration (..)                                     , Documented (docs, docsBlock)                                     ) where +import Data.Set (Set, empty)+ import Nirum.Constructs (Construct) import Nirum.Constructs.Annotation (AnnotationSet, lookupDocs) import Nirum.Constructs.Docs (Docs, toBlock)-import Nirum.Constructs.Name (Name)+import Nirum.Constructs.Identifier (Identifier)+import Nirum.Constructs.Name (Name (..)) import Nirum.Docs (Block)  class Documented a where@@ -19,7 +22,17 @@     docsBlock :: a -> Maybe Block     docsBlock = fmap toBlock . docs --- Construct which has its own unique 'name' and can has its 'docs'.+-- | Construct which has its own unique 'name' and can has its 'docs'. class (Construct a, Documented a) => Declaration a where     name :: a -> Name     annotations :: a -> AnnotationSet++    -- | A set of facial name identifiers that are public (or "exported")+    -- but not used for name resolution.  (If an identifier should be a key+    -- for resolution 'name' should return it.)+    --+    -- The default implementation simply returns an empty set.+    --+    -- Intended to be used for 'Nirum.Constructs.DeclarationSet.DeclarationSet'.+    extraPublicNames :: a -> Set Identifier+    extraPublicNames _ = empty
src/Nirum/Constructs/DeclarationSet.hs view
@@ -1,8 +1,12 @@-{-# LANGUAGE OverloadedLists, TypeFamilies #-}+{-# LANGUAGE OverloadedLists #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-} module Nirum.Constructs.DeclarationSet ( DeclarationSet ()                                        , NameDuplication ( BehindNameDuplication                                                          , FacialNameDuplication                                                          )+                                       , delete                                        , empty                                        , fromList                                        , lookup@@ -15,6 +19,7 @@                                        , (!)                                        ) where +import qualified Data.List as List import Data.Maybe (fromJust) import qualified GHC.Exts as L import Prelude hiding (lookup, null)@@ -22,7 +27,7 @@ import qualified Data.Map.Strict as M import qualified Data.Set as S -import Nirum.Constructs.Declaration (Declaration (name))+import Nirum.Constructs.Declaration (Declaration (..)) import Nirum.Constructs.Identifier (Identifier) import Nirum.Constructs.Name (Name (Name, behindName, facialName)) @@ -44,28 +49,52 @@                        , index = []                        } -fromList :: Declaration a => [a] -> Either NameDuplication (DeclarationSet a)-fromList declarations' =-    case findDup names facialName S.empty of-        Just dup -> Left $ FacialNameDuplication dup-        _ -> case findDup names behindName S.empty of-            Just dup -> Left $ BehindNameDuplication dup-            _ -> Right DeclarationSet { declarations = M.fromList mapList-                                      , index = index'-                                      }+fromList :: forall a . Declaration a+         => [a]+         -> Either NameDuplication (DeclarationSet a)+fromList decls =+    case ( List.find (\ d -> facialName (name d) `S.member` extraPublicNames d)+                     decls+         , findDup decls publicNames S.empty+         , findDup decls (S.singleton . behindName . name) S.empty+         ) of+        (Nothing, Nothing, Nothing) ->+            Right DeclarationSet+                { declarations = M.fromList mapList+                , index = index'+                }+        (Just dup, _, _) ->+            Left $ FacialNameDuplication (name dup)+        (Nothing, Just dup, _) ->+            Left $ FacialNameDuplication dup+        (Nothing, Nothing, Just dup) ->+            Left $ BehindNameDuplication dup   where     names :: [Name]-    names = map name declarations'+    names = map name decls     index' :: [Identifier]     index' = map facialName names-    mapList = [(facialName (name d), d) | d <- declarations']-    findDup :: [Name] -> (Name -> Identifier) -> S.Set Identifier -> Maybe Name-    findDup names' f dups =-        case names' of-            x : xs -> let name' = f x-                      in if name' `S.member` dups-                         then Just x-                         else findDup xs f $ S.insert name' dups+    mapList = [(facialName (name d), d) | d <- decls]+    publicNames :: a -> S.Set Identifier+    publicNames decl = facialName (name decl) `S.insert` extraPublicNames decl+    findDup :: [a]+            -> (a -> S.Set Identifier)+            -> S.Set Identifier+            -> Maybe Name+    findDup decls' f dups =+        case decls' of+            x : xs ->+                let publicNames' = f x+                    xName = name x+                    shadowings = publicNames' `S.intersection` dups+                in+                    case S.lookupMin shadowings of+                        Nothing -> findDup xs f $ S.union publicNames' dups+                        Just shadowing ->+                            if facialName xName `S.member` shadowings ||+                               behindName xName `S.member` shadowings+                            then Just xName+                            else Just (Name shadowing shadowing)             _ -> Nothing  toList :: Declaration a => DeclarationSet a -> [a]@@ -96,6 +125,19 @@       -> DeclarationSet a       -> Either NameDuplication (DeclarationSet a) union a b = fromList $ toList a ++ toList b++delete :: Declaration a+       => a+       -> DeclarationSet a+       -> DeclarationSet a+delete d DeclarationSet { declarations = ds, index = ix } =+    DeclarationSet+        { declarations = M.delete identifier ds+        , index = List.delete identifier ix+        }+  where+    identifier :: Identifier+    identifier = facialName $ name d  instance (Declaration a) => L.IsList (DeclarationSet a) where     type Item (DeclarationSet a) = a
src/Nirum/Constructs/Docs.hs view
@@ -1,7 +1,7 @@ {-# LANGUAGE OverloadedStrings #-} module Nirum.Constructs.Docs ( Docs (Docs)-                             , docsAnnotationName                              , docsAnnotationParameter+                             , docsAnnotationName                              , title                              , toBlock                              , toCode@@ -17,11 +17,11 @@ import Nirum.Constructs.Identifier (Identifier) import Nirum.Docs (Block (Document, Heading), parse) -docsAnnotationName :: Identifier-docsAnnotationName = "docs"- docsAnnotationParameter :: Identifier docsAnnotationParameter = "docs"++docsAnnotationName :: Identifier+docsAnnotationName = "docs"  -- | Docstring for constructs. newtype Docs = Docs T.Text deriving (Eq, Ord, Show)
src/Nirum/Constructs/Identifier.hs view
@@ -22,12 +22,12 @@ import Data.Char (toLower, toUpper) import Data.Maybe (fromMaybe) import Data.String (IsString (fromString))+import Data.Void  import qualified Data.Text as T import qualified Data.Set as S import qualified Text.Megaparsec as P import Text.Megaparsec.Char (oneOf, satisfy)-import Text.Megaparsec.Text (Parser)  import Nirum.Constructs (Construct (toCode)) @@ -61,9 +61,11 @@                    , "type"                    , "unboxed"                    , "union"+                   , "default"+                   , "as"                    ] -identifierRule :: Parser Identifier+identifierRule :: P.Parsec Void T.Text Identifier identifierRule = do     firstChar <- satisfy isAlpha     restChars <- P.many $ satisfy isAlnum@@ -88,7 +90,7 @@         Right ident -> Just ident         Left _ -> Nothing   where-    rule :: Parser Identifier+    rule :: P.Parsec Void T.Text Identifier     rule = do         identifier' <- identifierRule         _ <- P.eof
src/Nirum/Constructs/Module.hs view
@@ -30,7 +30,7 @@                                                                   , Int32                                                                   , Int64                                                                   , Text-                                                                  , Uri+                                                                  , Url                                                                   , Uuid                                                                   )                                         , Type (PrimitiveType)@@ -57,10 +57,18 @@       where         typeList :: [TypeDeclaration]         typeList = DS.toList types'+        importIdentifiersToCode :: (Identifier, Identifier) -> T.Text+        importIdentifiersToCode (i, s) = if i == s+                                            then toCode i+                                            else T.concat [ toCode s+                                                          , " as "+                                                          , toCode i+                                                          ]         importCodes :: [T.Text]         importCodes =             [ T.concat [ "import ", toCode p, " ("-                       , T.intercalate ", " $ map toCode $ S.toAscList i+                       , T.intercalate ", " $+                           map importIdentifiersToCode $ S.toAscList i                        , ");"                        ]             | (p, i) <- M.toAscList (imports m)@@ -76,9 +84,9 @@ instance Documented Module where     docs (Module _ docs') = docs' -imports :: Module -> M.Map ModulePath (S.Set Identifier)+imports :: Module -> M.Map ModulePath (S.Set (Identifier, Identifier)) imports (Module decls _) =-    M.fromListWith S.union [(p, [i]) | Import p i _ <- DS.toList decls]+    M.fromListWith S.union [(p, [(i, s)]) | Import p i s _ <- DS.toList decls]  coreModulePath :: ModulePath coreModulePath = ["core"]@@ -104,7 +112,9 @@     -- et cetera     , decl' "bool" Bool Boolean     , decl' "uuid" Uuid String-    , decl' "uri" Uri String+    , decl' "url" Url String+    -- FIXME: deprecated+    , decl' "uri" Url String     ]   where     decl' name prim json =
src/Nirum/Constructs/TypeDeclaration.hs view
@@ -19,7 +19,7 @@                                                                   , Int32                                                                   , Int64                                                                   , Text-                                                                  , Uri+                                                                  , Url                                                                   , Uuid                                                                   )                                         , Tag ( Tag@@ -34,12 +34,12 @@                                                , UnboxedType                                                , UnionType                                                , canonicalType+                                               , defaultTag                                                , fields                                                , innerType                                                , jsonType                                                , members                                                , primitiveTypeIdentifier-                                               , tags                                                )                                         , TypeDeclaration ( Import                                                           , ServiceDeclaration@@ -49,27 +49,31 @@                                                           , service                                                           , serviceAnnotations                                                           , serviceName+                                                          , sourceName                                                           , type'                                                           , typeAnnotations                                                           , typename                                                           )+                                        , unionType+                                        , tags                                         ) where -import Data.Maybe (isJust)+import Data.Maybe (isJust, maybeToList) import Data.String (IsString (fromString))  import qualified Data.Text as T+import qualified Data.Set as S  import Nirum.Constructs (Construct (toCode)) import Nirum.Constructs.Annotation as A (AnnotationSet, empty, lookupDocs)-import Nirum.Constructs.Declaration ( Declaration (annotations, name)+import Nirum.Constructs.Declaration ( Declaration (..)                                     , Documented (docs)                                     ) import Nirum.Constructs.Docs (Docs (Docs), toCodeWithPrefix)-import Nirum.Constructs.DeclarationSet (DeclarationSet, null', toList)+import Nirum.Constructs.DeclarationSet as DS import Nirum.Constructs.Identifier (Identifier) import Nirum.Constructs.ModulePath (ModulePath)-import Nirum.Constructs.Name (Name (Name))+import Nirum.Constructs.Name (Name (..)) import Nirum.Constructs.Service ( Method                                 , Service (Service)                                 , methodDocs@@ -81,12 +85,22 @@     | UnboxedType { innerType :: TypeExpression }     | EnumType { members :: DeclarationSet EnumMember }     | RecordType { fields :: DeclarationSet Field }-    | UnionType { tags :: DeclarationSet Tag }+    | UnionType -- | Use 'unionType' instaed.+        { nondefaultTags :: DeclarationSet Tag -- This should not be exported.+        , defaultTag :: Maybe Tag+        }     | PrimitiveType { primitiveTypeIdentifier :: PrimitiveTypeIdentifier                     , jsonType :: JsonType                     }     deriving (Eq, Ord, Show) +tags :: Type -> DeclarationSet Tag+tags UnionType { nondefaultTags = tags', defaultTag = defTag } =+    case fromList $ toList tags' ++ maybeToList defTag of+        Right ts -> ts+        Left _ -> DS.empty -- must never happen!+tags _ = DS.empty+ -- | Member of 'EnumType'. data EnumMember = EnumMember Name AnnotationSet deriving (Eq, Ord, Show) @@ -131,6 +145,15 @@                , tagAnnotations :: AnnotationSet                } deriving (Eq, Ord, Show) +-- | Create a 'UnionType'.+unionType :: [Tag] -> Maybe Tag -> Either NameDuplication Type+unionType t dt = case fromList t of+                     Right ts -> Right $+                         case dt of+                             Nothing -> UnionType ts Nothing+                             Just dt' -> UnionType (delete dt' ts) dt+                     Left a -> Left a+ instance Construct Tag where     toCode tag@(Tag name' fields' _) =         if null' fields'@@ -151,7 +174,7 @@ -- | Primitive type identifiers. data PrimitiveTypeIdentifier     = Bigint | Decimal | Int32 | Int64 | Float32 | Float64 | Text | Binary-    | Date | Datetime | Bool | Uuid | Uri+    | Date | Datetime | Bool | Uuid | Url     deriving (Eq, Ord, Show)  -- | Possible coded types of 'PrimitiveType' in JSON representation.@@ -169,6 +192,7 @@                          }     | Import { modulePath :: ModulePath              , importName :: Identifier+             , sourceName :: Identifier              , importAnnotations :: AnnotationSet              }     deriving (Eq, Ord, Show)@@ -204,10 +228,10 @@       where         fieldsCode = T.intercalate "\n" $ map toCode $ toList fields'         docs' = A.lookupDocs annotationSet'-    toCode (TypeDeclaration name' (UnionType tags') annotationSet') =-        T.concat [ toCode annotationSet'+    toCode (TypeDeclaration name' (UnionType tags' defaultTag') as') =+        T.concat [ toCode as'                  , "union ", nameCode-                 , toCodeWithPrefix "\n    " (A.lookupDocs annotationSet')+                 , toCodeWithPrefix "\n    " (A.lookupDocs as')                  , "\n    = " , tagsCode                  , "\n    ;"                  ]@@ -216,17 +240,20 @@         nameCode = toCode name'         tagsCode :: T.Text         tagsCode = T.intercalate "\n    | "-                                 [ T.replace "\n" "\n    " (toCode t)-                                 | t <- toList tags'+                                 [ T.replace "\n" "\n    " $+                                             if defaultTag' == Just t+                                             then T.append "default " (toCode t)+                                             else toCode t+                                 | t <- maybeToList defaultTag' ++ toList tags'                                  ]     toCode (TypeDeclaration name'                             (PrimitiveType typename' jsonType')-                            annotationSet') =-        T.concat [ toCode annotationSet'+                            as') =+        T.concat [ toCode as'                  , "// primitive type `", toCode name', "`\n"                  , "//     internal type identifier: ", showT typename', "\n"                  , "//     coded to json ", showT jsonType', " type\n"-                 , docString (A.lookupDocs annotationSet')+                 , docString (A.lookupDocs as')                  ]       where         showT :: Show a => a -> T.Text@@ -260,13 +287,16 @@         methodsText = T.intercalate "\n" $ map toCode methods'         docs' :: Maybe Docs         docs' = A.lookupDocs annotations'-    toCode (Import path ident aSet) = T.concat [ "import "-                                               , toCode path-                                               , " ("-                                               , toCode aSet-                                               , toCode ident-                                               , ");\n"-                                               ]+    toCode (Import path iName sName aSet) = T.concat+        [ "import "+        , toCode path+        , " ("+        , toCode aSet+        , if iName == sName+             then toCode iName+             else T.concat [ toCode sName, " as ", toCode iName ]+        , ");\n"+        ]  instance Documented TypeDeclaration @@ -274,6 +304,11 @@     name TypeDeclaration { typename = name' } = name'     name ServiceDeclaration { serviceName = name' } = name'     name Import { importName = id' } = Name id' id'+    extraPublicNames TypeDeclaration { type' = EnumType { members = ms } } =+        S.fromList [facialName mName | EnumMember mName _ <- toList ms]+    extraPublicNames TypeDeclaration { type' = unionType'@UnionType {} } =+        S.fromList $ map (facialName . tagName) $ toList $ tags unionType'+    extraPublicNames _ = S.empty     annotations TypeDeclaration { typeAnnotations = anno' } = anno'     annotations ServiceDeclaration { serviceAnnotations = anno' } = anno'     annotations Import { importAnnotations = anno' } = anno'
src/Nirum/Docs.hs view
@@ -37,6 +37,7 @@                   , headingLevelFromInt                   , headingLevelInt                   , parse+                  , trimTitle                   ) where  import Data.String (IsString (fromString))@@ -111,6 +112,13 @@     | Link { linkUrl :: Url, linkTitle :: Title, linkContents :: [Inline] }     | Image { imageUrl :: Url, imageTitle :: Title }     deriving (Eq, Ord, Show)++-- | Trim the top-level first heading from the block, if it exists.+trimTitle :: Block -> Block+trimTitle block =+    case block of+        Document (Heading {} : rest) -> Document rest+        b -> b  parse :: T.Text -> Block parse =
src/Nirum/Package.hs view
@@ -1,6 +1,7 @@ module Nirum.Package     ( Package (..)     , PackageError (..)+    , ParseError     , docs     , resolveModule     , scanModules
src/Nirum/Package/Metadata.hs view
@@ -1,13 +1,13 @@-{-# LANGUAGE GADTs, QuasiQuotes, RankNTypes, ScopedTypeVariables,+{-# LANGUAGE GADTs, LambdaCase, QuasiQuotes, RankNTypes, ScopedTypeVariables,              StandaloneDeriving, TypeFamilies #-} module Nirum.Package.Metadata ( Author (Author, email, name, uri)                               , Metadata ( Metadata                                          , authors-                                         , target-                                         , version                                          , description-                                         , license                                          , keywords+                                         , license+                                         , target+                                         , version                                          )                               , MetadataError ( FieldError                                               , FieldTypeError@@ -47,6 +47,7 @@                               , readMetadata                               , stringField                               , tableField+                              , textArrayField                               , versionField                               ) where @@ -261,14 +262,14 @@ optional (Left error') = Left error'  tableField :: MetadataField -> Table -> Either MetadataError Table-tableField = typedField "table" $ \ n -> case n of-                                              VTable t -> Just t-                                              _ -> Nothing+tableField = typedField "table" $ \ case+    VTable t -> Just t+    _ -> Nothing  stringField :: MetadataField -> Table -> Either MetadataError Text-stringField = typedField "string" $ \ n -> case n of-                                                VString s -> Just s-                                                _ -> Nothing+stringField = typedField "string" $ \ case+    VString s -> Just s+    _ -> Nothing  arrayField :: MetadataField -> Table -> Either MetadataError VArray arrayField f t =@@ -278,10 +279,9 @@         Left error' -> Left error'   where     arrayF :: MetadataField -> Table -> Either MetadataError VArray-    arrayF = typedField "array" $ \ node ->-        case node of-            VArray array -> Just array-            _ -> Nothing+    arrayF = typedField "array" $ \ case+        VArray array -> Just array+        _ -> Nothing   tableArrayField :: MetadataField -> Table -> Either MetadataError VTArray@@ -292,10 +292,9 @@         Left error' -> Left error'   where     arrayF :: MetadataField -> Table -> Either MetadataError VTArray-    arrayF = typedField "array of tables" $ \ node ->-        case node of-            VTArray array -> Just array-            _ -> Nothing+    arrayF = typedField "array of tables" $ \ case+        VTArray array -> Just array+        _ -> Nothing  uriField :: MetadataField -> Table -> Either MetadataError URI uriField field' table = do
src/Nirum/Package/ModuleSet.hs view
@@ -90,12 +90,12 @@                 Nothing -> [MissingModulePathError path path']                 Just (Module decls _) ->                     [ e-                    | i <- S.toList idents-                    , e <- case DS.lookup i decls of+                    | (_, s) <- S.toList idents+                    , e <- case DS.lookup s decls of                         Just TypeDeclaration {} -> []                         Just ServiceDeclaration {} -> []-                        Just Import {} -> [MissingImportError path path' i]-                        Nothing -> [MissingImportError path path' i]+                        Just Import {} -> [MissingImportError path path' s]+                        Nothing -> [MissingImportError path path' s]                     ]         ] 
src/Nirum/Parser.hs view
@@ -9,7 +9,9 @@                     , enumTypeDeclaration                     , file                     , handleNameDuplication+                    , handleNameDuplicationError                     , identifier+                    , importName                     , imports                     , listModifier                     , mapModifier@@ -31,15 +33,18 @@                     , unionTypeDeclaration                     ) where -import Control.Monad (void)+import Control.Monad (unless, void, when)+import Data.Void import qualified System.IO as SIO -import Data.Map.Strict as Map hiding (foldl)-import Data.Set hiding (empty, foldl, fromList, map)+import qualified Data.List as L+import Data.Map.Strict as Map hiding (foldl, toList)+import Data.Set hiding (foldl) import qualified Data.Text as T import qualified Data.Text.IO as TIO import Text.Megaparsec hiding (ParseError, parse) import Text.Megaparsec.Char ( char+                            , digitChar                             , eol                             , noneOf                             , spaceChar@@ -47,13 +52,19 @@                             , string'                             ) import qualified Text.Megaparsec.Error as E-import Text.Megaparsec.Text (Parser)-import Text.Megaparsec.Lexer (charLiteral)+import Text.Megaparsec.Char.Lexer (charLiteral)+import Text.Read hiding (choice)  import qualified Nirum.Constructs.Annotation as A+import Nirum.Constructs.Annotation.Internal hiding ( Text+                                                   , annotations+                                                   , name+                                                   )+import qualified Nirum.Constructs.Annotation.Internal as AI import Nirum.Constructs.Declaration (Declaration)+import qualified Nirum.Constructs.Declaration as D import Nirum.Constructs.Docs (Docs (Docs))-import Nirum.Constructs.DeclarationSet as DeclarationSet+import Nirum.Constructs.DeclarationSet as DeclarationSet hiding (toList) import Nirum.Constructs.Identifier ( Identifier                                    , identifierRule                                    , reservedKeywords@@ -61,27 +72,15 @@                                    ) import Nirum.Constructs.Module (Module (Module)) import Nirum.Constructs.ModulePath (ModulePath (ModulePath, ModuleName))-import Nirum.Constructs.Name (Name (Name))+import Nirum.Constructs.Name (Name (Name, facialName)) import Nirum.Constructs.Service ( Method (Method)                                 , Parameter (Parameter)                                 , Service (Service)                                 )-import Nirum.Constructs.TypeDeclaration ( EnumMember (EnumMember)-                                        , Field (Field)-                                        , Tag (Tag)-                                        , Type ( Alias-                                               , EnumType-                                               , RecordType-                                               , UnboxedType-                                               , UnionType-                                               )-                                        , TypeDeclaration ( Import-                                                          , ServiceDeclaration-                                                          , TypeDeclaration-                                                          , serviceAnnotations-                                                          , typeAnnotations-                                                          )-                                        )+import Nirum.Constructs.TypeDeclaration as TD hiding ( fields+                                                     , modulePath+                                                     , importName+                                                     ) import Nirum.Constructs.TypeExpression ( TypeExpression ( ListModifier                                                         , MapModifier                                                         , OptionModifier@@ -90,8 +89,26 @@                                                         )                                        ) -type ParseError = E.ParseError (Token T.Text) E.Dec+type Parser = Parsec Void T.Text+type ParseError = E.ParseError Char Void +-- | State-tracking 'many'.+many' :: [a] -> ([a] -> Parser a) -> Parser [a]+many' i p = do+    r <- optional (p i)+    case r of+        Nothing -> return i+        Just v -> many' (i ++ [v]) p+        -- FIXME: i ++ [v] is not efficient++-- | Get the facial name of a declaration.+declFacialName :: Declaration d => d -> Identifier+declFacialName = facialName . D.name++-- CHECK: If a new reserved keyword is introduced, it has to be also+-- added to `reservedKeywords` set in the `Nirum.Constructs.Identifier`+-- module.+ comment :: Parser () comment = string "//" >> void (many $ noneOf ("\n" :: String)) <?> "comment" @@ -122,21 +139,56 @@  name :: Parser Name name = do-    facialName <- identifier <?> "facial name"-    behindName <- option facialName $ try $ do+    facialName' <- identifier <?> "facial name"+    behindName <- option facialName' $ try $ do         spaces         char '/'         spaces         identifier <?> "behind name"-    return $ Name facialName behindName+    return $ Name facialName' behindName -annotationArgumentValue :: Parser T.Text+uniqueIdentifier :: [Identifier] -> String -> Parser Identifier+uniqueIdentifier forwardNames label' = try $ do+    ident <- lookAhead identP+    when (ident `elem` forwardNames)+         (fail $ "the " ++ label' ++ " `" ++ toString ident +++                 "` is duplicated")+    identP+  where+    identP :: Parser Identifier+    identP = identifier <?> label'++uniqueName :: [Identifier] -> String -> Parser Name+uniqueName forwardNames label' = try $ do+    Name fName _ <- lookAhead nameP+    when (fName `elem` forwardNames)+         (fail $ "the " ++ label' ++ " `" ++ toString fName +++                 "` is duplicated")+    nameP+  where+    nameP :: Parser Name+    nameP = name <?> label'++integer :: Parser Integer+integer = do+    v <- many digitChar+    case readMaybe v of+        Just i -> return i+        Nothing -> fail "digit expected." -- never happened+++annotationArgumentValue :: Parser AnnotationArgument annotationArgumentValue = do-    char '"'-    value <- manyTill charLiteral (char '"')-    return $ T.pack value+    startQuote <- optional $ try $ char '"'+    case startQuote of+        Just _ -> do+            v <- manyTill charLiteral (char '"')+            return $ AI.Text $ T.pack v+        Nothing -> do+            v <- integer+            return $ Integer v -annotationArgument :: Parser (Identifier, T.Text)+annotationArgument :: Parser (Identifier, AnnotationArgument) annotationArgument = do     arg <- identifier <?> "annotation parameter"     spaces@@ -244,48 +296,48 @@ annotationsWithDocs set' (Just docs') = A.insertDocs docs' set' annotationsWithDocs set' Nothing = return set' -aliasTypeDeclaration :: Parser TypeDeclaration-aliasTypeDeclaration = do+aliasTypeDeclaration :: [Identifier] -> Parser TypeDeclaration+aliasTypeDeclaration forwardNames = do     annotationSet' <- annotationSet <?> "type alias annotations"     string' "type" <?> "type alias keyword"     spaces-    typename <- identifier <?> "alias type name"-    let name' = Name typename typename+    typeName <- uniqueIdentifier forwardNames "alias type name"+    let name' = Name typeName typeName     spaces     char '='     spaces-    canonicalType <- typeExpression <?> "canonical type of alias"+    canonicalType' <- typeExpression <?> "canonical type of alias"     spaces     char ';'     docs' <- optional $ try $ spaces >> (docs <?> "type alias docs")     annotationSet'' <- annotationsWithDocs annotationSet' docs'-    return $ TypeDeclaration name' (Alias canonicalType) annotationSet''+    return $ TypeDeclaration name' (Alias canonicalType') annotationSet''  -unboxedTypeDeclaration :: Parser TypeDeclaration-unboxedTypeDeclaration = do+unboxedTypeDeclaration :: [Identifier] -> Parser TypeDeclaration+unboxedTypeDeclaration forwardNames = do     annotationSet' <- annotationSet <?> "unboxed type annotations"     string' "unboxed" <?> "unboxed type keyword"     spaces-    typename <- identifier <?> "unboxed type name"-    let name' = Name typename typename+    typeName <- uniqueIdentifier forwardNames "unboxed type name"+    let name' = Name typeName typeName     spaces     char '('     spaces-    innerType <- typeExpression <?> "inner type of unboxed type"+    innerType' <- typeExpression <?> "inner type of unboxed type"     spaces     char ')'     spaces     char ';'     docs' <- optional $ try $ spaces >> (docs <?> "unboxed type docs")     annotationSet'' <- annotationsWithDocs annotationSet' docs'-    return $ TypeDeclaration name' (UnboxedType innerType) annotationSet''+    return $ TypeDeclaration name' (UnboxedType innerType') annotationSet'' -enumMember :: Parser EnumMember-enumMember = do+enumMember :: [Identifier] -> Parser EnumMember+enumMember forwardNames = do     annotationSet' <- annotationSet <?> "enum member annotations"     spaces-    memberName <- name <?> "enum member name"+    memberName <- uniqueName forwardNames "enum member name"     spaces     docs' <- optional $ do         d <- docs <?> "enum member docs"@@ -295,25 +347,31 @@     return $ EnumMember memberName annotationSet''  handleNameDuplication :: Declaration a-                      => String -> [a]+                      => String+                      -> [a]                       -> (DeclarationSet a -> Parser b)                       -> Parser b-handleNameDuplication label' declarations cont =-    case DeclarationSet.fromList declarations of-        Left (BehindNameDuplication (Name _ bname)) ->-            fail ("the behind " ++ label' ++ " name `" ++ toString bname ++-                  "` is duplicated")-        Left (FacialNameDuplication (Name fname _)) ->-            fail ("the facial " ++ label' ++ " name `" ++ toString fname ++-                  "` is duplicated")-        Right set -> cont set+handleNameDuplication label' declarations cont = do+    set <- handleNameDuplicationError label' $+        DeclarationSet.fromList declarations+    cont set -enumTypeDeclaration :: Parser TypeDeclaration-enumTypeDeclaration = do+handleNameDuplicationError :: String -> Either NameDuplication a -> Parser a+handleNameDuplicationError _ (Right v) = return v+handleNameDuplicationError label' (Left dup) =+    fail ("the " ++ nameType ++ " " ++ label' ++ " name `" +++          toString name' ++ "` is duplicated")+  where+    (nameType, name') = case dup of+        BehindNameDuplication (Name _ bname) -> ("behind", bname)+        FacialNameDuplication (Name fname _) -> ("facial", fname)++enumTypeDeclaration :: [Identifier] -> Parser TypeDeclaration+enumTypeDeclaration forwardNames = do     annotationSet' <- annotationSet <?> "enum type annotations"     string "enum" <?> "enum keyword"     spaces-    typename <- name <?> "enum type name"+    typeName@(Name typeFName _) <- uniqueName forwardNames "enum type name"     spaces     frontDocs <- optional $ do         d <- docs <?> "enum type docs"@@ -328,9 +386,11 @@             spaces             return d     annotationSet'' <- annotationsWithDocs annotationSet' docs'-    members <- (enumMember `sepBy1` (spaces >> char '|' >> spaces))-                   <?> "enum members"-    case DeclarationSet.fromList members of+    members' <- sepBy1+        (enumMember (typeFName : forwardNames))+        (spaces >> char '|' >> spaces)+        <?> "enum members"+    case DeclarationSet.fromList members' of         Left (BehindNameDuplication (Name _ bname)) ->             fail ("the behind member name `" ++ toString bname ++                   "` is duplicated")@@ -340,7 +400,7 @@         Right memberSet -> do             spaces             char ';'-            return $ TypeDeclaration typename (EnumType memberSet)+            return $ TypeDeclaration typeName (EnumType memberSet)                                      annotationSet''  fieldsOrParameters :: forall a . (String, String)@@ -349,12 +409,12 @@ fieldsOrParameters (label', pluralLabel) make = do     annotationSet' <- annotationSet <?> (label' ++ " annotations")     spaces-    type' <- typeExpression <?> (label' ++ " type")+    typeExpr <- typeExpression <?> (label' ++ " type")     spaces1     name' <- name <?> (label' ++ " name")     spaces-    let makeWithDocs = make name' type' . A.union annotationSet'-                                        . annotationsFromDocs+    let makeWithDocs = make name' typeExpr . A.union annotationSet'+                                           . annotationsFromDocs     followedByComma makeWithDocs <|> do         d <- optional docs' <?> (label' ++ " docs")         return [makeWithDocs d]@@ -386,12 +446,12 @@     fields' <- fields <?> "fields"     handleNameDuplication "field" fields' return -recordTypeDeclaration :: Parser TypeDeclaration-recordTypeDeclaration = do+recordTypeDeclaration :: [Identifier] -> Parser TypeDeclaration+recordTypeDeclaration forwardNames = do     annotationSet' <- annotationSet <?> "record type annotations"     string "record" <?> "record keyword"     spaces-    typename <- name <?> "record type name"+    typeName <- uniqueName forwardNames "record type name"     spaces     char '('     spaces@@ -405,14 +465,16 @@     spaces     char ';'     annotationSet'' <- annotationsWithDocs annotationSet' docs'-    return $ TypeDeclaration typename (RecordType fields') annotationSet''+    return $ TypeDeclaration typeName (RecordType fields') annotationSet'' -tag :: Parser Tag-tag = do+tag :: [Identifier] -> Parser (Tag, Bool)+tag forwardNames = do     annotationSet' <- annotationSet <?> "union tag annotations"     spaces-    tagName <- name <?> "union tag name"+    default' <- optional (string "default" <?> "default tag")     spaces+    tagName' <- uniqueName forwardNames "union tag name"+    spaces     paren <- optional $ char '('     spaces     frontDocs <- optional $ do@@ -435,14 +497,18 @@             spaces             return d     annotationSet'' <- annotationsWithDocs annotationSet' docs'-    return $ Tag tagName fields' annotationSet''+    return ( Tag tagName' fields' annotationSet''+           , case default' of+                 Just _ -> True+                 Nothing -> False+           ) -unionTypeDeclaration :: Parser TypeDeclaration-unionTypeDeclaration = do+unionTypeDeclaration :: [Identifier] -> Parser TypeDeclaration+unionTypeDeclaration forwardNames = do     annotationSet' <- annotationSet <?> "union type annotations"     string "union" <?> "union keyword"     spaces-    typename <- name <?> "union type name"+    typeName <- uniqueName forwardNames "union type name"     spaces     docs' <- optional $ do         d <- docs <?> "union type docs"@@ -450,27 +516,41 @@         return d     char '='     spaces-    tags' <- (tag `sepBy1` try (spaces >> char '|' >> spaces))-             <?> "union tags"+    tags' <- sepBy1+        (tag forwardNames)+        (try (spaces >> char '|' >> spaces))+        <?> "union tags"+    let tags'' = [t | (t, _) <- tags']+    let defaultTag' = do+            (t''', _) <- L.find snd tags'+            return t'''     spaces     char ';'     annotationSet'' <- annotationsWithDocs annotationSet' docs'-    handleNameDuplication "tag" tags' $ \ tagSet ->-        return $ TypeDeclaration typename (UnionType tagSet) annotationSet''+    if length (L.filter snd tags') > 1+        then fail "A union type cannot have more than a default tag."+        else do+            ut <- handleNameDuplicationError "tag" $+                unionType tags'' defaultTag'+            return $ TypeDeclaration typeName ut annotationSet'' -typeDeclaration :: Parser TypeDeclaration-typeDeclaration = do+typeDeclaration :: [Identifier] -> Parser TypeDeclaration+typeDeclaration forwardNames = do     -- Preconsume the common prefix (annotations) to disambiguate     -- the continued branches of parsers.     spaces     annotationSet' <- annotationSet <?> "type annotations"     spaces     typeDecl <- choice-        [ unless' ["union", "record", "enum", "unboxed"] aliasTypeDeclaration-        , unless' ["union", "record", "enum"] unboxedTypeDeclaration-        , unless' ["union", "record"] enumTypeDeclaration-        , unless' ["union"] recordTypeDeclaration-        , unionTypeDeclaration+        [ unless' ["union", "record", "enum", "unboxed"]+                  (aliasTypeDeclaration forwardNames)+        , unless' ["union", "record", "enum"]+                  (unboxedTypeDeclaration forwardNames)+        , unless' ["union", "record"]+                  (enumTypeDeclaration forwardNames)+        , unless' ["union"]+                  (recordTypeDeclaration forwardNames)+        , unionTypeDeclaration forwardNames         ] <?> "type declaration (e.g. enum, record, unboxed, union)"     -- In theory, though it preconsumes annotationSet' before parsing typeDecl     -- so that typeDecl itself has no annotations, to prepare for an@@ -480,7 +560,7 @@     let annotations = A.union annotationSet' $ typeAnnotations typeDecl     return $ typeDecl { typeAnnotations = annotations }   where-    unless' :: [String] -> Parser a -> Parser a+    unless' :: [T.Text] -> Parser a -> Parser a     unless' [] _ = fail "no candidates"  -- Must never happen     unless' [s] p = notFollowedBy (string s) >> p     unless' (x : xs) p = notFollowedBy (string x) >> unless' xs p@@ -532,12 +612,12 @@     methods' <- methods <?> "service methods"     handleNameDuplication "method" methods' return -serviceDeclaration :: Parser TypeDeclaration-serviceDeclaration = do+serviceDeclaration :: [Identifier] -> Parser TypeDeclaration+serviceDeclaration forwardNames = do     annotationSet' <- annotationSet <?> "service annotation"     string "service" <?> "service keyword"     spaces-    serviceName <- name <?> "service name"+    serviceName' <- uniqueName forwardNames "service name"     spaces     char '('     spaces@@ -551,7 +631,7 @@     spaces     char ';'     annotationSet'' <- annotationsWithDocs annotationSet' docs'-    return $ ServiceDeclaration serviceName (Service methods') annotationSet''+    return $ ServiceDeclaration serviceName' (Service methods') annotationSet''  modulePath :: Parser ModulePath modulePath = do@@ -568,28 +648,49 @@     f Nothing i = Just $ ModuleName i     f (Just p) i = Just $ ModulePath p i -importName :: Parser (Identifier, A.AnnotationSet)-importName = do+importName :: [Identifier]+           -> Parser (Identifier, Identifier, A.AnnotationSet)+importName forwardNames = do     aSet <- annotationSet <?> "import annotations"     spaces     iName <- identifier <?> "name to import"-    return (iName, aSet)+    hasAlias <- optional $ try $ do+        spaces+        string' "as"+    aName <- case hasAlias of+        Just _ -> do+            spaces+            uniqueIdentifier forwardNames "alias name to import"+        Nothing ->+            return iName+    return (aName, iName, aSet) -imports :: Parser [TypeDeclaration]-imports = do+imports :: [Identifier] -> Parser [TypeDeclaration]+imports forwardNames = do     string' "import" <?> "import keyword"     spaces     path <- modulePath <?> "module path"     spaces     char '('     spaces-    idents <- (importName >>= \ i -> spaces >> return i)-        `sepEndBy1` (char ',' >> spaces)-        <?> "names to import"+    idents <- many' [] $ \ importNames' -> do+        notFollowedBy $ choice [char ')', char ',' >> spaces >> char ')']+        let forwardNames' = [i | (i, _, _) <- importNames'] ++ forwardNames+        unless (L.null importNames') $ do+            string' ","+            spaces+        n <- importName forwardNames'+        spaces+        return n+    when (L.null idents) $ fail "parentheses cannot be empty"+    void $ optional $ string' ","+    spaces     char ')'     spaces     char ';'-    return [Import path ident aSet | (ident, aSet) <- idents]+    return [ Import path imp source aSet+           | (imp, source, aSet) <- idents+           ]   module' :: Parser Module@@ -601,19 +702,27 @@         return d     spaces     importLists <- many $ do-        importList <- imports+        importList <- imports []         spaces         return importList-    types <- many $ do+    let imports' = [i | l <- importLists, i <- l]+    types <- many' imports' $ \ tds -> do         typeDecl <- do             -- Preconsume the common prefix (annotations) to disambiguate             -- the continued branches of parsers.             spaces             annotationSet' <- annotationSet <?> "annotations"             spaces-            decl <- choice [ notFollowedBy (string "service") >> typeDeclaration-                           , serviceDeclaration <?> "service declaration"-                           ]+            let forwardNames =+                    [ n+                    | td <- tds+                    , n <- declFacialName td : toList (D.extraPublicNames td)+                    ]+            decl <- choice+                [ notFollowedBy (string "service")+                      >> typeDeclaration forwardNames+                , serviceDeclaration forwardNames <?> "service declaration"+                ]             -- In theory, though it preconsumes annotationSet' before parsing             -- decl so that decl itself has no annotations, to prepare for an             -- unlikely situation (that I bet it'll never happen)@@ -627,7 +736,7 @@                 _ -> decl  -- Never happen!         spaces         return typeDecl-    handleNameDuplication "type" (types ++ [i | l <- importLists, i <- l]) $+    handleNameDuplication "type" types $                           \ typeSet -> return $ Module typeSet docs'  file :: Parser Module@@ -648,5 +757,3 @@         SIO.hSetEncoding h SIO.utf8_bom         TIO.hGetContents h     return $ runParser file path code--{-# ANN module ("HLint: ignore Reduce duplication" :: String) #-}
src/Nirum/Targets.hs view
@@ -1,14 +1,7 @@ {-# LANGUAGE QuasiQuotes, ScopedTypeVariables, TemplateHaskell #-} module Nirum.Targets ( BuildError (CompileError, PackageError, TargetNameError)                      , BuildResult-                     , Target ( CompileError-                              , CompileResult-                              , compilePackage-                              , parseTarget-                              , showCompileError-                              , targetName-                              , toByteString-                              )+                     , Target (..)                      , TargetName                      , buildPackage                      , targetNames
src/Nirum/Targets/Docs.hs view
@@ -19,7 +19,7 @@ import System.FilePath ((</>)) import Text.Blaze (ToMarkup (preEscapedToMarkup)) import Text.Blaze.Html.Renderer.Utf8 (renderHtml)-import Text.Cassius (cassius, renderCss)+import Text.Cassius import Text.Hamlet (Html, shamlet)  import Nirum.Constructs (Construct (toCode))@@ -39,6 +39,7 @@ import qualified Nirum.Constructs.TypeExpression as TE import Nirum.Docs ( Block (Heading)                   , filterReferences+                  , trimTitle                   ) import Nirum.Docs.Html (render, renderInlines) import Nirum.Package@@ -52,15 +53,23 @@                                        , targetName                                        , toByteString                                        )+                              , stringField                               ) import qualified Nirum.Package.ModuleSet as MS import Nirum.TypeInstance.BoundModule import Nirum.Version (versionText) -data Docs = Docs deriving (Eq, Ord, Show)+newtype Docs = Docs+    { docsTitle :: T.Text+    } deriving (Eq, Ord, Show)  type Error = T.Text +data CurrentPage+    = IndexPage+    | ModulePage ModulePath+    deriving (Eq, Show)+ makeFilePath :: ModulePath -> FilePath makeFilePath modulePath' = foldl (</>) "" $     map toNormalizedString (toList modulePath') ++ ["index.html"]@@ -71,8 +80,20 @@     T.intercalate "/" $                   map toNormalizedText (toList modulePath') ++ ["index.html"] -layout :: ToMarkup m => Package Docs -> Int -> m -> Html -> Html-layout Package { metadata = md } dirDepth title body = [shamlet|+layout :: ToMarkup m => Package Docs -> Int -> CurrentPage -> m -> Html -> Html+layout pkg dirDepth currentPage title body =+    layout' pkg dirDepth currentPage title body Nothing++layout' :: ToMarkup m+        => Package Docs+        -> Int+        -> CurrentPage+        -> m+        -> Html+        -> Maybe Html+        -> Html+layout' pkg@Package { metadata = md, modules = ms }+        dirDepth currentPage title body footer = [shamlet| $doctype 5 <html>     <head>@@ -81,9 +102,38 @@         <meta name="generator" content="Nirum #{versionText}">         $forall Author { name = name' } <- authors md             <meta name="author" content="#{name'}">-        <link rel="stylesheet" href="#{T.replicate dirDepth "../"}style.css">-    <body>#{body}+        <link rel="stylesheet" href="#{root}style.css">+    <body>+        <nav>+            $if currentPage == IndexPage+                <a class="index selected" href="#{root}index.html">+                    <strong>+                        #{docsTitle $ target pkg}+            $else+                <a class="index" href="#{root}index.html">+                    #{docsTitle $ target pkg}+            <ul class="toc">+                $forall (modulePath', mod) <- MS.toAscList ms+                    $if currentPage == ModulePage modulePath'+                        <li class="selected">+                            <a href="#{root}#{makeUri modulePath'}">+                                <strong>+                                    <code>#{toCode modulePath'}</code>+                                    $maybe tit <- moduleTitle mod+                                        &mdash; #{tit}+                    $else+                        <li>+                            <a href="#{root}#{makeUri modulePath'}">+                                <code>#{toCode modulePath'}</code>+                                $maybe tit <- moduleTitle mod+                                    &mdash; #{tit}+        <article>#{body}+        $maybe f <- footer+            <footer>#{f} |]+  where+    root :: T.Text+    root = T.replicate dirDepth "../"  typeExpression :: BoundModule Docs -> TE.TypeExpression -> Html typeExpression _ expr = [shamlet|#{typeExpr expr}|]@@ -104,15 +154,20 @@ |]  module' :: BoundModule Docs -> Html-module' docsModule = layout pkg depth path $ [shamlet|-    $maybe tit <- title-        <h1><code>#{path}</code>-        <p>#{tit}-    $nothing-        <h1><code>#{path}</code>-    $forall (ident, decl) <- types'-        <div class="#{showKind decl}" id="#{toNormalizedText ident}">-            #{typeDecl docsModule ident decl}+module' docsModule =+    layout pkg depth (ModulePage docsModulePath) title $ [shamlet|+$maybe tit <- headingTitle+    <h1>+        <dfn><code>#{path}</code>+        &#32;&mdash; #{tit}+$nothing+    <h1><code>#{path}</code>+$maybe m <- mod'+    $maybe d <- docsBlock m+        #{blockToHtml (trimTitle d)}+$forall (ident, decl) <- types'+    <div class="#{showKind decl}" id="#{toNormalizedText ident}">+        #{typeDecl docsModule ident decl} |]   where     docsModulePath :: ModulePath@@ -121,6 +176,8 @@     pkg = boundPackage docsModule     path :: T.Text     path = toCode docsModulePath+    title :: T.Text+    title = T.concat [path, " \8212 ", docsTitle $ target pkg]     types' :: [(Identifier, TD.TypeDeclaration)]     types' = [ (facialName $ DE.name decl, decl)              | decl <- DES.toList $ boundTypes docsModule@@ -130,8 +187,8 @@              ]     mod' :: Maybe Module     mod' = resolveModule docsModulePath pkg-    title :: Maybe Html-    title = do+    headingTitle :: Maybe Html+    headingTitle = do         m <- mod'         moduleTitle m     depth :: Int@@ -143,60 +200,83 @@ typeDecl :: BoundModule Docs -> Identifier -> TD.TypeDeclaration -> Html typeDecl mod' ident          tc@TD.TypeDeclaration { TD.type' = TD.Alias cname } = [shamlet|-    <h2><code>type</code> #{toNormalizedText ident} = #-        <code>#{typeExpression mod' cname}</code>+    <h2>+        type <dfn><code>#{toNormalizedText ident}</code></dfn> = #+        <code.type>#{typeExpression mod' cname}</code>     $maybe d <- docsBlock tc         #{blockToHtml d} |] typeDecl mod' ident          tc@TD.TypeDeclaration { TD.type' = TD.UnboxedType innerType } =     [shamlet|-        <h2><code>unboxed</code> #{toNormalizedText ident}+        <h2>+            unboxed+            <dfn><code>#{toNormalizedText ident}</code>             (<code>#{typeExpression mod' innerType}</code>)         $maybe d <- docsBlock tc             #{blockToHtml d}     |] typeDecl _ ident          tc@TD.TypeDeclaration { TD.type' = TD.EnumType members } = [shamlet|-    <h2><code>enum</code> #{toNormalizedText ident}+    <h2>enum <dfn><code>#{toNormalizedText ident}</code></dfn>     $maybe d <- docsBlock tc         #{blockToHtml d}     <dl class="members">         $forall decl <- DES.toList members-            <dt class="member-name">#{nameText $ DE.name decl}+            <dt class="member-name">+                <code>#{nameText $ DE.name decl}             <dd class="member-doc">                 $maybe d <- docsBlock decl                     #{blockToHtml d} |] typeDecl mod' ident          tc@TD.TypeDeclaration { TD.type' = TD.RecordType fields } = [shamlet|-    <h2><code>record</code> #{toNormalizedText ident}+    <h2>record <dfn><code>#{toNormalizedText ident}</code></dfn>     $maybe d <- docsBlock tc         #{blockToHtml d}     <dl.fields>         $forall fieldDecl@(TD.Field _ fieldType _) <- DES.toList fields             <dt>-                <code>#{typeExpression mod' fieldType}-                #{nameText $ DE.name fieldDecl}-            $maybe d <- docsBlock fieldDecl-                <dd>#{blockToHtml d}+                <code.type>#{typeExpression mod' fieldType}+                <var><code>#{nameText $ DE.name fieldDecl}</code>+            <dd>+                $maybe d <- docsBlock fieldDecl+                    #{blockToHtml d} |] typeDecl mod' ident-         tc@TD.TypeDeclaration { TD.type' = TD.UnionType tags } = [shamlet|-    <h2>union <code>#{toNormalizedText ident}</code>+         tc@TD.TypeDeclaration+             { TD.type' = unionType@TD.UnionType+                   { TD.defaultTag = defaultTag+                   }+             } =+    [shamlet|+    <h2>union <dfn><code>#{toNormalizedText ident}</code></dfn>     $maybe d <- docsBlock tc         #{blockToHtml d}-    $forall tagDecl@(TD.Tag _ fields _) <- DES.toList tags-        <h3 class="tag"><code>#{nameText $ DE.name tagDecl}</code>+    $forall (default_, tagDecl@(TD.Tag _ fields _)) <- tagList+        <h3 .tag :default_:.default-tag>+            $if default_+                default tag #+            $else+                tag #+            <dfn><code>#{nameText $ DE.name tagDecl}</code>         $maybe d <- docsBlock tagDecl             #{blockToHtml d}-        $forall fieldDecl@(TD.Field _ fieldType _) <- DES.toList fields-            <h4>-                <span.type>#{typeExpression mod' fieldType}-                <code>#{nameText $ DE.name fieldDecl}-            $maybe d <- docsBlock fieldDecl-                #{blockToHtml d}-|]+        <dl.fields>+            $forall fieldDecl@(TD.Field _ fieldType _) <- DES.toList fields+                <dt>+                    <code.type>#{typeExpression mod' fieldType}+                    <var><code>#{nameText $ DE.name fieldDecl}</code>+                <dd>+                    $maybe d <- docsBlock fieldDecl+                        #{blockToHtml d}+    |]+  where+    tagList :: [(Bool, TD.Tag)]+    tagList =+        [ (defaultTag == Just tag, tag)+        | tag <- DES.toList (TD.tags unionType)+        ] typeDecl _ ident          TD.TypeDeclaration { TD.type' = TD.PrimitiveType {} } = [shamlet|     <h2>primitive <code>#{toNormalizedText ident}</code>@@ -204,17 +284,23 @@ typeDecl mod' ident          tc@TD.ServiceDeclaration { TD.service = S.Service methods } =     [shamlet|-        <h2><code>service</code> #{toNormalizedText ident}+        <h2>service <dfn><code>#{toNormalizedText ident}</code></dfn>         $maybe d <- docsBlock tc             #{blockToHtml d}         $forall md@(S.Method _ ps ret err _) <- DES.toList methods-            <h3.method>#{nameText $ DE.name md} (-                $forall (i, pd@(S.Parameter _ pt _)) <- enumerateParams ps-                    $if i > 0-                        , #-                    <code.type>#{typeExpression mod' pt}</code> #-                    <var>#{nameText $ DE.name pd}</var>#-                )+            <h3.method>+                $maybe retType <- ret+                    <span.return>+                        <code.type>#{typeExpression mod' retType}+                        &#32;+                <dfn>+                    <code>#{nameText $ DE.name md}+                    &#32;+                <span.parentheses>()+                $maybe errType <- err+                    <span.error>+                        throws+                        <code.error.type>#{typeExpression mod' errType}             $maybe d <- docsBlock md                 #{blockToHtml d}             <dl.parameters>@@ -222,21 +308,9 @@                     $maybe d <- docsBlock paramDecl                         <dt>                             <code.type>#{typeExpression mod' paramType}-                            <var>#{nameText $ DE.name paramDecl}</var>:+                            <code><var>#{nameText $ DE.name paramDecl}</var>                         <dd>#{blockToHtml d}-            <dl.result>-                $maybe retType <- ret-                    <dt.return-label>returns:-                    <dd.return-type><code>#{typeExpression mod' retType}</code>-                $maybe errType <- err-                    <dt.raise-label>raises:-                    <dd.raise-type><code>#{typeExpression mod' errType}</code> |]-  where-    enumerate :: [a] -> [(Int, a)]-    enumerate = zip [0 ..]-    enumerateParams :: DES.DeclarationSet S.Parameter -> [(Int, S.Parameter)]-    enumerateParams = enumerate . DES.toList typeDecl _ _ TD.Import {} =     error ("It shouldn't happen; please report it to Nirum's bug tracker:\n" ++            "https://github.com/spoqa/nirum/issues")@@ -258,17 +332,25 @@ contents :: Package Docs -> Html contents pkg@Package { metadata = md                      , modules = ms-                     } = layout pkg 0 ("Package docs" :: T.Text) [shamlet|+                     } =+    layout' pkg 0 IndexPage title body $ case authors md of+        [] -> Nothing+        _ : _ -> Just footer+  where+    body :: Html+    body = [shamlet| <h1>Modules $forall (modulePath', mod) <- MS.toAscList ms-    $maybe tit <- moduleTitle mod-        <h2>-            <a href="#{makeUri modulePath'}"><code>#{toCode modulePath'}</code>-        <p>#{tit}-    $nothing-        <h2>-            <a href="#{makeUri modulePath'}"><code>#{toCode modulePath'}</code>-<hr>+    <h2>+        <a href="#{makeUri modulePath'}">+            <code>#{toCode modulePath'}</code>+            $maybe tit <- moduleTitle mod+                &mdash; #{tit}+|]+    title :: T.Text+    title = docsTitle $ target pkg+    footer :: Html+    footer = [shamlet| <dl>     <dt.author>         $if 1 < length (authors md)@@ -284,7 +366,6 @@             $nothing                 <dd.author>#{n} |]-  where     emailText :: E.EmailAddress -> T.Text     emailText = decodeUtf8 . E.toByteString @@ -302,12 +383,16 @@ stylesheet = renderCss ([cassius| @import url(#{fontUrl}) body+    padding: 0+    margin: 0     font-family: Source Sans Pro     color: #{gray8} code     font-family: Source Code Pro     font-weight: 300     background-color: #{gray1}+strong code+    font-weight: 400 pre     padding: 16px 10px     background-color: #{gray1}@@ -333,6 +418,42 @@ dd     p         margin-top: 0++nav+    position: fixed+    left: 0+    top: 0+    bottom: 0+    width: #{navWidth}+    overflow-y: auto+    border-right: 1px solid #{gray2}+    background-color: #{gray0}+    code+        background: none+    a.index, ul.toc li a+        display: block+        padding: 0 1em+        margin: 1em 0+        overflow: hidden+        white-space: nowrap+        text-overflow: ellipsis+        color: #{gray8}+    .selected > a, a.selected+        color: #{indigo8} !important+    ul.toc+        margin: 0+        padding: 0+        border-top: 1px solid #{gray2}+        li+            display: block+article, footer+    margin-left: #{navWidth}+    padding: 1em+    > h1, > h2, > h3, > h4, > h5, > h6, > dl+        &:first-child+            margin-top: 0+footer+    border-top: 1px solid #{gray2} |] undefined)   where     fontUrl :: T.Text@@ -341,16 +462,22 @@         , "?family=Source+Code+Pro:300,400|Source+Sans+Pro"         ]     -- from Open Color https://yeun.github.io/open-color/-    gray1 :: T.Text-    gray1 = "#f1f3f5"-    gray3 :: T.Text-    gray3 = "#dee2e6"-    gray8 :: T.Text-    gray8 = "#343a40"-    graph8 :: T.Text-    graph8 = "#9c36b5"-    indigo8 :: T.Text-    indigo8 = "#3b5bdb"+    gray0 :: Color+    gray0 = Color 0xf8 0xf9 0xfa+    gray1 :: Color+    gray1 = Color 0xf1 0xf3 0xf5+    gray2 :: Color+    gray2 = Color 0xe9 0xec 0xef+    gray3 :: Color+    gray3 = Color 0xde 0xe2 0xe6+    gray8 :: Color+    gray8 = Color 0x34 0x3a 0x40+    graph8 :: Color+    graph8 = Color 0x9c 0x36 0xb5+    indigo8 :: Color+    indigo8 = Color 0x3b 0x5b 0xdb+    navWidth :: PixelSize+    navWidth = PixelSize 300  compilePackage' :: Package Docs -> Map FilePath (Either Error BS.ByteString) compilePackage' pkg =@@ -372,7 +499,9 @@     type CompileResult Docs = BS.ByteString     type CompileError Docs = Error     targetName _ = "docs"-    parseTarget _ = return Docs+    parseTarget table = do+        title <- stringField "title" table+        return Docs { docsTitle = title }     compilePackage = compilePackage'     showCompileError _ = id     toByteString _ = id
src/Nirum/Targets/Python.hs view
@@ -1,1655 +1,1799 @@-{-# LANGUAGE DeriveDataTypeable, ExtendedDefaultRules, OverloadedLists,-             QuasiQuotes, TypeFamilies, TypeSynonymInstances,-             MultiParamTypeClasses #-}-module Nirum.Targets.Python ( Code-                            , CodeGen-                            , CodeGenContext ( localImports-                                             , standardImports-                                             , thirdPartyImports-                                             )-                            , CompileError-                            , InstallRequires ( InstallRequires-                                              , dependencies-                                              , optionalDependencies-                                              )-                            , Source ( Source-                                     , sourceModule-                                     , sourcePackage-                                     )-                            , Python (Python)-                            , PythonVersion ( Python2-                                            , Python3-                                            )-                            , RenameMap-                            , addDependency-                            , addOptionalDependency-                            , compileModule-                            , compilePrimitiveType-                            , compileTypeDeclaration-                            , compileTypeExpression-                            , empty-                            , insertLocalImport-                            , insertStandardImport-                            , insertThirdPartyImports-                            , insertThirdPartyImportsA-                            , localImportsMap-                            , minimumRuntime-                            , parseModulePath-                            , renameModulePath-                            , runCodeGen-                            , stringLiteral-                            , toAttributeName-                            , toClassName-                            , toImportPath-                            , toImportPaths-                            , toNamePair-                            , unionInstallRequires-                            ) where--import Control.Monad (forM)-import qualified Control.Monad.State as ST-import qualified Data.List as L-import Data.Maybe (catMaybes, fromMaybe)-import Data.Typeable (Typeable)-import GHC.Exts (IsList (toList))-import Text.Printf (printf)--import qualified Data.HashMap.Strict as HM-import qualified Data.Map.Strict as M-import qualified Data.SemVer as SV-import qualified Data.Set as S-import qualified Data.Text as T-import Data.Text.Lazy (toStrict)-import Data.Text.Encoding (decodeUtf8, encodeUtf8)-import Data.Function (on)-import System.FilePath (joinPath)-import Text.Blaze.Renderer.Text-import qualified Text.Email.Validate as E-import Text.Heterocephalus (compileText)-import Text.InterpolatedString.Perl6 (q, qq)--import qualified Nirum.CodeGen as C-import Nirum.CodeGen (Failure)-import qualified Nirum.Constructs.Annotation as A-import qualified Nirum.Constructs.DeclarationSet as DS-import qualified Nirum.Constructs.Identifier as I-import Nirum.Constructs.Declaration (Documented (docsBlock))-import Nirum.Constructs.ModulePath ( ModulePath-                                   , fromIdentifiers-                                   , hierarchy-                                   , hierarchies-                                   , replacePrefix-                                   )-import Nirum.Constructs.Name (Name (Name))-import qualified Nirum.Constructs.Name as N-import Nirum.Constructs.Service ( Method ( Method-                                         , errorType-                                         , methodAnnotations-                                         , methodName-                                         , parameters-                                         , returnType-                                         )-                                , Parameter (Parameter)-                                , Service (Service)-                                )-import Nirum.Constructs.TypeDeclaration ( EnumMember (EnumMember)-                                        , Field (Field, fieldName)-                                        , PrimitiveTypeIdentifier (..)-                                        , Tag (Tag)-                                        , Type ( Alias-                                               , EnumType-                                               , PrimitiveType-                                               , RecordType-                                               , UnboxedType-                                               , UnionType-                                               , primitiveTypeIdentifier-                                               )-                                        , TypeDeclaration (..)-                                        )-import Nirum.Constructs.TypeExpression ( TypeExpression ( ListModifier-                                                        , MapModifier-                                                        , OptionModifier-                                                        , SetModifier-                                                        , TypeIdentifier-                                                        )-                                       )-import Nirum.Docs.ReStructuredText (ReStructuredText, render)-import Nirum.Package hiding (target)-import Nirum.Package.Metadata ( Author (Author, name, email)-                              , Metadata ( Metadata-                                         , authors-                                         , target-                                         , version-                                         , description-                                         , license-                                         )-                              , MetadataError ( FieldError-                                              , FieldTypeError-                                              , FieldValueError-                                              )-                              , Node (VString)-                              , Target ( CompileError-                                       , CompileResult-                                       , compilePackage-                                       , parseTarget-                                       , showCompileError-                                       , targetName-                                       , toByteString-                                       )-                              , fieldType-                              , stringField-                              , tableField-                              , versionField-                              )-import qualified Nirum.Package.ModuleSet as MS-import qualified Nirum.Package.Metadata as MD-import Nirum.TypeInstance.BoundModule--minimumRuntime :: SV.Version-minimumRuntime = SV.version 0 6 0 [] []--data Python = Python { packageName :: T.Text-                     , minimumRuntimeVersion :: SV.Version-                     , renames :: RenameMap-                     } deriving (Eq, Ord, Show, Typeable)--type RenameMap = M.Map ModulePath ModulePath-type Package' = Package Python-type CompileError' = T.Text--data PythonVersion = Python2-                   | Python3-                   deriving (Eq, Ord, Show)--data Source = Source { sourcePackage :: Package'-                     , sourceModule :: BoundModule Python-                     } deriving (Eq, Ord, Show)--type Code = T.Text--instance Failure CodeGenContext CompileError' where-    fromString = return . T.pack--data CodeGenContext-    = CodeGenContext { standardImports :: S.Set T.Text-                     , thirdPartyImports :: M.Map T.Text (M.Map T.Text T.Text)-                     , localImports :: M.Map T.Text (S.Set T.Text)-                     , pythonVersion :: PythonVersion-                     }-    deriving (Eq, Ord, Show)--localImportsMap :: CodeGenContext -> M.Map T.Text (M.Map T.Text T.Text)-localImportsMap CodeGenContext { localImports = imports } =-    M.map (M.fromSet id) imports--sourceDirectory :: PythonVersion -> T.Text-sourceDirectory Python2 = "src-py2"-sourceDirectory Python3 = "src"--empty :: PythonVersion -> CodeGenContext-empty pythonVersion' = CodeGenContext { standardImports = []-                                      , thirdPartyImports = []-                                      , localImports = []-                                      , pythonVersion = pythonVersion'-                                      }--type CodeGen = C.CodeGen CodeGenContext CompileError'--runCodeGen :: CodeGen a-           -> CodeGenContext-           -> (Either CompileError' a, CodeGenContext)-runCodeGen = C.runCodeGen--insertStandardImport :: T.Text -> CodeGen ()-insertStandardImport module' = ST.modify insert'-  where-    insert' c@CodeGenContext { standardImports = si } =-        c { standardImports = S.insert module' si }--insertThirdPartyImports :: [(T.Text, S.Set T.Text)] -> CodeGen ()-insertThirdPartyImports imports =-    insertThirdPartyImportsA [ (from, M.fromSet id objects)-                             | (from, objects) <- imports-                             ]--insertThirdPartyImportsA :: [(T.Text, M.Map T.Text T.Text)] -> CodeGen ()-insertThirdPartyImportsA imports =-    ST.modify insert'-  where-    insert' c@CodeGenContext { thirdPartyImports = ti } =-        c { thirdPartyImports = L.foldl (M.unionWith M.union) ti importList }-    importList :: [M.Map T.Text (M.Map T.Text T.Text)]-    importList = [ M.singleton from objects-                 | (from, objects) <- imports-                 ]--insertLocalImport :: T.Text -> T.Text -> CodeGen ()-insertLocalImport module' object = ST.modify insert'-  where-    insert' c@CodeGenContext { localImports = li } =-        c { localImports = M.insertWith S.union module' [object] li }--importTypingForPython3 :: CodeGen ()-importTypingForPython3 = do-    pyVer <- getPythonVersion-    case pyVer of-        Python2 -> return ()-        Python3 -> insertStandardImport "typing"--getPythonVersion :: CodeGen PythonVersion-getPythonVersion = fmap pythonVersion ST.get--renameModulePath :: RenameMap -> ModulePath -> ModulePath-renameModulePath renameMap path' =-    rename (M.toDescList renameMap)-    -- longest paths should be processed first-  where-    rename :: [(ModulePath, ModulePath)] -> ModulePath-    rename ((from, to) : xs) = let r = replacePrefix from to path'-                               in if r == path'-                                  then rename xs-                                  else r-    rename [] = path'--renameMP :: Python -> ModulePath -> ModulePath-renameMP Python { renames = table } = renameModulePath table--thd3 :: (a, b, c) -> c-thd3 (_, _, v) = v--mangleVar :: Code -> T.Text -> Code-mangleVar expr arbitrarySideName = T.concat-    [ "__nirum_"-    , (`T.map` expr) $ \ c -> if 'A' <= c && c <= 'Z' ||-                                 'a' <= c && c <= 'z' || c == '_'-                              then c else '_'-    , "__"-    , arbitrarySideName-    , "__"-    ]---- | The set of Python reserved keywords.--- See also: https://docs.python.org/3/reference/lexical_analysis.html#keywords-keywords :: S.Set T.Text-keywords = [ "False", "None", "True"-           , "and", "as", "assert", "break", "class", "continue"-           , "def", "del" , "elif", "else", "except", "finally"-           , "for", "from", "global", "if", "import", "in", "is"-           , "lambda", "nonlocal", "not", "or", "pass", "raise"-           , "return", "try", "while", "with", "yield"-           ]--toClassName :: I.Identifier -> T.Text-toClassName identifier =-    if className `S.member` keywords then className `T.snoc` '_' else className-  where-    className :: T.Text-    className = I.toPascalCaseText identifier--toClassName' :: Name -> T.Text-toClassName' = toClassName . N.facialName--toAttributeName :: I.Identifier -> T.Text-toAttributeName identifier =-    if attrName `S.member` keywords then attrName `T.snoc` '_' else attrName-  where-    attrName :: T.Text-    attrName = I.toSnakeCaseText identifier--toAttributeName' :: Name -> T.Text-toAttributeName' = toAttributeName . N.facialName--toEnumMemberName :: Name -> T.Text-toEnumMemberName name'-  | attributeName `elem` memberKeywords = attributeName `T.snoc` '_'-  | otherwise = attributeName-  where-    memberKeywords :: [T.Text]-    memberKeywords = ["mro"]-    attributeName :: T.Text-    attributeName = toAttributeName' name'--toImportPath' :: ModulePath -> T.Text-toImportPath' = T.intercalate "." . map toAttributeName . toList--toImportPath :: Python -> ModulePath -> T.Text-toImportPath target' = toImportPath' . renameMP target'--toImportPaths :: Python -> S.Set ModulePath -> [T.Text]-toImportPaths target' paths =-    S.toAscList $ S.map toImportPath' $ hierarchies renamedPaths-  where-    renamedPaths :: S.Set ModulePath-    renamedPaths = S.map (renameMP target') paths--toNamePair :: Name -> T.Text-toNamePair (Name f b) = [qq|('{toAttributeName f}', '{I.toSnakeCaseText b}')|]--stringLiteral :: T.Text -> T.Text-stringLiteral string =-    open $ T.concatMap esc string `T.snoc` '"'-  where-    open :: T.Text -> T.Text-    open = if T.any (> '\xff') string then T.append [qq|u"|] else T.cons '"'-    esc :: Char -> T.Text-    esc '"' = "\\\""-    esc '\\' = "\\\\"-    esc '\t' = "\\t"-    esc '\n' = "\\n"-    esc '\r' = "\\r"-    esc c-        | c >= '\x10000' = T.pack $ printf "\\U%08x" c-        | c >= '\xff' = T.pack $ printf "\\u%04x" c-        | c < ' ' || c >= '\x7f' = T.pack $ printf "\\x%02x" c-        | otherwise = T.singleton c--toIndentedCodes :: (a -> T.Text) -> [a] -> T.Text -> T.Text-toIndentedCodes f traversable concatenator =-    T.intercalate concatenator $ map f traversable--compileParameters :: (ParameterName -> ParameterType -> Code)-                  -> [(T.Text, Code, Bool)]-                  -> Code-compileParameters gen nameTypeTriples =-    toIndentedCodes-        (\ (n, t, o) -> gen n t `T.append` if o then "=None" else "")-        nameTypeTriples ", "--compileFieldInitializers :: DS.DeclarationSet Field -> Int -> CodeGen Code-compileFieldInitializers fields depth = do-    initializers <- forM (toList fields) compileFieldInitializer-    return $ T.intercalate indentSpaces initializers-  where-    indentSpaces :: T.Text-    indentSpaces = "\n" `T.append` T.replicate depth "    "-    compileFieldInitializer :: Field -> CodeGen Code-    compileFieldInitializer (Field fieldName' fieldType' _) =-        case fieldType' of-            SetModifier _ ->-                return [qq|self.$attributeName = frozenset($attributeName)|]-            ListModifier _ -> do-                insertThirdPartyImportsA [ ( "nirum.datastructures"-                                           , [("list_type", "List")]-                                           )-                                         ]-                return [qq|self.$attributeName = list_type($attributeName)|]-            _ -> return [qq|self.$attributeName = $attributeName|]-      where-        attributeName :: Code-        attributeName = toAttributeName' fieldName'--compileDocs :: Documented a => a -> Maybe ReStructuredText-compileDocs = fmap render . docsBlock--quoteDocstring :: ReStructuredText -> Code-quoteDocstring rst = T.concat ["r'''", rst, "\n'''\n"]--compileDocstring' :: Documented a => Code -> a -> [ReStructuredText] -> Code-compileDocstring' indentSpace d extra =-    case (compileDocs d, extra) of-        (Nothing, []) -> "\n"-        (result, extra') -> indent indentSpace $ quoteDocstring $-            T.append (fromMaybe "" result) $-                     T.concat ['\n' `T.cons` e `T.snoc` '\n' | e <- extra']--compileDocstring :: Documented a => Code -> a -> Code-compileDocstring indentSpace d = compileDocstring' indentSpace d []--compileDocstringWithFields :: Documented a-                           => Code -> a -> DS.DeclarationSet Field -> Code-compileDocstringWithFields indentSpace decl fields =-    compileDocstring' indentSpace decl extra-  where-    extra :: [ReStructuredText]-    extra =-        [ case compileDocs f of-              Nothing -> T.concat [ ".. attribute:: "-                                  , toAttributeName' n-                                  , "\n"-                                  ]-              Just docs' -> T.concat [ ".. attribute:: "-                                     , toAttributeName' n-                                     , "\n\n"-                                     , indent "   " docs'-                                     ]-        | f@(Field n _ _) <- toList fields-        ]--compileDocsComment :: Documented a => Code -> a -> Code-compileDocsComment indentSpace d =-    case compileDocs d of-        Nothing -> "\n"-        Just rst -> indent (indentSpace `T.append` "#: ") rst--indent :: Code -> Code -> Code-indent space =-    T.intercalate "\n" . map indentLn . T.lines-  where-    indentLn :: Code -> Code-    indentLn line-      | T.null line = T.empty-      | otherwise = space `T.append` line--typeReprCompiler :: CodeGen (Code -> Code)-typeReprCompiler = do-    ver <- getPythonVersion-    case ver of-        Python2 -> return $ \ t -> [qq|($t.__module__ + '.' + $t.__name__)|]-        Python3 -> do-            insertStandardImport "typing"-            return $ \ t -> [qq|typing._type_repr($t)|]--type ParameterName = Code-type ParameterType = Code-type ReturnType = Code--parameterCompiler :: CodeGen (ParameterName -> ParameterType -> Code)-parameterCompiler = do-    ver <- getPythonVersion-    return $ \ n t -> case ver of-                          Python2 -> n-                          Python3 -> [qq|$n: '{t}'|]--returnCompiler :: CodeGen (ReturnType -> Code)-returnCompiler = do-    ver <- getPythonVersion-    return $ \ r ->-        case (ver, r) of-            (Python2, _) -> ""-            (Python3, "None") -> [qq| -> None|]-            (Python3, _) -> [qq| -> '{r}'|]---compileUnionTag :: Source -> Name -> Tag -> CodeGen Code-compileUnionTag source parentname d@(Tag typename' fields _) = do-    typeExprCodes <- mapM (compileTypeExpression source)-        [Just typeExpr | (Field _ typeExpr _) <- toList fields]-    let nameTypeTriples = L.sortBy (compare `on` thd3)-                                   (zip3 tagNames typeExprCodes optionFlags)-        slotTypes = toIndentedCodes-            (\ (n, t, _) -> [qq|('{n}', {t})|]) nameTypeTriples ",\n        "-    insertThirdPartyImportsA-        [ ("nirum.validate", [("validate_union_type", "validate_union_type")])-        , ("nirum.constructs", [("name_dict_type", "NameDict")])-        ]-    arg <- parameterCompiler-    ret <- returnCompiler-    pyVer <- getPythonVersion-    initializers <- compileFieldInitializers fields $ case pyVer of-        Python3 -> 2-        Python2 -> 3-    let initParams = compileParameters arg nameTypeTriples-        inits = case pyVer of-            Python2 -> [qq|-    def __init__(self, **kwargs):-        def __init__($initParams):-            $initializers-            pass-        __init__(**kwargs)-        validate_union_type(self)-            |]-            Python3 -> [qq|-    def __init__(self{ if null nameTypeTriples-                         then T.empty-                         else ", *, " `T.append` initParams }) -> None:-        $initializers-        validate_union_type(self)-            |]-    return [qq|-class $className($parentClass):-{compileDocstringWithFields "    " d fields}-    __slots__ = (-        $slots-    )-    __nirum_type__ = 'union'-    __nirum_tag__ = $parentClass.Tag.{toEnumMemberName typename'}-    __nirum_tag_names__ = name_dict_type([-        $nameMaps-    ])--    @staticmethod-    def __nirum_tag_types__():-        return [$slotTypes]--    { inits :: T.Text }--    def __nirum_serialize__(self):-        return \{-            '_type': '{behindParentTypename}',-            '_tag': '{behindTagName}',-            $fieldSerializers-        \}--    def __repr__(self){ ret "str" }:-        return (-            $parentClass.__module__ + '.$parentClass.$className(' +-            ', '.join('\{0\}=\{1!r\}'.format(attr, getattr(self, attr))-                      for attr in self.__slots__) +-            ')'-        )--    def __eq__(self, other){ ret "bool" }:-        return isinstance(other, $className) and all(-            getattr(self, attr) == getattr(other, attr)-            for attr in self.__slots__-        )--    def __ne__(self, other){ ret "bool" }:-        return not self == other--    def __hash__(self){ ret "int" }:-        return hash($hashTuple)---$parentClass.$className = $className-if hasattr($parentClass, '__qualname__'):-    $className.__qualname__ = $parentClass.__qualname__ + '.{className}'-|]-  where-    optionFlags :: [Bool]-    optionFlags = [ case typeExpr of-                        OptionModifier _ -> True-                        _ -> False-                  | (Field _ typeExpr _) <- toList fields-                  ]-    className :: T.Text-    className = toClassName' typename'-    behindParentTypename :: T.Text-    behindParentTypename = I.toSnakeCaseText $ N.behindName parentname-    tagNames :: [T.Text]-    tagNames = map (toAttributeName' . fieldName) (toList fields)-    behindTagName :: T.Text-    behindTagName = I.toSnakeCaseText $ N.behindName typename'-    slots :: Code-    slots = if length tagNames == 1-            then [qq|'{head tagNames}'|] `T.snoc` ','-            else toIndentedCodes (\ n -> [qq|'{n}'|]) tagNames ",\n        "-    hashTuple :: Code-    hashTuple = if null tagNames-        then "self.__nirum_tag__"-        else [qq|({toIndentedCodes (T.append "self.") tagNames ", "},)|]-    fieldList :: [Field]-    fieldList = toList fields-    nameMaps :: Code-    nameMaps = toIndentedCodes toNamePair-                               (map fieldName fieldList)-                               ",\n        "-    parentClass :: T.Text-    parentClass = toClassName' parentname-    fieldSerializers :: Code-    fieldSerializers = T.intercalate ",\n"-        [ T.concat [ "'", I.toSnakeCaseText (N.behindName fn), "': "-                   , compileSerializer source ft-                                       [qq|self.{toAttributeName' fn}|]-                   ]-        | Field fn ft _ <- fieldList-        ]-compilePrimitiveType :: PrimitiveTypeIdentifier -> CodeGen Code-compilePrimitiveType primitiveTypeIdentifier' = do-    pyVer <- getPythonVersion-    case (primitiveTypeIdentifier', pyVer) of-        (Bool, _) -> return "bool"-        (Bigint, _) -> return "int"-        (Decimal, _) -> do-            insertStandardImport "decimal"-            return "decimal.Decimal"-        (Int32, _) -> return "int"-        (Int64, Python2) -> do-            insertStandardImport "numbers"-            return "numbers.Integral"-        (Int64, Python3) -> return "int"-        (Float32, _) -> return "float"-        (Float64, _) -> return "float"-        (Text, Python2) -> return "unicode"-        (Text, Python3) -> return "str"-        (Binary, _) -> return "bytes"-        (Date, _) -> do-            insertStandardImport "datetime"-            return "datetime.date"-        (Datetime, _) -> do-            insertStandardImport "datetime"-            return "datetime.datetime"-        (Uuid, _) -> insertStandardImport "uuid" >> return "uuid.UUID"-        (Uri, Python2) -> return "unicode"-        (Uri, Python3) -> return "str"--compileTypeExpression :: Source -> Maybe TypeExpression -> CodeGen Code-compileTypeExpression Source { sourcePackage = Package { metadata = meta }-                             , sourceModule = boundModule-                             }-                      (Just (TypeIdentifier i)) =-    case lookupType i boundModule of-        Missing -> fail $ "undefined identifier: " ++ I.toString i-        Imported _ (PrimitiveType p _) -> compilePrimitiveType p-        Imported m _ -> do-            insertThirdPartyImports [(toImportPath target' m, [toClassName i])]-            return $ toClassName i-        Local _ -> return $ toClassName i-  where-    target' :: Python-    target' = target meta-compileTypeExpression source (Just (MapModifier k v)) = do-    kExpr <- compileTypeExpression source (Just k)-    vExpr <- compileTypeExpression source (Just v)-    insertStandardImport "typing"-    return [qq|typing.Mapping[$kExpr, $vExpr]|]-compileTypeExpression source (Just modifier) = do-    expr <- compileTypeExpression source (Just typeExpr)-    insertStandardImport "typing"-    return [qq|typing.$className[$expr]|]-  where-    typeExpr :: TypeExpression-    className :: T.Text-    (typeExpr, className) = case modifier of-        OptionModifier t' -> (t', "Optional")-        SetModifier t' -> (t', "AbstractSet")-        ListModifier t' -> (t', "Sequence")-        TypeIdentifier _ -> undefined  -- never happen!-        MapModifier _ _ -> undefined  -- never happen!-compileTypeExpression _ Nothing =-    return "None"--compileSerializer :: Source -> TypeExpression -> Code -> Code-compileSerializer Source { sourceModule = boundModule } =-    compileSerializer' boundModule--compileSerializer' :: BoundModule Python -> TypeExpression -> Code -> Code-compileSerializer' mod' (OptionModifier typeExpr) pythonVar =-    [qq|(None if ($pythonVar) is None-              else ({compileSerializer' mod' typeExpr pythonVar}))|]-compileSerializer' mod' (SetModifier typeExpr) pythonVar =-    compileSerializer' mod' (ListModifier typeExpr) pythonVar-compileSerializer' mod' (ListModifier typeExpr) pythonVar =-    [qq|list(($serializer) for $elemVar in ($pythonVar))|]-  where-    elemVar :: Code-    elemVar = mangleVar pythonVar "elem"-    serializer :: Code-    serializer = compileSerializer' mod' typeExpr elemVar-compileSerializer' mod' (MapModifier kt vt) pythonVar =-    [qq|list(-        \{-            'key': ({compileSerializer' mod' kt kVar}),-            'value': ({compileSerializer' mod' vt vVar}),-        \}-        for $kVar, $vVar in ($pythonVar).items()-    )|]-  where-    kVar :: Code-    kVar = mangleVar pythonVar "key"-    vVar :: Code-    vVar = mangleVar pythonVar "value"-compileSerializer' mod' (TypeIdentifier typeId) pythonVar =-    case lookupType typeId mod' of-        Missing -> "None"  -- must never happen-        Local (Alias t) -> compileSerializer' mod' t pythonVar-        Imported modulePath' (Alias t) ->-            case resolveBoundModule modulePath' (boundPackage mod') of-                Nothing -> "None"  -- must never happen-                Just foundMod -> compileSerializer' foundMod t pythonVar-        Local PrimitiveType { primitiveTypeIdentifier = p } ->-            compilePrimitiveTypeSerializer p pythonVar-        Imported _ PrimitiveType { primitiveTypeIdentifier = p } ->-            compilePrimitiveTypeSerializer p pythonVar-        Local EnumType {} -> serializerCall-        Imported _ EnumType {} -> serializerCall-        Local RecordType {} -> serializerCall-        Imported _ RecordType {} -> serializerCall-        Local UnboxedType {} -> serializerCall-        Imported _ UnboxedType {} -> serializerCall-        Local UnionType {} -> serializerCall-        Imported _ UnionType {} -> serializerCall-  where-    serializerCall :: Code-    serializerCall = [qq|$pythonVar.__nirum_serialize__()|]--compilePrimitiveTypeSerializer :: PrimitiveTypeIdentifier -> Code -> Code-compilePrimitiveTypeSerializer Bigint var = var-compilePrimitiveTypeSerializer Decimal var = [qq|str($var)|]-compilePrimitiveTypeSerializer Int32 var = var-compilePrimitiveTypeSerializer Int64 var = var-compilePrimitiveTypeSerializer Float32 var = var-compilePrimitiveTypeSerializer Float64 var = var-compilePrimitiveTypeSerializer Text var = var-compilePrimitiveTypeSerializer Binary var =-    [qq|__import__('base64').b64encode($var).decode('ascii')|]-compilePrimitiveTypeSerializer Date var = [qq|($var).isoformat()|]-compilePrimitiveTypeSerializer Datetime var = [qq|($var).isoformat()|]-compilePrimitiveTypeSerializer Bool var = var-compilePrimitiveTypeSerializer Uuid var = [qq|str($var)|]-compilePrimitiveTypeSerializer Uri var = var--compileTypeDeclaration :: Source -> TypeDeclaration -> CodeGen Code-compileTypeDeclaration _ TypeDeclaration { type' = PrimitiveType {} } =-    return ""  -- never used-compileTypeDeclaration src d@TypeDeclaration { typename = typename'-                                             , type' = Alias ctype-                                             } = do-    ctypeExpr <- compileTypeExpression src (Just ctype)-    return $ toStrict $ renderMarkup [compileText|-%{ case compileDocs d }-%{ of Just rst }-#: #{rst}-%{ of Nothing }-%{ endcase }-#{toClassName' typename'} = #{ctypeExpr}-    |]-compileTypeDeclaration src d@TypeDeclaration { typename = typename'-                                             , type' = UnboxedType itype-                                             } = do-    let className = toClassName' typename'-    itypeExpr <- compileTypeExpression src (Just itype)-    insertStandardImport "typing"-    insertThirdPartyImports-        [ ("nirum.validate", ["validate_unboxed_type"])-        , ("nirum.deserialize", ["deserialize_meta"])-        ]-    pyVer <- getPythonVersion-    return $ toStrict $ renderMarkup $ [compileText|-class #{className}(object):-#{compileDocstring "    " d}--    __nirum_type__ = 'unboxed'--    @staticmethod-    def __nirum_get_inner_type__():-        return #{itypeExpr}--%{ case pyVer }-%{ of Python2 }-    def __init__(self, value):-%{ of Python3 }-    def __init__(self, value: '#{itypeExpr}') -> None:-%{ endcase }-        validate_unboxed_type(value, #{itypeExpr})-        self.value = value  # type: #{itypeExpr}--%{ case pyVer }-%{ of Python2 }-    def __ne__(self, other):-        return not self == other--    def __eq__(self, other):-%{ of Python3 }-    def __eq__(self, other) -> bool:-%{ endcase }-        return (isinstance(other, #{className}) and-                self.value == other.value)--%{ case pyVer }-%{ of Python2 }-    def __hash__(self):-%{ of Python3 }-    def __hash__(self) -> int:-%{ endcase }-        return hash(self.value)--    def __nirum_serialize__(self):-        return (#{compileSerializer src itype "self.value"})--    @classmethod-%{ case pyVer }-%{ of Python2 }-    def __nirum_deserialize__(cls, value):-%{ of Python3 }-    def __nirum_deserialize__(cls: type, value: typing.Any) -> '#{className}':-%{ endcase }-        inner_type = cls.__nirum_get_inner_type__()-        deserializer = getattr(inner_type, '__nirum_deserialize__', None)-        if deserializer:-            value = deserializer(value)-        else:-            value = deserialize_meta(inner_type, value)-        return cls(value=value)--%{ case pyVer }-%{ of Python2 }-    def __repr__(self):-        return '{0.__module__}.{0.__name__}({1!r})'.format(-            type(self), self.value-        )-%{ of Python3 }-    def __repr__(self) -> str:-        return '{0}({1!r})'.format(typing._type_repr(type(self)), self.value)-%{ endcase }--%{ case pyVer }-%{ of Python2 }-    def __hash__(self):-%{ of Python3 }-    def __hash__(self) -> int:-%{ endcase }-        return hash(self.value)-|]-compileTypeDeclaration _ d@TypeDeclaration { typename = typename'-                                           , type' = EnumType members-                                           } = do-    let className = toClassName' typename'-    insertStandardImport "enum"-    pyVer <- getPythonVersion-    return $ toStrict $ renderMarkup [compileText|-class #{className}(enum.Enum):-#{compileDocstring "    " d}--%{ forall member@(EnumMember memberName@(Name _ behind) _) <- toList members }-#{compileDocsComment "    " member}-    #{toEnumMemberName memberName} = '#{I.toSnakeCaseText behind}'-%{ endforall }--%{ case pyVer }-%{ of Python2 }-    def __nirum_serialize__(self):-%{ of Python3 }-    def __nirum_serialize__(self) -> str:-%{ endcase }-        return self.value--    @classmethod-%{ case pyVer }-%{ of Python2 }-    def __nirum_deserialize__(cls, value):-%{ of Python3 }-    def __nirum_deserialize__(cls: type, value: str) -> '#{className}':-%{ endcase }-        return cls(value.replace('-', '_'))  # FIXME: validate input---# Since enum.Enum doesn't allow to define non-member when the class is defined,-# __nirum_type__ should be defined after the class is defined.-#{className}.__nirum_type__ = 'enum'-|]-compileTypeDeclaration src d@TypeDeclaration { typename = typename'-                                             , type' = RecordType fields-                                             } = do-    typeExprCodes <- mapM (compileTypeExpression src)-        [Just typeExpr | (Field _ typeExpr _) <- fieldList]-    let nameTypeTriples = L.sortBy (compare `on` thd3)-                                   (zip3 fieldNames typeExprCodes optionFlags)-        slotTypes = toIndentedCodes-            (\ (n, t, _) -> [qq|'{n}': {t}|]) nameTypeTriples ",\n        "-    importTypingForPython3-    insertThirdPartyImports [ ("nirum.validate", ["validate_record_type"])-                            , ("nirum.deserialize", ["deserialize_meta"])-                            ]-    insertThirdPartyImportsA [ ( "nirum.constructs"-                               , [("name_dict_type", "NameDict")]-                               )-                             ]-    arg <- parameterCompiler-    ret <- returnCompiler-    typeRepr <- typeReprCompiler-    pyVer <- getPythonVersion-    initializers <- compileFieldInitializers fields $ case pyVer of-        Python3 -> 2-        Python2 -> 3-    let initParams = compileParameters arg nameTypeTriples-        inits = case pyVer of-            Python2 -> [qq|-    def __init__(self, **kwargs):-        def __init__($initParams):-            $initializers-            pass-        __init__(**kwargs)-        validate_record_type(self)-            |]-            Python3 -> [qq|-    def __init__(self{ if null nameTypeTriples-                         then T.empty-                         else ", *, " `T.append` initParams }) -> None:-        $initializers-        validate_record_type(self)-            |]-    let clsType = arg "cls" "type"-    return [qq|-class $className(object):-{compileDocstringWithFields "    " d fields}-    __slots__ = (-        $slots,-    )-    __nirum_type__ = 'record'-    __nirum_record_behind_name__ = '{behindTypename}'-    __nirum_field_names__ = name_dict_type([$nameMaps])--    @staticmethod-    def __nirum_field_types__():-        return \{$slotTypes\}--    {inits :: T.Text}--    def __repr__(self){ret "bool"}:-        return '\{0\}(\{1\})'.format(-            {typeRepr "type(self)"},-            ', '.join('\{\}=\{\}'.format(attr, getattr(self, attr))-                      for attr in self.__slots__)-        )--    def __eq__(self, other){ret "bool"}:-        return isinstance(other, $className) and all(-            getattr(self, attr) == getattr(other, attr)-            for attr in self.__slots__-        )--    def __ne__(self, other){ ret "bool" }:-        return not self == other--    def __nirum_serialize__(self):-        return \{-            '_type': '{behindTypename}',-            $fieldSerializers-        \}--    @classmethod-    def __nirum_deserialize__($clsType, value){ ret className }:-        if '_type' not in value:-            raise ValueError('"_type" field is missing.')-        if not cls.__nirum_record_behind_name__ == value['_type']:-            raise ValueError(-                '%s expect "_type" equal to "%s"'-                ', but found %s.' % (-                    typing._type_repr(cls),-                    cls.__nirum_record_behind_name__,-                    value['_type']-                )-            )-        args = dict()-        behind_names = cls.__nirum_field_names__.behind_names-        field_types = cls.__nirum_field_types__-        if callable(field_types):-            field_types = field_types()-            # old compiler could generate non-callable dictionary-        errors = set()-        for attribute_name, item in value.items():-            if attribute_name == '_type':-                continue-            if attribute_name in behind_names:-                name = behind_names[attribute_name]-            else:-                name = attribute_name-            try:-                field_type = field_types[name]-            except KeyError:-                continue-            try:-                args[name] = deserialize_meta(field_type, item)-            except ValueError as e:-                errors.add('%s: %s' % (attribute_name, str(e)))-        if errors:-            raise ValueError('\\n'.join(sorted(errors)))-        return cls(**args)--    def __hash__(self){ret "int"}:-        return hash(($hashText,))-|]-  where-    className :: T.Text-    className = toClassName' typename'-    fieldList :: [Field]-    fieldList = toList fields-    behindTypename :: T.Text-    behindTypename = I.toSnakeCaseText $ N.behindName typename'-    optionFlags :: [Bool]-    optionFlags = [ case typeExpr of-                        OptionModifier _ -> True-                        _ -> False-                  | (Field _ typeExpr _) <- fieldList-                  ]-    fieldNames :: [T.Text]-    fieldNames = [toAttributeName' name' | Field name' _ _ <- fieldList]-    slots :: Code-    slots = toIndentedCodes (\ n -> [qq|'{n}'|]) fieldNames ",\n        "-    nameMaps :: Code-    nameMaps = toIndentedCodes-        toNamePair-        (map fieldName $ toList fields)-        ",\n        "-    hashText :: Code-    hashText = toIndentedCodes (\ n -> [qq|self.{n}|]) fieldNames ", "-    fieldSerializers :: Code-    fieldSerializers = T.intercalate ",\n"-        [ T.concat [ "'", I.toSnakeCaseText (N.behindName fn), "': "-                   , compileSerializer src ft [qq|self.{ toAttributeName' fn}|]-                   ]-        | Field fn ft _ <- fieldList-        ]-compileTypeDeclaration src-                       d@TypeDeclaration { typename = typename'-                                         , type' = UnionType tags-                                         , typeAnnotations = annotations-                                         } = do-    tagCodes <- mapM (compileUnionTag src typename') $ toList tags-    let className = toClassName' typename'-        tagCodes' = T.intercalate "\n\n" tagCodes-        tagClasses = T.intercalate ", " [ toClassName' tagName-                                        | Tag tagName _ _ <- toList tags-                                        ]-        enumMembers = toIndentedCodes-            (\ (t, b) -> [qq|$t = '{b}'|]) enumMembers' "\n        "-    importTypingForPython3-    insertStandardImport "enum"-    insertThirdPartyImports [ ("nirum.deserialize", ["deserialize_meta"])-                            ]-    insertThirdPartyImportsA [ ( "nirum.constructs"-                               , [("name_dict_type", "NameDict")]-                               )-                             ]-    insertThirdPartyImportsA [ ( "nirum.datastructures"-                               , [("map_type", "Map")]-                               )-                             ]-    typeRepr <- typeReprCompiler-    ret <- returnCompiler-    arg <- parameterCompiler-    return [qq|-class $className({T.intercalate "," $ compileExtendClasses annotations}):-{compileDocstring "    " d}--    __nirum_type__ = 'union'-    __nirum_union_behind_name__ = '{I.toSnakeCaseText $ N.behindName typename'}'-    __nirum_field_names__ = name_dict_type([$nameMaps])--    class Tag(enum.Enum):-        $enumMembers--    def __init__(self, *args, **kwargs):-        raise NotImplementedError(-            "\{0\} cannot be instantiated "-            "since it is an abstract class.  Instantiate a concrete subtype "-            "of it instead.".format({typeRepr "type(self)"})-        )--    def __nirum_serialize__(self):-        raise NotImplementedError(-            "\{0\} cannot be instantiated "-            "since it is an abstract class.  Instantiate a concrete subtype "-            "of it instead.".format({typeRepr "type(self)"})-        )--    @classmethod-    def __nirum_deserialize__(-        {arg "cls" "type"}, value-    ){ ret className }:-        if '_type' not in value:-            raise ValueError('"_type" field is missing.')-        if '_tag' not in value:-            raise ValueError('"_tag" field is missing.')-        if not hasattr(cls, '__nirum_tag__'):-            for sub_cls in cls.__subclasses__():-                if sub_cls.__nirum_tag__.value == value['_tag']:-                    cls = sub_cls-                    break-            else:-                raise ValueError(-                    '%r is not deserialzable tag of `%s`' % (-                        value, typing._type_repr(cls)-                    )-                )-        if not cls.__nirum_union_behind_name__ == value['_type']:-            raise ValueError(-                '%s expect "_type" equal to "%s", but found %s' % (-                    typing._type_repr(cls),-                    cls.__nirum_union_behind_name__,-                    value['_type']-                )-            )-        if not cls.__nirum_tag__.value == value['_tag']:-            raise ValueError(-                '%s expect "_tag" equal to "%s", but found %s' % (-                    typing._type_repr(cls),-                    cls.__nirum_tag__.value,-                    cls-                )-            )-        args = dict()-        behind_names = cls.__nirum_tag_names__.behind_names-        errors = set()-        for attribute_name, item in value.items():-            if attribute_name in ('_type', '_tag'):-                continue-            if attribute_name in behind_names:-                name = behind_names[attribute_name]-            else:-                name = attribute_name-            tag_types = dict(cls.__nirum_tag_types__())-            try:-                field_type = tag_types[name]-            except KeyError:-                continue-            try:-                args[name] = deserialize_meta(field_type, item)-            except ValueError as e:-                errors.add('%s: %s' % (attribute_name, str(e)))-        if errors:-            raise ValueError('\\n'.join(sorted(errors)))-        return cls(**args)---$tagCodes'--$className.__nirum_tag_classes__ = map_type(-    (tcls.__nirum_tag__, tcls)-    for tcls in [$tagClasses]-)-            |]-  where-    enumMembers' :: [(T.Text, T.Text)]-    enumMembers' = [ ( toEnumMemberName tagName-                     , I.toSnakeCaseText $ N.behindName tagName-                     )-                   | (Tag tagName _ _) <- toList tags-                   ]-    nameMaps :: T.Text-    nameMaps = toIndentedCodes-        toNamePair-        [name' | Tag name' _ _ <- toList tags]-        ",\n        "-    compileExtendClasses :: A.AnnotationSet -> [Code]-    compileExtendClasses annotations' =-        if null extendClasses-            then ["object"]-            else extendClasses-      where-        extendsClassMap :: M.Map I.Identifier Code-        extendsClassMap = [("error", "Exception")]-        extendClasses :: [Code]-        extendClasses = catMaybes-            [ M.lookup annotationName extendsClassMap-            | (A.Annotation annotationName _) <- A.toList annotations'-            ]-compileTypeDeclaration-    src@Source { sourcePackage = Package { metadata = metadata' } }-    d@ServiceDeclaration { serviceName = name'-                         , service = Service methods-                         } = do-    let methods' = toList methods-    methodMetadata <- mapM compileMethodMetadata methods'-    let methodMetadata' = commaNl methodMetadata-    dummyMethods <- mapM compileMethod methods'-    clientMethods <- mapM compileClientMethod methods'-    methodErrorTypes <- mapM compileErrorType methods'-    let dummyMethods' = T.intercalate "\n\n" dummyMethods-        clientMethods' = T.intercalate "\n\n" clientMethods-        methodErrorTypes' =-            T.intercalate "," $ catMaybes methodErrorTypes-    param <- parameterCompiler-    ret <- returnCompiler-    insertStandardImport "json"-    insertThirdPartyImports [ ("nirum.deserialize", ["deserialize_meta"])-                            ]-    insertThirdPartyImportsA-        [ ("nirum.constructs", [("name_dict_type", "NameDict")])-        , ("nirum.datastructures", [(nirumMapName, "Map")])-        , ("nirum.service", [("service_type", "Service")])-        , ("nirum.transport", [("transport_type", "Transport")])-        ]-    return [qq|-class $className(service_type):-{compileDocstring "    " d}-    __nirum_type__ = 'service'-    __nirum_schema_version__ = \'{SV.toText $ version metadata'}\'-    __nirum_service_methods__ = \{-        {methodMetadata'}-    \}-    __nirum_method_names__ = name_dict_type([-        $methodNameMap-    ])-    __nirum_method_annotations__ = $methodAnnotations'--    @staticmethod-    def __nirum_method_error_types__(k, d=None):-        return dict([-            $methodErrorTypes'-        ]).get(k, d)--    {dummyMethods'}---# FIXME client MUST be generated & saved on diffrent module-#       where service isn't included.-class {className}_Client($className):-    """The client object of :class:`{className}`."""--    def __init__(self,-                 { param "transport" "transport_type" }){ ret "None" }:-        if not isinstance(transport, transport_type):-            raise TypeError(-                'expected an instance of \{0.__module__\}.\{0.__name__\}, not '-                '\{1!r\}'.format(transport_type, transport)-            )-        self.__nirum_transport__ = transport  # type: transport_type--    {clientMethods'}--{className}.Client = {className}_Client-{className}.Client.__name__ = 'Client'-if hasattr({className}.Client, '__qualname__'):-    {className}.Client.__qualname__ = '{className}.Client'-|]-  where-    nirumMapName :: T.Text-    nirumMapName = "map_type"-    className :: T.Text-    className = toClassName' name'-    commaNl :: [T.Text] -> T.Text-    commaNl = T.intercalate ",\n"-    compileErrorType :: Method -> CodeGen (Maybe Code)-    compileErrorType (Method mn _ _ me _) =-        case me of-            Just errorTypeExpression -> do-                et <- compileTypeExpression src (Just errorTypeExpression)-                return $ Just [qq|('{toAttributeName' mn}', $et)|]-            Nothing -> return Nothing-    compileMethod :: Method -> CodeGen Code-    compileMethod m@(Method mName params rtype _etype _anno) = do-        let mName' = toAttributeName' mName-        params' <- mapM compileMethodParameter $ toList params-        let paramDocs = [ T.concat [ ":param "-                                   , toAttributeName' pName-                                   , maybe "" (T.append ": ") $ compileDocs p-                                   -- TODO: types-                                   ]-                        | p@(Parameter pName _ _) <- toList params-                        ]-        rtypeExpr <- compileTypeExpression src rtype-        ret <- returnCompiler-        return [qq|-    def {mName'}(self, {commaNl params'}){ ret rtypeExpr }:-{compileDocstring' "        " m paramDocs}-        raise NotImplementedError('$className has to implement {mName'}()')-|]-    compileMethodParameter :: Parameter -> CodeGen Code-    compileMethodParameter (Parameter pName pType _) = do-        pTypeExpr <- compileTypeExpression src (Just pType)-        arg <- parameterCompiler-        return [qq|{arg (toAttributeName' pName) pTypeExpr}|]-    compileMethodMetadata :: Method -> CodeGen Code-    compileMethodMetadata Method { methodName = mName-                                 , parameters = params-                                 , returnType = rtype-                                 } = do-        let params' = toList params :: [Parameter]-        rtypeExpr <- compileTypeExpression src rtype-        paramMetadata <- mapM compileParameterMetadata params'-        let paramMetadata' = commaNl paramMetadata-        insertThirdPartyImportsA-            [("nirum.constructs", [("name_dict_type", "NameDict")])]-        return [qq|'{toAttributeName' mName}': \{-            '_v': 2,-            '_return': lambda: $rtypeExpr,-            '_names': name_dict_type([{paramNameMap params'}]),-            {paramMetadata'}-        \}|]-    methodList :: [Method]-    methodList = toList methods-    compileParameterMetadata :: Parameter -> CodeGen Code-    compileParameterMetadata (Parameter pName pType _) = do-        let pName' = toAttributeName' pName-        pTypeExpr <- compileTypeExpression src (Just pType)-        return [qq|'{pName'}': lambda: $pTypeExpr|]-    methodNameMap :: T.Text-    methodNameMap = toIndentedCodes-        toNamePair-        [mName | Method { methodName = mName } <- methodList]-        ",\n        "-    paramNameMap :: [Parameter] -> T.Text-    paramNameMap params = toIndentedCodes-        toNamePair [pName | Parameter pName _ _ <- params] ",\n        "-    compileClientPayload :: Parameter -> CodeGen Code-    compileClientPayload (Parameter pName pt _) = do-        let pName' = toAttributeName' pName-        return [qq|'{I.toSnakeCaseText $ N.behindName pName}':-                   ({compileSerializer src pt pName'})|]-    compileClientMethod :: Method -> CodeGen Code-    compileClientMethod Method { methodName = mName-                               , parameters = params-                               , returnType = rtype-                               , errorType = etypeM-                               } = do-        let clientMethodName' = toAttributeName' mName-        params' <- mapM compileMethodParameter $ toList params-        rtypeExpr <- compileTypeExpression src rtype-        errorCode <- case etypeM of-             Just e -> do-                e' <- compileTypeExpression src (Just e)-                return $ "result_type = " `T.append` e'-             Nothing ->-                return "raise UnexpectedNirumResponseError(serialized)"-        payloadArguments <- mapM compileClientPayload $ toList params-        ret <- returnCompiler-        return [qq|-    def {clientMethodName'}(self, {commaNl params'}){ret rtypeExpr}:-        successful, serialized = self.__nirum_transport__(-            '{I.toSnakeCaseText $ N.behindName mName}',-            payload=\{{commaNl payloadArguments}\},-            # FIXME Give annotations.-            service_annotations=\{\},-            method_annotations=self.__nirum_method_annotations__,-            parameter_annotations=\{\}-        )-        if successful:-            result_type = $rtypeExpr-        else:-            $errorCode-        if result_type is None:-            result = None-        else:-            result = deserialize_meta(result_type, serialized)-        if successful:-            return result-        raise result-|]-    toKeyItem :: I.Identifier -> T.Text -> T.Text-    toKeyItem ident v = [qq|'{toAttributeName ident}': {v}|]-    wrapMap :: T.Text -> T.Text-    wrapMap items = [qq|$nirumMapName(\{$items\})|]-    compileAnnotation :: I.Identifier -> A.AnnotationArgumentSet -> T.Text-    compileAnnotation ident annoArgument =-        toKeyItem ident $-            wrapMap $ T.intercalate ","-                [ toKeyStr ident' value :: T.Text-                | (ident', value) <- M.toList annoArgument-                ]-      where-        escapeSingle :: T.Text -> T.Text-        escapeSingle = T.strip . T.replace "'" "\\'"-        toKeyStr :: I.Identifier -> T.Text -> T.Text-        toKeyStr k v =-            [qq|'{toAttributeName k}': u'''{escapeSingle v}'''|]-    compileMethodAnnotation :: Method -> T.Text-    compileMethodAnnotation Method { methodName = mName-                                   , methodAnnotations = annoSet-                                   } =-        toKeyItem (N.facialName mName) $ wrapMap annotationDict-      where-        annotationDict :: T.Text-        annotationDict = T.intercalate ","-            [ compileAnnotation ident annoArgSet :: T.Text-            | (ident, annoArgSet) <- M.toList $ A.annotations annoSet-            ]-    methodAnnotations' :: T.Text-    methodAnnotations' = wrapMap $ commaNl $ map compileMethodAnnotation-        methodList--compileTypeDeclaration _ Import {} =-    return ""  -- Nothing to compile--compileModuleBody :: Source -> CodeGen Code-compileModuleBody src@Source { sourceModule = boundModule } = do-    let types' = boundTypes boundModule-    typeCodes <- mapM (compileTypeDeclaration src) $ toList types'-    return $ T.intercalate "\n\n" typeCodes--data InstallRequires =-    InstallRequires { dependencies :: S.Set T.Text-                    , optionalDependencies :: M.Map (Int, Int) (S.Set T.Text)-                    } deriving (Eq, Ord, Show)--addDependency :: InstallRequires -> T.Text -> InstallRequires-addDependency requires package =-    requires { dependencies = S.insert package $ dependencies requires }--addOptionalDependency :: InstallRequires-                      -> (Int, Int)       -- ^ Python version already stasified-                      -> T.Text           -- ^ PyPI package name-                      -> InstallRequires-addOptionalDependency requires pyVer package =-    requires { optionalDependencies = newOptDeps }-  where-    oldOptDeps :: M.Map (Int, Int) (S.Set T.Text)-    oldOptDeps = optionalDependencies requires-    newOptDeps :: M.Map (Int, Int) (S.Set T.Text)-    newOptDeps = M.alter (Just . S.insert package . fromMaybe S.empty)-                         pyVer oldOptDeps--unionInstallRequires :: InstallRequires -> InstallRequires -> InstallRequires-unionInstallRequires a b =-    a { dependencies = S.union (dependencies a) (dependencies b)-      , optionalDependencies = M.unionWith S.union (optionalDependencies a)-                                                   (optionalDependencies b)-      }--compileModule :: PythonVersion-              -> Source-              -> Either CompileError' (InstallRequires, Code)-compileModule pythonVersion' source = do-    let (result, context) = runCodeGen (compileModuleBody source)-                                       (empty pythonVersion')-    let deps = require "nirum" "nirum" $ M.keysSet $ thirdPartyImports context-    let optDeps =-            [ ((3, 4), require "enum34" "enum" $ standardImports context)-            , ((3, 5), require "typing" "typing" $ standardImports context)-            ]-    let installRequires = InstallRequires deps optDeps-    let fromImports = M.assocs (localImportsMap context) ++-                      M.assocs (thirdPartyImports context)-    code <- result-    return $ (,) installRequires $ toStrict $ renderMarkup $-        [compileText|# -*- coding: utf-8 -*--#{compileDocstring "" $ sourceModule source}-%{ forall i <- S.elems (standardImports context) }-import #{i}-%{ endforall }--%{ forall (from, nameMap) <- fromImports }-from #{from} import (-%{ forall (alias, name) <- M.assocs nameMap }-%{ if (alias == name) }-    #{name},-%{ else }-    #{name} as #{alias},-%{ endif }-%{ endforall }-)-%{ endforall }--#{code}-|]-  where-    has :: S.Set T.Text -> T.Text -> Bool-    has set module' = module' `S.member` set ||-                      any (T.isPrefixOf $ module' `T.snoc` '.') set-    require :: T.Text -> T.Text -> S.Set T.Text -> S.Set T.Text-    require pkg module' set =-        if set `has` module' then S.singleton pkg else S.empty--compilePackageMetadata :: Package' -> InstallRequires -> Code-compilePackageMetadata Package-                           { metadata = Metadata-                                 { authors = authors'-                                 , version = version'-                                 , description = description'-                                 , license = license'-                                 , MD.keywords = keywords'-                                 , target = target'@Python-                                       { packageName = packageName'-                                       , minimumRuntimeVersion = minRuntimeVer-                                       }-                                 }-                           , modules = modules'-                           }-                       (InstallRequires deps optDeps) =-    toStrict $ renderMarkup [compileText|# -*- coding: utf-8 -*--import sys--from setuptools import setup, __version__ as setuptools_version--install_requires = [-%{ forall p <- S.toList deps }-%{ if (p == "nirum") }-    'nirum >= #{SV.toText minRuntimeVer}',-%{ else }-    (#{stringLiteral p}),-%{ endif }-%{ endforall }-]-polyfill_requires = {-%{ forall ((major, minor), deps') <- M.toList optDeps }-    (#{major}, #{minor}): [-%{ forall dep' <- S.toList deps' }-        (#{stringLiteral dep'}),-%{ endforall }-    ],-%{ endforall }-}--%{ if (not $ M.null optDeps) }-# '<' operator for environment markers are supported since setuptools 17.1.-# Read PEP 496 for details of environment markers.-setup_requires = ['setuptools >= 17.1']-if tuple(map(int, setuptools_version.split('.'))) < (17, 1):-    extras_require = {}-    if 'bdist_wheel' not in sys.argv:-        for (major, minor), deps in polyfill_requires.items():-            if sys.version_info < (major, minor):-                install_requires.extend(deps)-    envmarker = ":python_version=='{0}.{1}'"-    python_versions = [(2, 6), (2, 7),-                       (3, 3), (3, 4), (3, 5), (3, 6)]  # FIXME-    for pyver in python_versions:-        extras_require[envmarker.format(*pyver)] = list({-            d-            for v, vdeps in polyfill_requires.items()-            if pyver < v-            for d in vdeps-        })-else:-    extras_require = {-        ":python_version<'{0}.{1}'".format(*pyver): deps-        for pyver, deps in polyfill_requires.items()-    }-%{ else }-setup_requires = []-extras_require = {}-%{ endif }---SOURCE_ROOT = #{stringLiteral $ sourceDirectory Python3}--if sys.version_info < (3, 0):-    SOURCE_ROOT = #{stringLiteral $ sourceDirectory Python2}--# TODO: long_description, url, classifiers-setup(-    name=#{stringLiteral packageName'},-    version=#{stringLiteral $ SV.toText version'},-    description=#{nStringLiteral description'},-    license=#{nStringLiteral license'},-    keywords=#{stringLiteral $ T.intercalate " " keywords'},-    author=', '.join([-%{ forall Author { name = name } <- authors' }-    (#{stringLiteral name}),-%{ endforall }-    ]),-    author_email=', '.join([-%{ forall Author { email = email' } <- authors' }-%{ case email' }-%{ of Just authorEmail }-    (#{stringLiteral $ decodeUtf8 $ E.toByteString authorEmail}),-%{ of Nothing }-%{ endcase }-%{ endforall }-    ]),-    package_dir={'': SOURCE_ROOT},-    packages=[#{strings $ toImportPaths target' $ MS.keysSet modules'}],-    provides=[#{strings $ toImportPaths target' $ MS.keysSet modules'}],-    requires=[#{strings $ S.toList deps}],-    setup_requires=setup_requires,-    install_requires=install_requires,-    extras_require=extras_require,-)-|]-  where-    nStringLiteral :: Maybe T.Text -> T.Text-    nStringLiteral (Just value) = stringLiteral value-    nStringLiteral Nothing = "None"-    strings :: [Code] -> Code-    strings values = T.intercalate ", " $ map stringLiteral (L.sort values)--manifestIn :: Code-manifestIn = [q|recursive-include src *.py-recursive-include src-py2 *.py-|]--compilePackage' :: Package'-                -> M.Map FilePath (Either CompileError' Code)-compilePackage' package@Package { metadata = Metadata { target = target' } } =-    M.fromList $-        initFiles ++-        [ ( f-          , case cd of-                Left e -> Left e-                Right (_, cd') -> Right cd'-          )-        | (f, cd) <- modules'-        ] ++-        [ ("setup.py", Right $ compilePackageMetadata package installRequires)-        , ("MANIFEST.in", Right manifestIn)-        ]-  where-    toPythonFilename :: ModulePath -> [FilePath]-    toPythonFilename mp = [ T.unpack (toAttributeName i)-                          | i <- toList $ renameMP target' mp-                          ] ++ ["__init__.py"]-    versions :: [PythonVersion]-    versions = [Python2, Python3]-    toFilename :: T.Text -> ModulePath -> FilePath-    toFilename sourceRootDirectory mp =-        joinPath $ T.unpack sourceRootDirectory : toPythonFilename mp-    initFiles :: [(FilePath, Either CompileError' Code)]-    initFiles = [ (toFilename (sourceDirectory ver) mp', Right "")-                | mp <- MS.keys (modules package)-                , mp' <- S.elems (hierarchy mp)-                , ver <- versions-                ]-    modules' :: [(FilePath, Either CompileError' (InstallRequires, Code))]-    modules' =-        [ ( toFilename (sourceDirectory ver) modulePath'-          , compileModule ver $ Source package boundModule-          )-        | (modulePath', _) <- MS.toAscList (modules package)-        , Just boundModule <- [resolveBoundModule modulePath' package]-        , ver <- versions-        ]-    installRequires :: InstallRequires-    installRequires = foldl unionInstallRequires-                            (InstallRequires [] [])-                            [deps | (_, Right (deps, _)) <- modules']--parseModulePath :: T.Text -> Maybe ModulePath-parseModulePath string =-    mapM I.fromText identTexts >>= fromIdentifiers-  where-    identTexts :: [T.Text]-    identTexts = T.split (== '.') string--instance Target Python where-    type CompileResult Python = Code-    type CompileError Python = CompileError'-    targetName _ = "python"-    parseTarget table = do-        name' <- stringField "name" table-        minRuntime <- case versionField "minimum_runtime" table of-            Left (FieldError _) -> Right minimumRuntime-            otherwise' -> otherwise'-        renameTable <- case tableField "renames" table of-            Right t -> Right t-            Left (FieldError _) -> Right HM.empty-            otherwise' -> otherwise'-        renamePairs <- sequence-            [ case (parseModulePath k, v) of-                  (Just modulePath', VString v') -> case parseModulePath v' of-                      Just altPath -> Right (modulePath', altPath)-                      Nothing -> Left $ FieldValueError [qq|renames.$k|]-                          [qq|expected a module path, not "$v'"|]-                  (Nothing, _) -> Left $ FieldValueError [qq|renams.$k|]-                      [qq|expected a module path as a key, not "$k"|]-                  _ -> Left $ FieldTypeError [qq|renames.$k|] "string" $-                                             fieldType v-            | (k, v) <- HM.toList renameTable-            ]-        return Python { packageName = name'-                      , minimumRuntimeVersion = max minRuntime minimumRuntime-                      , renames = M.fromList renamePairs-                      }-    compilePackage = compilePackage'-    showCompileError _ e = e-    toByteString _ = encodeUtf8+{-# OPTIONS_GHC -Wno-orphans #-}+{-# LANGUAGE ExtendedDefaultRules #-}+{-# LANGUAGE OverloadedLists #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+module Nirum.Targets.Python+    ( Python (..)+    , Source (..)+    , compileModule+    , compileTypeDeclaration+    , parseModulePath+    ) where++import Control.Monad (forM)+import Control.Monad.State (modify)+import qualified Data.List as L+import Data.Maybe (catMaybes, fromMaybe)+import GHC.Exts (IsList (toList))++import qualified Data.ByteString.Lazy+import qualified Data.HashMap.Strict as HM+import qualified Data.Map.Strict as M+import qualified Data.SemVer as SV+import qualified Data.Set as S+import qualified Data.Text as T+import Data.Text.Encoding (decodeUtf8)+import System.FilePath (joinPath)+import Text.Blaze (Markup)+import qualified Text.Blaze.Renderer.Utf8+import qualified Text.Email.Validate as E+import Text.Heterocephalus (compileText)+import Text.InterpolatedString.Perl6 (qq)++import qualified Nirum.Constructs.Annotation as A+import Nirum.Constructs.Annotation.Internal hiding (Text, annotations, name)+import qualified Nirum.Constructs.Annotation.Internal as AI+import Nirum.Constructs.Declaration hiding (annotations, name)+import qualified Nirum.Constructs.DeclarationSet as DS+import qualified Nirum.Constructs.Identifier as I+import Nirum.Constructs.Module hiding (imports)+import Nirum.Constructs.ModulePath ( ModulePath+                                   , fromIdentifiers+                                   , hierarchy+                                   )+import Nirum.Constructs.Name (Name (Name))+import qualified Nirum.Constructs.Name as N+import Nirum.Constructs.Service ( Method ( Method+                                         , errorType+                                         , methodAnnotations+                                         , methodName+                                         , parameters+                                         , returnType+                                         )+                                , Parameter (Parameter)+                                , Service (Service)+                                )+import Nirum.Constructs.TypeDeclaration as TD+import Nirum.Constructs.TypeExpression hiding (type')+import Nirum.Docs.ReStructuredText (ReStructuredText, render)+import Nirum.Package hiding (target)+import Nirum.Package.Metadata ( Author (Author, name, email)+                              , Metadata ( authors+                                         , description+                                         , license+                                         , target+                                         , version+                                         )+                              , MetadataError ( FieldError+                                              , FieldTypeError+                                              , FieldValueError+                                              )+                              , Node (VString)+                              , Target ( CompileError+                                       , CompileResult+                                       , compilePackage+                                       , parseTarget+                                       , showCompileError+                                       , targetName+                                       , toByteString+                                       )+                              , stringField+                              , tableField+                              , textArrayField+                              , versionField+                              )+import qualified Nirum.Package.ModuleSet as MS+import qualified Nirum.Package.Metadata as MD+import Nirum.Targets.Python.CodeGen+import Nirum.Targets.Python.Deserializers+import Nirum.Targets.Python.Serializers+import Nirum.Targets.Python.TypeExpression+import Nirum.Targets.Python.Validators+import Nirum.TypeInstance.BoundModule as BM++type Package' = Package Python+type CompileError' = Nirum.Targets.Python.CodeGen.CompileError++data Source = Source { sourcePackage :: Package'+                     , sourceModule :: BoundModule Python+                     } deriving (Eq, Ord, Show)++sourceImportPath :: Source -> T.Text+sourceImportPath (Source (Package MD.Metadata { MD.target = t } _) bm) =+    toImportPath t (BM.modulePath bm)++sourceDirectory :: PythonVersion -> T.Text+sourceDirectory Python2 = "src-py2"+sourceDirectory Python3 = "src"++enumerate :: [a] -> [(Int, a)]+enumerate = zip [0 ..]++toEnumMemberName :: Name -> T.Text+toEnumMemberName name'+  | attributeName `elem` memberKeywords = attributeName `T.snoc` '_'+  | otherwise = attributeName+  where+    memberKeywords :: [T.Text]+    memberKeywords = ["mro"]+    attributeName :: T.Text+    attributeName = toAttributeName' name'++compileFieldInitializer :: Field -> CodeGen Code+compileFieldInitializer (Field fieldName' fieldType' _) =+    case fieldType' of+        SetModifier _ -> do+            b <- importBuiltins+            return [qq|self.$attributeName = $b.frozenset($attributeName)|]+        ListModifier _ -> do+            insertThirdPartyImportsA [ ( "nirum.datastructures"+                                       , [("_list_type", "List")]+                                       )+                                     ]+            return [qq|self.$attributeName = _list_type($attributeName)|]+        _ -> return [qq|self.$attributeName = $attributeName|]+  where+    attributeName :: Code+    attributeName = toAttributeName' fieldName'++compileDocs :: Documented a => a -> Maybe ReStructuredText+compileDocs = fmap render . docsBlock++quoteDocstring :: ReStructuredText -> Code+quoteDocstring rst = T.concat ["r'''", rst, "\n'''\n"]++compileDocstring' :: Documented a => Code -> a -> [ReStructuredText] -> Code+compileDocstring' indentSpace d extra =+    case (compileDocs d, extra) of+        (Nothing, []) -> "\n"+        (result, extra') -> indent indentSpace $ quoteDocstring $+            T.append (fromMaybe "" result) $+                     T.concat ['\n' `T.cons` e `T.snoc` '\n' | e <- extra']++compileDocstring :: Documented a => Code -> a -> Code+compileDocstring indentSpace d = compileDocstring' indentSpace d []++compileDocstringWithFields :: Documented a => Code -> a -> [Field] -> Code+compileDocstringWithFields indentSpace decl fields' =+    compileDocstring' indentSpace decl extra+  where+    extra :: [ReStructuredText]+    extra =+        [ case compileDocs f of+              Nothing -> T.concat [ ".. attribute:: "+                                  , toAttributeName' n+                                  , "\n"+                                  ]+              Just docs' -> T.concat [ ".. attribute:: "+                                     , toAttributeName' n+                                     , "\n\n"+                                     , indent "   " docs'+                                     ]+        | f@(Field n _ _) <- toList fields'+        ]++compileDocstringWithParameters :: Code+                               -> Method+                               -> [MethodParameterCode]+                               -> Code+compileDocstringWithParameters indentSpace decl methodParameterCodes =+    compileDocstring'+        indentSpace+        decl+        [ case compileDocs (mpcParam mpc) of+              Nothing ->+                  [qq|:param {paramName}: (:class:`{simplifyTypeExpr tx}`)+|]+              Just docs' ->+                  [qq|:param {paramName}: (:class:`{simplifyTypeExpr tx}`)+{indentN (9 + (T.length paramName)) docs'}+|]+        | mpc@MethodParameterCode { mpcTypeExpr = tx } <- methodParameterCodes+        , paramName <- [mpcAttributeName mpc]+        ]+  where+    indentN :: Int -> Code -> Code+    indentN n = indent (T.replicate n " ")+    simplifyTypeExpr :: Code -> Code+    simplifyTypeExpr = T.takeWhileEnd (/= '.')++compileDocsComment :: Documented a => Code -> a -> Code+compileDocsComment indentSpace d =+    case compileDocs d of+        Nothing -> "\n"+        Just rst -> indent (indentSpace `T.append` "#: ") rst++data FieldCode = FieldCode+    { fcField :: Field+    , fcInitializer :: Code+    , fcTypeExpr :: Code+    , fcValidator :: Validator+    , fcDeserializer :: Markup+    }++fcAttributeName :: FieldCode -> T.Text+fcAttributeName = toAttributeName' . fieldName . fcField++fcBehindName :: FieldCode -> T.Text+fcBehindName = toBehindSnakeCaseText . fieldName . fcField++fcOptional :: FieldCode -> Bool+fcOptional FieldCode { fcField = Field { fieldType = OptionModifier _ } } = True+fcOptional _ = False++fcTypePredicateCode :: FieldCode -> Code+fcTypePredicateCode = typePredicateCode . fcValidator++fcValueValidators :: FieldCode -> [ValueValidator]+fcValueValidators = valueValidators . fcValidator++toFieldCodes :: Source+             -> (Field -> Code)+             -> (Field -> Code)+             -> (Field -> Code)+             -> DS.DeclarationSet Field+             -> CodeGen [FieldCode]+toFieldCodes src vIn vOut vError = flip (forM . toList) $ \ field -> do+    typeExpr <- compileTypeExpression' src (Just $ fieldType field)+    initializer <- compileFieldInitializer field+    validator <- compileValidator' src+        (fieldType field)+        (toAttributeName' $ fieldName field)+    deserializer <- compileDeserializer' src (fieldType field)+        (vIn field)+        (vOut field)+        (vError field)+    return FieldCode+        { fcField = field+        , fcInitializer = initializer+        , fcTypeExpr = typeExpr+        , fcValidator = validator+        , fcDeserializer = deserializer+        }++instance Eq FieldCode where+    a == b =+        t a == t b+      where+          t :: FieldCode+            -> (Field, Code, Code, Validator, Data.ByteString.Lazy.ByteString)+          t fc =+              ( fcField fc+              , fcInitializer fc+              , fcTypeExpr fc+              , fcValidator fc+              , Text.Blaze.Renderer.Utf8.renderMarkup $ fcDeserializer fc+              )++-- When [FieldCode] is sorted optional fields go back.+instance Ord FieldCode where+    a <= b = fcOptional a <= fcOptional b++data MethodCode = MethodCode+    { mcMethod :: Method+    , mcRTypeExpr :: Code+    , mcETypeExpr :: Code+    , mcParams :: [MethodParameterCode]+    , mcRSerializer :: Code -> Markup+    , mcRDeserializer :: Maybe Markup+    , mcESerializer :: Code -> Markup+    , mcEDeserializer :: Maybe Markup+    }++mcAttributeName :: MethodCode -> T.Text+mcAttributeName = toAttributeName' . methodName . mcMethod++mcBehindName :: MethodCode -> T.Text+mcBehindName = toBehindSnakeCaseText . methodName . mcMethod++toMethodCode :: Source+             -> Code+             -> Code+             -> Code+             -> (Parameter -> Code)+             -> (Parameter -> Code)+             -> (Parameter -> Code)+             -> Method+             -> CodeGen MethodCode+toMethodCode source+             vInput vOutput vError+             paramVInput paramVOutput paramVError+             method@Method { returnType = rType, errorType = eType } = do+    rTypeExpr <- compileTypeExpression' source rType+    errTypeExpr <- compileTypeExpression' source eType+    params' <- sequence $ (`map` toList (parameters method)) $ \ param ->+        toMethodParameterCode source+            (paramVInput param)+            (paramVOutput param)+            (paramVError param)+            param+    resultSerializer <- serializer rType+    errorSerializer <- serializer eType+    resultDeserializer <- coalesce rType $ \ t ->+        compileDeserializer' source t vInput vOutput vError+    errorDeserializer <- coalesce eType $ \ t ->+        compileDeserializer' source t vInput vOutput vError+    return MethodCode+        { mcMethod = method+        , mcRTypeExpr = rTypeExpr+        , mcETypeExpr = errTypeExpr+        , mcParams = params'+        , mcRSerializer = resultSerializer+        , mcRDeserializer = resultDeserializer+        , mcESerializer = errorSerializer+        , mcEDeserializer = errorDeserializer+        }+  where+    coalesce :: Maybe a -> (a -> CodeGen b) -> CodeGen (Maybe b)+    coalesce (Just v) f = Just <$> f v+    coalesce Nothing _ = return Nothing+    serializer :: Maybe TypeExpression -> CodeGen (Code -> Markup)+    serializer Nothing =+        return $ \ funcName -> [compileText|(#{funcName}) = None|]+    serializer (Just type_) = do+        typing <- importStandardLibrary "typing"+        builtins <- importBuiltins+        typeExpr <- compileTypeExpression' source $ Just type_+        Validator predicateCode' valueValidators' <-+            compileValidator' source type_ "input"+        return $ \ funcName -> [compileText|+def #{funcName}(input):+    if not (#{predicateCode'}):+        raise #{builtins}.TypeError(+            'expected a value of ' + #{typing}._type_repr(#{typeExpr}) ++            ', not ' + repr(input)+        )+%{ forall ValueValidator valuePredCode valueErrorMsg <- valueValidators' }+    elif not (#{valuePredCode}):+        raise #{builtins}.ValueError(#{stringLiteral valueErrorMsg})+%{ endforall }+    return #{compileSerializer' source type_ "input"}+        |]++data MethodParameterCode = MethodParameterCode+    { mpcParam :: Parameter+    , mpcTypeExpr :: Code+    , mpcValidator :: Validator+    , mpcDeserializer :: Markup+    }++mpcAttributeName :: MethodParameterCode -> T.Text+mpcAttributeName MethodParameterCode { mpcParam = Parameter pName _ _ } =+    toAttributeName' pName++mpcBehindName :: MethodParameterCode -> T.Text+mpcBehindName MethodParameterCode { mpcParam = Parameter pName _ _ } =+    toBehindSnakeCaseText pName++mpcOptional :: MethodParameterCode -> Bool+mpcOptional mpc = case mpcType mpc of+    OptionModifier _ -> True+    _ -> False++mpcType :: MethodParameterCode -> TypeExpression+mpcType MethodParameterCode { mpcParam = Parameter _ typeExpr _ } = typeExpr++mpcTypePredicateCode :: MethodParameterCode -> Code+mpcTypePredicateCode = typePredicateCode . mpcValidator++mpcValueValidators :: MethodParameterCode -> [ValueValidator]+mpcValueValidators = valueValidators . mpcValidator++toMethodParameterCode :: Source+                      -> Code+                      -> Code+                      -> Code+                      -> Parameter+                      -> CodeGen MethodParameterCode+toMethodParameterCode source vInput vOutput vError+                      parameter@(Parameter pName pType _) = do+    typeExpr <- compileTypeExpression' source $ Just pType+    validator <- compileValidator' source pType $ toAttributeName' pName+    deserializer <- compileDeserializer' source pType vInput vOutput vError+    return MethodParameterCode+        { mpcParam = parameter+        , mpcTypeExpr = typeExpr+        , mpcValidator = validator+        , mpcDeserializer = deserializer+        }++defaultDeserializerErrorHandler :: CodeGen Code+defaultDeserializerErrorHandler = do+    modify $ \ c@CodeGenContext { globalDefinitions = defs } ->+        c { globalDefinitions = S.insert code defs }+    return funcName+  where+    funcName :: Code+    funcName = "__nirum_default_deserialization_error_handler__"+    code :: Code+    code = [qq|+class $funcName(object):+    def __init__(self, on_error=None):+        self.on_error = on_error+        self.errors = set()+        self.errored = False+    def __call__(self, field, message):+        self.errored = True+        if self.on_error is None:+            self.errors.add((field, message))+        else:+            self.on_error(field, message)+    def raise_error(self):+        """Raise :exc:`ValueError` if there's no overridden ``on_error``+        callback and ever errored.+        """+        if self.errored and self.on_error is None:+            raise ValueError(+                chr(0xa).join(+                    sorted(e[0] + ': ' + e[1] for e in self.errors)+                )+            )+    |]++compileUnionTag :: Source -> Name -> Tag -> CodeGen Markup+compileUnionTag source parentname d@(Tag typename' fields' _) = do+    abc <- collectionsAbc+    fieldCodes <- toFieldCodes source+        (\ f -> [qq|value.get('{toBehindSnakeCaseText (fieldName f)}')|])+        (\ f -> [qq|rv_{toAttributeName' (fieldName f)}|])+        (\ f -> [qq|error_{toAttributeName' (fieldName f)}|])+        fields'+    pyVer <- getPythonVersion+    defaultErrorHandler <- defaultDeserializerErrorHandler+    return $ [compileText|+class #{className}(#{parentClass}):+#{compileDocstringWithFields "    " d (map fcField fieldCodes)}+    __slots__ = (+%{ forall fieldCode <- fieldCodes }+        '#{fcAttributeName fieldCode}',+%{ endforall }+    )+    __nirum_type__ = 'union'+    __nirum_tag__ = #{parentClass}.Tag.#{toEnumMemberName typename'}++%{ case pyVer }+%{ of Python2 }+    def __init__(self, **kwargs):+%{ of Python3 }+    def __init__(+%{ if null fieldCodes }+        self+%{ else }+        self, *+%{ forall fieldCode <- L.sort fieldCodes }+        , #{fcAttributeName fieldCode}: #{fcTypeExpr fieldCode}+%{ if fcOptional fieldCode }+            =None+%{ endif }+%{ endforall }+%{ endif }+    ) -> None:+%{ endcase }+        def __init__(+%{ forall (i, fieldCode) <- enumerate (L.sort fieldCodes) }+%{ if i > 0 }+            ,+%{ endif }+            #{fcAttributeName fieldCode}+%{ case pyVer }+%{ of Python3 }+                : #{fcTypeExpr fieldCode}+%{ of Python2 }+%{ endcase }+%{ if fcOptional fieldCode }+                =None+%{ endif }+%{ endforall }+        ):+%{ forall fc <- fieldCodes }+            if not (#{fcTypePredicateCode fc}):+                raise TypeError(+                    '#{fcAttributeName fc} must be a value of ' ++                    __import__('typing')._type_repr(#{fcTypeExpr fc}) ++                    ', not ' + repr(#{fcAttributeName fc})+                )+%{ forall ValueValidator fValuePredCode fValueErrorMsg <- fcValueValidators fc }+            elif not (#{fValuePredCode}):+                raise ValueError(+                    'invalid #{fcAttributeName fc}: '+                    #{stringLiteral fValueErrorMsg}+                )+%{ endforall }+%{ endforall }+%{ forall FieldCode { fcInitializer = initializer } <- fieldCodes }+            #{initializer}+%{ endforall }+            pass  # it's necessary when there are no parameters at all+%{ case pyVer }+%{ of Python2 }+        __init__(**kwargs)+%{ of Python3 }+        __init__(+%{ forall fieldCode <- fieldCodes }+            #{fcAttributeName fieldCode}=#{fcAttributeName fieldCode},+%{ endforall }+        )+%{ endcase }++    def __nirum_serialize__(self):+        return {+            '_type': '#{behindParentTypename}',+            '_tag': '#{behindTagName}',+%{ forall fc@FieldCode { fcField = Field { fieldType = fType } } <- fieldCodes }+            '#{fcBehindName fc}':+#{compileSerializer' source fType $ T.append "self." $ fcAttributeName fc},+%{ endforall }+        }++    @classmethod+%{ case pyVer }+%{ of Python2 }+    def __nirum_deserialize__(cls, value, on_error=None):+%{ of Python3 }+    def __nirum_deserialize__(+        cls: type,+        value,+        on_error: typing.Optional[+            typing.Callable[[typing.Tuple[str, str]], None]+        ]=None+    ) -> typing.Optional['#{className}']:+%{ endcase }+        handle_error = #{defaultErrorHandler}(on_error)+        if isinstance(value, #{abc}.Mapping):+            try:+                tag = value['_tag']+            except KeyError:+                handle_error('._tag', 'Expected to exist.')+            else:+                if tag == '#{toBehindSnakeCaseText typename'}':+%{ forall fieldCode@FieldCode { fcDeserializer = deserializer } <- fieldCodes }+                    error_#{fcAttributeName fieldCode} = lambda ef, em: \+                        handle_error('.#{fcBehindName fieldCode}' + ef, em)+%{ if fcOptional fieldCode }+                    if '#{fcBehindName fieldCode}' not in value:+                        value['#{fcBehindName fieldCode}'] = None+#{indent "                    " deserializer}+%{ else }+                    if '#{fcBehindName fieldCode}' in value:+#{indent "                        " deserializer}+                    else:+                        error_#{fcAttributeName fieldCode}(+                            '', 'Expected to exist.'+                        )+%{ endif }+%{ endforall }+                    pass  # No-op; just for convenience' sake of the compiler+                else:+                    handle_error(+                        '._tag',+                        'Expected to be a "#{toBehindSnakeCaseText typename'}".'+                    )+        else:+            handle_error('', 'Expected an object.')+        handle_error.raise_error()+        if not handle_error.errored:+            return cls(+%{ forall fieldCode <- fieldCodes }+                #{fcAttributeName fieldCode}=rv_#{fcAttributeName fieldCode},+%{ endforall }+            )++%{ case pyVer }+%{ of Python2 }+    def __eq__(self, other):+%{ of Python3 }+    def __eq__(self, other: '#{parentClass}') -> bool:+%{ endcase }+        return isinstance(other, #{className}) and all(+            getattr(self, attr) == getattr(other, attr)+            for attr in self.__slots__+        )++%{ case pyVer }+%{ of Python2 }+    def __ne__(self, other):+%{ of Python3 }+    def __ne__(self, other: '#{parentClass}') -> bool:+%{ endcase }+        return not self == other++%{ case pyVer }+%{ of Python2 }+    def __hash__(self):+%{ of Python3 }+    def __hash__(self) -> int:+%{ endcase }+        return hash((+%{ forall fieldCode <- fieldCodes }+            self.#{fcAttributeName fieldCode},+%{ endforall }+        ))++%{ case pyVer }+%{ of Python2 }+    def __repr__(self):+%{ of Python3 }+    def __repr__(self) -> bool:+%{ endcase }+        return ''.join([+            '#{sourceImportPath source}.#{parentClass}.#{className}(',+%{ forall (i, fieldCode) <- enumerate fieldCodes }+%{ if i > 0 }+            ', ',+%{ endif }+            '#{fcAttributeName fieldCode}=',+            repr(self.#{fcAttributeName fieldCode}),+%{ endforall }+            ')'+        ])+++#{parentClass}.#{className} = #{className}+if hasattr(#{parentClass}, '__qualname__'):+    (#{className}).__qualname__ = '#{parentClass}.#{className}'+|]+  where+    className :: T.Text+    className = toClassName' typename'+    behindParentTypename :: T.Text+    behindParentTypename = I.toSnakeCaseText $ N.behindName parentname+    behindTagName :: T.Text+    behindTagName = I.toSnakeCaseText $ N.behindName typename'+    parentClass :: T.Text+    parentClass = toClassName' parentname++compileTypeExpression' :: Source -> Maybe TypeExpression -> CodeGen Code+compileTypeExpression' Source { sourceModule = boundModule } =+    compileTypeExpression boundModule++compileSerializer' :: Source -> TypeExpression -> Code -> Code+compileSerializer' Source { sourceModule = boundModule } =+    compileSerializer boundModule++compileValidator' :: Source -> TypeExpression -> Code -> CodeGen Validator+compileValidator' Source { sourceModule = boundModule } =+    compileValidator boundModule++compileDeserializer' :: Source+                     -> TypeExpression+                     -> Code+                     -> Code+                     -> Code+                     -> CodeGen Markup+compileDeserializer' Source { sourceModule = boundModule } =+    compileDeserializer boundModule++compileTypeDeclaration :: Source -> TypeDeclaration -> CodeGen Markup+compileTypeDeclaration _ TypeDeclaration { type' = PrimitiveType {} } =+    return ""  -- never used+compileTypeDeclaration src d@TypeDeclaration { typename = typename'+                                             , type' = Alias ctype+                                             } = do+    ctypeExpr <- compileTypeExpression' src (Just ctype)+    return [compileText|+%{ case compileDocs d }+%{ of Just rst }+#: #{rst}+%{ of Nothing }+%{ endcase }+#{toClassName' typename'} = #{ctypeExpr}+    |]+compileTypeDeclaration src d@TypeDeclaration { typename = typename'+                                             , type' = UnboxedType itype+                                             } = do+    let className = toClassName' typename'+    itypeExpr <- compileTypeExpression' src (Just itype)+    insertStandardImport "typing"+    pyVer <- getPythonVersion+    Validator typePred valueValidators' <- compileValidator' src itype "value"+    deserializer <- compileDeserializer' src itype "value" "rv" "on_error"+    defaultErrorHandler <- defaultDeserializerErrorHandler+    return [compileText|+class #{className}(object):+#{compileDocstring "    " d}++    __nirum_type__ = 'unboxed'++%{ case pyVer }+%{ of Python2 }+    def __init__(self, value):+%{ of Python3 }+    def __init__(self, value: '#{itypeExpr}') -> None:+%{ endcase }+        if not (#{typePred}):+            raise TypeError(+                'expected {0}, not {1!r}'.format(+                    typing._type_repr(#{itypeExpr}),+                    value+                )+            )+%{ forall ValueValidator predCode msg <- valueValidators' }+        if not (#{predCode}):+            raise ValueError(#{stringLiteral msg})+%{ endforall }+        self.value = value  # type: #{itypeExpr}++%{ case pyVer }+%{ of Python2 }+    def __ne__(self, other):+        return not self == other++    def __eq__(self, other):+%{ of Python3 }+    def __eq__(self, other) -> bool:+%{ endcase }+        return (isinstance(other, #{className}) and+                self.value == other.value)++%{ case pyVer }+%{ of Python2 }+    def __hash__(self):+%{ of Python3 }+    def __hash__(self) -> int:+%{ endcase }+        return hash(self.value)++    def __nirum_serialize__(self):+        return (#{compileSerializer' src itype "self.value"})++    @classmethod+%{ case pyVer }+%{ of Python2 }+    def __nirum_deserialize__(cls, value, on_error=None):+%{ of Python3 }+    def __nirum_deserialize__(+        cls: type,+        value: typing.Any,+        on_error: typing.Optional[+            typing.Callable[[typing.Tuple[str, str]], None]+        ]=None+    ) -> typing.Optional['#{className}']:+%{ endcase }+        on_error = #{defaultErrorHandler}(on_error)+#{indent "        " deserializer}+        on_error.raise_error()+        if not on_error.errored:+            return cls(rv)++%{ case pyVer }+%{ of Python2 }+    def __repr__(self):+        return '{0.__module__}.{0.__name__}({1!r})'.format(+            type(self), self.value+        )+%{ of Python3 }+    def __repr__(self) -> str:+        return '{0}({1!r})'.format(typing._type_repr(type(self)), self.value)+%{ endcase }++%{ case pyVer }+%{ of Python2 }+    def __hash__(self):+%{ of Python3 }+    def __hash__(self) -> int:+%{ endcase }+        return hash(self.value)+|]+compileTypeDeclaration _ d@TypeDeclaration { typename = typename'+                                           , type' = EnumType members'+                                           } = do+    let className = toClassName' typename'+    insertStandardImport "enum"+    insertStandardImport "typing"+    baseString <- baseStringClass+    pyVer <- getPythonVersion+    defaultErrorHandler <- defaultDeserializerErrorHandler+    return [compileText|+class #{className}(enum.Enum):+#{compileDocstring "    " d}++%{ forall member@(EnumMember memberName@(Name _ behind) _) <- toList members' }+#{compileDocsComment "    " member}+    #{toEnumMemberName memberName} = '#{I.toSnakeCaseText behind}'+%{ endforall }++%{ case pyVer }+%{ of Python2 }+    def __nirum_serialize__(self):+%{ of Python3 }+    def __nirum_serialize__(self) -> str:+%{ endcase }+        return self.value++    @classmethod+%{ case pyVer }+%{ of Python2 }+    def __nirum_deserialize__(cls, value, on_error=None):+%{ of Python3 }+    def __nirum_deserialize__(+        cls: type,+        value: str,+        on_error: typing.Optional[+            typing.Callable[[typing.Tuple[str, str]], None]+        ]=None+    ) -> '#{className}':+%{ endcase }+        on_error = #{defaultErrorHandler}(on_error)+        if isinstance(value, #{baseString}):+            member = value.replace('-', '_')+            try:+                result = cls(member)+            except ValueError:+                on_error(+                    '',+                    'Expected a string of a member name, but the given '+                    'string is not a member.  Available member names are: '+                    + ', '.join('"{0}"'.format(m.value) for m in cls)+                )+        else:+            on_error(+                '',+                'Expected a string of a member name, but the given value '+                'is not a string.'+            )+        on_error.raise_error()+        if not on_error.errored:+            return result+++# Since enum.Enum doesn't allow to define non-member when the class is defined,+# __nirum_type__ should be defined after the class is defined.+#{className}.__nirum_type__ = 'enum'+|]+compileTypeDeclaration src d@TypeDeclaration { typename = Name tnFacial tnBehind+                                             , type' = RecordType fields'+                                             } = do+    let className = toClassName tnFacial+    insertStandardImport "typing"+    abc <- collectionsAbc+    pyVer <- getPythonVersion+    fieldCodes <- toFieldCodes src+        (\ f -> [qq|value.get('{toBehindSnakeCaseText (fieldName f)}')|])+        (\ f -> [qq|rv_{toAttributeName' (fieldName f)}|])+        (\ f -> [qq|error_{toAttributeName' (fieldName f)}|])+        fields'+    defaultErrorHandler <- defaultDeserializerErrorHandler+    return [compileText|+class #{className}(object):+#{compileDocstringWithFields "    " d (map fcField fieldCodes)}+    __slots__ = (+%{ forall fieldCode <- fieldCodes }+        '#{fcAttributeName fieldCode}',+%{ endforall }+    )+    __nirum_type__ = 'record'++%{ case pyVer }+%{ of Python2 }+    def __init__(self, **kwargs):+%{ of Python3 }+    def __init__(+%{ if null fieldCodes }+        self+%{ else }+        self, *+%{ forall fieldCode <- L.sort fieldCodes }+        , #{fcAttributeName fieldCode}: #{fcTypeExpr fieldCode}+%{ if fcOptional fieldCode }+            =None+%{ endif }+%{ endforall }+%{ endif }+    ) -> None:+%{ endcase }+        def __init__(+%{ forall (i, fieldCode) <- enumerate (L.sort fieldCodes) }+%{ if i > 0 }+            ,+%{ endif }+            #{fcAttributeName fieldCode}+%{ case pyVer }+%{ of Python3 }+                : #{fcTypeExpr fieldCode}+%{ of Python2 }+%{ endcase }+%{ if fcOptional fieldCode }+                =None+%{ endif }+%{ endforall }+        ):+%{ forall fc <- fieldCodes }+            if not (#{fcTypePredicateCode fc}):+                raise TypeError(+                    '#{fcAttributeName fc} must be a value of ' ++                    __import__('typing')._type_repr(#{fcTypeExpr fc}) ++                    ', not ' + repr(#{fcAttributeName fc})+                )+%{ forall ValueValidator fValuePredCode fValueErrorMsg <- fcValueValidators fc }+            elif not (#{fValuePredCode}):+                raise ValueError(+                    'invalid #{fcAttributeName fc}: '+                    #{stringLiteral fValueErrorMsg}+                )+%{ endforall }+%{ endforall }+%{ forall FieldCode { fcInitializer = initializer } <- fieldCodes }+            #{initializer}+%{ endforall }+            pass  # it's necessary when there are no parameters at all+%{ case pyVer }+%{ of Python2 }+        __init__(**kwargs)+%{ of Python3 }+        __init__(+%{ forall fieldCode <- fieldCodes }+            #{fcAttributeName fieldCode}=#{fcAttributeName fieldCode},+%{ endforall }+        )+%{ endcase }++%{ case pyVer }+%{ of Python2 }+    def __repr__(self):+%{ of Python3 }+    def __repr__(self) -> bool:+%{ endcase }+        return ''.join([+            '#{sourceImportPath src}.#{className}(',+%{ forall (i, fieldCode) <- enumerate fieldCodes }+%{ if i > 0 }+            ', ',+%{ endif }+            '#{fcAttributeName fieldCode}=',+            repr(self.#{fcAttributeName fieldCode}),+%{ endforall }+            ')'+        ])++%{ case pyVer }+%{ of Python2 }+    def __eq__(self, other):+%{ of Python3 }+    def __eq__(self, other: '#{className}') -> bool:+%{ endcase }+        return isinstance(other, #{className}) and all(+            getattr(self, attr) == getattr(other, attr)+            for attr in self.__slots__+        )++%{ case pyVer }+%{ of Python2 }+    def __ne__(self, other):+%{ of Python3 }+    def __ne__(self, other: '#{className}') -> bool:+%{ endcase }+        return not self == other++    def __nirum_serialize__(self):+        return {+            '_type': '#{I.toSnakeCaseText tnBehind}',+%{ forall fc@FieldCode { fcField = Field { fieldType = fType } } <- fieldCodes }+            '#{fcBehindName fc}':+#{compileSerializer' src fType $ T.append "self." $ fcAttributeName fc},+%{ endforall }+        }++    @classmethod+%{ case pyVer }+%{ of Python2 }+    def __nirum_deserialize__(cls, value, on_error=None):+%{ of Python3 }+    def __nirum_deserialize__(+        cls: type,+        value,+        on_error: typing.Optional[+            typing.Callable[[typing.Tuple[str, str]], None]+        ]=None+    ) -> typing.Optional['#{className}']:+%{ endcase }+        on_error = #{defaultErrorHandler}(on_error)+        if isinstance(value, #{abc}.Mapping):+%{ forall fieldCode@FieldCode { fcDeserializer = deserializer } <- fieldCodes }+            error_#{fcAttributeName fieldCode} = lambda ef, em: \+                on_error('.#{fcBehindName fieldCode}' + ef, em)+%{ if fcOptional fieldCode }+            if '#{fcBehindName fieldCode}' not in value:+                value['#{fcBehindName fieldCode}'] = None+#{indent "            " deserializer}+%{ else }+            if '#{fcBehindName fieldCode}' in value:+#{indent "                " deserializer}+            else:+                error_#{fcAttributeName fieldCode}('', 'Expected to exist.')+%{ endif }+%{ endforall }+        else:+            on_error('', 'Expected an object.')+        on_error.raise_error()+        if not on_error.errored:+            return cls(+%{ forall fieldCode <- fieldCodes }+                #{fcAttributeName fieldCode}=rv_#{fcAttributeName fieldCode},+%{ endforall }+            )++%{ case pyVer }+%{ of Python2 }+    def __hash__(self):+%{ of Python3 }+    def __hash__(self) -> int:+%{ endcase }+        return hash((+%{ forall fieldCode <- fieldCodes }+            self.#{fcAttributeName fieldCode},+%{ endforall }+        ))+|]+compileTypeDeclaration src+                       d@TypeDeclaration { typename = typename'+                                         , type' = union@UnionType {}+                                         , typeAnnotations = annotations+                                         } = do+    tagCodes <- mapM (compileUnionTag src typename') tags'+    abc <- collectionsAbc+    insertStandardImport "typing"+    insertStandardImport "enum"+    insertThirdPartyImportsA [("nirum.datastructures", [("map_type", "Map")])]+    baseString <- baseStringClass+    defaultErrorHandler <- defaultDeserializerErrorHandler+    pyVer <- getPythonVersion+    return [compileText|+class #{className}(#{T.intercalate "," $ compileExtendClasses annotations}):+#{compileDocstring "    " d}++    __nirum_type__ = 'union'++    class Tag(enum.Enum):+%{ forall (Tag tn _ _) <- tags' }+        #{toEnumMemberName tn} = '#{toBehindSnakeCaseText tn}'+%{ endforall }++%{ case pyVer }+%{ of Python2 }+    def __init__(self, *args, **kwargs):+%{ of Python3 }+    def __init__(self, *args, **kwargs) -> None:+%{ endcase }+        raise NotImplementedError(+            "{0} cannot be instantiated "+            "since it is an abstract class.  Instantiate a concrete subtype "+            "of it instead.".format(typing._type_repr(self))+        )++%{ case pyVer }+%{ of Python2 }+    def __nirum_serialize__(self):+%{ of Python3 }+    def __nirum_serialize__(self) -> typing.Mapping[str, object]:+%{ endcase }+        raise NotImplementedError(+            "{0} cannot be instantiated "+            "since it is an abstract class.  Instantiate a concrete subtype "+            "of it instead.".format(typing._type_repr(self))+        )++    @classmethod+%{ case pyVer }+%{ of Python2 }+    def __nirum_deserialize__(cls, value, on_error=None):+%{ of Python3 }+    def __nirum_deserialize__(+        cls: type,+        value,+        on_error: typing.Optional[+            typing.Callable[[typing.Tuple[str, str]], None]+        ]=None+    ) -> '#{className}':+%{ endcase }+        handle_error = #{defaultErrorHandler}(on_error)+        if isinstance(value, #{abc}.Mapping):+            try:+                tag = value['_tag']+            except KeyError:+%{ case defaultTag union }+%{ of Just dt }+                tag = '#{toBehindSnakeCaseText $ tagName dt}'+                value = dict(value)+                value['_tag'] = tag+%{ of Nothing }+                handle_error('._tag', 'Expected to exist.')+%{ endcase }+        else:+            handle_error('', 'Expected an object.')+        if handle_error.errored:+            pass+%{ forall (Tag tn _ _) <- tags' }+        elif tag == '#{toBehindSnakeCaseText tn}':+            rv = #{toClassName' tn}.__nirum_deserialize__(+                value, handle_error+            )+%{ endforall }+        elif isinstance(tag, #{baseString}):+            handle_error(+                '._tag',+                'Expected one of the following strings: '+%{ forall (i, (Tag tn _ _)) <- enumerate tags' }+%{ if i < 1 }+%{ elseif i < pred (length tags') }+                ', '+%{ else }+                ', or '+%{ endif }+                '"#{toBehindSnakeCaseText tn}"'+%{ endforall }+                '.'+            )+        else:+            handle_error(+                '._tag',+                'Expected a string, but the given value is not a string.'+            )+        handle_error.raise_error()+        if not handle_error.errored:+            return rv++%{ forall tagCode <- tagCodes }+#{tagCode}++%{ endforall }++#{className}.__nirum_tag_classes__ = map_type({+%{ forall (Tag tn _ _) <- tags' }+    #{className}.Tag.#{toEnumMemberName tn}: #{toClassName' tn},+%{ endforall }+})+|]+  where+    tags' :: [Tag]+    tags' = DS.toList $ tags union+    className :: T.Text+    className = toClassName' typename'+    compileExtendClasses :: A.AnnotationSet -> [Code]+    compileExtendClasses annotations' =+        if null extendClasses+            then ["object"]+            else extendClasses+      where+        extendsClassMap :: M.Map I.Identifier Code+        extendsClassMap = [("error", "Exception")]+        extendClasses :: [Code]+        extendClasses = catMaybes+            [ M.lookup annotationName extendsClassMap+            | (A.Annotation annotationName _) <- A.toList annotations'+            ]++compileTypeDeclaration src d@ServiceDeclaration { serviceName = name'+                                                , service = Service methods+                                                } = do+    insertThirdPartyImportsA+        [ ("nirum.constructs", [("name_dict_type", "NameDict")])+        , ("nirum.datastructures", [(nirumMapName, "Map")])+        , ("nirum.exc", [ ("_unexpected_nirum_response_error"+                          , "UnexpectedNirumResponseError"+                          )+                        ]+          )+        , ("nirum.service", [("service_type", "Service")])+        , ("nirum.transport", [("transport_type", "Transport")])+        ]+    abc <- collectionsAbc+    builtins <- importBuiltins+    typing <- importStandardLibrary "typing"+    pyVer <- getPythonVersion+    methodCodes <- sequence $ (`map` toList methods) $ toMethodCode+        src+        "value" "rv" "on_error"+        (const "value") (const "rv") (const "on_error")+    defaultErrorHandler <- defaultDeserializerErrorHandler+    return [compileText|+class #{className}(service_type):+#{compileDocstring "    " d}+    __nirum_type__ = 'service'+    __nirum_service_methods__ = {+%{ forall mc <- methodCodes }+        '#{mcAttributeName mc}': {+            '_v': 2,+            '_return': lambda: #{mcRTypeExpr mc},+            '_names': name_dict_type([+%{ forall mpc <- mcParams mc }+                ('#{mpcAttributeName mpc}', '#{mpcBehindName mpc}'),+%{ endforall }+            ]),+%{ forall mpc <- mcParams mc }+            '#{mpcAttributeName mpc}': lambda: #{mpcTypeExpr mpc},+%{ endforall }+        },+%{ endforall }+    }+    __nirum_method_names__ = name_dict_type([+%{ forall mc <- methodCodes }+        ('#{mcAttributeName mc}', '#{mcBehindName mc}'),+%{ endforall }+    ])+    __nirum_method_annotations__ = #{methodAnnotations'}++    @staticmethod+    def __nirum_method_error_types__(k, d=None):+%{ forall mc <- methodCodes }+        if k == '#{mcAttributeName mc}':+            return #{mcETypeExpr mc}+%{ endforall }+        return d++%{ forall mc <- methodCodes }+    def #{mcAttributeName mc}(+        self,+%{ case pyVer }+%{ of Python3 }+%{ forall mpc <- mcParams mc }+        #{mpcAttributeName mpc}: '#{mpcTypeExpr mpc}',+%{ endforall }+    ) -> '#{mcRTypeExpr mc}':+%{ of Python2 }+%{ forall mpc <- mcParams mc }+        #{mpcAttributeName mpc},+%{ endforall }+    ):+%{ endcase }+#{compileDocstringWithParameters "        " (mcMethod mc) (mcParams mc)}+        raise NotImplementedError(+            '#{className} has to implement #{mcAttributeName mc}()'+        )++    #{mcAttributeName mc}.__nirum_argument_serializers__ = {+    }  # type: typing.Mapping[str, typing.Callable[[object], object]]+    #{mcAttributeName mc}.__nirum_argument_deserializers__ = {+    }+%{ forall mpc <- mcParams mc }+    def __nirum_argument_serializer__(#{mpcAttributeName mpc}):+        if not (#{mpcTypePredicateCode mpc}):+            raise #{builtins}.TypeError(+                '#{mpcAttributeName mpc} must be a value of ' ++                #{typing}._type_repr(#{mpcTypeExpr mpc}) + ', not ' ++                #{builtins}.repr(#{mpcAttributeName mpc})+            )+%{ forall ValueValidator pValuePredCode pValueErrMsg <- mpcValueValidators mpc}+        elif not (#{pValuePredCode}):+            raise #{builtins}.ValueError(+                'invalid #{mpcAttributeName mpc}: '+                #{stringLiteral pValueErrMsg}+            )+%{ endforall }+        return #{compileSerializer' src (mpcType mpc) (mpcAttributeName mpc)}+    __nirum_argument_serializer__.__name__ = '#{mpcAttributeName mpc}'+    #{mcAttributeName mc}.__nirum_argument_serializers__[+        '#{mpcAttributeName mpc}'] = __nirum_argument_serializer__+    del __nirum_argument_serializer__++    def __nirum_argument_deserializer__(value, on_error=None):+        on_error = #{defaultErrorHandler}(on_error)+#{indent "        " (mpcDeserializer mpc)}+        on_error.raise_error()+        if not on_error.errored:+            return rv+    __nirum_argument_deserializer__.__name__ = '#{mpcBehindName mpc}'+    #{mcAttributeName mc}.__nirum_argument_deserializers__[+        '#{mpcBehindName mpc}'] = __nirum_argument_deserializer__+    del __nirum_argument_deserializer__+%{ endforall }++    def __nirum_serialize_arguments__(+%{ case pyVer }+%{ of Python3 }+%{ forall mpc <- mcParams mc }+        #{mpcAttributeName mpc}: '#{mpcTypeExpr mpc}',+%{ endforall }+    ) -> '#{mcRTypeExpr mc}':+%{ of Python2 }+%{ forall mpc <- mcParams mc}+        #{mpcAttributeName mpc},+%{ endforall }+    ):+%{ endcase }+        return {+%{ forall mpc <- mcParams mc }+            '#{mpcBehindName mpc}':+                #{className}.#{mcAttributeName mc}+                    .__nirum_argument_serializers__['#{mpcAttributeName mpc}'](+                    #{mpcAttributeName mpc}+                ),+%{ endforall }+        }+    #{mcAttributeName mc}.__nirum_serialize_arguments__ = \+        __nirum_serialize_arguments__+    del __nirum_serialize_arguments__++    def __nirum_deserialize_arguments__(value, on_error=None):+        on_error = #{defaultErrorHandler}(on_error)+        table = #{className}.#{mcAttributeName mc} \+            .__nirum_argument_deserializers__+        if isinstance(value, #{abc}.Mapping):+            result = {}+%{ forall mpc <- mcParams mc }+            try:+                field_value = value['#{mpcBehindName mpc}']+            except KeyError:+%{ if mpcOptional mpc }+                result['#{mpcAttributeName mpc}'] = None+%{ else }+                on_error('.#{mpcBehindName mpc}', 'Expected to exist.')+%{ endif }+            else:+                result['#{mpcAttributeName mpc}'] = \+                    table['#{mpcBehindName mpc}'](+                        field_value,+                        lambda f, m: on_error('.#{mpcBehindName mpc}' + f, m)+                    )+%{ endforall }+        else:+            on_error('', 'Expected an object.')+        on_error.raise_error()+        if not on_error.errored:+            return result+    #{mcAttributeName mc}.__nirum_deserialize_arguments__ = \+        __nirum_deserialize_arguments__+    del __nirum_deserialize_arguments__++#{indent "    " (mcRSerializer mc "__nirum_serialize_result__")}+    #{mcAttributeName mc}.__nirum_serialize_result__ = \+        __nirum_serialize_result__+    del __nirum_serialize_result__++%{ case mcRDeserializer mc }+%{ of Just resultDeserializer }+    def __nirum_deserialize_result__(value, on_error=None):+        on_error = #{defaultErrorHandler}(on_error)+#{indent "        " resultDeserializer}+        on_error.raise_error()+        if not on_error.errored:+            return rv+    #{mcAttributeName mc}.__nirum_deserialize_result__ = \+        __nirum_deserialize_result__+    del __nirum_deserialize_result__+%{ of Nothing }+    #{mcAttributeName mc}.__nirum_deserialize_result__ = None+%{ endcase }++#{indent "    " (mcESerializer mc "__nirum_serialize_error__")}+    #{mcAttributeName mc}.__nirum_serialize_error__ = \+        __nirum_serialize_error__+    del __nirum_serialize_error__++%{ case mcEDeserializer mc }+%{ of Just errorDeserializer }+    def __nirum_deserialize_error__(value, on_error=None):+        on_error = #{defaultErrorHandler}(on_error)+#{indent "        " errorDeserializer}+        on_error.raise_error()+        if not on_error.errored:+            return rv+    #{mcAttributeName mc}.__nirum_deserialize_error__ = \+        __nirum_deserialize_error__+    del __nirum_deserialize_error__+%{ of Nothing }+    #{mcAttributeName mc}.__nirum_deserialize_error__ = None+%{ endcase }+%{ endforall }+++class #{className}_Client(#{className}):+    """The client object of :class:`{className}`."""++%{ case pyVer }+%{ of Python3 }+    def __init__(self, transport: transport_type) -> None:+%{ of Python2 }+    def __init__(self, transport):+%{ endcase }+        if not isinstance(transport, transport_type):+            raise TypeError(+                'expected an instance of {0.__module__}.{0.__name__}, not '+                '{1!r}'.format(transport_type, transport)+            )+        self.__nirum_transport__ = transport  # type: transport_type++%{ forall mc <- methodCodes }+    def #{mcAttributeName mc}(+        self, *args, **kwargs+%{ case pyVer }+%{ of Python3 }+    ) -> '#{mcRTypeExpr mc}':+%{ of Python2 }+    ):+%{ endcase }+        prototype = #{className}.#{mcAttributeName mc}+        successful, serialized = self.__nirum_transport__(+            '#{mcBehindName mc}',+            payload=prototype.__nirum_serialize_arguments__(*args, **kwargs),+            # FIXME Give annotations.+            service_annotations={},+            method_annotations=self.__nirum_method_annotations__,+            parameter_annotations={}+        )+        on_deserializer_error = #{defaultErrorHandler}()+        if successful:+            deserializer = prototype.__nirum_deserialize_result__+        else:+            deserializer = prototype.__nirum_deserialize_error__+        if callable(deserializer):+            result = deserializer(serialized, on_deserializer_error)+        elif not successful:+            raise _unexpected_nirum_response_error(serialized)+        else:+            result = None+        on_deserializer_error.raise_error()+        if successful:+            return result+        raise result+%{ endforall }++#{className}.Client = #{className}_Client+#{className}.Client.__name__ = 'Client'+if hasattr(#{className}.Client, '__qualname__'):+    #{className}.Client.__qualname__ = '#{className}.Client'+|]+  where+    nirumMapName :: T.Text+    nirumMapName = "map_type"+    className :: T.Text+    className = toClassName' name'+    commaNl :: [T.Text] -> T.Text+    commaNl = T.intercalate ",\n"+    toKeyItem :: I.Identifier -> T.Text -> T.Text+    toKeyItem ident v = [qq|'{toAttributeName ident}': {v}|]+    wrapMap :: T.Text -> T.Text+    wrapMap items = [qq|$nirumMapName(\{$items\})|]+    compileAnnotation :: I.Identifier -> A.AnnotationArgumentSet -> T.Text+    compileAnnotation ident annoArgument =+        toKeyItem ident $+            wrapMap $ T.intercalate ","+                [ [qq|'{toAttributeName ident'}': {annoArgToText value}|]+                | (ident', value) <- M.toList annoArgument+                ]+      where+        escapeSingle :: T.Text -> T.Text+        escapeSingle = T.strip . T.replace "'" "\\'"+        annoArgToText :: AnnotationArgument -> T.Text+        annoArgToText (AI.Text t) = [qq|u'''{escapeSingle t}'''|]+        annoArgToText (Integer i) = T.pack $ show i+    compileMethodAnnotation :: Method -> T.Text+    compileMethodAnnotation Method { methodName = mName+                                   , methodAnnotations = annoSet+                                   } =+        toKeyItem (N.facialName mName) $ wrapMap annotationDict+      where+        annotationDict :: T.Text+        annotationDict = T.intercalate ","+            [ compileAnnotation ident annoArgSet :: T.Text+            | (ident, annoArgSet) <- M.toList $ A.annotations annoSet+            ]+    methodAnnotations' :: T.Text+    methodAnnotations' = wrapMap $ commaNl $ map compileMethodAnnotation+        (toList methods)++compileTypeDeclaration _ Import {} =+    return ""  -- Nothing to compile++compileModuleBody :: Source -> CodeGen Markup+compileModuleBody src@Source { sourceModule = boundModule } = do+    let types' = boundTypes boundModule+    typeCodes <- mapM (compileTypeDeclaration src) $ toList types'+    return $ [compileText|+%{forall typeCode <- typeCodes}+#{typeCode}+%{endforall}+|]++compileModule :: PythonVersion+              -> Source+              -> Either CompileError' ( S.Set T.Text+                                      , M.Map (Int, Int) (S.Set T.Text)+                                      , Markup+                                      )+compileModule pythonVersion' source = do+    let (result, context) = runCodeGen (compileModuleBody source)+                                       (empty pythonVersion')+    let deps = S.union+            (dependencies context)+            (require "nirum" "nirum" $ M.keysSet $ thirdPartyImports context)+    let standardImportSet' = standardImportSet context+    let optDeps = M.unionWith S.union+            (optionalDependencies context)+            [ ((3, 4), require "enum34" "enum" standardImportSet')+            , ((3, 5), require "typing" "typing" standardImportSet')+            ]+    let fromImports = M.assocs (localImportsMap context) +++                      M.assocs (thirdPartyImports context)+    let globalDefs = globalDefinitions context+    code <- result+    return $ (deps, optDeps,) $+        [compileText|# -*- coding: utf-8 -*-+#{compileDocstring "" $ sourceModule source}+%{ forall (alias, import') <- M.assocs (standardImports context) }+%{ if import' == alias }+import #{import'}+%{ else }+import #{import'} as #{alias}+%{ endif }+%{ endforall }++%{ forall (from, nameMap) <- fromImports }+from #{from} import (+%{ forall (alias, name) <- M.assocs nameMap }+%{ if (alias == name) }+    #{name},+%{ else }+    #{name} as #{alias},+%{ endif }+%{ endforall }+)+%{ endforall }++%{ forall globalDef <- S.toList globalDefs }+#{globalDef}+%{ endforall }++#{code}+|]+  where+    has :: S.Set T.Text -> T.Text -> Bool+    has set module' = module' `S.member` set ||+                      any (T.isPrefixOf $ module' `T.snoc` '.') set+    require :: T.Text -> T.Text -> S.Set T.Text -> S.Set T.Text+    require pkg module' set =+        if set `has` module' then S.singleton pkg else S.empty++compilePackageMetadata :: Package'+                       -> (S.Set T.Text, M.Map (Int, Int) (S.Set T.Text))+                       -> Markup+compilePackageMetadata Package+                           { metadata = MD.Metadata+                                 { authors = authors'+                                 , version = version'+                                 , description = description'+                                 , license = license'+                                 , MD.keywords = keywords'+                                 , target = target'@Python+                                       { packageName = packageName'+                                       , minimumRuntimeVersion = minRuntimeVer+                                       , classifiers = classifiers'+                                       }+                                 }+                           , modules = modules'+                           }+                       (deps, optDeps) =+    [compileText|# -*- coding: utf-8 -*-+import sys++from setuptools import setup, __version__ as setuptools_version++install_requires = [+%{ forall p <- S.toList deps }+%{ if (p == "nirum") }+    'nirum >= #{SV.toText minRuntimeVer}',+%{ else }+    (#{stringLiteral p}),+%{ endif }+%{ endforall }+]+polyfill_requires = {+%{ forall ((major, minor), deps') <- M.toList optDeps }+    (#{major}, #{minor}): [+%{ forall dep' <- S.toList deps' }+        (#{stringLiteral dep'}),+%{ endforall }+    ],+%{ endforall }+}++%{ if (not $ M.null optDeps) }+# '<' operator for environment markers are supported since setuptools 17.1.+# Read PEP 496 for details of environment markers.+setup_requires = ['setuptools >= 17.1']+if tuple(map(int, setuptools_version.split('.'))) < (17, 1):+    extras_require = {}+    if 'bdist_wheel' not in sys.argv:+        for (major, minor), deps in polyfill_requires.items():+            if sys.version_info < (major, minor):+                install_requires.extend(deps)+    envmarker = ":python_version=='{0}.{1}'"+    python_versions = [(2, 6), (2, 7),+                       (3, 3), (3, 4), (3, 5), (3, 6)]  # FIXME+    for pyver in python_versions:+        extras_require[envmarker.format(*pyver)] = list({+            d+            for v, vdeps in polyfill_requires.items()+            if pyver < v+            for d in vdeps+        })+else:+    extras_require = {+        ":python_version<'{0}.{1}'".format(*pyver): deps+        for pyver, deps in polyfill_requires.items()+    }+%{ else }+setup_requires = []+extras_require = {}+%{ endif }+++SOURCE_ROOT = #{stringLiteral $ sourceDirectory Python3}++if sys.version_info < (3, 0):+    SOURCE_ROOT = #{stringLiteral $ sourceDirectory Python2}++# TODO: long_description, url+setup(+    name=#{stringLiteral packageName'},+    version=#{stringLiteral $ SV.toText version'},+    description=#{nStringLiteral description'},+    license=#{nStringLiteral license'},+    keywords=#{stringLiteral $ T.intercalate " " keywords'},+    classifiers=[+%{ forall classifier <- classifiers' }+    #{stringLiteral classifier},+%{ endforall }+    ],+    author=', '.join([+%{ forall Author { name = name } <- authors' }+    (#{stringLiteral name}),+%{ endforall }+    ]),+    author_email=', '.join([+%{ forall Author { email = email' } <- authors' }+%{ case email' }+%{ of Just authorEmail }+    (#{stringLiteral $ decodeUtf8 $ E.toByteString authorEmail}),+%{ of Nothing }+%{ endcase }+%{ endforall }+    ]),+    package_dir={'': SOURCE_ROOT},+    packages=[#{strings $ toImportPaths target' $ MS.keysSet modules'}],+    provides=[#{strings $ toImportPaths target' $ MS.keysSet modules'}],+    requires=[#{strings $ S.toList deps}],+    setup_requires=setup_requires,+    install_requires=install_requires,+    extras_require=extras_require,+    entry_points={+        'nirum.modules': [+%{ forall modPath <- MS.keys modules' }+            '#{normalizeModulePath modPath} = #{toImportPath target' modPath}',+%{ endforall }+        ],+        'nirum.classes': [+%{ forall (modPath, Module types' _) <- MS.toList modules' }+%{ forall typeName <- catMaybes (typeNames types') }+            '#{normalizeModulePath modPath}.#{I.toNormalizedText typeName} = '+            '#{toImportPath target' modPath}:#{toClassName typeName}',+%{ endforall }+%{ endforall }+        ],+    },+)+|]+  where+    normalizeModulePath :: ModulePath -> T.Text+    normalizeModulePath = T.intercalate "." . map I.toNormalizedText . toList+    typeNames :: DS.DeclarationSet TD.TypeDeclaration -> [Maybe I.Identifier]+    typeNames types' =+        [ case td of+              TD.TypeDeclaration { TD.typename = (Name n _) } -> Just n+              TD.ServiceDeclaration { TD.serviceName = (Name n _) } -> Just n+              TD.Import {} -> Nothing+        | td <- DS.toList types'+        ]+    nStringLiteral :: Maybe T.Text -> T.Text+    nStringLiteral (Just value) = stringLiteral value+    nStringLiteral Nothing = "None"+    strings :: [Code] -> Code+    strings values = T.intercalate ", " $ map stringLiteral (L.sort values)++manifestIn :: Markup+manifestIn = [compileText|recursive-include src *.py+recursive-include src-py2 *.py+|]++compilePackage' :: Package'+                -> M.Map FilePath (Either CompileError' Markup)+compilePackage' package@Package { metadata = MD.Metadata { target = target' }+                                } =+    M.fromList $+        initFiles +++        [ ( f+          , case cd of+                Left e -> Left e+                Right (_, _, cd') -> Right cd'+          )+        | (f, cd) <- modules'+        ] +++        [ ("setup.py", Right $ compilePackageMetadata package allDependencies)+        , ("MANIFEST.in", Right manifestIn)+        ]+  where+    toPythonFilename :: ModulePath -> [FilePath]+    toPythonFilename mp = [ T.unpack (toAttributeName i)+                          | i <- toList $ renameModulePath' target' mp+                          ] ++ ["__init__.py"]+    versions :: [PythonVersion]+    versions = [Python2, Python3]+    toFilename :: T.Text -> ModulePath -> FilePath+    toFilename sourceRootDirectory mp =+        joinPath $ T.unpack sourceRootDirectory : toPythonFilename mp+    initFiles :: [(FilePath, Either CompileError' Markup)]+    initFiles = [ (toFilename (sourceDirectory ver) mp', Right [compileText||])+                | mp <- MS.keys (modules package)+                , mp' <- S.elems (hierarchy mp)+                , ver <- versions+                ]+    modules' :: [ ( FilePath+                  , Either CompileError' ( S.Set T.Text+                                         , M.Map (Int, Int) (S.Set T.Text)+                                         , Markup+                                         )+                  )+                ]+    modules' =+        [ ( toFilename (sourceDirectory ver) modulePath'+          , compileModule ver $ Source package boundModule+          )+        | (modulePath', _) <- MS.toAscList (modules package)+        , Just boundModule <- [resolveBoundModule modulePath' package]+        , ver <- versions+        ]+    allDependencies :: (S.Set T.Text, M.Map (Int, Int) (S.Set T.Text))+    allDependencies =+        ( S.unions [deps | (_, Right (deps, _, _)) <- modules']+        , M.unionsWith S.union [oDeps | (_, Right (_, oDeps, _)) <- modules']+        )++parseModulePath :: T.Text -> Maybe ModulePath+parseModulePath string =+    mapM I.fromText identTexts >>= fromIdentifiers+  where+    identTexts :: [T.Text]+    identTexts = T.split (== '.') string++instance Target Python where+    type CompileResult Python = Markup+    type CompileError Python = CompileError'+    targetName _ = "python"+    parseTarget table = do+        name' <- stringField "name" table+        minRuntime <- case versionField "minimum_runtime" table of+            Left (FieldError _) -> Right minimumRuntime+            otherwise' -> otherwise'+        renameTable <- case tableField "renames" table of+            Right t -> Right t+            Left (FieldError _) -> Right HM.empty+            otherwise' -> otherwise'+        renamePairs <- sequence+            [ case (parseModulePath k, v) of+                  (Just modulePath', VString v') -> case parseModulePath v' of+                      Just altPath -> Right (modulePath', altPath)+                      Nothing -> Left $ FieldValueError [qq|renames.$k|]+                          [qq|expected a module path, not "$v'"|]+                  (Nothing, _) -> Left $ FieldValueError [qq|renams.$k|]+                      [qq|expected a module path as a key, not "$k"|]+                  _ -> Left $ FieldTypeError [qq|renames.$k|] "string" $+                                             MD.fieldType v+            | (k, v) <- HM.toList renameTable+            ]+        classifiers' <- case textArrayField "classifiers" table of+            Right t -> Right t+            Left (FieldError _) -> Right []+            otherwise' -> otherwise'+        return Python { packageName = name'+                      , minimumRuntimeVersion = max minRuntime minimumRuntime+                      , renames = M.fromList renamePairs+                      , classifiers = classifiers'+                      }+    compilePackage = compilePackage'+    showCompileError _ e = e+    toByteString _ =+        Data.ByteString.Lazy.toStrict . Text.Blaze.Renderer.Utf8.renderMarkup
+ src/Nirum/Targets/Python.hs-boot view
@@ -0,0 +1,7 @@+{-# OPTIONS_GHC -Wno-missing-methods -Wno-orphans #-}+module Nirum.Targets.Python () where++import Nirum.Package.Metadata (Target (..))+import Nirum.Targets.Python.CodeGen as CG++instance Target Python where
+ src/Nirum/Targets/Python/CodeGen.hs view
@@ -0,0 +1,342 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedLists #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE TypeSynonymInstances #-}+module Nirum.Targets.Python.CodeGen+    ( Code+    , CodeGen+    , CodeGenContext (..)+    , CompileError+    , Python (..)+    , PythonVersion (..)+    , RenameMap+    , addDependency+    , addOptionalDependency+    , baseIntegerClass+    , baseStringClass+    , collectionsAbc+    , empty+    , getPythonVersion+    , importBuiltins+    , importStandardLibrary+    , importTypingForPython3+    , indent+    , insertLocalImport+    , insertStandardImport+    , insertStandardImportA+    , insertThirdPartyImports+    , insertThirdPartyImportsA+    , keywords+    , localImportsMap+    , mangleVar+    , minimumRuntime+    , renameModulePath+    , renameModulePath'+    , runCodeGen+    , stringLiteral+    , toAttributeName+    , toAttributeName'+    , toBehindSnakeCaseText+    , toClassName+    , toClassName'+    , toImportPath'+    , toImportPath+    , toImportPaths+    ) where++import Control.Monad.State+import Data.Maybe+import Data.Typeable+import GHC.Exts++import Data.Map.Strict hiding (empty, member, toAscList)+import Data.SemVer hiding (Identifier)+import Data.Set hiding (empty)+import qualified Data.Set+import Data.Text hiding (empty)+import qualified Data.Text+import Data.Text.Lazy (toStrict)+import qualified Data.Text.Lazy+import Text.Blaze (ToMarkup (preEscapedToMarkup))+import Text.Blaze.Renderer.Text (renderMarkup)+import Text.InterpolatedString.Perl6 (qq)+import Text.Printf (printf)++import qualified Nirum.CodeGen+import Nirum.Constructs.Identifier+import Nirum.Constructs.ModulePath+import Nirum.Constructs.Name++minimumRuntime :: Version+minimumRuntime = version 0 6 0 [] []++-- | The set of Python reserved keywords.+-- See also: https://docs.python.org/3/reference/lexical_analysis.html#keywords+keywords :: Set Code+keywords = [ "False", "None", "True"+           , "and", "as", "assert", "break", "class", "continue"+           , "def", "del" , "elif", "else", "except", "finally"+           , "for", "from", "global", "if", "import", "in", "is"+           , "lambda", "nonlocal", "not", "or", "pass", "raise"+           , "return", "try", "while", "with", "yield"+           ]++type RenameMap = Map ModulePath ModulePath++data Python = Python { packageName :: Text+                     , minimumRuntimeVersion :: Version+                     , renames :: RenameMap+                     , classifiers :: [Text]+                     } deriving (Eq, Ord, Show, Typeable)++data PythonVersion = Python2+                   | Python3+                   deriving (Eq, Ord, Show)++type CompileError = Text+type Code = Text++data CodeGenContext+    = CodeGenContext { standardImports :: Map Text Text+                     , standardImportSet :: Set Text+                     , thirdPartyImports :: Map Text (Map Text Text)+                     , localImports :: Map Text (Set Text)+                     , pythonVersion :: PythonVersion+                     , dependencies :: Set Text+                     , optionalDependencies :: Map (Int, Int) (Set Text)+                     , globalDefinitions :: Set Code+                     }+    deriving (Eq, Ord, Show)++instance Nirum.CodeGen.Failure CodeGenContext CompileError where+    fromString = return . pack++empty :: PythonVersion -> CodeGenContext+empty pythonVer = CodeGenContext+    { standardImports = []+    , standardImportSet = []+    , thirdPartyImports = []+    , localImports = []+    , pythonVersion = pythonVer+    , dependencies = []+    , optionalDependencies = []+    , globalDefinitions = []+    }++localImportsMap :: CodeGenContext -> Map Text (Map Text Text)+localImportsMap CodeGenContext { localImports = imports } =+    Data.Map.Strict.map (Data.Map.Strict.fromSet id) imports++type CodeGen = Nirum.CodeGen.CodeGen CodeGenContext CompileError++runCodeGen :: CodeGen a+           -> CodeGenContext+           -> (Either CompileError a, CodeGenContext)+runCodeGen = Nirum.CodeGen.runCodeGen++importStandardLibrary :: Text -> CodeGen Code+importStandardLibrary module' = do+    insertStandardImportA alias module'+    return alias+  where+    alias :: Code+    alias+      | "_" `isPrefixOf` module' = module'+      | otherwise = '_' `cons` Data.Text.replace "." "_" module'++importBuiltins :: CodeGen Code+importBuiltins = do+    pyVer <- getPythonVersion+    case pyVer of+        Python3 -> do+            insertStandardImportA "__builtin__" "builtins"+            return "__builtin__"+        Python2 -> importStandardLibrary "__builtin__"++insertStandardImport :: Text -> CodeGen ()+insertStandardImport module' =+    insertStandardImportA module' module'++insertStandardImportA :: Code -> Text -> CodeGen ()+insertStandardImportA alias module' = modify insert'+  where+    insert' c@CodeGenContext { standardImports = si, standardImportSet = ss } =+        c { standardImports = Data.Map.Strict.insert alias module' si+          , standardImportSet = Data.Set.insert module' ss+          }++insertThirdPartyImports :: [(Text, Set Text)] -> CodeGen ()+insertThirdPartyImports imports =+    insertThirdPartyImportsA [ (from, Data.Map.Strict.fromSet id objects)+                             | (from, objects) <- imports+                             ]++insertThirdPartyImportsA :: [(Text, Map Text Text)] -> CodeGen ()+insertThirdPartyImportsA imports =+    modify insert'+  where+    insert' c@CodeGenContext { thirdPartyImports = ti } =+        c { thirdPartyImports = Prelude.foldl (unionWith Data.Map.Strict.union)+                                              ti+                                              importList+          }+    importList :: [Map Text (Map Text Text)]+    importList = [ Data.Map.Strict.singleton from objects+                 | (from, objects) <- imports+                 ]++insertLocalImport :: Text -> Text -> CodeGen ()+insertLocalImport module' object = modify insert'+  where+    insert' c@CodeGenContext { localImports = li } =+        c { localImports = insertWith Data.Set.union module' [object] li }++importTypingForPython3 :: CodeGen ()+importTypingForPython3 = do+    pyVer <- getPythonVersion+    case pyVer of+        Python2 -> return ()+        Python3 -> insertStandardImport "typing"++addDependency :: Text -> CodeGen ()+addDependency package =+    modify $ \ c@CodeGenContext { dependencies = deps } ->+        c { dependencies = Data.Set.insert package deps }++addOptionalDependency :: (Int, Int) -- | Python version already stasified.+                      -> Text -- | PyPI package name.+                      -> CodeGen ()+addOptionalDependency pyVer package =+    modify $ \ c@CodeGenContext { optionalDependencies = oldOptDeps } ->+        c { optionalDependencies = newOptDeps oldOptDeps }+  where+    newOptDeps :: Map (Int, Int) (Set Text) -> Map (Int, Int) (Set Text)+    newOptDeps = Data.Map.Strict.alter+        (Just . Data.Set.insert package . fromMaybe Data.Set.empty)+        pyVer++getPythonVersion :: CodeGen PythonVersion+getPythonVersion = fmap pythonVersion Control.Monad.State.get++renameModulePath :: RenameMap -> ModulePath -> ModulePath+renameModulePath renameMap path' =+    rename (Data.Map.Strict.toDescList renameMap)+    -- longest paths should be processed first+  where+    rename :: [(ModulePath, ModulePath)] -> ModulePath+    rename ((from, to) : xs) = let r = replacePrefix from to path'+                               in if r == path'+                                  then rename xs+                                  else r+    rename [] = path'++renameModulePath' :: Python -> ModulePath -> ModulePath+renameModulePath' Python { renames = table } = renameModulePath table++toImportPath' :: ModulePath -> Text+toImportPath' =+    intercalate "." . fmap toAttributeName . GHC.Exts.toList++toImportPath :: Python -> ModulePath -> Text+toImportPath target' = toImportPath' . renameModulePath' target'++toImportPaths :: Python -> Set ModulePath -> [Text]+toImportPaths target' paths =+    toAscList $ Data.Set.map toImportPath' $ hierarchies renamedPaths+  where+    renamedPaths :: Set ModulePath+    renamedPaths = Data.Set.map (renameModulePath' target') paths++toClassName :: Identifier -> Text+toClassName identifier =+    if className `member` keywords then className `snoc` '_' else className+  where+    className :: Text+    className = toPascalCaseText identifier++toClassName' :: Name -> Text+toClassName' = toClassName . facialName++toAttributeName :: Identifier -> Text+toAttributeName identifier =+    if attrName `member` keywords then attrName `snoc` '_' else attrName+  where+    attrName :: Text+    attrName = toSnakeCaseText identifier++toAttributeName' :: Name -> Text+toAttributeName' = toAttributeName . facialName++toBehindSnakeCaseText :: Name -> Text+toBehindSnakeCaseText = toSnakeCaseText . behindName++mangleVar :: Code -> Text -> Code+mangleVar expr arbitrarySideName = Data.Text.concat+    [ "__nirum_"+    , (`Data.Text.map` expr) $ \ c ->+          if 'A' <= c && c <= 'Z' || 'a' <= c && c <= 'z' || c == '_'+          then c+          else '_'+    , "__"+    , arbitrarySideName+    , "__"+    ]++collectionsAbc :: CodeGen Code+collectionsAbc = do+    ver <- getPythonVersion+    importStandardLibrary $ case ver of+        Python2 -> "collections"+        Python3 -> "collections.abc"++-- | Indent the given code.  If there are empty lines these are not indented.+indent :: ToMarkup m => Code -> m -> Code+indent space =+    intercalate "\n"+        . fmap indentLn+        . Data.Text.Lazy.split (== '\n')+        . renderMarkup+        . preEscapedToMarkup+  where+    indentLn :: Data.Text.Lazy.Text -> Code+    indentLn line+      | Data.Text.Lazy.null line = Data.Text.empty+      | otherwise = space `append` toStrict line++stringLiteral :: Text -> Code+stringLiteral string =+    open $ Data.Text.concatMap esc string `snoc` '"'+  where+    open :: Text -> Text+    open =+        if Data.Text.any (> '\xff') string+        then Data.Text.append "u\""+        else Data.Text.cons '"'+    esc :: Char -> Text+    esc '"' = "\\\""+    esc '\\' = "\\\\"+    esc '\t' = "\\t"+    esc '\n' = "\\n"+    esc '\r' = "\\r"+    esc c+        | c >= '\x10000' = pack $ printf "\\U%08x" c+        | c >= '\xff' = pack $ printf "\\u%04x" c+        | c < ' ' || c >= '\x7f' = pack $ printf "\\x%02x" c+        | otherwise = Data.Text.singleton c++baseStringClass :: CodeGen Code+baseStringClass = do+    builtinsMod <- importBuiltins+    pyVer <- getPythonVersion+    let className = case pyVer of+            Python2 -> "basestring" :: Code+            Python3 -> "str"+    return [qq|$builtinsMod.$className|]++baseIntegerClass :: CodeGen Code+baseIntegerClass = do+    builtinsMod <- importBuiltins+    pyVer <- getPythonVersion+    return $ case pyVer of+        Python2 -> [qq|($builtinsMod.int, $builtinsMod.long)|]+        Python3 -> [qq|$builtinsMod.int|]
+ src/Nirum/Targets/Python/Deserializers.hs view
@@ -0,0 +1,655 @@+{-# LANGUAGE OverloadedLists #-}+{-# LANGUAGE QuasiQuotes #-}+module Nirum.Targets.Python.Deserializers+    ( compileDeserializer+    ) where++import Text.Blaze (Markup)+import Text.Heterocephalus (compileText)+import Text.InterpolatedString.Perl6 (qq)++import Nirum.Constructs.Identifier+import Nirum.Constructs.ModulePath+import Nirum.Constructs.TypeDeclaration+import Nirum.Constructs.TypeExpression+import Nirum.Package.Metadata+import Nirum.Targets.Python.CodeGen+import Nirum.Targets.Python.Validators+import Nirum.TypeInstance.BoundModule++-- | It takes these arguments:+--+--     1. a 'BoundModule Python' for the context,+--     2. a 'TypeExpression' which determines how it interprets an input,+--     3. a Python expression of an input,+--     4. a Python expression to store an output, and+--     5. a Python expression of a function, takes two arguments, to store a+--        possible error.+--+-- It returns a Python code that deserializes an input.+--+-- A Python expressions of the third argument should be a target (lvalue)+-- expression, and the last argument should be evaluated as a Python callable.+--+-- A generated Python can be more than an expression; it can+-- consists of multiple statements.  Note that its indentation level is zero.+--+-- For example, if we have a deserializer named @d@ the following code:+--+-- @+--     d "inputs['x']" "outputs['x']" "error"+-- @+--+-- could return a string containing a Python code like the following:+--+-- @+--     if isinstance(inputs['x'], str):+--         try:+--             outputs['x'] = int(inputs['x'])+--         except ValueError:+--             errors('', 'Expected a numeric string.')+--     else:+--         error('', 'Expected a string.')+-- @+compileDeserializer+    :: BoundModule Python -- | The compilation context.+    -> TypeExpression -- | Determines how it interprets an input.+    -> Code -- | A Python expression of an input.+    -> Code -- | A Python expression to store an output.+    -> Code -- | A Python expression of a function to store a possible error.+    -> CodeGen Markup -- | A Python code that deserializes an input.+compileDeserializer mod' typeExpr vInput vOutput vError = do+    let intermOutput = mangleVar vOutput "interm"+    let intermError = mangleVar vError "interm"+    deserializer <- compileDeserializer'+        mod' typeExpr vInput [qq|$intermOutput['rv']|] intermError+    Validator pred' valueValidators' <-+        compileValidator mod' typeExpr [qq|$intermOutput['rv']|]+    return [compileText|+#{intermOutput} = {}+def #{intermError}(err_field, err_msg):+    #{intermError}.errored = True+    #{vError}(err_field, err_msg)+#{deserializer}+if not getattr(#{intermError}, 'errored', False) and #{intermOutput}:+    if not (#{pred'}):+        (#{vError})(+            '',+            'A deserialized value is unexpected type: {0!r}.'.format(+                #{intermOutput}['rv']+            )+        )+%{ forall ValueValidator predCode errorMsg <- valueValidators' }+    elif not (#{predCode}):+        (#{vError})('', #{stringLiteral errorMsg})+%{ endforall }+    (#{vOutput}) = #{intermOutput}['rv']+    |]++compileDeserializer'+    :: BoundModule Python -- | The compilation context.+    -> TypeExpression -- | Determines how it interprets an input.+    -> Code -- | A Python expression of an input.+    -> Code -- | A Python expression to store an output.+    -> Code -- | A Python expression of a function to store a possible error.+    -> CodeGen Markup -- | A Python code that deserializes an input.++compileDeserializer' mod' (OptionModifier typeExpr) vInput vOutput vError = do+    deserializer <- compileDeserializer mod' typeExpr vInput vOutput vError+    return [compileText|+if (#{vInput}) is None:+    (#{vOutput}) = None+else:+#{indent "    " deserializer}+    |]++compileDeserializer' mod' (SetModifier typeExpr) vInput vOutput vError = do+    let elInput = mangleVar vInput "element"+        elIndex = mangleVar vInput "index"+        elOutput = mangleVar vOutput "element"+        elError = mangleVar vError "element"+        elErrorFlag = mangleVar vError "errored"+    builtins <- importBuiltins+    baseString <- baseStringClass+    mAbc <- collectionsAbc+    deserializer <- compileDeserializer mod' typeExpr elInput elOutput elError+    return [compileText|+if (#{builtins}.isinstance(#{vInput}, #{mAbc}.Sequence) and+    not #{builtins}.isinstance(#{vInput}, #{baseString})):+    (#{vOutput}) = #{builtins}.set()+    #{elErrorFlag} = [False]+    def #{elError}(err_field, err_msg):+        #{elErrorFlag}[0] = True+        #{vError}(+            '[{0}]{1}'.format(#{elIndex}, err_field), err_msg+        )+    for #{elIndex}, #{elInput} in #{builtins}.enumerate(#{vInput}):+        #{elErrorFlag}[0] = False+#{indent "        " deserializer}+        if not #{elErrorFlag}[0]:+            (#{vOutput}).add(#{elOutput})+    (#{vOutput}) = #{builtins}.frozenset(#{vOutput})+else:+    (#{vError})('', 'Expected an array.')+    |]++compileDeserializer' mod' (ListModifier typeExpr) vInput vOutput vError = do+    let elInput = mangleVar vInput "elem"+        elIndex = mangleVar vInput "idx"+        elOutput = mangleVar vOutput "elem"+        elError = mangleVar vError "elem"+        elErrorFlag = mangleVar vError "flag"+    builtins <- importBuiltins+    mAbc <- collectionsAbc+    baseString <- baseStringClass+    insertThirdPartyImportsA [("nirum.datastructures", [("list_type", "List")])]+    deserializer <- compileDeserializer mod' typeExpr elInput elOutput elError+    return [compileText|+if (#{builtins}.isinstance(#{vInput}, #{mAbc}.Sequence) and+    not #{builtins}.isinstance(#{vInput}, #{baseString})):+    (#{vOutput}) = []+    #{elErrorFlag} = [False]+    def #{elError}(err_field, err_msg):+        #{elErrorFlag}[0] = True+        #{vError}(+            '[{0}]{1}'.format(#{elIndex}, err_field), err_msg+        )+    for #{elIndex}, #{elInput} in #{builtins}.enumerate(#{vInput}):+        #{elErrorFlag}[0] = False+#{indent "        " deserializer}+        if not #{elErrorFlag}[0]:+            (#{vOutput}).append(#{elOutput})+    (#{vOutput}) = list_type(#{vOutput})+else:+    (#{vError})(('', 'Expected an array.'))+    |]++compileDeserializer' mod' (MapModifier keyTypeExpr valueTypeExpr)+                     vInput vOutput vError = do+    let pairInput = mangleVar vInput "pair"+        pairIndex = mangleVar vInput "index"+        pairErrored = mangleVar vInput "errored"+        keyInput = mangleVar vInput "key"+        keyOutput = mangleVar vOutput "key"+        keyError = mangleVar vError "key"+        valueInput = mangleVar vInput "value"+        valueOutput = mangleVar vOutput "value"+        valueError = mangleVar vError "value"+    mAbc <- collectionsAbc+    builtins <- importBuiltins+    baseString <- baseStringClass+    insertThirdPartyImportsA [("nirum.datastructures", [("map_type", "Map")])]+    keyDeserializer <- compileDeserializer+        mod' keyTypeExpr keyInput keyOutput keyError+    valueDeserializer <- compileDeserializer+        mod' valueTypeExpr valueInput valueOutput valueError+    return [compileText|+if (#{builtins}.isinstance(#{vInput}, #{mAbc}.Sequence) and+    not #{builtins}.isinstance(#{vInput}, #{baseString})):+    (#{vOutput}) = []+    (#{keyError}) = lambda err_field, err_msg: #{vError}(+        '[{0}].key{1}'.format(#{pairIndex}, err_field),+        err_msg+    )+    (#{valueError}) = lambda err_field, err_msg: #{vError}(+        '[{0}].value{1}'.format(#{pairIndex}, err_field),+        err_msg+    )+    for #{pairIndex}, #{pairInput} in #{builtins}.enumerate(#{vInput}):+        (#{pairErrored}) = False+        if #{builtins}.isinstance(#{pairInput}, #{mAbc}.Mapping):+            try:+                (#{keyInput}) = #{pairInput}['key']+            except KeyError:+                (#{vError})(+                    '[{0}].key'.format(#{pairIndex}), 'Expected to exist.'+                )+                (#{pairErrored}) = True+            else:+#{indent "                " keyDeserializer}+            try:+                (#{valueInput}) = #{pairInput}['value']+            except KeyError:+                (#{vError})(+                    '[{0}].value'.format(#{pairIndex}), 'Expected to exist.'+                )+                (#{pairErrored}) = True+            else:+#{indent "                " valueDeserializer}+            if not #{pairErrored}:+                (#{vOutput}).append((#{keyOutput}, #{valueOutput}))+        else:+            (#{vError})(+                '[{0}]'.format(#{pairIndex}),+                'Expected an object which has the fields "key" and "value".'+            )+    (#{vOutput}) = map_type(#{vOutput})+else:+    (#{vError})('', 'Expected an array of objects.')+    |]++compileDeserializer' mod' (TypeIdentifier typeId) vInput vOutput vError = do+    builtins <- importBuiltins+    case lookupType typeId mod' of+        Missing -> return [compileText|raise #{builtins}.RuntimeError(+            "This must never happen; it is likely to be a Nirum compiler's bug."+        )|]+        Local (Alias t) -> compileDeserializer mod' t vInput vOutput vError+        Imported modulePath' _ (Alias t) ->+            case resolveBoundModule modulePath' (boundPackage mod') of+                Nothing -> return [compileText|raise #{builtins}.RuntimeError(+                    "This must never happen; "+                    "it is likely to be a Nirum compiler's bug."+                )|]+                Just foundMod ->+                    compileDeserializer foundMod t vInput vOutput vError+        Local PrimitiveType { primitiveTypeIdentifier = p } ->+            compilePrimitiveTypeDeserializer p vInput vOutput vError+        Imported _ _ PrimitiveType { primitiveTypeIdentifier = p } ->+            compilePrimitiveTypeDeserializer p vInput vOutput vError+        Local EnumType {} -> deserializerCall Nothing typeId+        Imported m srcTypeId EnumType {} -> deserializerCall (Just m) srcTypeId+        Local RecordType {} -> deserializerCall Nothing typeId+        Imported m srcTypId RecordType {} -> deserializerCall (Just m) srcTypId+        Local UnboxedType {} -> deserializerCall Nothing typeId+        Imported m srcTypId UnboxedType {} -> deserializerCall (Just m) srcTypId+        Local UnionType {} -> deserializerCall Nothing typeId+        Imported m srcTypeId UnionType {} -> deserializerCall (Just m) srcTypeId+  where+    target' :: Python+    target' = packageTarget $ boundPackage mod'+    deserializerCall :: Maybe ModulePath -> Identifier -> CodeGen Markup+    deserializerCall m sourceTypeId = do+        case m of+            Just mp -> insertThirdPartyImportsA+                [ ( toImportPath target' mp+                  , [(toClassName typeId, toClassName sourceTypeId)]+                  )+                ]+            Nothing -> return ()+        return [compileText|+#{vOutput} = #{toClassName typeId}.__nirum_deserialize__(+    #{vInput},+    on_error=(#{vError})+)+        |]++compilePrimitiveTypeDeserializer :: PrimitiveTypeIdentifier+                                 -> Code+                                 -> Code+                                 -> Code+                                 -> CodeGen Markup++compilePrimitiveTypeDeserializer Bigint vInput vOutput vError = do+    builtins <- importBuiltins+    baseInteger <- baseIntegerClass+    baseString <- baseStringClass+    return [compileText|+if #{builtins}.isinstance(#{vInput}, #{baseString}):+    try:+        #{vOutput} = #{builtins}.int(#{vInput})+    except ValueError:+        #{vError}(+            '',+            'Expected a string of decimal digits, '+            'but the string consists of other than decimal digits.'+        )+elif #{builtins}.isinstance(#{vInput}, #{baseInteger}):+    #{vOutput} = #{vInput}+else:+    #{vError}(+        '',+        'Expected a string of decimal digits, '+        'but the given value is not a string.'+    )+    |]++compilePrimitiveTypeDeserializer Decimal vInput vOutput vError = do+    builtins <- importBuiltins+    decimal <- importStandardLibrary "decimal"+    baseString <- baseStringClass+    return [compileText|+if #{builtins}.isinstance(#{vInput}, #{baseString}):+    try:+        #{vOutput} = #{decimal}.Decimal(#{vInput})+    except #{builtins}.ValueError:+        #{vError}(+            '', 'Expected a numeric string, but the string is not numeric.'+        )+else:+    #{vError}(+        '', 'Expected a numeric string, but the given value is not a string.'+    )+    |]++compilePrimitiveTypeDeserializer Int32 vInput vOutput vError = do+    baseInteger <- baseIntegerClass+    builtins <- importBuiltins+    baseString <- baseStringClass+    return [compileText|+if #{builtins}.isinstance(#{vInput}, #{baseInteger}):+    #{vOutput} = #{vInput}+elif #{builtins}.isinstance(#{vInput}, #{builtins}.float):+    #{vOutput} = #{builtins}.int(#{vInput})+    if #{vOutput} != (#{vInput}):+        #{vError}(+            '',+            'Expected an integral number, the given number is not integral.'+        )+elif #{builtins}.isinstance(#{vInput}, #{baseString}):+    try:+        #{vOutput} = #{builtins}.int(#{vInput})+    except #{builtins}.ValueError:+        #{vError}(+            '', 'Expected an integral number or a string of decimal digits.'+        )+else:+    #{vError}(+        '',+        'Expected an integral number, but the given value is not a number.'+    )+    |]++compilePrimitiveTypeDeserializer Int64 vInput vOutput vError =+    compilePrimitiveTypeDeserializer Int32 vInput vOutput vError++compilePrimitiveTypeDeserializer Float32 vInput vOutput vError = do+    builtins <- importBuiltins+    baseString <- baseStringClass+    baseInteger <- baseIntegerClass+    return [compileText|+if #{builtins}.isinstance(#{vInput}, #{builtins}.float):+    #{vOutput} = #{vInput}+elif (#{builtins}.isinstance(#{vInput}, #{baseString}) or+      #{builtins}.isinstance(#{vInput}, #{baseInteger})):+    try:+        #{vOutput} = #{builtins}.int(#{vInput})+    except #{builtins}.ValueError:+        #{vError}(+            '',+            'Expected a floating-point number or its string representation.'+        )+else:+    #{vError}(+        '',+        'Expected a floating-point number, '+        'but the given value is not a number.'+    )+    |]++compilePrimitiveTypeDeserializer Float64 vInput vOutput vError =+    compilePrimitiveTypeDeserializer Float32 vInput vOutput vError++compilePrimitiveTypeDeserializer Text vInput vOutput vError = do+    builtins <- importBuiltins+    pyVer <- getPythonVersion+    case pyVer of+        Python3 -> return [compileText|+if #{builtins}.isinstance(#{vInput}, #{builtins}.str):+    #{vOutput} = #{vInput}+else:+    #{vError}('', 'Expected a string.')+        |]+        Python2 -> return [compileText|+if #{builtins}.isinstance(#{vInput}, #{builtins}.unicode):+    #{vOutput} = #{vInput}+elif #{builtins}.isinstance(#{vInput}, str):+    try:+        #{vOutput} = (#{vInput}).decode('utf-8')+    except #{builtins}.UnicodeDecodeError:+        try:+            #{vOutput} = unicode(#{vInput})+        except #{builtins}.UnicodeDecodeError:+            #{vError}('', 'Expected a Unicode string.')+else:+    #{vError}('', 'Expected a string.')+        |]++compilePrimitiveTypeDeserializer Binary vInput vOutput vError = do+    builtins <- importBuiltins+    base64 <- importStandardLibrary "base64"+    baseString <- baseStringClass+    return [compileText|+if #{builtins}.isinstance(#{vInput}, #{baseString}):+    try:+        #{vOutput} = #{base64}.b64decode(#{vInput})+    except #{builtins}.ValueError:+        #{vError}(+            '',+            'Expected a base64-encoded string, '+            'but the string is not properly base64-encoded.'+        )+else:+    #{vError}(+        '',+        'Expected a base64-encoded string, but the given value is not a string'+    )+    |]++compilePrimitiveTypeDeserializer Date vInput vOutput vError = do+    builtins <- importBuiltins+    datetime <- importStandardLibrary "datetime"+    re <- importStandardLibrary "re"+    let vMatch = mangleVar vInput "match"+    baseString <- baseStringClass+    wrapScope vInput vOutput vError $ \ in' _ err -> return [compileText|+if not #{builtins}.isinstance(#{in'}, #{baseString}):+    #{err}(+        '',+        'Expected a string of RFC 3339 date, '+        'but the given value is not a string.'+    )+#{vMatch} = #{re}.match(r'^(\d{4})-(\d\d)-(\d\d)$', #{in'})+if not #{vMatch}:+    #{err}(+        '',+        'Expected a string of RFC 3339 date, '+        'but the string is not a valid RFC 3339 date format.'+    )+try:+    return #{datetime}.date(+        #{builtins}.int(#{vMatch}.group(1)),+        #{builtins}.int(#{vMatch}.group(2)),+        #{builtins}.int(#{vMatch}.group(3)),+    )+except #{builtins}.ValueError:+    #{err}(+        '',+        'Expected a string of RFC 3339 date, but the date is invalid.'+    )+    |]++compilePrimitiveTypeDeserializer Datetime vInput vOutput vError = do+    builtins <- importBuiltins+    datetime <- importStandardLibrary "datetime"+    pyVer <- getPythonVersion+    case pyVer of+        Python3 -> do+            re <- importStandardLibrary "re"+            let vMatch = mangleVar vInput "match"+                vTz = mangleVar vInput "tz"+            wrapScope vInput vOutput vError $ \ in' _ err ->+                return [compileText|+if not #{builtins}.isinstance(#{in'}, #{builtins}.str):+    #{err}(+        '',+        'Expected a string of RFC 3339 date & time, '+        'but the given value is not a string.'+    )+#{vMatch} = #{re}.match(+    r'^(\d{4})-(\d\d)-(\d\d)T(\d\d):(\d\d):(\d\d)'+    r'(?:\.(\d*))?'+    r'(Z|([+-])(\d\d):?(\d\d))$',+    #{in'}+)+if not #{vMatch}:+    #{err}(+        '',+        'Expected a string of RFC 3339 date & time, '+        'but the string is not a valid RFC 3339 date & time format.'+    )+try:+    if #{vMatch}.group(8) == 'Z':+        #{vTz} = #{datetime}.timezone.utc+    else:+        #{vTz} = #{datetime}.timezone(+            #{datetime}.timedelta(+                hours=#{builtins}.int(#{vMatch}.group(10)),+                minutes=#{builtins}.int(#{vMatch}.group(11))+            )+        )+        if #{vMatch}.group(9) == '-':+            #{vTz} = -#{vTz}+    return #{datetime}.datetime(+        #{builtins}.int(#{vMatch}.group(1)),+        #{builtins}.int(#{vMatch}.group(2)),+        #{builtins}.int(#{vMatch}.group(3)),+        #{builtins}.int(#{vMatch}.group(4)),+        #{builtins}.int(#{vMatch}.group(5)),+        #{builtins}.int(#{vMatch}.group(6)),+        #{builtins}.int((#{vMatch}.group(7) or '0')[:6].zfill(6)),+        tzinfo=#{vTz}+    )+except #{builtins}.ValueError:+    #{err}(+        '',+        'Expected a string of RFC 3339 date & time, '+        'but the date & time is invalid.'+    )+                |]+        Python2 -> do+            addOptionalDependency (3, 0) "iso8601"+            insertThirdPartyImportsA+                [("iso8601", [("_parse_iso8601", "parse_date")])]+            insertThirdPartyImportsA+                [("iso8601.iso8601", [("_iso8601_parse_error", "ParseError")])]+            let vException = mangleVar vError "exc"+            wrapScope vInput vOutput vError $ \ in' _ err ->+                return [compileText|+if not #{builtins}.isinstance(#{in'}, #{builtins}.basestring):+    #{err}(+        '',+        'Expected a string of RFC 3339 date & time, '+        'but the given value is not a string.'+    )+try:+    return _parse_iso8601(#{in'})+except _iso8601_parse_error as #{vException}:+    if #{builtins}.str(#{vException}).startswith('Unable to parse'):+        #{err}(+            '',+            'Expected a string of RFC 3339 date & time, '+            'but the string is not a valid RFC 3339 date & time format.'+        )+    else:+        #{err}(+            '',+            'Expected a string of RFC 3339 date & time, '+            'but the date & time is invalid.'+        )+                |]++compilePrimitiveTypeDeserializer Bool vInput vOutput vError = do+    builtins <- importBuiltins+    return [compileText|+if #{builtins}.isinstance(#{vInput}, #{builtins}.bool):+    #{vOutput} = #{vInput}+else:+    #{vError}('', 'Expected a boolean value; true or false.')+    |]++compilePrimitiveTypeDeserializer Uuid vInput vOutput vError =+    wrapScope vInput vOutput vError $ \ in' _ err -> do+        builtins <- importBuiltins+        uuid <- importStandardLibrary "uuid"+        baseString <- baseStringClass+        return [compileText|+if not #{builtins}.isinstance(#{in'}, #{baseString}):+    #{err}(+        '', 'Expected a string of UUID, but the given value is not a string.'+    )+try:+    return #{uuid}.UUID(#{in'})+except #{builtins}.ValueError:+    #{err}(+        '',+        'Expected a string of UUID, '+        'but the string is not a valid hexadecimal UUID format.'+    )+        |]++compilePrimitiveTypeDeserializer Url vInput vOutput vError =+    compilePrimitiveTypeDeserializer Text vInput vOutput vError++-- | Wrap a Python deserializer code block into an isolated scope.+--+-- Without this function, a deserializer code cannot @return@ or @raise@,+-- because it is embeded in the middle of other Python code which shares+-- the flow.  It it controls its flow using @return@ or @raise@ the other+-- code that embeds it also can be terminated together.+--+-- That means a deserializer code should not be like:+--+-- @+--     if not condition_1:+--         #{vError}('', 'It should satisfy the condition_1.')+--     elif not condition_2:+--         #{vError}('', 'It should satisfy the condition_2.')+--     if mode:+--         try:+--             return result()+--         except ValueError:+--             #{vError}('', 'A value is invalid')+--     return result2()+-- @+--+-- but instead be:+--+-- @+--     if condition_1:+--         if not condition_2:+--             if mode:+--                 try:+--                     #{vOutput} = result()+--                 except ValueError:+--                     #{vError}('', 'A value is invalid')+--              else:+--                  #{vOutput} = result2()+--         else:+--             #{vError}('', 'It should satisfy the condition_2.')+--     else:+--         #{vError}('', 'It should satisfy the condition_1.')+-- @+--+-- which is too much indented and using assignig a result to the output+-- variable instead of just returning it.  It is fragile and bug-prone since+-- we can use @return@ or @raise@ by mistake.+--+-- The 'wrapScope' function offers an isolated flow, i.e., a function scope.+-- With this, returning a value is equivalent to assigning it to the output+-- variable, and raising an exception is calling an error function.+wrapScope :: Code -> Code -> Code+          -> (Code -> Code -> Code -> CodeGen Markup)+          -> CodeGen Markup+wrapScope vInput vOutput vError callback = do+    let f = mangleVar vInput "scoped_func"+    let exc = mangleVar vError "exc"+    let scopedInput = mangleVar vInput "scoped"+    let scopedOutput = mangleVar vOutput "scoped"+    let scopedError = mangleVar vError "scoped"+    builtins <- importBuiltins+    scopedCode <- callback scopedInput scopedOutput scopedError+    return [compileText|+def #{f}(#{scopedInput}):+    def #{scopedError}(err_field, err_msg):+        raise ValueError(err_field, err_msg)+    #{indent "    " scopedCode}+    return #{scopedOutput}+try:+    #{vOutput} = #{f}(#{vInput})+except #{builtins}.ValueError as #{exc}:+    if #{builtins}.len(#{exc}.args) == 2:+        #{vError}(*#{exc}.args)+    else:+        raise+|]
+ src/Nirum/Targets/Python/Serializers.hs view
@@ -0,0 +1,83 @@+{-# LANGUAGE QuasiQuotes #-}+module Nirum.Targets.Python.Serializers (compileSerializer) where++import Data.Text (replace)+import Text.InterpolatedString.Perl6 (q, qq)++import Nirum.Constructs.TypeDeclaration+import Nirum.Constructs.TypeExpression+import {-# SOURCE #-} Nirum.Targets.Python ()+import Nirum.Targets.Python.CodeGen+import Nirum.TypeInstance.BoundModule++compileSerializer :: BoundModule Python -> TypeExpression -> Code -> Code+compileSerializer mod' (OptionModifier typeExpr) pythonVar =+    [qq|(None if ($pythonVar) is None+              else ({compileSerializer mod' typeExpr pythonVar}))|]+compileSerializer mod' (SetModifier typeExpr) pythonVar =+    compileSerializer mod' (ListModifier typeExpr) pythonVar+compileSerializer mod' (ListModifier typeExpr) pythonVar =+    [qq|list(($serializer) for $elemVar in ($pythonVar))|]+  where+    elemVar :: Code+    elemVar = mangleVar pythonVar "elem"+    serializer :: Code+    serializer = compileSerializer mod' typeExpr elemVar+compileSerializer mod' (MapModifier kt vt) pythonVar =+    [qq|list(+        \{+            'key': ({compileSerializer mod' kt kVar}),+            'value': ({compileSerializer mod' vt vVar}),+        \}+        for $kVar, $vVar in ($pythonVar).items()+    )|]+  where+    kVar :: Code+    kVar = mangleVar pythonVar "key"+    vVar :: Code+    vVar = mangleVar pythonVar "value"+compileSerializer mod' (TypeIdentifier typeId) pythonVar =+    case lookupType typeId mod' of+        Missing -> "None"  -- must never happen+        Local (Alias t) -> compileSerializer mod' t pythonVar+        Imported modulePath' _ (Alias t) ->+            case resolveBoundModule modulePath' (boundPackage mod') of+                Nothing -> "None"  -- must never happen+                Just foundMod -> compileSerializer foundMod t pythonVar+        Local PrimitiveType { primitiveTypeIdentifier = p } ->+            compilePrimitiveTypeSerializer p pythonVar+        Imported _ _ PrimitiveType { primitiveTypeIdentifier = p } ->+            compilePrimitiveTypeSerializer p pythonVar+        Local EnumType {} -> serializerCall+        Imported _ _ EnumType {} -> serializerCall+        Local RecordType {} -> serializerCall+        Imported _ _ RecordType {} -> serializerCall+        Local UnboxedType {} -> serializerCall+        Imported _ _ UnboxedType {} -> serializerCall+        Local UnionType {} -> serializerCall+        Imported _ _ UnionType {} -> serializerCall+  where+    serializerCall :: Code+    serializerCall = [qq|$pythonVar.__nirum_serialize__()|]++compilePrimitiveTypeSerializer :: PrimitiveTypeIdentifier -> Code -> Code+compilePrimitiveTypeSerializer Bigint var = var+compilePrimitiveTypeSerializer Decimal var = [qq|str($var)|]+compilePrimitiveTypeSerializer Int32 var = var+compilePrimitiveTypeSerializer Int64 var = var+compilePrimitiveTypeSerializer Float32 var = var+compilePrimitiveTypeSerializer Float64 var = var+compilePrimitiveTypeSerializer Text var = var+compilePrimitiveTypeSerializer Binary var =+    [qq|__import__('base64').b64encode($var).decode('ascii')|]+compilePrimitiveTypeSerializer Date var = [qq|($var).isoformat()|]+compilePrimitiveTypeSerializer Datetime var = replace "$var" var [q|(+    '{0}-{1:02}-{2:02}T{3:02}:{4:02}:{5:02}'.format(+        *($var).utctimetuple()+    ) ++    ('.{0:06}'.format(($var).microsecond) if ($var).microsecond else '') ++    'Z'+)|]+compilePrimitiveTypeSerializer Bool var = var+compilePrimitiveTypeSerializer Uuid var = [qq|str($var).lower()|]+compilePrimitiveTypeSerializer Url var = var
+ src/Nirum/Targets/Python/TypeExpression.hs view
@@ -0,0 +1,91 @@+{-# LANGUAGE OverloadedLists #-}+{-# LANGUAGE QuasiQuotes #-}+module Nirum.Targets.Python.TypeExpression+    ( compileTypeExpression+    , compilePrimitiveType+    ) where++import Data.Text+import Text.InterpolatedString.Perl6 (qq)++import Nirum.Constructs.Identifier+import Nirum.Constructs.TypeDeclaration+import Nirum.Constructs.TypeExpression+import Nirum.Package.Metadata+import {-# SOURCE #-} Nirum.Targets.Python ()+import Nirum.Targets.Python.CodeGen+import Nirum.TypeInstance.BoundModule++compileTypeExpression :: BoundModule Python+                      -> Maybe TypeExpression+                      -> CodeGen Code+compileTypeExpression mod' (Just (TypeIdentifier i)) =+    case lookupType i mod' of+        Missing -> fail $ "undefined identifier: " ++ toString i+        Imported _ _ (PrimitiveType p _) -> compilePrimitiveType p+        Imported m in' _ -> do+            insertThirdPartyImportsA [ ( toImportPath target' m+                                       , [(toClassName i, toClassName in')]+                                       )+                                     ]+            return $ toClassName i+        Local _ -> return $ toClassName i+  where+    target' :: Python+    target' = target $ metadata $ boundPackage mod'+compileTypeExpression mod' (Just (MapModifier k v)) = do+    kExpr <- compileTypeExpression mod' (Just k)+    vExpr <- compileTypeExpression mod' (Just v)+    typing <- importStandardLibrary "typing"+    return [qq|$typing.Mapping[$kExpr, $vExpr]|]+compileTypeExpression mod' (Just modifier) = do+    expr <- compileTypeExpression mod' (Just typeExpr)+    typing <- importStandardLibrary "typing"+    return [qq|$typing.$className[$expr]|]+  where+    typeExpr :: TypeExpression+    className :: Text+    (typeExpr, className) = case modifier of+        OptionModifier t' -> (t', "Optional")+        SetModifier t' -> (t', "AbstractSet")+        ListModifier t' -> (t', "Sequence")+        TypeIdentifier _ -> undefined  -- never happen!+        MapModifier _ _ -> undefined  -- never happen!+compileTypeExpression _ Nothing =+    return "None"++compilePrimitiveType :: PrimitiveTypeIdentifier -> CodeGen Code+compilePrimitiveType primitiveTypeIdentifier' = do+    pyVer <- getPythonVersion+    case (primitiveTypeIdentifier', pyVer) of+        (Bool, _) -> builtins "bool"+        (Bigint, Python2) -> do+            numbers <- importStandardLibrary "numbers"+            return [qq|$numbers.Integral|]+        (Bigint, Python3) -> builtins "int"+        (Decimal, _) -> do+            decimal <- importStandardLibrary "decimal"+            return [qq|$decimal.Decimal|]+        (Int32, _) -> compilePrimitiveType Bigint+        (Int64, _) -> compilePrimitiveType Bigint+        (Float32, _) -> builtins "float"+        (Float64, _) -> builtins "float"+        (Text, Python2) -> builtins "unicode"+        (Text, Python3) -> builtins "str"+        (Binary, _) -> builtins "bytes"+        (Date, _) -> do+            datetime <- importStandardLibrary "datetime"+            return [qq|$datetime.date|]+        (Datetime, _) -> do+            datetime <- importStandardLibrary "datetime"+            return [qq|$datetime.datetime|]+        (Uuid, _) -> do+            uuid <- importStandardLibrary "uuid"+            return [qq|$uuid.UUID|]+        (Url, Python2) -> builtins "basestring"+        (Url, Python3) -> builtins "str"+  where+    builtins :: Code -> CodeGen Code+    builtins typename' = do+        builtinsMod <- importBuiltins+        return [qq|$builtinsMod.$typename'|]
+ src/Nirum/Targets/Python/Validators.hs view
@@ -0,0 +1,149 @@+{-# LANGUAGE QuasiQuotes #-}+module Nirum.Targets.Python.Validators+    ( Validator (..)+    , ValueValidator (..)+    , compilePrimitiveTypeValidator+    , compileValidator+    ) where++import Data.Text (Text, intercalate)+import Text.InterpolatedString.Perl6 (qq)++import Nirum.Constructs.Identifier+import Nirum.Constructs.TypeDeclaration+import Nirum.Constructs.TypeExpression+import {-# SOURCE #-} Nirum.Targets.Python ()+import Nirum.Targets.Python.CodeGen+import Nirum.Targets.Python.TypeExpression+import Nirum.TypeInstance.BoundModule++data Validator = Validator+    { typePredicateCode :: Code+    , valueValidators :: [ValueValidator]+    } deriving (Eq, Show)++data ValueValidator = ValueValidator+    { predicateCode :: Code+    , errorMessage :: Text+    } deriving (Eq, Show)++compileValidator :: BoundModule Python+                 -> TypeExpression+                 -> Code+                 -> CodeGen Validator+compileValidator mod' (OptionModifier typeExpr) pythonVar = do+    Validator typePred vvs <- compileValidator mod' typeExpr pythonVar+    let typeValidator = [qq|(($pythonVar) is None or $typePred)|]+        valueValidators' =+            [ ValueValidator [qq|(($pythonVar) is None or ($vPredCode))|] msg+            | ValueValidator vPredCode msg <- vvs+            ]+    return $ Validator typeValidator valueValidators'+compileValidator mod' (SetModifier typeExpr) pythonVar = do+    abc <- collectionsAbc+    builtins <- importBuiltins+    Validator typePred vvs <-+        multiplexValidators mod' pythonVar [(typeExpr, "elem")]+    return $ Validator+        [qq|($builtins.isinstance($pythonVar, $abc.Set) and $typePred)|]+        vvs+compileValidator mod' (ListModifier typeExpr) pythonVar = do+    builtins <- importBuiltins+    abc <- collectionsAbc+    Validator typePred vvs <-+        multiplexValidators mod' pythonVar [(typeExpr, "item")]+    return $ Validator+        [qq|($builtins.isinstance($pythonVar, $abc.Sequence) and $typePred)|]+        vvs+compileValidator mod' (MapModifier keyTypeExpr valueTypeExpr) pythonVar = do+    abc <- collectionsAbc+    Validator typePred vvs <-+        multiplexValidators mod' [qq|(($pythonVar).items())|]+        [(keyTypeExpr, "key"), (valueTypeExpr, "value")]+    builtins <- importBuiltins+    return $ Validator+        [qq|($builtins.isinstance($pythonVar, $abc.Mapping) and $typePred)|]+        vvs+compileValidator mod' (TypeIdentifier typeId) pythonVar =+    case lookupType typeId mod' of+        Missing -> return $ Validator "False" []  -- must never happen+        Local (Alias typeExpr') -> compileValidator mod' typeExpr' pythonVar+        Imported modulePath' _ (Alias typeExpr') ->+            case resolveBoundModule modulePath' (boundPackage mod') of+                Nothing -> return $ Validator "False" []  -- must never happen+                Just foundMod -> compileValidator foundMod typeExpr' pythonVar+        Local PrimitiveType { primitiveTypeIdentifier = pId } ->+            compilePrimitiveTypeValidator pId pythonVar+        Imported _ _ PrimitiveType { primitiveTypeIdentifier = pId } ->+            compilePrimitiveTypeValidator pId pythonVar+        _ ->+            compileInstanceValidator mod' typeId pythonVar++compilePrimitiveTypeValidator :: PrimitiveTypeIdentifier+                              -> Code+                              -> CodeGen Validator+compilePrimitiveTypeValidator primitiveTypeId pythonVar = do+    builtins <- importBuiltins+    typeName <- compilePrimitiveType primitiveTypeId+    return $ Validator+        [qq|($builtins.isinstance(($pythonVar), ($typeName)))|]+        (vv primitiveTypeId pythonVar)+  where+    vv :: PrimitiveTypeIdentifier -> Code -> [ValueValidator]+    vv Int32 var =+        [ ValueValidator [qq|(-0x80000000 <= ($var) < 0x80000000)|]+                         "out of range of 32-bit integer"+        ]+    vv Int64 var =+        [ ValueValidator+              [qq|(-0x8000000000000000 <= ($var) < 0x8000000000000000)|]+              "out of range of 64-bit integer"+        ]+    vv Datetime var =+        [ ValueValidator [qq|(($var).tzinfo is not None)|]+                         "naive datetime (lacking tzinfo)"+        ]+    vv Url var =+        [ ValueValidator [qq|('\\n' not in ($var))|]+                         "URL cannot contain new line characters"+        ]+    vv _ _ = []++compileInstanceValidator :: BoundModule Python+                         -> Identifier+                         -> Code+                         -> CodeGen Validator+compileInstanceValidator mod' typeId pythonVar = do+    builtins <- importBuiltins+    cls <- compileTypeExpression mod' (Just (TypeIdentifier typeId))+    return $ Validator [qq|($builtins.isinstance(($pythonVar), ($cls)))|] []++multiplexValidators :: BoundModule Python+                    -> Code+                    -> [(TypeExpression, Code)]+                    -> CodeGen Validator+multiplexValidators mod' iterableExpr elements = do+    builtins <- importBuiltins+    validators <- sequence+        [ do+              v <- compileValidator mod' tExpr elemVar+              return (elemVar, v)+        | (tExpr, var) <- elements+        , elemVar <- [mangleVar iterableExpr var]+        ]+    let csElemVars = intercalate "," [v | (v, _) <- validators]+        typePredLogicalAnds = intercalate+            " and "+            [typePred | (_, Validator typePred _) <- validators]+    return $ Validator+        [qq|($builtins.all(+            ($typePredLogicalAnds) for ($csElemVars) in $iterableExpr)+        )|]+        [ ValueValidator+              [qq|($builtins.all(+                  ($typePred) for ($csElemVars) in $iterableExpr)+              )|]+              [qq|invalid elements ($msg)|]+        | (_, Validator _ vvs) <- validators+        , ValueValidator typePred msg <- vvs+        ]
src/Nirum/TypeInstance/BoundModule.hs view
@@ -47,25 +47,28 @@  data TypeLookup = Missing                 | Local Type-                | Imported ModulePath Type+                | Imported ModulePath Identifier Type                 deriving (Eq, Ord, Show)  lookupType :: Target t => Identifier -> BoundModule t -> TypeLookup lookupType identifier boundModule =     case DS.lookup identifier (boundTypes boundModule) of-        Nothing -> toType coreModulePath-            (DS.lookup identifier $ types coreModule)+        Nothing ->+            toType+                coreModulePath+                identifier+                (DS.lookup identifier $ types coreModule)         Just TypeDeclaration { type' = t } -> Local t-        Just (Import path' _ _) ->+        Just (Import path' _ s _) ->             case resolveModule path' (boundPackage boundModule) of                 Nothing -> Missing                 Just (Module decls _) ->-                    toType path' (DS.lookup identifier decls)+                    toType path' s (DS.lookup s decls)         Just ServiceDeclaration {} -> Missing   where-    toType :: ModulePath -> Maybe TypeDeclaration -> TypeLookup-    toType mp (Just TypeDeclaration { type' = t }) = Imported mp t-    toType _ _ = Missing+    toType :: ModulePath -> Identifier -> Maybe TypeDeclaration -> TypeLookup+    toType mp i (Just TypeDeclaration { type' = t }) = Imported mp i t+    toType _ _ _ = Missing  instance Target t => Documented (BoundModule t) where     docs = findInBoundModule Nirum.Constructs.Module.docs Nothing
− test/HLint.hs
@@ -1,12 +0,0 @@-import Language.Haskell.HLint (hlint)-import System.Exit (exitFailure, exitSuccess)--arguments :: [String]-arguments = ["src", "test"]--main :: IO ()-main = do-    hlints <- hlint arguments-    case hlints of-        [] -> exitSuccess-        _ -> exitFailure
+ test/Main.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-meta-discover #-}
test/Nirum/CodeBuilderSpec.hs view
@@ -79,9 +79,9 @@             let run' = fst . runBuilder package ["fruits"] ()             let core = ModuleName "core"             run' (lookupType "text") `shouldBe`-                Imported core (TD.PrimitiveType TD.Text TD.String)+                Imported core "text" (TD.PrimitiveType TD.Text TD.String)             run' (lookupType "int32") `shouldBe`-                Imported core (TD.PrimitiveType TD.Int32 TD.Number)+                Imported core "int32" (TD.PrimitiveType TD.Int32 TD.Number)   data DummyTarget = DummyTarget deriving (Eq, Ord, Show)
test/Nirum/Constructs/AnnotationSpec.hs view
@@ -7,14 +7,15 @@ import qualified Data.Map.Strict as M  import Nirum.Constructs.Annotation as A-import Nirum.Constructs.Annotation.Internal ( AnnotationSet (AnnotationSet) )+import Nirum.Constructs.Annotation.Internal  spec :: Spec spec = do     let annotation = Annotation "foo" M.empty-        loremAnno = Annotation "lorem" [("arg", "ipsum")]-        escapeCharAnno = Annotation "quote" [("arg", "\"")]-        longNameAnno = Annotation "long-cat-is-long" [("long", "nyancat")]+        loremAnno = Annotation "lorem" [("arg", Text "ipsum")]+        escapeCharAnno = Annotation "quote" [("arg", Text "\"")]+        longNameAnno =+            Annotation "long-cat-is-long" [("long", Text "nyancat")]         docsAnno = docs "Description"     describe "Annotation" $ do         describe "toCode Annotation" $@@ -24,15 +25,15 @@                 toCode escapeCharAnno `shouldBe` "@quote(arg = \"\\\"\")"         specify "docs" $             docsAnno `shouldBe`-                Annotation "docs" [("docs", "Description\n")]+                Annotation "docs" [("docs", Text "Description\n")]     describe "AnnotationSet" $ do         specify "empty" $             empty `shouldSatisfy` null         specify "singleton" $ do             singleton (Annotation "foo" []) `shouldBe`                 AnnotationSet [("foo", [])]-            singleton (Annotation "bar" [("arg", "baz")]) `shouldBe`-                AnnotationSet [("bar", [("arg", "baz")])]+            singleton (Annotation "bar" [("arg", Text "baz")]) `shouldBe`+                AnnotationSet [("bar", [("arg", Text "baz")])]         describe "fromList" $ do             it "success" $ do                 let Right empty' = fromList []@@ -49,12 +50,12 @@         specify "union" $ do             let Right a = fromList [annotation, loremAnno]             let Right b = fromList [docsAnno, escapeCharAnno]-            let c = AnnotationSet [("foo", [("arg", "bar")])]+            let c = AnnotationSet [("foo", [("arg", Text "bar")])]             A.union a b `shouldBe`                 AnnotationSet [ ("foo", [])-                              , ("lorem", [("arg", "ipsum")])-                              , ("quote", [("arg", "\"")])-                              , ("docs", [("docs", "Description\n")])+                              , ("lorem", [("arg", Text "ipsum")])+                              , ("quote", [("arg", Text "\"")])+                              , ("docs", [("docs", Text "Description\n")])                               ]             A.union a c `shouldBe` a         let Right annotationSet = fromList [ annotation@@ -85,6 +86,6 @@         describe "insertDocs" $ do             it "should insert the doc comment as an annotation" $                 A.insertDocs "yay" empty `shouldReturn`-                    AnnotationSet [("docs", [("docs", "yay\n")])]+                    AnnotationSet [("docs", [("docs", Text "yay\n")])]             it "should fail on the annotation that already have a doc" $                 A.insertDocs "yay" annotationSet `shouldThrow` anyException
test/Nirum/Constructs/DeclarationSetSpec.hs view
@@ -2,8 +2,10 @@ module Nirum.Constructs.DeclarationSetSpec (SampleDecl (..), spec) where  import Control.Exception.Base (evaluate)+import Data.List (sort) import Data.String (IsString (..)) +import qualified Data.Set as S import Test.Hspec.Meta  import Nirum.Constructs (Construct (..))@@ -12,6 +14,7 @@ import Nirum.Constructs.Declaration (Declaration (..), Documented) import Nirum.Constructs.DeclarationSet ( DeclarationSet                                        , NameDuplication (..)+                                       , delete                                        , empty                                        , fromList                                        , lookup'@@ -21,6 +24,7 @@                                        , union                                        , (!)                                        )+import Nirum.Constructs.Identifier (Identifier) import Nirum.Constructs.Name (Name (Name))  data SampleDecl = SampleDecl Name AnnotationSet deriving (Eq, Ord, Show)@@ -39,6 +43,19 @@  type SampleDeclSet = DeclarationSet SampleDecl +data SampleDecl2 =+    SampleDecl2 Name (S.Set Identifier) AnnotationSet deriving (Eq, Ord, Show)++instance Construct SampleDecl2 where+    toCode _ = "(do not impl)"++instance Documented SampleDecl2++instance Declaration SampleDecl2 where+    name (SampleDecl2 name' _ _) = name'+    extraPublicNames (SampleDecl2 _ otherNames _) = otherNames+    annotations (SampleDecl2 _ _ annotations') = annotations'+ spec :: Spec spec =     describe "DeclarationSet" $ do@@ -63,6 +80,22 @@             it "returns Right DeclarationSet if there are no duplications" $ do                 let Right dset = fl ["foo", "bar", "baz"]                 toList dset `shouldBe` ["foo", "bar", "baz"]+            it "checks extraPublicNames as well" $ do+                let sampleDecl n on = SampleDecl2 n on A.empty+                let decls =+                        [ sampleDecl "foo" ["foo-a", "foo-b"]+                        , sampleDecl (Name "bar" "bar2") ["bar-a", "bar-b"]+                        ]+                let Right a = fromList decls+                sort (toList a) `shouldBe` sort decls+                fromList (sampleDecl "baz" ["foo"] : decls) `shouldBe`+                    Left (FacialNameDuplication "foo")+                fromList (sampleDecl "baz" ["bar"] : decls) `shouldBe`+                    Left (FacialNameDuplication $ Name "bar" "bar2")+                fromList (sampleDecl "baz" ["foo-a"] : decls) `shouldBe`+                    Left (FacialNameDuplication "foo-a")+                fromList [sampleDecl "foo" ["foo"]] `shouldBe`+                    Left (FacialNameDuplication "foo")         let dset = ["foo", "bar", sd "baz" "asdf"] :: SampleDeclSet         context "toList" $             it "returns [Declaration]" $ do@@ -102,3 +135,5 @@             it "returns Left BehindNameDuplication if behind names are dup" $                 union dset [sd "xyz" "foo"] `shouldBe`                     Left (BehindNameDuplication $ Name "xyz" "foo")+        specify "delete" $+            delete "bar" dset `shouldBe` ["foo", sd "baz" "asdf"]
test/Nirum/Constructs/ModuleSpec.hs view
@@ -21,20 +21,27 @@             pathT = TypeDeclaration "path" (Alias "text") (singleton docsAnno)             offsetT =                 TypeDeclaration "offset" (UnboxedType "float64") empty-            decls = [ Import ["foo", "bar"] "baz" empty-                    , Import ["foo", "bar"] "qux" empty-                    , Import ["zzz"] "qqq" empty-                    , Import ["zzz"] "ppp" empty-                    , Import ["xyz"] "asdf" empty+            decls = [ Import ["foo", "bar"] "baz" "baz" empty+                    , Import ["foo", "bar"] "qux" "qux" empty+                    , Import ["zzz"] "qqq" "qqq" empty+                    , Import ["zzz"] "ppp" "ppp" empty+                    , Import ["xyz"] "asdf" "asdf" empty                     , pathT                     , offsetT                     ] :: DeclarationSet TypeDeclaration+            decls2 = [ Import ["foo", "bar"] "qux" "baz" empty+                     ] :: DeclarationSet TypeDeclaration             mod1 = Module decls Nothing             mod2 = Module decls $ Just "module level docs...\nblahblah"+            mod3 = Module decls2 Nothing         specify "imports" $ do-            imports mod1 `shouldBe` [ (["foo", "bar"], ["baz", "qux"])-                                    , (["xyz"], ["asdf"])-                                    , (["zzz"], ["qqq", "ppp"])+            imports mod1 `shouldBe` [ ( ["foo", "bar"]+                                      , [("baz", "baz"), ("qux", "qux")]+                                      )+                                    , (["xyz"], [("asdf", "asdf")])+                                    , ( ["zzz"]+                                      , [("qqq", "qqq"), ("ppp", "ppp")]+                                      )                                     ]             imports mod2 `shouldBe` imports mod1         specify "toCode" $ do@@ -57,4 +64,8 @@ # path string  unboxed offset (float64);+|]+            toCode mod3 `shouldBe` [q|import foo.bar (baz as qux);++ |]
test/Nirum/Constructs/ServiceSpec.hs view
@@ -6,6 +6,7 @@ import Test.Hspec.Meta  import Nirum.Constructs.Annotation+import Nirum.Constructs.Annotation.Internal import Nirum.Constructs.Docs (toCode) import Nirum.Constructs.Service (Method (Method), Parameter (Parameter)) import Nirum.Constructs.TypeExpression ( TypeExpression ( ListModifier@@ -18,8 +19,8 @@ spec :: Spec spec = do     let methodAnno = singleton $ Annotation "http" $ Map.fromList-            [ ("method", "GET")-            , ("path", "/ping/")+            [ ("method", Text "GET")+            , ("path", Text "/ping/")             ]     let docsAnno = singleDocs "docs..."     describe "Parameter" $
test/Nirum/Constructs/TypeDeclarationSpec.hs view
@@ -7,9 +7,10 @@ import Test.Hspec.Meta  import Nirum.Constructs (Construct (toCode))-import Nirum.Constructs.Annotation hiding (docs, name)+import Nirum.Constructs.Annotation hiding (docs, fromList, name)+import qualified Nirum.Constructs.Annotation.Internal as AI import Nirum.Constructs.Declaration (Declaration (name), docs)-import Nirum.Constructs.DeclarationSet (DeclarationSet)+import Nirum.Constructs.DeclarationSet hiding (empty) import Nirum.Constructs.Service (Method (Method), Service (Service)) import Nirum.Constructs.TypeDeclaration ( EnumMember (EnumMember)                                         , Field (Field)@@ -18,11 +19,12 @@                                         , Tag (Tag)                                         , Type (..)                                         , TypeDeclaration (..)+                                        , unionType                                         ) import Util (singleDocs)  barAnnotationSet :: AnnotationSet-barAnnotationSet = singleton $ Annotation "bar" [("val", "baz")]+barAnnotationSet = singleton $ Annotation "bar" [("val", AI.Text "baz")]  spec :: Spec spec = do@@ -127,7 +129,7 @@                         , Tag "rectangle" rectangleFields empty                         , Tag "none" [] empty                         ]-                union' = UnionType tags'+            let Right union' = unionType tags' Nothing                 a = TypeDeclaration { typename = "shape"                                     , type' = union'                                     , typeAnnotations = empty@@ -184,13 +186,104 @@                     "@bar(val = \"baz\")\nservice anno-service (bool ping ());"                 -- TODO: more tests         context "Import" $ do-            let import' = Import ["foo", "bar"] "baz" empty+            let import' = Import ["foo", "bar"] "baz" "baz" empty+            let importAliasing = Import ["foo", "bar"] "qux" "baz" empty             specify "name" $                 name import' `shouldBe` "baz"             specify "docs" $                 docs import' `shouldBe` Nothing             specify "toCode" $                 toCode import' `shouldBe` "import foo.bar (baz);\n"+            specify "name" $+                name importAliasing `shouldBe` "qux"+            specify "docs" $+                docs importAliasing `shouldBe` Nothing+            specify "toCode" $+                toCode importAliasing `shouldBe`+                    "import foo.bar (baz as qux);\n"++        context "member/tag name shadowing" $ do+            let fromRight either' = head [v | Right v <- [either']]+            let unionType' t a = fromRight $ unionType t a+            let unionFoo = TypeDeclaration+                    { typename = "foo"+                    , type' = unionType'+                          [ Tag "bar" [Field "a" "text" empty] empty+                          , Tag "baz" [Field "b" "text" empty] empty+                          ]+                          Nothing+                    , typeAnnotations = empty+                    }+            let enumQux = TypeDeclaration+                    { typename = "qux"+                    , type' = EnumType+                          [ EnumMember "quux" empty+                          , EnumMember "bar" empty+                          ]+                    , typeAnnotations = empty+                    }+            let unboxedBar = TypeDeclaration "bar" (UnboxedType "text") empty+            specify "a union tag is disallowed to shadow a type name" $ do+                fromList [unionFoo, unboxedBar]+                    `shouldBe` Left (FacialNameDuplication "bar")+                fromList+                    [ TypeDeclaration+                          { typename = "bar"+                          , type' = unionType'+                                [ Tag "foo" [Field "a" "text" empty] empty+                                , Tag "bar" [Field "b" "text" empty] empty+                                ]+                                Nothing+                          , typeAnnotations = empty+                          }+                    ]+                    `shouldBe` Left (FacialNameDuplication "bar")+            specify "an enum member is disallowed to shadow a type name" $ do+                fromList [enumQux, unboxedBar]+                    `shouldBe` Left (FacialNameDuplication "bar")+                fromList+                    [ TypeDeclaration+                          { typename = "foo"+                          , type' = EnumType+                                [ EnumMember "foo" empty+                                , EnumMember "bar" empty+                                ]+                          , typeAnnotations = empty+                          }+                    ]+                    `shouldBe` Left (FacialNameDuplication "foo")+            it "is disallowed two unions to have a tag of the same name" $+                fromList+                    [ unionFoo+                    , TypeDeclaration+                          { typename = "qux"+                          , type' = unionType'+                                [ Tag "quux" [Field "c" "text" empty] empty+                                , Tag "baz" [Field "d" "text" empty] empty+                                ]+                                Nothing+                          , typeAnnotations = empty+                          }+                    ]+                    `shouldBe` Left (FacialNameDuplication "baz")+            it "is disallowed two enums to have a member of the same name" $+                fromList+                    [ TypeDeclaration+                          { typename = "foo"+                          , type' = EnumType+                                [ EnumMember "bar" empty+                                , EnumMember "baz" empty+                                ]+                          , typeAnnotations = empty+                          }+                    , enumQux+                    ]+                    `shouldBe` Left (FacialNameDuplication "bar")+            it ("is disallowed an enum member and a union tag to " +++                "have the same name") $+                fromList [unionFoo, enumQux] `shouldBe`+                    Left (FacialNameDuplication "bar")+     describe "EnumMember" $ do         let kr = EnumMember "kr" empty             jp = EnumMember "jp" (singleDocs "Japan")
test/Nirum/DocsSpec.hs view
@@ -5,16 +5,7 @@ import Test.Hspec.Meta import Text.InterpolatedString.Perl6 (q) -import Nirum.Docs ( Block (..)-                  , HeadingLevel (..)-                  , Inline (..)-                  , ItemList (..)-                  , ListDelimiter (..)-                  , ListType (..)-                  , filterReferences-                  , headingLevelFromInt-                  , parse-                  )+import Nirum.Docs  sampleSource :: Text sampleSource = [q|@@ -38,11 +29,18 @@  |] +sampleHeading :: Block+sampleHeading =+    Heading H1 ["Hello"]+ sampleDocument :: Block sampleDocument =-    Document-        [ Heading H1 ["Hello"]-        , Paragraph ["Tight list:"]+    sampleDocument' (sampleHeading :)++sampleDocument' :: ([Block] -> [Block]) -> Block+sampleDocument' adjust =+    (Document . adjust)+        [ Paragraph ["Tight list:"]         , List BulletList $ TightItemList [ ["List test"]                                           , ["test2"]                                           ]@@ -91,3 +89,8 @@                 , "image"                 , "."                 ]+    specify "trimTitle" $ do+        -- Remove the top-level heading if it exists:+        trimTitle sampleDocument `shouldBe` sampleDocument' id+        -- No-op if there is no top-level heading:+        trimTitle (sampleDocument' id) `shouldBe` sampleDocument' id
test/Nirum/Package/MetadataSpec.hs view
@@ -40,6 +40,7 @@                               , readFromPackage                               , readMetadata                               , stringField+                              , textArrayField                               , versionField                               ) @@ -250,6 +251,16 @@             fieldType (get "t1") `shouldBe` "table of an item"             fieldType (get "t2") `shouldBe` "table of 2 items"             fieldType (get "ta") `shouldBe` "array of 2 tables"+        specify "textArrayField" $ do+            let Right table = parseTomlDoc "<string>"+                    [q|ta = []+                       sa = ["a", "b", "c"]+                       i = 1|]+            textArrayField "ta" table `shouldBe` Right []+            textArrayField "sa" table `shouldBe` Right ["a", "b", "c"]+            textArrayField "i" table `shouldBe` Left (FieldTypeError+                "i" "array" "integer (1)")+   where     parse :: Text -> Either MetadataError (Metadata DummyTarget)     parse = parseMetadata "<string>"
test/Nirum/Package/ModuleSetSpec.hs view
@@ -47,45 +47,67 @@     , (["foo", "baz"], Module [] $ Just "foo.baz")     , (["qux"], Module [] $ Just "qux")     , ( ["xyz"]-      , Module [ Import ["abc"] "a" empty+      , Module [ Import ["abc"] "a" "a" empty                , TypeDeclaration "x" (Alias "text") empty-               ] Nothing+               ]+               Nothing       )+    , ( ["zar"]+      , Module [ Import ["abc"] "aliased" "a" empty+               , TypeDeclaration "quuz" (Alias "text") empty+               ]+               Nothing+      )     ]  missingImportsModules :: [(ModulePath, Module)] missingImportsModules =     [ ( ["foo"]-      , Module [ Import ["foo", "bar"] "xyz" empty -- MissingModulePathError-               , Import ["foo", "bar"] "zzz" empty -- MissingModulePathError-               , Import ["baz"] "qux" empty-               ] Nothing+      , Module+            [ Import ["foo", "bar"] "xyz" "xyz" empty -- MissingModulePathError+            , Import ["foo", "bar"] "zzz" "zzz" empty -- MissingModulePathError+            , Import ["baz"] "qux" "qux" empty+            ]+            Nothing       )     , ( ["baz"]       , Module [ TypeDeclaration "qux" (Alias "text") empty ] Nothing       )-    , (["qux"], Module [ Import ["foo"] "abc" empty -- MissingImportError-                       , Import ["foo"] "def" empty -- MissingImportError-                       ] Nothing)+    , ( ["qux"]+      , Module [ Import ["foo"] "abc" "abc" empty -- MissingImportError+               , Import ["foo"] "def" "def" empty -- MissingImportError+               ]+               Nothing+      )     ]  circularImportsModules :: [(ModulePath, Module)] circularImportsModules =-    [ (["asdf"], Module [ Import ["asdf"] "foo" empty-                        , TypeDeclaration "bar" (Alias "text") empty-                        ] Nothing)-    , (["abc", "def"], Module [ Import ["abc", "ghi"] "bar" empty-                              , TypeDeclaration-                                    "foo" (Alias "text") empty-                              ] Nothing)-    , (["abc", "ghi"], Module [ Import ["abc", "xyz"] "baz" empty-                              , TypeDeclaration-                                    "bar" (Alias "text") empty-                              ] Nothing)-    , (["abc", "xyz"], Module [ Import ["abc", "def"] "foo" empty-                              , TypeDeclaration-                                    "baz" (Alias "text") empty-                              ] Nothing)+    [ ( ["asdf"]+      , Module [ Import ["asdf"] "foo" "foo" empty+               , TypeDeclaration "bar" (Alias "text") empty+               ]+               Nothing+      )+    , ( ["abc", "def"]+      , Module [ Import ["abc", "ghi"] "bar" "bar" empty+               , TypeDeclaration+                     "foo" (Alias "text") empty+               ]+               Nothing+      )+    , ( ["abc", "ghi"]+      , Module [ Import ["abc", "xyz"] "baz" "baz" empty+               , TypeDeclaration "bar" (Alias "text") empty+               ]+               Nothing+      )+    , ( ["abc", "xyz"]+      , Module [ Import ["abc", "def"] "foo" "foo" empty+               , TypeDeclaration "baz" (Alias "text") empty+               ]+               Nothing+      )     ]  spec :: Spec@@ -119,7 +141,7 @@             mod' `shouldBe` fooBarModule             lookup ["wrong", "path"] validModuleSet `shouldSatisfy` isNothing         specify "length" $-            length validModuleSet `shouldBe` 6+            length validModuleSet `shouldBe` 7         specify "null" $             validModuleSet `shouldNotSatisfy` null   where
test/Nirum/PackageSpec.hs view
@@ -4,6 +4,7 @@  import Data.Either (isLeft, isRight) import Data.Proxy (Proxy (Proxy))+import Data.Text import System.IO.Error (isDoesNotExistError)  import qualified Data.SemVer as SV@@ -33,7 +34,8 @@                                ) import Nirum.Package.ModuleSetSpec (validModules) import Nirum.Parser (parseFile)-import Nirum.Targets.Python (Python (Python), minimumRuntime)+import Nirum.Targets.Python (Python (Python))+import Nirum.Targets.Python.CodeGen (minimumRuntime)  createPackage :: Metadata t -> [(ModulePath, Module)] -> Package t createPackage metadata' modules' =@@ -52,8 +54,15 @@  spec :: Spec spec = do-    testPackage (Python "nirum-examples" minimumRuntime [])+    testPackage (Python "nirum-examples" minimumRuntime [] classifiers')     testPackage DummyTarget+  where+    classifiers' :: [Text]+    classifiers' =+        [ "Development Status :: 3 - Alpha"+        , append "License :: OSI Approved :: "+                 "GNU General Public License v3 or later (GPLv3+)"+        ]  testPackage :: forall t . Target t => t -> Spec testPackage target' = do@@ -81,8 +90,10 @@                 Right countriesM <- parseFile (path </> "countries.nrm")                 Right addressM <- parseFile (path </> "address.nrm")                 Right pdfServiceM <- parseFile (path </> "pdf-service.nrm")+                Right geoM <- parseFile (path </> "geo.nrm")                 let modules = [ (["blockchain"], blockchainM)                               , (["builtins"], builtinsM)+                              , (["geo"], geoM)                               , (["product"], productM)                               , (["shapes"], shapesM)                               , (["countries"], countriesM)@@ -121,6 +132,7 @@             mods' <- scanModules path             mods' `shouldBe` [ (["blockchain"], path </> "blockchain.nrm")                              , (["builtins"], path </> "builtins.nrm")+                             , (["geo"], path </> "geo.nrm")                              , (["product"], path </> "product.nrm")                              , (["shapes"], path </> "shapes.nrm")                              , (["countries"], path </> "countries.nrm")
test/Nirum/ParserSpec.hs view
@@ -1,4 +1,7 @@-{-# LANGUAGE OverloadedLists, QuasiQuotes, TypeFamilies #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedLists #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE TypeFamilies #-} module Nirum.ParserSpec where  import Control.Monad (forM_)@@ -17,27 +20,24 @@ import Text.Megaparsec.Char (string) import Text.Megaparsec.Error (errorPos, parseErrorPretty) import Text.Megaparsec.Pos (Pos, SourcePos (sourceColumn, sourceLine), mkPos)-import Text.Megaparsec.Text (Parser)  import qualified Nirum.Parser as P+import Nirum.Parser (Parser, ParseError) import Nirum.Constructs (Construct (toCode)) import Nirum.Constructs.Annotation as A+import Nirum.Constructs.Annotation.Internal hiding (Text)+import qualified Nirum.Constructs.Annotation.Internal as AI import Nirum.Constructs.Docs (Docs (Docs)) import Nirum.Constructs.DeclarationSet (DeclarationSet) import Nirum.Constructs.DeclarationSetSpec (SampleDecl (..))-import Nirum.Constructs.Identifier (fromText)+import Nirum.Constructs.Identifier (Identifier, fromText) import Nirum.Constructs.Module (Module (Module)) import Nirum.Constructs.Name (Name (..)) import Nirum.Constructs.Service ( Method (Method)                                 , Parameter (Parameter)                                 , Service (Service)                                 )-import Nirum.Constructs.TypeDeclaration ( EnumMember (EnumMember)-                                        , Field (Field, fieldAnnotations)-                                        , Tag (Tag, tagAnnotations, tagFields)-                                        , Type (..)-                                        , TypeDeclaration (..)-                                        )+import Nirum.Constructs.TypeDeclaration as TD hiding (tags) import Nirum.Constructs.TypeExpression ( TypeExpression ( ListModifier                                                         , MapModifier                                                         , OptionModifier@@ -50,16 +50,16 @@ shouldBeRight :: (Eq l, Eq r, Show l, Show r) => Either l r -> r -> Expectation shouldBeRight actual expected = actual `shouldBe` Right expected -erroredPos :: Either P.ParseError a -> (Pos, Pos)+erroredPos :: Either ParseError a -> (Pos, Pos) erroredPos left =     (sourceLine pos, sourceColumn pos)   where-    error' = head $ lefts [left] :: P.ParseError+    error' = head $ lefts [left] :: ParseError     pos = NE.head (errorPos error') :: SourcePos  helperFuncs :: (Show a)             => Parser a-            -> ( T.Text -> Either P.ParseError a+            -> ( T.Text -> Either ParseError a                , T.Text -> Int -> Int -> Expectation                ) helperFuncs parser =@@ -71,9 +71,9 @@         return r     parse' = runParser parserAndEof ""     expectError inputString line col = do-        line' <- mkPos line-        col' <- mkPos col         let parseResult = parse' inputString+            line' = mkPos line+            col' = mkPos col         parseResult `shouldSatisfy` isLeft         let Left parseError = parseResult             msg = parseErrorPretty parseError@@ -82,7 +82,7 @@   fooAnnotationSet :: AnnotationSet-fooAnnotationSet = A.singleton $ Annotation "foo" [("v", "bar")]+fooAnnotationSet = A.singleton $ Annotation "foo" [("v", AI.Text "bar")]  bazAnnotationSet :: AnnotationSet bazAnnotationSet = A.singleton $ Annotation "baz" []@@ -179,7 +179,10 @@     describe "annotation" $ do         let (parse', expectError) = helperFuncs P.annotation         context "with single argument" $ do-            let rightAnnotaiton = Annotation "name-abc" [("foo", "wo\"rld")]+            let rightAnnotaiton =+                    Annotation "name-abc" [("foo", AI.Text "wo\"rld")]+            let rightIntAnnotation =+                    Annotation "name-abc" [("foo", Integer 1)]             it "success" $ do                 parse' "@name-abc(foo=\"wo\\\"rld\")"                     `shouldBeRight` rightAnnotaiton@@ -194,7 +197,11 @@                 parse' "@name-abc ( foo=\"wo\\\"rld\")"                     `shouldBeRight` rightAnnotaiton                 parse' "@name-abc(foo=\"wo\\\"rld\\n\")" `shouldBeRight`-                    Annotation "name-abc" [("foo", "wo\"rld\n")]+                    Annotation "name-abc" [("foo", AI.Text "wo\"rld\n")]+                parse' "@name-abc(foo=1)" `shouldBeRight` rightIntAnnotation+                parse' "@name-abc( foo=1)" `shouldBeRight` rightIntAnnotation+                parse' "@name-abc(foo=1 )" `shouldBeRight` rightIntAnnotation+                parse' "@name-abc( foo=1 )" `shouldBeRight` rightIntAnnotation             it "fails to parse if annotation name start with hyphen" $ do                 expectError "@-abc(v=\"helloworld\")" 1 2                 expectError "@-abc-d(v = \"helloworld\")" 1 2@@ -220,7 +227,7 @@     describe "annotationSet" $ do         let (parse', expectError) = helperFuncs P.annotationSet             Right annotationSet = fromList-                [ Annotation "a" [("arg", "b")]+                [ Annotation "a" [("arg", AI.Text "b")]                 , Annotation "c" []                 ]         it "success" $ do@@ -360,12 +367,13 @@             expectError "// comment" 1 1      let descTypeDecl label parser spec' =-            let parsers = [ (label, parser)-                          , (label ++ " (typeDescription)", P.typeDeclaration)-                          ] :: [(String, Parser TypeDeclaration)]+            let parsers =+                    [ (label, parser)+                    , (label ++ " (typeDescription)", P.typeDeclaration)+                    ] :: [(String, [Identifier] -> Parser TypeDeclaration)]             in forM_ parsers $ \ (label', parser') ->                 describe label' $-                    spec' $ helperFuncs parser'+                    spec' $ helperFuncs $ parser' []      describe "handleNameDuplication" $ do         let cont dset = do@@ -519,9 +527,10 @@          ;|] 4 10         it "fails to parse if trailing semicolon is missing" $ do             let (_, expectErr) = helperFuncs P.module'-            expectErr "enum a = x | y;\nenum b = x | y\nenum c = x | y;" 3 1+            expectErr "enum a = a1 | a2;\nenum b = b1 | y\nenum c = c1 | c2;"+                      3 1             expectErr "unboxed a (text);\nenum b = x | y\nunboxed c (text);" 3 1-            expectErr "enum a = x | y;\nunboxed b (text)\nenum c = x | y;" 3 1+            expectErr "enum a = x | y;\nunboxed b (text)\nenum c = c1 | c2;" 3 1      descTypeDecl "recordTypeDeclaration"                  P.recordTypeDeclaration $ \ helpers -> do@@ -656,6 +665,23 @@      descTypeDecl "unionTypeDeclaration" P.unionTypeDeclaration $ \ helpers -> do         let (parse', expectError) = helpers+        it "has defaultTag" $ do+            let cOriginF = Field "origin" "point" empty+                cRadiusF = Field "radius" "offset" empty+                circleFields = [cOriginF, cRadiusF]+                rUpperLeftF = Field "upper-left" "point" empty+                rLowerRightF = Field "lower-right" "point" empty+                rectangleFields = [rUpperLeftF, rLowerRightF]+                circleTag = Tag "circle" circleFields empty+                rectTag = Tag "rectangle" rectangleFields empty+                tags' = [circleTag]+                Right union' = unionType tags' $ Just rectTag+                a = TypeDeclaration "shape" union' empty+            parse' [s|+union shape+    = circle (point origin, offset radius,)+    | default rectangle (point upper-left, point lower-right,)+    ;|] `shouldBeRight` a         it "emits (TypeDeclaration (UnionType ...)) if succeeded to parse" $ do             let cOriginF = Field "origin" "point" empty                 cRadiusF = Field "radius" "offset" empty@@ -667,7 +693,7 @@                 rectTag = Tag "rectangle" rectangleFields empty                 noneTag = Tag "none" [] empty                 tags' = [circleTag, rectTag, noneTag]-                union' = UnionType tags'+                Right union' = unionType tags' Nothing                 a = TypeDeclaration "shape" union' empty                 b = a { typeAnnotations = singleDocs "shape type" }             parse' [s|@@ -702,18 +728,21 @@     | rectangle (point upper-left, point lower-right,)     | none     ;|] `shouldBeRight` b+            let Right union3 = unionType+                    [circleTag, rectTag, Tag "none" [] fooAnnotationSet]+                    Nothing             parse' [s| union shape     = circle (point origin, offset radius,)     | rectangle (point upper-left, point lower-right,)     | @foo (v = "bar") none-    ;|] `shouldBeRight`-                    a { type' = union' { tags = [ circleTag-                                                , rectTag-                                                , Tag "none" [] fooAnnotationSet-                                                ]-                                       }-                      }+    ;|] `shouldBeRight` a { type' = union3 }+            let Right union4 = unionType+                    [ circleTag { tagAnnotations = singleDocs "tag docs" }+                    , rectTag { tagAnnotations = singleDocs "front docs" }+                    , noneTag+                    ]+                    Nothing             parse' [s| union shape     = circle (point origin, offset radius,)@@ -723,59 +752,42 @@           point upper-left, point lower-right,       )     | none-    ;|] `shouldBeRight`-                    a { type' = union'-                            { tags = [ circleTag-                                        { tagAnnotations = singleDocs "tag docs"-                                        }-                                     , rectTag-                                        { tagAnnotations =-                                              singleDocs "front docs"-                                        }-                                     , noneTag-                                     ]-                            }-                      }+    ;|] `shouldBeRight` a { type' = union4 }+            let Right union5 = unionType+                    [ circleTag, rectTag+                    , noneTag { tagAnnotations = singleDocs "tag docs" }+                    ]+                    Nothing             parse' [s| union shape     = circle (point origin, offset radius,)     | rectangle (point upper-left, point lower-right,)     | none  # tag docs-    ;|] `shouldBeRight`-                    a { type' = union'-                            { tags = [ circleTag, rectTag-                                     , noneTag-                                        { tagAnnotations = singleDocs "tag docs"-                                        }-                                     ]-                            }-                      }+    ;|] `shouldBeRight` a { type' = union5 }+            let Right union6 = unionType+                    [ circleTag+                          { tagFields =+                                 [ cOriginF+                                 , cRadiusF+                                       { fieldAnnotations = bazAnnotationSet }+                                 ]+                          }+                    , rectTag+                          { tagFields =+                                [ rUpperLeftF+                                , rLowerRightF+                                      { fieldAnnotations = fooAnnotationSet }+                                ]+                          }+                    , noneTag+                    ]+                    Nothing             parse' [s| union shape     = circle (point origin, @baz offset radius,)     | rectangle (point upper-left, @foo (v = "bar") point lower-right,)     | none-    ;|] `shouldBeRight`-                    a { type' = union'-                            { tags = [ circleTag-                                           { tagFields =-                                                 [ cOriginF-                                                 , cRadiusF { fieldAnnotations =-                                                              bazAnnotationSet }-                                                 ]-                                           }-                                     , rectTag-                                           { tagFields =-                                                 [ rUpperLeftF-                                                 , rLowerRightF-                                                       { fieldAnnotations =-                                                         fooAnnotationSet }-                                                 ]-                                           }-                                     , noneTag-                                     ]-                             }-                      }+    ;|] `shouldBeRight` a { type' = union6 }         it "fails to parse if there are duplicated facial names" $ do             expectError [s| union dup@@ -802,16 +814,25 @@     ;|] 2 38         it "fails to parse if trailing semicolon is missing" $ do             let (_, expectErr) = helperFuncs P.module'-            expectErr "union a = x | y;\nunion b = x | y\nunion c = x | y;" 3 1+            expectErr+                "union a = a1 | a2;\nunion b = b1 | b2\nunion c = c1 | c2;"+                3 1             expectErr "unboxed a (text);\nunion b = x | y\nunboxed c (text);"                       3 1-            expectErr "union a = x | y;\nunboxed b (text)\nunion c = x | y;" 3 1-+            expectErr "union a = a1 | a2;\nunboxed b (text)\nunion c = c1 | c2;"+                      3 1+        it "failed to parse union with more than 1 default keyword." $ do+            let (_, expectErr) = helperFuncs P.module'+            expectErr [s|+union shape+    = default circle (point origin, offset radius,)+    | default rectangle (point upper-left, point lower-right,)+    ;|] 4 6     describe "method" $ do         let (parse', expectError) = helperFuncs P.method             httpGetAnnotation = singleton $ Annotation "http"-                [ ("method", "GET")-                , ("path", "/get-name/")+                [ ("method", AI.Text "GET")+                , ("path", AI.Text "/get-name/")                 ]         it "emits Method if succeeded to parse" $ do             parse' "text get-name()" `shouldBeRight`@@ -819,14 +840,14 @@             parse' "text get-name (person user)" `shouldBeRight`                 Method "get-name" [Parameter "user" "person" empty]                        (Just "text") Nothing empty-            parse' "text get-name  ( person user,text default )" `shouldBeRight`+            parse' "text get-name (person user,text `default`)" `shouldBeRight`                 Method "get-name"                        [ Parameter "user" "person" empty                        , Parameter "default" "text" empty                        ]                        (Just "text") Nothing empty             parse' "@http(method = \"GET\", path = \"/get-name/\") \-                   \text get-name  ( person user,text default )" `shouldBeRight`+                   \text get-name (person user,text `default`)" `shouldBeRight`                 Method "get-name"                        [ Parameter "user" "person" empty                        , Parameter "default" "text" empty@@ -835,7 +856,7 @@             parse' "text get-name() throws name-error" `shouldBeRight`                 Method "get-name" [] (Just "text") (Just "name-error") empty             parse' [s|-text get-name  ( person user,text default )+text get-name  ( person user,text `default` )                throws get-name-error|] `shouldBeRight`                 Method "get-name"                        [ Parameter "user" "person" empty@@ -844,7 +865,7 @@                        (Just "text") (Just "get-name-error") empty             parse' [s| @http(method = "GET", path = "/get-name/")-text get-name  ( person user,text default )+text get-name  ( person user,text `default` )                throws get-name-error|] `shouldBeRight`                 Method "get-name"                        [ Parameter "user" "person" empty@@ -908,7 +929,7 @@   # Gets the name of the user.   person user,   # The person to find their name.-  text default+  text `default`   # The default name used when the user has no name. )|] `shouldBeRight` expectedMethod         it "fails to parse if there are parameters of the same facial name" $ do@@ -921,7 +942,7 @@             expectError "bool pred(text a/c, text b/c)" 1 11      describe "serviceDeclaration" $ do-        let (parse', expectError) = helperFuncs P.serviceDeclaration+        let (parse', expectError) = helperFuncs $ P.serviceDeclaration []             getUserD = singleDocs "Gets an user by its id."             createUserD = singleDocs "Creates a new user"             noMethodsD = singleDocs "Service having no methods."@@ -1109,7 +1130,7 @@                 parse' "" `shouldBeRight` Module [] Nothing                 parse' "# docs" `shouldBeRight` Module [] (Just "docs")             it "errors if there are any duplicated facial names" $-                expectError "type a = text;\ntype a/b = text;" 2 7+                expectError "type a = text;\ntype a/b = text;" 2 6             it "errors if there are any duplicated behind names" $                 expectError "type b = text;\ntype a/b = text;" 2 7 @@ -1133,43 +1154,124 @@             expectError "foo.bar.baz." 1 13      describe "imports" $ do-        let (parse', expectError) = helperFuncs P.imports-        it "emits Import values if succeeded to parse" $+        let (parse', expectError) = helperFuncs $ P.imports []+        it "can single import name w/o trailing comma" $ do+            parse' "import foo.bar (a);" `shouldBeRight`+                [Import ["foo", "bar"] "a" "a" empty]+            parse' "import foo.bar (a as qux);" `shouldBeRight`+                [Import ["foo", "bar"] "qux" "a" empty]+        it "can single import name w/ trailing comma" $ do+            parse' "import foo.bar (a,);" `shouldBeRight`+                [Import ["foo", "bar"] "a" "a" empty]+            parse' "import foo.bar (a as qux,);" `shouldBeRight`+                [Import ["foo", "bar"] "qux" "a" empty]+        it "emits Import values if succeeded to parse" $ do             parse' "import foo.bar (a, b);" `shouldBeRight`-                [ Import ["foo", "bar"] "a" empty-                , Import ["foo", "bar"] "b" empty+                [ Import ["foo", "bar"] "a" "a" empty+                , Import ["foo", "bar"] "b" "b" empty                 ]+            parse' "import foo.bar (a as foo, b as bar);" `shouldBeRight`+                [ Import ["foo", "bar"] "foo" "a" empty+                , Import ["foo", "bar"] "bar" "b" empty+                ]         it "can be annotated" $ do             parse' "import foo.bar (@foo (v = \"bar\") a, @baz b);"                 `shouldBeRight`-                    [ Import ["foo", "bar"] "a" fooAnnotationSet-                    , Import ["foo", "bar"] "b" bazAnnotationSet+                    [ Import ["foo", "bar"] "a" "a" fooAnnotationSet+                    , Import ["foo", "bar"] "b" "b" bazAnnotationSet                     ]             parse' "import foo.bar (@foo (v = \"bar\") @baz a, b);"                 `shouldBeRight`-                    [ Import ["foo", "bar"] "a" $+                    [ Import ["foo", "bar"] "a" "a" $                              union fooAnnotationSet bazAnnotationSet-                    , Import ["foo", "bar"] "b" empty+                    , Import ["foo", "bar"] "b" "b" empty                     ]-        specify "import names can have a trailing comma" $+            parse'+                "import foo.bar (@foo (v = \"bar\") a as foo, @baz b as bar);"+                `shouldBeRight`+                    [ Import ["foo", "bar"] "foo" "a" fooAnnotationSet+                    , Import ["foo", "bar"] "bar" "b" bazAnnotationSet+                    ]+            parse'+                "import foo.bar (@foo (v = \"bar\") @baz a as foo, b as bar);"+                `shouldBeRight`+                    [ Import ["foo", "bar"] "foo" "a" $+                             union fooAnnotationSet bazAnnotationSet+                    , Import ["foo", "bar"] "bar" "b" empty+                    ]+        specify "import names can have a trailing comma" $ do             parse' "import foo.bar (a, b,);" `shouldBeRight`-                [ Import ["foo", "bar"] "a" empty-                , Import ["foo", "bar"] "b" empty+                [ Import ["foo", "bar"] "a" "a" empty+                , Import ["foo", "bar"] "b" "b" empty                 ]+            parse' "import foo.bar (a as foo, b as bar,);" `shouldBeRight`+                [ Import ["foo", "bar"] "foo" "a" empty+                , Import ["foo", "bar"] "bar" "b" empty+                ]         specify "import names in parentheses can be multiline" $ do             -- without a trailing comma             parse' "import foo.bar (\n  a,\n  b\n);" `shouldBeRight`-                [ Import ["foo", "bar"] "a" empty-                , Import ["foo", "bar"] "b" empty+                [ Import ["foo", "bar"] "a" "a" empty+                , Import ["foo", "bar"] "b" "b" empty                 ]+            parse' "import foo.bar (\n  a as foo,\n  b as bar\n);"+                `shouldBeRight`+                    [ Import ["foo", "bar"] "foo" "a" empty+                    , Import ["foo", "bar"] "bar" "b" empty+                    ]             -- with a trailing comma-            parse' "import foo.bar (\n  c,\n  d,\n);" `shouldBeRight`-                [ Import ["foo", "bar"] "c" empty-                , Import ["foo", "bar"] "d" empty-                ]+            parse' "import foo.bar (\n  c,\n  d,\n);"+                `shouldBeRight`+                    [ Import ["foo", "bar"] "c" "c" empty+                    , Import ["foo", "bar"] "d" "d" empty+                    ]+            parse' "import foo.bar (\n  c as foo,\n  d as bar,\n);"+                `shouldBeRight`+                    [ Import ["foo", "bar"] "foo" "c" empty+                    , Import ["foo", "bar"] "bar" "d" empty+                    ]+         it "errors if parentheses have nothing" $             expectError "import foo.bar ();" 1 17+        it "disallows when there are duplicated alias names" $+            expectError "import foo.bar (lorem as yolo, ipsum as yolo);" 1 41 +    describe "module'" $ do+        context "handling name duplications" $ do+            let (_, expectError) = helperFuncs P.module'+            let examples =+                    -- Vertical alignment of `dup` is an intention; it purposes+                    -- to generate the same error offsets.+                    [ "type       dup = text;"+                    , "unboxed    dup (text);"+                    , "record     dup (text a);"+                    , "enum       dup = m1 | m2;"+                    , "enum e1 =  dup | foo;"+                    , "union      dup = t1 | t2;"+                    , "union u1 = dup | foo;"+                    , "service    dup (text ping ());"+                    ]+            let importExample = "import foo (dup);"+            let shiftDigit = \ case+                    '1' -> '3'+                    '2' -> '4'+                    c -> c+            let inputs = [ (a, if a == b then T.map shiftDigit b else b)+                         | a <- importExample : examples+                         , b <- examples+                         ]+            forM_ inputs $ \ (forward, shadowing) ->+                let input = T.concat [forward, "\n", shadowing]+                in+                    specify (T.unpack input) $ expectError input 2 12+        specify "allows import duplicated source name when it use alias" $ do+            let (parse', _) = helperFuncs P.module'+            parse' "import foo.bar (a);\n import lorem.ipsum (a as dolor);"+                `shouldBeRight`+                    Module [ Import ["foo", "bar"] "a" "a" empty+                           , Import ["lorem", "ipsum"] "dolor" "a" empty+                           ] Nothing+     specify "parse & parseFile" $ do         files <- getDirectoryContents "examples"         let examples = map ("examples/" ++) $ filter (isSuffixOf ".nrm") files@@ -1184,5 +1286,3 @@             parseFileResult <- P.parseFile filePath             parseFileResult `shouldSatisfy` isRight             parseFileResult `shouldBe` parseResult--{-# ANN module ("HLint: ignore Reduce duplication" :: String) #-}
test/Nirum/Targets/DocsSpec.hs view
@@ -1,20 +1,30 @@ {-# LANGUAGE OverloadedLists #-} module Nirum.Targets.DocsSpec where +import Control.Monad+import GHC.Exts (IsList (toList))++import Data.Text hiding (empty)+import Data.Text.Encoding import System.FilePath ((</>)) import Test.Hspec.Meta import Text.Blaze.Html.Renderer.Utf8 (renderHtml)+import Text.XML.HXT.Core hiding (when)  import Nirum.Constructs.Annotation (empty) import Nirum.Constructs.DeclarationSet (DeclarationSet) import Nirum.Constructs.Module (Module (..)) import Nirum.Constructs.TypeDeclaration (TypeDeclaration (Import)) import qualified Nirum.Docs as D+import Nirum.Package+import Nirum.Package.Metadata (Target (compilePackage, toByteString)) import qualified Nirum.Targets.Docs as DT+import Nirum.TestFixtures  spec :: Spec spec = describe "Docs" $ do-    let decls = [Import ["zzz"] "qqq" empty] :: DeclarationSet TypeDeclaration+    let decls = [ Import ["zzz"] "qqq" "qqq" empty+                ] :: DeclarationSet TypeDeclaration         mod1 = Module decls Nothing         mod2 = Module decls $ Just "module level docs...\nblahblah"         mod3 = Module decls $ Just "# One Spoqa Trinity Studio\nblahblah"@@ -31,3 +41,17 @@     specify "blockToHtml" $ do         let h = D.Paragraph [D.Strong ["Hi!"]]         renderHtml (DT.blockToHtml h) `shouldBe` "<p><strong>Hi!</strong></p>"+    specify "<title>" $ do+        pkg <- fixturePackage+        let t = target pkg+        forM_ (toList $ compilePackage (pkg :: Package DT.Docs)) $ \ (f, r) ->+            when (".html" `isSuffixOf` pack f) $ do+                let Right html = r+                let doc = readString+                              [withParseHTML yes, withWarnings no]+                              (unpack . decodeUtf8 . toByteString t $ html)+                titles <- runX $ doc //> hasName "title" /> getText+                titles `shouldNotBe` []+                forM_ titles $ \ title ->+                    pack title `shouldSatisfy`+                        isSuffixOf "Fixtures for Nirum tests"
+ test/Nirum/Targets/Python/CodeGenSpec.hs view
@@ -0,0 +1,347 @@+{-# LANGUAGE OverloadedLists #-}+{-# LANGUAGE QuasiQuotes #-}+module Nirum.Targets.Python.CodeGenSpec+    ( makeDummySource+    , makeDummySource'+    , pythonVersionSpecs+    , spec+    ) where++import Control.Monad+import Data.Either+import Data.Maybe++import Data.SemVer hiding (Identifier, metadata)+import Test.Hspec.Meta+import Text.Email.Validate (emailAddress)+import Text.InterpolatedString.Perl6 (q, qq)++import Nirum.Constructs.Annotation (empty)+import Nirum.Constructs.Identifier+import Nirum.Constructs.Module+import Nirum.Constructs.ModulePath+import Nirum.Constructs.TypeDeclaration+import Nirum.Package.Metadata+import Nirum.Package.ModuleSet+import Nirum.PackageSpec (createPackage)+import Nirum.Targets.Python (Source (..))+import Nirum.Targets.Python.CodeGen hiding (empty, renames)+import qualified Nirum.Targets.Python.CodeGen as CodeGen+import Nirum.TypeInstance.BoundModule++makeDummySource' :: [Identifier] -> Module -> RenameMap -> Source+makeDummySource' pathPrefix m renames =+    Source pkg $ fromJust $ resolveBoundModule ["foo"] pkg+  where+    mp :: [Identifier] -> ModulePath+    mp identifiers = fromJust $ fromIdentifiers (pathPrefix ++ identifiers)+    metadata' :: Metadata Python+    metadata' = Metadata+        { Nirum.Package.Metadata.version = Data.SemVer.version 1 2 3 [] []+        , authors =+              [ Author+                    { name = "John Doe"+                    , email = Just (fromJust $ emailAddress "john@example.com")+                    , uri = Nothing+                    }+              ]+        , description = Just "Package description"+        , license = Just "MIT"+        , Nirum.Package.Metadata.keywords = ["sample", "example", "nirum"]+        , target = Python "sample-package" minimumRuntime renames ["classifier"]+        }+    pkg :: Package Python+    pkg = createPackage+            metadata'+            [ (mp ["foo"], m)+            , ( mp ["foo", "bar"]+              , Module [ Import (mp ["qux"]) "path" "path" empty+                       , TypeDeclaration "path-unbox" (UnboxedType "path") empty+                       , TypeDeclaration "int-unbox"+                                         (UnboxedType "bigint") empty+                       , TypeDeclaration "point"+                                         (RecordType [ Field "x" "int64" empty+                                                     , Field "y" "int64" empty+                                                     ])+                                         empty+                       ] Nothing+              )+            , ( mp ["qux"]+              , Module+                  [ TypeDeclaration "path" (Alias "text") empty+                  , TypeDeclaration "name" (UnboxedType "text") empty+                  ]+                  Nothing+              )+            ]++makeDummySource :: Module -> Source+makeDummySource m = makeDummySource' [] m []++pythonVersionSpecs :: (PythonVersion -> Spec) -> Spec+pythonVersionSpecs =+    parallel . forM_ ([Python2, Python3] :: [PythonVersion])++spec' :: Spec+spec' = pythonVersionSpecs $ \ ver -> do+    let empty' = CodeGen.empty ver+        -- compileError :: CodeGen a -> Maybe CompileError+        compileError cg = either Just (const Nothing) $ fst $+            runCodeGen cg empty'++    describe [qq|CodeGen ($ver)|] $ do+        specify "packages and imports" $ do+            let c = do+                    insertStandardImport "sys"+                    insertThirdPartyImports+                        [("nirum", ["serialize_unboxed_type"])]+                    insertLocalImport ".." "Gender"+                    insertStandardImport "os"+                    insertThirdPartyImports [("nirum", ["serialize_enum_type"])]+                    insertThirdPartyImportsA+                        [("nirum.constructs", [("name_dict_type", "NameDict")])]+                    insertLocalImport ".." "Path"+            let (e, ctx) = runCodeGen c empty'+            e `shouldSatisfy` isRight+            standardImports ctx `shouldBe` [("os", "os"), ("sys", "sys")]+            thirdPartyImports ctx `shouldBe`+                [ ( "nirum"+                  , [ ("serialize_unboxed_type", "serialize_unboxed_type")+                    , ("serialize_enum_type", "serialize_enum_type")+                    ]+                  )+                , ( "nirum.constructs"+                  , [("name_dict_type", "NameDict")]+                  )+                ]+            localImports ctx `shouldBe` [("..", ["Gender", "Path"])]+            localImportsMap ctx `shouldBe`+                [ ( ".."+                  , [ ("Gender", "Gender")+                    , ("Path", "Path")+                    ]+                  )+                ]+        specify "importStandardLibrary" $ do+            let codeGen1 = importStandardLibrary "io"+            let (e1, ctx1) = runCodeGen codeGen1 empty'+            e1 `shouldBe` Right "_io"+            standardImports ctx1 `shouldBe` [("_io", "io")]+            standardImportSet ctx1 `shouldBe` ["io"]+            thirdPartyImports ctx1 `shouldBe` []+            localImports ctx1 `shouldBe` []+            compileError codeGen1 `shouldBe` Nothing+            -- importing a nested module, i.e., import path that contains "."+            let codeGen2 = codeGen1 >> importStandardLibrary "os.path"+            let (e2, ctx2) = runCodeGen codeGen2 empty'+            e2 `shouldBe` Right "_os_path"+            standardImports ctx2 `shouldBe`+                [("_os_path", "os.path"), ("_io", "io")]+            standardImportSet ctx2 `shouldBe` ["os.path", "io"]+            thirdPartyImports ctx2 `shouldBe` []+            localImports ctx2 `shouldBe` []+            compileError codeGen2 `shouldBe` Nothing+            -- importing a module that begins with "_"+            let codeGen3 = codeGen2 >> importStandardLibrary "__builtin__"+            let (e3, ctx3) = runCodeGen codeGen3 empty'+            e3 `shouldBe` Right "__builtin__"+            standardImports ctx3 `shouldBe`+                [ ("__builtin__", "__builtin__")+                , ("_os_path", "os.path")+                , ("_io", "io")+                ]+            standardImportSet ctx3 `shouldBe` ["__builtin__", "os.path", "io"]+            thirdPartyImports ctx3 `shouldBe` []+            localImports ctx3 `shouldBe` []+            compileError codeGen3 `shouldBe` Nothing+        specify "importBuiltins" $ do+            let codeGen1 = importBuiltins+            let (e1, ctx1) = runCodeGen codeGen1 empty'+            e1 `shouldSatisfy` isRight+            standardImports ctx1 `shouldBe`+                [ if ver == Python2+                  then ("__builtin__", "__builtin__")+                  else ("__builtin__", "builtins")+                ]+            standardImportSet ctx1 `shouldBe`+                [if ver == Python2 then "__builtin__" else "builtins"]+            thirdPartyImports ctx1 `shouldBe` []+            localImports ctx1 `shouldBe` []+            compileError codeGen1 `shouldBe` Nothing+        specify "insertStandardImport" $ do+            let codeGen1 = insertStandardImport "sys"+            let (e1, ctx1) = runCodeGen codeGen1 empty'+            e1 `shouldSatisfy` isRight+            standardImports ctx1 `shouldBe` [("sys", "sys")]+            standardImportSet ctx1 `shouldBe` ["sys"]+            thirdPartyImports ctx1 `shouldBe` []+            localImports ctx1 `shouldBe` []+            compileError codeGen1 `shouldBe` Nothing+            let codeGen2 = codeGen1 >> insertStandardImport "os"+            let (e2, ctx2) = runCodeGen codeGen2 empty'+            e2 `shouldSatisfy` isRight+            standardImports ctx2 `shouldBe` [("os", "os"), ("sys", "sys")]+            standardImportSet ctx2 `shouldBe` ["os", "sys"]+            thirdPartyImports ctx2 `shouldBe` []+            localImports ctx2 `shouldBe` []+            compileError codeGen2 `shouldBe` Nothing+        specify "insertStandardImportA" $ do+            let codeGen1 = insertStandardImportA "_csv" "csv"+            let (e1, ctx1) = runCodeGen codeGen1 empty'+            e1 `shouldSatisfy` isRight+            standardImports ctx1 `shouldBe` [("_csv", "csv")]+            standardImportSet ctx1 `shouldBe` ["csv"]+            thirdPartyImports ctx1 `shouldBe` []+            localImports ctx1 `shouldBe` []+            compileError codeGen1 `shouldBe` Nothing+            let codeGen2 = codeGen1 >> insertStandardImportA "_gc" "gc"+            let (e2, ctx2) = runCodeGen codeGen2 empty'+            e2 `shouldSatisfy` isRight+            standardImports ctx2 `shouldBe` [("_gc", "gc"), ("_csv", "csv")]+            standardImportSet ctx2 `shouldBe` ["gc", "csv"]+            thirdPartyImports ctx2 `shouldBe` []+            localImports ctx2 `shouldBe` []+            compileError codeGen2 `shouldBe` Nothing+        specify "collectionsAbc" $ do+            let expected@(expectedModule, _) = case ver of+                    Python2 -> ("_collections", "collections")+                    Python3 -> ("_collections_abc", "collections.abc")+            let (abc, ctx) = runCodeGen collectionsAbc empty'+            abc `shouldBe` Right expectedModule+            standardImports ctx `shouldBe` [expected]+        specify "baseStringClass" $ do+            let (baseString, ctx) = runCodeGen baseStringClass empty'+            case ver of+                Python2 -> do+                    baseString `shouldBe` Right "__builtin__.basestring"+                    standardImports ctx `shouldBe`+                        [("__builtin__", "__builtin__")]+                Python3 -> do+                    baseString `shouldBe` Right "__builtin__.str"+                    standardImports ctx `shouldBe` [("__builtin__", "builtins")]+        specify "baseIntegerClass" $ do+            let (baseString, ctx) = runCodeGen baseIntegerClass empty'+            case ver of+                Python2 -> do+                    baseString `shouldBe`+                        Right "(__builtin__.int, __builtin__.long)"+                    standardImports ctx `shouldBe`+                        [("__builtin__", "__builtin__")]+                Python3 -> do+                    baseString `shouldBe` Right "__builtin__.int"+                    standardImports ctx `shouldBe` [("__builtin__", "builtins")]++        let evalContext f = snd $ runCodeGen f empty'+        let req = empty'+        let req2 = req { dependencies = ["six"] }+        let req3 = req { optionalDependencies = [((3, 4), ["enum34"])] }+        specify "addDependency" $ do+            evalContext (addDependency "six") `shouldBe` req2+            evalContext (addDependency "six" >> addDependency "six")+                `shouldBe` req2+            evalContext (addDependency "nirum") `shouldBe`+                req { dependencies = ["nirum"] }+            evalContext (addDependency "six" >> addDependency "nirum")+                `shouldBe` req2 { dependencies = ["nirum", "six"] }+        specify "addOptionalDependency" $ do+            evalContext (addOptionalDependency (3, 4) "enum34") `shouldBe` req3+            evalContext ( addOptionalDependency (3, 4) "enum34"+                        >> addOptionalDependency (3, 4) "enum34"+                        )+                `shouldBe` req3+            evalContext (addOptionalDependency (3, 4) "ipaddress") `shouldBe`+                req { optionalDependencies = [((3, 4), ["ipaddress"])] }+            evalContext ( addOptionalDependency (3, 4) "enum34"+                        >> addOptionalDependency (3, 4) "ipaddress"+                        )+                `shouldBe` req+                    { optionalDependencies = [ ((3, 4), ["enum34", "ipaddress"])+                                             ]+                    }+            evalContext (addOptionalDependency (3, 5) "typing")+                `shouldBe` req { optionalDependencies = [((3, 5), ["typing"])] }+            evalContext ( addOptionalDependency (3, 4) "enum34"+                        >> addOptionalDependency (3, 5) "typing"+                        )+                `shouldBe` req3+                    { optionalDependencies = [ ((3, 4), ["enum34"])+                                             , ((3, 5), ["typing"])+                                             ]+                    }++spec :: Spec+spec = do+    spec'++    describe "toClassName" $ do+        it "transform the facial name of the argument into PascalCase" $ do+            toClassName "test" `shouldBe` "Test"+            toClassName "hello-world" `shouldBe` "HelloWorld"+        it "appends an underscore to the result if it's a reserved keyword" $ do+            toClassName "true" `shouldBe` "True_"+            toClassName "false" `shouldBe` "False_"+            toClassName "none" `shouldBe` "None_"++    describe "toAttributeName" $ do+        it "transform the facial name of the argument into snake_case" $ do+            toAttributeName "test" `shouldBe` "test"+            toAttributeName "hello-world" `shouldBe` "hello_world"+        it "appends an underscore to the result if it's a reserved keyword" $ do+            toAttributeName "def" `shouldBe` "def_"+            toAttributeName "lambda" `shouldBe` "lambda_"+            toAttributeName "nonlocal" `shouldBe` "nonlocal_"++    specify "toImportPath" $ do+        let (Source pkg _) = makeDummySource $ Module [] Nothing+            target' = target $ metadata pkg+        toImportPath target' ["foo", "bar"] `shouldBe` "foo.bar"++    describe "toImportPaths" $ do+        it "adds ancestors of packages" $ do+            let (Source pkg _) = makeDummySource $ Module [] Nothing+                modulePaths = keysSet $ modules pkg+                target' = target $ metadata pkg+            toImportPaths target' modulePaths `shouldBe`+                [ "foo"+                , "foo.bar"+                , "qux"+                ]+        it "applies renames before add ancestors of packages" $ do+            let (Source pkg _) = makeDummySource' [] (Module [] Nothing)+                                                  [(["foo"], ["f", "oo"])]+                modulePaths = keysSet $ modules pkg+                target' = target $ metadata pkg+            toImportPaths target' modulePaths `shouldBe`+                [ "f"  -- > "f" should be added+                , "f.oo"+                , "f.oo.bar"+                , "qux"+                ]++    specify "renameModulePath" $ do+        let renames = [ (["foo"], ["poo"])+                      , (["foo", "bar"], ["foo"])+                      , (["baz"], ["p", "az"])+                      ] :: RenameMap+        renameModulePath renames ["foo"] `shouldBe` ["poo"]+        renameModulePath renames ["foo", "baz"] `shouldBe` ["poo", "baz"]+        renameModulePath renames ["foo", "bar"] `shouldBe` ["foo"]+        renameModulePath renames ["foo", "bar", "qux"] `shouldBe` ["foo", "qux"]+        renameModulePath renames ["baz"] `shouldBe` ["p", "az"]+        renameModulePath renames ["baz", "qux"] `shouldBe` ["p", "az", "qux"]+        renameModulePath renames ["qux", "foo"] `shouldBe` ["qux", "foo"]++    specify "indent" $ do+        indent "    " ("a\n    b\n\nc\n" :: Code) `shouldBe`+            "    a\n        b\n\n    c\n"+        indent "    " ("\"\"\"foo\nbar\n\"\"\"" :: Code) `shouldBe`+            "    \"\"\"foo\n    bar\n    \"\"\""++    specify "stringLiteral" $ do+        stringLiteral "asdf" `shouldBe` [q|"asdf"|]+        stringLiteral [q|Say 'hello world'|]+            `shouldBe` [q|"Say 'hello world'"|]+        stringLiteral [q|Say "hello world"|]+            `shouldBe` [q|"Say \"hello world\""|]+        stringLiteral "Say '\xc548\xb155'"+            `shouldBe` [q|u"Say '\uc548\ub155'"|]
+ test/Nirum/Targets/Python/TypeExpressionSpec.hs view
@@ -0,0 +1,101 @@+{-# LANGUAGE OverloadedLists #-}+{-# LANGUAGE QuasiQuotes #-}+module Nirum.Targets.Python.TypeExpressionSpec where++import Test.Hspec.Meta+import Text.InterpolatedString.Perl6 (qq)++import Nirum.Constructs.Module+import Nirum.Constructs.TypeDeclaration+import Nirum.Constructs.TypeExpression+import Nirum.Targets.Python (Source (..))+import Nirum.Targets.Python.CodeGen+import Nirum.Targets.Python.CodeGenSpec hiding (spec)+import Nirum.Targets.Python.TypeExpression++spec :: Spec+spec = pythonVersionSpecs $ \ ver -> do+    let empty' = empty ver+        -- run' :: CodeGen a -> (Either CompileError a, CodeGenContext)+        run' c = runCodeGen c empty'+        -- code :: CodeGen a -> a+        code = either (const undefined) id . fst . run'+        builtinsPair =+            ( "__builtin__"+            , case ver of+                  Python2 -> "__builtin__"+                  Python3 -> "builtins"+            )++    specify [qq|compilePrimitiveType ($ver)|] $ do+        let (boolCode, boolContext) = run' $ compilePrimitiveType Bool+        let intTypeCode = case ver of+                Python2 -> "_numbers.Integral"+                Python3 -> "__builtin__.int"+        boolCode `shouldBe` Right "__builtin__.bool"+        standardImports boolContext `shouldBe` [builtinsPair]+        code (compilePrimitiveType Bigint) `shouldBe` intTypeCode+        let (decimalCode, decimalContext) = run' (compilePrimitiveType Decimal)+        decimalCode `shouldBe` Right "_decimal.Decimal"+        standardImports decimalContext `shouldBe` [("_decimal", "decimal")]+        code (compilePrimitiveType Int32) `shouldBe` intTypeCode+        code (compilePrimitiveType Int64) `shouldBe` intTypeCode+        code (compilePrimitiveType Float32) `shouldBe` "__builtin__.float"+        code (compilePrimitiveType Float64) `shouldBe` "__builtin__.float"+        code (compilePrimitiveType Text) `shouldBe`+            case ver of+                Python2 -> "__builtin__.unicode"+                Python3 -> "__builtin__.str"+        code (compilePrimitiveType Binary) `shouldBe` "__builtin__.bytes"+        let (dateCode, dateContext) = run' (compilePrimitiveType Date)+        dateCode `shouldBe` Right "_datetime.date"+        standardImports dateContext `shouldBe` [("_datetime", "datetime")]+        let (datetimeCode, datetimeContext) =+                run' (compilePrimitiveType Datetime)+        datetimeCode `shouldBe` Right "_datetime.datetime"+        standardImports datetimeContext `shouldBe` [("_datetime", "datetime")]+        let (uuidCode, uuidContext) = run' (compilePrimitiveType Uuid)+        uuidCode `shouldBe` Right "_uuid.UUID"+        standardImports uuidContext `shouldBe` [("_uuid", "uuid")]+        code (compilePrimitiveType Url) `shouldBe`+            case ver of+                Python2 -> "__builtin__.basestring"+                Python3 -> "__builtin__.str"++    describe [qq|compileTypeExpression ($ver)|] $ do+        let Source { sourceModule = bm } = makeDummySource $ Module [] Nothing+        specify "TypeIdentifier" $ do+            let (c, ctx) = run' $+                    compileTypeExpression bm (Just $ TypeIdentifier "binary")+            standardImports ctx `shouldBe` [builtinsPair]+            localImports ctx `shouldBe` []+            c `shouldBe` Right "__builtin__.bytes"+        specify "OptionModifier" $ do+            let (c', ctx') = run' $+                    compileTypeExpression bm (Just $ OptionModifier "binary")+            standardImports ctx' `shouldBe`+                [builtinsPair, ("_typing", "typing")]+            localImports ctx' `shouldBe` []+            c' `shouldBe` Right "_typing.Optional[__builtin__.bytes]"+        specify "SetModifier" $ do+            let (c'', ctx'') = run' $+                    compileTypeExpression bm (Just $ SetModifier "float32")+            standardImports ctx'' `shouldBe`+                [builtinsPair, ("_typing", "typing")]+            localImports ctx'' `shouldBe` []+            c'' `shouldBe` Right "_typing.AbstractSet[__builtin__.float]"+        specify "ListModifier" $ do+            let (c''', ctx''') = run' $+                    compileTypeExpression bm (Just $ ListModifier "float64")+            standardImports ctx''' `shouldBe`+                [builtinsPair, ("_typing", "typing")]+            localImports ctx''' `shouldBe` []+            c''' `shouldBe` Right "_typing.Sequence[__builtin__.float]"+        specify "MapModifier" $ do+            let (c'''', ctx'''') = run' $ compileTypeExpression bm $+                    Just $ MapModifier "uuid" "binary"+            standardImports ctx'''' `shouldBe`+                [builtinsPair, ("_typing", "typing"), ("_uuid", "uuid")]+            localImports ctx'''' `shouldBe` []+            c'''' `shouldBe`+                Right "_typing.Mapping[_uuid.UUID, __builtin__.bytes]"
test/Nirum/Targets/PythonSpec.hs view
@@ -1,308 +1,22 @@-{-# LANGUAGE OverloadedLists, OverloadedStrings, QuasiQuotes,-             ScopedTypeVariables #-}+{-# LANGUAGE OverloadedLists #-}+{-# LANGUAGE ScopedTypeVariables #-} module Nirum.Targets.PythonSpec where -import Control.Monad (forM_)-import Data.Either (isRight)-import Data.Maybe (fromJust)- import qualified Data.Map.Strict as M-import qualified Data.SemVer as SV import System.FilePath ((</>)) import Test.Hspec.Meta-import Text.Email.Validate (emailAddress)-import Text.InterpolatedString.Perl6 (q, qq) -import Nirum.Constructs.Annotation (empty)-import Nirum.Constructs.Identifier (Identifier) import Nirum.Constructs.Module (Module (Module))-import Nirum.Constructs.ModulePath (ModulePath, fromIdentifiers)-import Nirum.Constructs.Name (Name (Name))-import Nirum.Constructs.TypeDeclaration ( Field (Field)-                                        , PrimitiveTypeIdentifier (..)-                                        , Type ( Alias-                                               , RecordType-                                               , UnboxedType-                                               )-                                        , TypeDeclaration ( Import-                                                          , TypeDeclaration-                                                          )-                                        )-import Nirum.Constructs.TypeExpression ( TypeExpression ( ListModifier-                                                        , MapModifier-                                                        , OptionModifier-                                                        , SetModifier-                                                        , TypeIdentifier-                                                        )-                                       )-import Nirum.Package hiding (target)-import Nirum.Package.Metadata ( Author (Author, email, name, uri)-                              , Metadata ( Metadata-                                         , authors-                                         , target-                                         , version-                                         , description-                                         , license-                                         , keywords-                                         )-                              , Target (compilePackage)-                              )-import qualified Nirum.Package.ModuleSet as MS-import Nirum.PackageSpec (createPackage)-import qualified Nirum.Targets.Python as PY-import Nirum.Targets.Python ( Source (Source)-                            , CodeGen-                            , CodeGenContext ( localImports-                                             , standardImports-                                             , thirdPartyImports-                                             )-                            , InstallRequires ( InstallRequires-                                              , dependencies-                                              , optionalDependencies-                                              )-                            , Python (Python)-                            , PythonVersion (Python2, Python3)-                            , RenameMap-                            , addDependency-                            , addOptionalDependency-                            , compilePrimitiveType-                            , compileTypeExpression-                            , insertLocalImport-                            , insertStandardImport-                            , insertThirdPartyImports-                            , insertThirdPartyImportsA-                            , localImportsMap-                            , minimumRuntime-                            , parseModulePath-                            , renameModulePath-                            , runCodeGen-                            , stringLiteral-                            , toAttributeName-                            , toClassName-                            , toNamePair-                            , unionInstallRequires-                            )-import Nirum.TypeInstance.BoundModule--codeGen :: a -> CodeGen a-codeGen = return--makeDummySource' :: [Identifier] -> Module -> RenameMap -> Source-makeDummySource' pathPrefix m renames =-    Source pkg $ fromJust $ resolveBoundModule ["foo"] pkg-  where-    mp :: [Identifier] -> ModulePath-    mp identifiers = fromJust $ fromIdentifiers (pathPrefix ++ identifiers)-    metadata' :: Metadata Python-    metadata' = Metadata-        { version = SV.version 1 2 3 [] []-        , authors =-              [ Author-                    { name = "John Doe"-                    , email = Just (fromJust $ emailAddress "john@example.com")-                    , uri = Nothing-                    }-              ]-        , description = Just "Package description"-        , license = Just "MIT"-        , keywords = ["sample", "example", "nirum"]-        , target = Python "sample-package" minimumRuntime renames-        }-    pkg :: Package Python-    pkg = createPackage-            metadata'-            [ (mp ["foo"], m)-            , ( mp ["foo", "bar"]-              , Module [ Import (mp ["qux"]) "path" empty-                       , TypeDeclaration "path-unbox" (UnboxedType "path") empty-                       , TypeDeclaration "int-unbox"-                                         (UnboxedType "bigint") empty-                       , TypeDeclaration "point"-                                         (RecordType [ Field "x" "int64" empty-                                                     , Field "y" "int64" empty-                                                     ])-                                         empty-                       ] Nothing-              )-            , ( mp ["qux"]-              , Module-                  [ TypeDeclaration "path" (Alias "text") empty-                  , TypeDeclaration "name" (UnboxedType "text") empty-                  ]-                  Nothing-              )-            ]--makeDummySource :: Module -> Source-makeDummySource m = makeDummySource' [] m []+import Nirum.Package.Metadata (Target (compilePackage))+import Nirum.Targets.Python+    ( Source (Source)+    , parseModulePath+    )+import Nirum.Targets.Python.CodeGenSpec hiding (spec)  spec :: Spec-spec = parallel $ forM_ ([Python2, Python3] :: [PythonVersion]) $ \ ver -> do-    let empty' = PY.empty ver-        -- run' :: CodeGen a -> (Either CompileError a, CodeGenContext)-        run' c = runCodeGen c empty'-        -- code :: CodeGen a -> a-        code = either (const undefined) id . fst . run'-        -- compileError :: CodeGen a -> Maybe CompileError-        compileError cg = either Just (const Nothing) $ fst $-            runCodeGen cg empty'-    describe [qq|CodeGen ($ver)|] $ do-        specify "packages and imports" $ do-            let c = do-                    insertStandardImport "sys"-                    insertThirdPartyImports-                        [("nirum", ["serialize_unboxed_type"])]-                    insertLocalImport ".." "Gender"-                    insertStandardImport "os"-                    insertThirdPartyImports [("nirum", ["serialize_enum_type"])]-                    insertThirdPartyImportsA-                        [("nirum.constructs", [("name_dict_type", "NameDict")])]-                    insertLocalImport ".." "Path"-            let (e, ctx) = runCodeGen c empty'-            e `shouldSatisfy` isRight-            standardImports ctx `shouldBe` ["os", "sys"]-            thirdPartyImports ctx `shouldBe`-                [ ( "nirum"-                  , [ ("serialize_unboxed_type", "serialize_unboxed_type")-                    , ("serialize_enum_type", "serialize_enum_type")-                    ]-                  )-                , ( "nirum.constructs"-                  , [("name_dict_type", "NameDict")]-                  )-                ]-            localImports ctx `shouldBe` [("..", ["Gender", "Path"])]-            localImportsMap ctx `shouldBe`-                [ ( ".."-                  , [ ("Gender", "Gender")-                    , ("Path", "Path")-                    ]-                  )-                ]-        specify "insertStandardImport" $ do-            let codeGen1 = insertStandardImport "sys"-            let (e1, ctx1) = runCodeGen codeGen1 empty'-            e1 `shouldSatisfy` isRight-            standardImports ctx1 `shouldBe` ["sys"]-            thirdPartyImports ctx1 `shouldBe` []-            localImports ctx1 `shouldBe` []-            compileError codeGen1 `shouldBe` Nothing-            let codeGen2 = codeGen1 >> insertStandardImport "os"-            let (e2, ctx2) = runCodeGen codeGen2 empty'-            e2 `shouldSatisfy` isRight-            standardImports ctx2 `shouldBe` ["os", "sys"]-            thirdPartyImports ctx2 `shouldBe` []-            localImports ctx2 `shouldBe` []-            compileError codeGen2 `shouldBe` Nothing--    specify [qq|compilePrimitiveType ($ver)|] $ do-        code (compilePrimitiveType Bool) `shouldBe` "bool"-        code (compilePrimitiveType Bigint) `shouldBe` "int"-        let (decimalCode, decimalContext) = run' (compilePrimitiveType Decimal)-        decimalCode `shouldBe` Right "decimal.Decimal"-        standardImports decimalContext `shouldBe` ["decimal"]-        code (compilePrimitiveType Int32) `shouldBe` "int"-        code (compilePrimitiveType Int64) `shouldBe`-            case ver of-                Python2 -> "numbers.Integral"-                Python3 -> "int"-        code (compilePrimitiveType Float32) `shouldBe` "float"-        code (compilePrimitiveType Float64) `shouldBe` "float"-        code (compilePrimitiveType Text) `shouldBe`-            case ver of-                Python2 -> "unicode"-                Python3 -> "str"-        code (compilePrimitiveType Binary) `shouldBe` "bytes"-        let (dateCode, dateContext) = run' (compilePrimitiveType Date)-        dateCode `shouldBe` Right "datetime.date"-        standardImports dateContext `shouldBe` ["datetime"]-        let (datetimeCode, datetimeContext) =-                run' (compilePrimitiveType Datetime)-        datetimeCode `shouldBe` Right "datetime.datetime"-        standardImports datetimeContext `shouldBe` ["datetime"]-        let (uuidCode, uuidContext) = run' (compilePrimitiveType Uuid)-        uuidCode `shouldBe` Right "uuid.UUID"-        standardImports uuidContext `shouldBe` ["uuid"]-        code (compilePrimitiveType Uri) `shouldBe`-            case ver of-                Python2 -> "unicode"-                Python3 -> "str"--    describe [qq|compileTypeExpression ($ver)|] $ do-        let s = makeDummySource $ Module [] Nothing-        specify "TypeIdentifier" $ do-            let (c, ctx) = run' $-                    compileTypeExpression s (Just $ TypeIdentifier "bigint")-            standardImports ctx `shouldBe` []-            localImports ctx `shouldBe` []-            c `shouldBe` Right "int"-        specify "OptionModifier" $ do-            let (c', ctx') = run' $-                    compileTypeExpression s (Just $ OptionModifier "int32")-            standardImports ctx' `shouldBe` ["typing"]-            localImports ctx' `shouldBe` []-            c' `shouldBe` Right "typing.Optional[int]"-        specify "SetModifier" $ do-            let (c'', ctx'') = run' $-                    compileTypeExpression s (Just $ SetModifier "int32")-            standardImports ctx'' `shouldBe` ["typing"]-            localImports ctx'' `shouldBe` []-            c'' `shouldBe` Right "typing.AbstractSet[int]"-        specify "ListModifier" $ do-            let (c''', ctx''') = run' $-                    compileTypeExpression s (Just $ ListModifier "int32")-            standardImports ctx''' `shouldBe` ["typing"]-            localImports ctx''' `shouldBe` []-            c''' `shouldBe` Right "typing.Sequence[int]"-        specify "MapModifier" $ do-            let (c'''', ctx'''') = run' $-                    compileTypeExpression s (Just $ MapModifier "uuid" "int32")-            standardImports ctx'''' `shouldBe` ["typing", "uuid"]-            localImports ctx'''' `shouldBe` []-            c'''' `shouldBe` Right "typing.Mapping[uuid.UUID, int]"--    describe [qq|toClassName ($ver)|] $ do-        it "transform the facial name of the argument into PascalCase" $ do-            toClassName "test" `shouldBe` "Test"-            toClassName "hello-world" `shouldBe` "HelloWorld"-        it "appends an underscore to the result if it's a reserved keyword" $ do-            toClassName "true" `shouldBe` "True_"-            toClassName "false" `shouldBe` "False_"-            toClassName "none" `shouldBe` "None_"--    describe [qq|toAttributeName ($ver)|] $ do-        it "transform the facial name of the argument into snake_case" $ do-            toAttributeName "test" `shouldBe` "test"-            toAttributeName "hello-world" `shouldBe` "hello_world"-        it "appends an underscore to the result if it's a reserved keyword" $ do-            toAttributeName "def" `shouldBe` "def_"-            toAttributeName "lambda" `shouldBe` "lambda_"-            toAttributeName "nonlocal" `shouldBe` "nonlocal_"--    describe [qq|toNamePair ($ver)|] $ do-        it "transforms the name to a Python code string of facial/behind pair" $-            do toNamePair "text" `shouldBe` "('text', 'text')"-               toNamePair (Name "test" "hello") `shouldBe` "('test', 'hello')"-        it "replaces hyphens to underscores" $ do-            toNamePair "hello-world" `shouldBe` "('hello_world', 'hello_world')"-            toNamePair (Name "hello-world" "annyeong-sesang") `shouldBe`-                "('hello_world', 'annyeong_sesang')"-        it "appends an underscore if the facial name is a Python keyword" $ do-            toNamePair "def" `shouldBe` "('def_', 'def')"-            toNamePair "lambda" `shouldBe` "('lambda_', 'lambda')"-            toNamePair (Name "abc" "lambda") `shouldBe` "('abc', 'lambda')"-            toNamePair (Name "lambda" "abc") `shouldBe` "('lambda_', 'abc')"--    specify [qq|stringLiteral ($ver)|] $ do-        stringLiteral "asdf" `shouldBe` [q|"asdf"|]-        stringLiteral [q|Say 'hello world'|]-            `shouldBe` [q|"Say 'hello world'"|]-        stringLiteral [q|Say "hello world"|]-            `shouldBe` [q|"Say \"hello world\""|]-        stringLiteral "Say '\xc548\xb155'"-            `shouldBe` [q|u"Say '\uc548\ub155'"|]--    describe [qq|compilePackage ($ver)|] $ do+spec = do+    describe "compilePackage" $ do         it "returns a Map of file paths and their contents to generate" $ do             let (Source pkg _) = makeDummySource $ Module [] Nothing                 files = compilePackage pkg@@ -364,74 +78,6 @@                     ]             M.keysSet files' `shouldBe` directoryStructure' -    describe [qq|InstallRequires ($ver)|] $ do-        let req = InstallRequires [] []-            req2 = req { dependencies = ["six"] }-            req3 = req { optionalDependencies = [((3, 4), ["enum34"])] }-        specify "addDependency" $ do-            addDependency req "six" `shouldBe` req2-            addDependency req2 "six" `shouldBe` req2-            addDependency req "nirum" `shouldBe`-                req { dependencies = ["nirum"] }-            addDependency req2 "nirum" `shouldBe`-                req2 { dependencies = ["nirum", "six"] }-        specify "addOptionalDependency" $ do-            addOptionalDependency req (3, 4) "enum34" `shouldBe` req3-            addOptionalDependency req3 (3, 4) "enum34" `shouldBe` req3-            addOptionalDependency req (3, 4) "ipaddress" `shouldBe`-                req { optionalDependencies = [((3, 4), ["ipaddress"])] }-            addOptionalDependency req3 (3, 4) "ipaddress" `shouldBe`-                req { optionalDependencies = [ ((3, 4), ["enum34", "ipaddress"])-                                             ]-                    }-            addOptionalDependency req (3, 5) "typing" `shouldBe`-                req { optionalDependencies = [((3, 5), ["typing"])] }-            addOptionalDependency req3 (3, 5) "typing" `shouldBe`-                req3 { optionalDependencies = [ ((3, 4), ["enum34"])-                                              , ((3, 5), ["typing"])-                                              ]-                     }-        specify "unionInstallRequires" $ do-            (req `unionInstallRequires` req) `shouldBe` req-            (req `unionInstallRequires` req2) `shouldBe` req2-            (req2 `unionInstallRequires` req) `shouldBe` req2-            (req `unionInstallRequires` req3) `shouldBe` req3-            (req3 `unionInstallRequires` req) `shouldBe` req3-            let req4 = req3 { dependencies = ["six"] }-            (req2 `unionInstallRequires` req3) `shouldBe` req4-            (req3 `unionInstallRequires` req2) `shouldBe` req4-            let req5 = req { dependencies = ["nirum"]-                           , optionalDependencies = [((3, 4), ["ipaddress"])]-                           }-                req6 = addOptionalDependency (addDependency req4 "nirum")-                                             (3, 4) "ipaddress"-            (req4 `unionInstallRequires` req5) `shouldBe` req6-            (req5 `unionInstallRequires` req4) `shouldBe` req6-    specify [qq|toImportPath ($ver)|] $ do-        let (Source pkg _) = makeDummySource $ Module [] Nothing-            target' = target $ metadata pkg-        PY.toImportPath target' ["foo", "bar"] `shouldBe` "foo.bar"-    describe [qq|toImportPath ($ver)|] $ do-        it "adds ancestors of packages" $ do-            let (Source pkg _) = makeDummySource $ Module [] Nothing-                modulePaths = MS.keysSet $ modules pkg-                target' = target $ metadata pkg-            PY.toImportPaths target' modulePaths `shouldBe`-                [ "foo"-                , "foo.bar"-                , "qux"-                ]-        it "applies renames before add ancestors of packages" $ do-            let (Source pkg _) = makeDummySource' [] (Module [] Nothing)-                                                  [(["foo"], ["f", "oo"])]-                modulePaths = MS.keysSet $ modules pkg-                target' = target $ metadata pkg-            PY.toImportPaths target' modulePaths `shouldBe`-                [ "f"  -- > "f" should be added-                , "f.oo"-                , "f.oo.bar"-                , "qux"-                ]     specify "parseModulePath" $ do         parseModulePath "" `shouldBe` Nothing         parseModulePath "foo" `shouldBe` Just ["foo"]@@ -444,15 +90,3 @@         parseModulePath "foo..bar" `shouldBe` Nothing         parseModulePath "foo.bar>" `shouldBe` Nothing         parseModulePath "foo.bar-" `shouldBe` Nothing-    specify "renameModulePath" $ do-        let renames = [ (["foo"], ["poo"])-                      , (["foo", "bar"], ["foo"])-                      , (["baz"], ["p", "az"])-                      ] :: RenameMap-        renameModulePath renames ["foo"] `shouldBe` ["poo"]-        renameModulePath renames ["foo", "baz"] `shouldBe` ["poo", "baz"]-        renameModulePath renames ["foo", "bar"] `shouldBe` ["foo"]-        renameModulePath renames ["foo", "bar", "qux"] `shouldBe` ["foo", "qux"]-        renameModulePath renames ["baz"] `shouldBe` ["p", "az"]-        renameModulePath renames ["baz", "qux"] `shouldBe` ["p", "az", "qux"]-        renameModulePath renames ["qux", "foo"] `shouldBe` ["qux", "foo"]
test/Nirum/TargetsSpec.hs view
@@ -56,6 +56,7 @@                     , "src-py2" </> "blockchain" </> "__init__.py"                     , "src-py2" </> "builtins" </> "__init__.py"                     , "src-py2" </> "countries" </> "__init__.py"+                    , "src-py2" </> "geo" </> "__init__.py"                     , "src-py2" </> "pdf_service" </> "__init__.py"                     , "src-py2" </> "product" </> "__init__.py"                     , "src-py2" </> "shapes" </> "__init__.py"@@ -63,6 +64,7 @@                     , "src" </> "blockchain" </> "__init__.py"                     , "src" </> "builtins" </> "__init__.py"                     , "src" </> "countries" </> "__init__.py"+                    , "src" </> "geo" </> "__init__.py"                     , "src" </> "pdf_service" </> "__init__.py"                     , "src" </> "product" </> "__init__.py"                     , "src" </> "shapes" </> "__init__.py"
+ test/Nirum/TestFixtures.hs view
@@ -0,0 +1,22 @@+module Nirum.TestFixtures (fixturePackage, scanFixturePackage) where++import Control.Monad+import Data.Either++import System.FilePath++import Nirum.Package+import Nirum.Package.Metadata+++-- | Scan test/nirum_fixture/ package.+scanFixturePackage :: Target t => IO (Either PackageError (Package t))+scanFixturePackage = scanPackage $ "test" </> "nirum_fixture"++-- | Unsafe version of 'scanFixturePackage'.+fixturePackage :: Target t => IO (Package t)+fixturePackage = do+    result <- scanFixturePackage+    when (isLeft result) $ fail ("result: " ++ show result)+    let Right pkg = result+    return pkg
test/Nirum/TypeInstance/BoundModuleSpec.hs view
@@ -15,12 +15,13 @@ import Nirum.Package.Metadata import Nirum.Package.MetadataSpec import Nirum.PackageSpec (createValidPackage)-import Nirum.Targets.Python (Python (Python), minimumRuntime)+import Nirum.Targets.Python (Python (Python))+import Nirum.Targets.Python.CodeGen (minimumRuntime) import Nirum.TypeInstance.BoundModule  spec :: Spec spec = do-    testPackage (Python "nirum-examples" minimumRuntime [])+    testPackage (Python "nirum-examples" minimumRuntime [] [])     testPackage DummyTarget  testPackage :: forall t . Target t => t -> Spec@@ -36,25 +37,31 @@         let Just bm = resolveBoundModule ["foo", "bar"] validPackage             Just abc = resolveBoundModule ["abc"] validPackage             Just xyz = resolveBoundModule ["xyz"] validPackage+            Just zar = resolveBoundModule ["zar"] validPackage         specify "docs" $ do             docs bm `shouldBe` Just "foo.bar"             let Just bm' = resolveBoundModule ["foo"] validPackage             docs bm' `shouldBe` Just "foo"         specify "boundTypes" $ do             boundTypes bm `shouldBe` []-            boundTypes abc `shouldBe` [TypeDeclaration "a" (Alias "text") empty]+            boundTypes abc `shouldBe`+                [TypeDeclaration "a" (Alias "text") empty]             boundTypes xyz `shouldBe`-                [ Import ["abc"] "a" empty+                [ Import ["abc"] "a" "a" empty                 , TypeDeclaration "x" (Alias "text") empty                 ]         specify "lookupType" $ do             lookupType "a" bm `shouldBe` Missing             lookupType "a" abc `shouldBe` Local (Alias "text")-            lookupType "a" xyz `shouldBe` Imported ["abc"] (Alias "text")+            lookupType "a" xyz `shouldBe` Imported ["abc"] "a" (Alias "text")+            lookupType "aliased" zar `shouldBe`+                Imported ["abc"] "a" (Alias "text")             lookupType "x" bm `shouldBe` Missing             lookupType "x" abc `shouldBe` Missing             lookupType "x" xyz `shouldBe` Local (Alias "text")+            lookupType "quuz" zar `shouldBe` Local (Alias "text")             lookupType "text" bm `shouldBe`-                Imported coreModulePath (PrimitiveType Text String)+                Imported coreModulePath "text" (PrimitiveType Text String)             lookupType "text" abc `shouldBe` lookupType "text" bm             lookupType "text" xyz `shouldBe` lookupType "text" bm+            lookupType "text" zar `shouldBe` lookupType "text" bm
test/Nirum/VersionSpec.hs view
@@ -17,7 +17,7 @@             version `shouldSatisfy` SV.isDevelopment         it "is the proper version" $             -- is it a necessary test?-            version `shouldBe` SV.version 0 3 3 [] []+            version `shouldBe` SV.version 0 4 0 [] []     describe "versionText" $ do         it "is equivalent to version" $             versionText `shouldBe` SV.toText version
− test/Spec.hs
@@ -1,1 +0,0 @@-{-# OPTIONS_GHC -F -pgmF hspec-meta-discover #-}