layered-graph-drawing (empty) → 0.1.0.0

raw patch · 7 files changed

+2986/−0 lines, 7 filesdep +aesondep +basedep +containerssetup-changed

Dependencies added: aeson, base, containers, data-ordlist, intmap-graph, layered-graph-drawing, text, vector, vector-algorithms

Files

• LICENSE +674/−0
• Setup.hs +2/−0
• app/Main.hs +319/−0
• layered-graph-drawing.cabal +46/−0
• src/Graph/CommonGraph.hs +226/−0
• src/Graph/GraphDrawing.hs +1478/−0
• src/Graph/SubGraphWindows.hs +241/−0

@@ -0,0 +1,674 @@+                    GNU GENERAL PUBLIC LICENSE+                       Version 3, 29 June 2007++ Copyright (C) 2007 Free Software Foundation, Inc. <https://fsf.org/>+ Everyone is permitted to copy and distribute verbatim copies+ of this license document, but changing it is not allowed.++                            Preamble++  The GNU General Public License is a free, copyleft license for+software and other kinds of works.++  The licenses for most software and other practical works are designed+to take away your freedom to share and change the works.  By contrast,+the GNU General Public License is intended to guarantee your freedom to+share and change all versions of a program--to make sure it remains free+software for all its users.  We, the Free Software Foundation, use the+GNU General Public License for most of our software; it applies also to+any other work released this way by its authors.  You can apply it to+your programs, too.++  When we speak of free software, we are referring to freedom, not+price.  Our General Public Licenses are designed to make sure that you+have the freedom to distribute copies of free software (and charge for+them if you wish), that you receive source code or can get it if you+want it, that you can change the software or use pieces of it in new+free programs, and that you know you can do these things.++  To protect your rights, we need to prevent others from denying you+these rights or asking you to surrender the rights.  Therefore, you have+certain responsibilities if you distribute copies of the software, or if+you modify it: responsibilities to respect the freedom of others.++  For example, if you distribute copies of such a program, whether+gratis or for a fee, you must pass on to the recipients the same+freedoms that you received.  You must make sure that they, too, receive+or can get the source code.  And you must show them these terms so they+know their rights.++  Developers that use the GNU GPL protect your rights with two steps:+(1) assert copyright on the software, and (2) offer you this License+giving you legal permission to copy, distribute and/or modify it.++  For the developers' and authors' protection, the GPL clearly explains+that there is no warranty for this free software.  For both users' and+authors' sake, the GPL requires that modified versions be marked as+changed, so that their problems will not be attributed erroneously to+authors of previous versions.++  Some devices are designed to deny users access to install or run+modified versions of the software inside them, although the manufacturer+can do so.  This is fundamentally incompatible with the aim of+protecting users' freedom to change the software.  The systematic+pattern of such abuse occurs in the area of products for individuals to+use, which is precisely where it is most unacceptable.  Therefore, we+have designed this version of the GPL to prohibit the practice for those+products.  If such problems arise substantially in other domains, we+stand ready to extend this provision to those domains in future versions+of the GPL, as needed to protect the freedom of users.++  Finally, every program is threatened constantly by software patents.+States should not allow patents to restrict development and use of+software on general-purpose computers, but in those that do, we wish to+avoid the special danger that patents applied to a free program could+make it effectively proprietary.  To prevent this, the GPL assures that+patents cannot be used to render the program non-free.++  The precise terms and conditions for copying, distribution and+modification follow.++                       TERMS AND CONDITIONS++  0. Definitions.++  "This License" refers to version 3 of the GNU General Public License.++  "Copyright" also means copyright-like laws that apply to other kinds of+works, such as semiconductor masks.++  "The Program" refers to any copyrightable work licensed under this+License.  Each licensee is addressed as "you".  "Licensees" and+"recipients" may be individuals or organizations.++  To "modify" a work means to copy from or adapt all or part of the work+in a fashion requiring copyright permission, other than the making of an+exact copy.  The resulting work is called a "modified version" of the+earlier work or a work "based on" the earlier work.++  A "covered work" means either the unmodified Program or a work based+on the Program.++  To "propagate" a work means to do anything with it that, without+permission, would make you directly or secondarily liable for+infringement under applicable copyright law, except executing it on a+computer or modifying a private copy.  Propagation includes copying,+distribution (with or without modification), making available to the+public, and in some countries other activities as well.++  To "convey" a work means any kind of propagation that enables other+parties to make or receive copies.  Mere interaction with a user through+a computer network, with no transfer of a copy, is not conveying.++  An interactive user interface displays "Appropriate Legal Notices"+to the extent that it includes a convenient and prominently visible+feature that (1) displays an appropriate copyright notice, and (2)+tells the user that there is no warranty for the work (except to the+extent that warranties are provided), that licensees may convey the+work under this License, and how to view a copy of this License.  If+the interface presents a list of user commands or options, such as a+menu, a prominent item in the list meets this criterion.++  1. Source Code.++  The "source code" for a work means the preferred form of the work+for making modifications to it.  "Object code" means any non-source+form of a work.++  A "Standard Interface" means an interface that either is an official+standard defined by a recognized standards body, or, in the case of+interfaces specified for a particular programming language, one that+is widely used among developers working in that language.++  The "System Libraries" of an executable work include anything, other+than the work as a whole, that (a) is included in the normal form of+packaging a Major Component, but which is not part of that Major+Component, and (b) serves only to enable use of the work with that+Major Component, or to implement a Standard Interface for which an+implementation is available to the public in source code form.  A+"Major Component", in this context, means a major essential component+(kernel, window system, and so on) of the specific operating system+(if any) on which the executable work runs, or a compiler used to+produce the work, or an object code interpreter used to run it.++  The "Corresponding Source" for a work in object code form means all+the source code needed to generate, install, and (for an executable+work) run the object code and to modify the work, including scripts to+control those activities.  However, it does not include the work's+System Libraries, or general-purpose tools or generally available free+programs which are used unmodified in performing those activities but+which are not part of the work.  For example, Corresponding Source+includes interface definition files associated with source files for+the work, and the source code for shared libraries and dynamically+linked subprograms that the work is specifically designed to require,+such as by intimate data communication or control flow between those+subprograms and other parts of the work.++  The Corresponding Source need not include anything that users+can regenerate automatically from other parts of the Corresponding+Source.++  The Corresponding Source for a work in source code form is that+same work.++  2. Basic Permissions.++  All rights granted under this License are granted for the term of+copyright on the Program, and are irrevocable provided the stated+conditions are met.  This License explicitly affirms your unlimited+permission to run the unmodified Program.  The output from running a+covered work is covered by this License only if the output, given its+content, constitutes a covered work.  This License acknowledges your+rights of fair use or other equivalent, as provided by copyright law.++  You may make, run and propagate covered works that you do not+convey, without conditions so long as your license otherwise remains+in force.  You may convey covered works to others for the sole purpose+of having them make modifications exclusively for you, or provide you+with facilities for running those works, provided that you comply with+the terms of this License in conveying all material for which you do+not control copyright.  Those thus making or running the covered works+for you must do so exclusively on your behalf, under your direction+and control, on terms that prohibit them from making any copies of+your copyrighted material outside their relationship with you.++  Conveying under any other circumstances is permitted solely under+the conditions stated below.  Sublicensing is not allowed; section 10+makes it unnecessary.++  3. Protecting Users' Legal Rights From Anti-Circumvention Law.++  No covered work shall be deemed part of an effective technological+measure under any applicable law fulfilling obligations under article+11 of the WIPO copyright treaty adopted on 20 December 1996, or+similar laws prohibiting or restricting circumvention of such+measures.++  When you convey a covered work, you waive any legal power to forbid+circumvention of technological measures to the extent such circumvention+is effected by exercising rights under this License with respect to+the covered work, and you disclaim any intention to limit operation or+modification of the work as a means of enforcing, against the work's+users, your or third parties' legal rights to forbid circumvention of+technological measures.++  4. Conveying Verbatim Copies.++  You may convey verbatim copies of the Program's source code as you+receive it, in any medium, provided that you conspicuously and+appropriately publish on each copy an appropriate copyright notice;+keep intact all notices stating that this License and any+non-permissive terms added in accord with section 7 apply to the code;+keep intact all notices of the absence of any warranty; and give all+recipients a copy of this License along with the Program.++  You may charge any price or no price for each copy that you convey,+and you may offer support or warranty protection for a fee.++  5. Conveying Modified Source Versions.++  You may convey a work based on the Program, or the modifications to+produce it from the Program, in the form of source code under the+terms of section 4, provided that you also meet all of these conditions:++    a) The work must carry prominent notices stating that you modified+    it, and giving a relevant date.++    b) The work must carry prominent notices stating that it is+    released under this License and any conditions added under section+    7.  This requirement modifies the requirement in section 4 to+    "keep intact all notices".++    c) You must license the entire work, as a whole, under this+    License to anyone who comes into possession of a copy.  This+    License will therefore apply, along with any applicable section 7+    additional terms, to the whole of the work, and all its parts,+    regardless of how they are packaged.  This License gives no+    permission to license the work in any other way, but it does not+    invalidate such permission if you have separately received it.++    d) If the work has interactive user interfaces, each must display+    Appropriate Legal Notices; however, if the Program has interactive+    interfaces that do not display Appropriate Legal Notices, your+    work need not make them do so.++  A compilation of a covered work with other separate and independent+works, which are not by their nature extensions of the covered work,+and which are not combined with it such as to form a larger program,+in or on a volume of a storage or distribution medium, is called an+"aggregate" if the compilation and its resulting copyright are not+used to limit the access or legal rights of the compilation's users+beyond what the individual works permit.  Inclusion of a covered work+in an aggregate does not cause this License to apply to the other+parts of the aggregate.++  6. Conveying Non-Source Forms.++  You may convey a covered work in object code form under the terms+of sections 4 and 5, provided that you also convey the+machine-readable Corresponding Source under the terms of this License,+in one of these ways:++    a) Convey the object code in, or embodied in, a physical product+    (including a physical distribution medium), accompanied by the+    Corresponding Source fixed on a durable physical medium+    customarily used for software interchange.++    b) Convey the object code in, or embodied in, a physical product+    (including a physical distribution medium), accompanied by a+    written offer, valid for at least three years and valid for as+    long as you offer spare parts or customer support for that product+    model, to give anyone who possesses the object code either (1) a+    copy of the Corresponding Source for all the software in the+    product that is covered by this License, on a durable physical+    medium customarily used for software interchange, for a price no+    more than your reasonable cost of physically performing this+    conveying of source, or (2) access to copy the+    Corresponding Source from a network server at no charge.++    c) Convey individual copies of the object code with a copy of the+    written offer to provide the Corresponding Source.  This+    alternative is allowed only occasionally and noncommercially, and+    only if you received the object code with such an offer, in accord+    with subsection 6b.++    d) Convey the object code by offering access from a designated+    place (gratis or for a charge), and offer equivalent access to the+    Corresponding Source in the same way through the same place at no+    further charge.  You need not require recipients to copy the+    Corresponding Source along with the object code.  If the place to+    copy the object code is a network server, the Corresponding Source+    may be on a different server (operated by you or a third party)+    that supports equivalent copying facilities, provided you maintain+    clear directions next to the object code saying where to find the+    Corresponding Source.  Regardless of what server hosts the+    Corresponding Source, you remain obligated to ensure that it is+    available for as long as needed to satisfy these requirements.++    e) Convey the object code using peer-to-peer transmission, provided+    you inform other peers where the object code and Corresponding+    Source of the work are being offered to the general public at no+    charge under subsection 6d.++  A separable portion of the object code, whose source code is excluded+from the Corresponding Source as a System Library, need not be+included in conveying the object code work.++  A "User Product" is either (1) a "consumer product", which means any+tangible personal property which is normally used for personal, family,+or household purposes, or (2) anything designed or sold for incorporation+into a dwelling.  In determining whether a product is a consumer product,+doubtful cases shall be resolved in favor of coverage.  For a particular+product received by a particular user, "normally used" refers to a+typical or common use of that class of product, regardless of the status+of the particular user or of the way in which the particular user+actually uses, or expects or is expected to use, the product.  A product+is a consumer product regardless of whether the product has substantial+commercial, industrial or non-consumer uses, unless such uses represent+the only significant mode of use of the product.++  "Installation Information" for a User Product means any methods,+procedures, authorization keys, or other information required to install+and execute modified versions of a covered work in that User Product from+a modified version of its Corresponding Source.  The information must+suffice to ensure that the continued functioning of the modified object+code is in no case prevented or interfered with solely because+modification has been made.++  If you convey an object code work under this section in, or with, or+specifically for use in, a User Product, and the conveying occurs as+part of a transaction in which the right of possession and use of the+User Product is transferred to the recipient in perpetuity or for a+fixed term (regardless of how the transaction is characterized), the+Corresponding Source conveyed under this section must be accompanied+by the Installation Information.  But this requirement does not apply+if neither you nor any third party retains the ability to install+modified object code on the User Product (for example, the work has+been installed in ROM).++  The requirement to provide Installation Information does not include a+requirement to continue to provide support service, warranty, or updates+for a work that has been modified or installed by the recipient, or for+the User Product in which it has been modified or installed.  Access to a+network may be denied when the modification itself materially and+adversely affects the operation of the network or violates the rules and+protocols for communication across the network.++  Corresponding Source conveyed, and Installation Information provided,+in accord with this section must be in a format that is publicly+documented (and with an implementation available to the public in+source code form), and must require no special password or key for+unpacking, reading or copying.++  7. Additional Terms.++  "Additional permissions" are terms that supplement the terms of this+License by making exceptions from one or more of its conditions.+Additional permissions that are applicable to the entire Program shall+be treated as though they were included in this License, to the extent+that they are valid under applicable law.  If additional permissions+apply only to part of the Program, that part may be used separately+under those permissions, but the entire Program remains governed by+this License without regard to the additional permissions.++  When you convey a copy of a covered work, you may at your option+remove any additional permissions from that copy, or from any part of+it.  (Additional permissions may be written to require their own+removal in certain cases when you modify the work.)  You may place+additional permissions on material, added by you to a covered work,+for which you have or can give appropriate copyright permission.++  Notwithstanding any other provision of this License, for material you+add to a covered work, you may (if authorized by the copyright holders of+that material) supplement the terms of this License with terms:++    a) Disclaiming warranty or limiting liability differently from the+    terms of sections 15 and 16 of this License; or++    b) Requiring preservation of specified reasonable legal notices or+    author attributions in that material or in the Appropriate Legal+    Notices displayed by works containing it; or++    c) Prohibiting misrepresentation of the origin of that material, or+    requiring that modified versions of such material be marked in+    reasonable ways as different from the original version; or++    d) Limiting the use for publicity purposes of names of licensors or+    authors of the material; or++    e) Declining to grant rights under trademark law for use of some+    trade names, trademarks, or service marks; or++    f) Requiring indemnification of licensors and authors of that+    material by anyone who conveys the material (or modified versions of+    it) with contractual assumptions of liability to the recipient, for+    any liability that these contractual assumptions directly impose on+    those licensors and authors.++  All other non-permissive additional terms are considered "further+restrictions" within the meaning of section 10.  If the Program as you+received it, or any part of it, contains a notice stating that it is+governed by this License along with a term that is a further+restriction, you may remove that term.  If a license document contains+a further restriction but permits relicensing or conveying under this+License, you may add to a covered work material governed by the terms+of that license document, provided that the further restriction does+not survive such relicensing or conveying.++  If you add terms to a covered work in accord with this section, you+must place, in the relevant source files, a statement of the+additional terms that apply to those files, or a notice indicating+where to find the applicable terms.++  Additional terms, permissive or non-permissive, may be stated in the+form of a separately written license, or stated as exceptions;+the above requirements apply either way.++  8. Termination.++  You may not propagate or modify a covered work except as expressly+provided under this License.  Any attempt otherwise to propagate or+modify it is void, and will automatically terminate your rights under+this License (including any patent licenses granted under the third+paragraph of section 11).++  However, if you cease all violation of this License, then your+license from a particular copyright holder is reinstated (a)+provisionally, unless and until the copyright holder explicitly and+finally terminates your license, and (b) permanently, if the copyright+holder fails to notify you of the violation by some reasonable means+prior to 60 days after the cessation.++  Moreover, your license from a particular copyright holder is+reinstated permanently if the copyright holder notifies you of the+violation by some reasonable means, this is the first time you have+received notice of violation of this License (for any work) from that+copyright holder, and you cure the violation prior to 30 days after+your receipt of the notice.++  Termination of your rights under this section does not terminate the+licenses of parties who have received copies or rights from you under+this License.  If your rights have been terminated and not permanently+reinstated, you do not qualify to receive new licenses for the same+material under section 10.++  9. Acceptance Not Required for Having Copies.++  You are not required to accept this License in order to receive or+run a copy of the Program.  Ancillary propagation of a covered work+occurring solely as a consequence of using peer-to-peer transmission+to receive a copy likewise does not require acceptance.  However,+nothing other than this License grants you permission to propagate or+modify any covered work.  These actions infringe copyright if you do+not accept this License.  Therefore, by modifying or propagating a+covered work, you indicate your acceptance of this License to do so.++  10. Automatic Licensing of Downstream Recipients.++  Each time you convey a covered work, the recipient automatically+receives a license from the original licensors, to run, modify and+propagate that work, subject to this License.  You are not responsible+for enforcing compliance by third parties with this License.++  An "entity transaction" is a transaction transferring control of an+organization, or substantially all assets of one, or subdividing an+organization, or merging organizations.  If propagation of a covered+work results from an entity transaction, each party to that+transaction who receives a copy of the work also receives whatever+licenses to the work the party's predecessor in interest had or could+give under the previous paragraph, plus a right to possession of the+Corresponding Source of the work from the predecessor in interest, if+the predecessor has it or can get it with reasonable efforts.++  You may not impose any further restrictions on the exercise of the+rights granted or affirmed under this License.  For example, you may+not impose a license fee, royalty, or other charge for exercise of+rights granted under this License, and you may not initiate litigation+(including a cross-claim or counterclaim in a lawsuit) alleging that+any patent claim is infringed by making, using, selling, offering for+sale, or importing the Program or any portion of it.++  11. Patents.++  A "contributor" is a copyright holder who authorizes use under this+License of the Program or a work on which the Program is based.  The+work thus licensed is called the contributor's "contributor version".++  A contributor's "essential patent claims" are all patent claims+owned or controlled by the contributor, whether already acquired or+hereafter acquired, that would be infringed by some manner, permitted+by this License, of making, using, or selling its contributor version,+but do not include claims that would be infringed only as a+consequence of further modification of the contributor version.  For+purposes of this definition, "control" includes the right to grant+patent sublicenses in a manner consistent with the requirements of+this License.++  Each contributor grants you a non-exclusive, worldwide, royalty-free+patent license under the contributor's essential patent claims, to+make, use, sell, offer for sale, import and otherwise run, modify and+propagate the contents of its contributor version.++  In the following three paragraphs, a "patent license" is any express+agreement or commitment, however denominated, not to enforce a patent+(such as an express permission to practice a patent or covenant not to+sue for patent infringement).  To "grant" such a patent license to a+party means to make such an agreement or commitment not to enforce a+patent against the party.++  If you convey a covered work, knowingly relying on a patent license,+and the Corresponding Source of the work is not available for anyone+to copy, free of charge and under the terms of this License, through a+publicly available network server or other readily accessible means,+then you must either (1) cause the Corresponding Source to be so+available, or (2) arrange to deprive yourself of the benefit of the+patent license for this particular work, or (3) arrange, in a manner+consistent with the requirements of this License, to extend the patent+license to downstream recipients.  "Knowingly relying" means you have+actual knowledge that, but for the patent license, your conveying the+covered work in a country, or your recipient's use of the covered work+in a country, would infringe one or more identifiable patents in that+country that you have reason to believe are valid.++  If, pursuant to or in connection with a single transaction or+arrangement, you convey, or propagate by procuring conveyance of, a+covered work, and grant a patent license to some of the parties+receiving the covered work authorizing them to use, propagate, modify+or convey a specific copy of the covered work, then the patent license+you grant is automatically extended to all recipients of the covered+work and works based on it.++  A patent license is "discriminatory" if it does not include within+the scope of its coverage, prohibits the exercise of, or is+conditioned on the non-exercise of one or more of the rights that are+specifically granted under this License.  You may not convey a covered+work if you are a party to an arrangement with a third party that is+in the business of distributing software, under which you make payment+to the third party based on the extent of your activity of conveying+the work, and under which the third party grants, to any of the+parties who would receive the covered work from you, a discriminatory+patent license (a) in connection with copies of the covered work+conveyed by you (or copies made from those copies), or (b) primarily+for and in connection with specific products or compilations that+contain the covered work, unless you entered into that arrangement,+or that patent license was granted, prior to 28 March 2007.++  Nothing in this License shall be construed as excluding or limiting+any implied license or other defenses to infringement that may+otherwise be available to you under applicable patent law.++  12. No Surrender of Others' Freedom.++  If conditions are imposed on you (whether by court order, agreement or+otherwise) that contradict the conditions of this License, they do not+excuse you from the conditions of this License.  If you cannot convey a+covered work so as to satisfy simultaneously your obligations under this+License and any other pertinent obligations, then as a consequence you may+not convey it at all.  For example, if you agree to terms that obligate you+to collect a royalty for further conveying from those to whom you convey+the Program, the only way you could satisfy both those terms and this+License would be to refrain entirely from conveying the Program.++  13. Use with the GNU Affero General Public License.++  Notwithstanding any other provision of this License, you have+permission to link or combine any covered work with a work licensed+under version 3 of the GNU Affero General Public License into a single+combined work, and to convey the resulting work.  The terms of this+License will continue to apply to the part which is the covered work,+but the special requirements of the GNU Affero General Public License,+section 13, concerning interaction through a network will apply to the+combination as such.++  14. Revised Versions of this License.++  The Free Software Foundation may publish revised and/or new versions of+the GNU General Public License from time to time.  Such new versions will+be similar in spirit to the present version, but may differ in detail to+address new problems or concerns.++  Each version is given a distinguishing version number.  If the+Program specifies that a certain numbered version of the GNU General+Public License "or any later version" applies to it, you have the+option of following the terms and conditions either of that numbered+version or of any later version published by the Free Software+Foundation.  If the Program does not specify a version number of the+GNU General Public License, you may choose any version ever published+by the Free Software Foundation.++  If the Program specifies that a proxy can decide which future+versions of the GNU General Public License can be used, that proxy's+public statement of acceptance of a version permanently authorizes you+to choose that version for the Program.++  Later license versions may give you additional or different+permissions.  However, no additional obligations are imposed on any+author or copyright holder as a result of your choosing to follow a+later version.++  15. Disclaimer of Warranty.++  THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY+APPLICABLE LAW.  EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT+HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY+OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO,+THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR+PURPOSE.  THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM+IS WITH YOU.  SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF+ALL NECESSARY SERVICING, REPAIR OR CORRECTION.++  16. Limitation of Liability.++  IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING+WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS+THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY+GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE+USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF+DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD+PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS),+EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF+SUCH DAMAGES.++  17. Interpretation of Sections 15 and 16.++  If the disclaimer of warranty and limitation of liability provided+above cannot be given local legal effect according to their terms,+reviewing courts shall apply local law that most closely approximates+an absolute waiver of all civil liability in connection with the+Program, unless a warranty or assumption of liability accompanies a+copy of the Program in return for a fee.++                     END OF TERMS AND CONDITIONS++            How to Apply These Terms to Your New Programs++  If you develop a new program, and you want it to be of the greatest+possible use to the public, the best way to achieve this is to make it+free software which everyone can redistribute and change under these terms.++  To do so, attach the following notices to the program.  It is safest+to attach them to the start of each source file to most effectively+state the exclusion of warranty; and each file should have at least+the "copyright" line and a pointer to where the full notice is found.++    <one line to give the program's name and a brief idea of what it does.>+    Copyright (C) <year>  <name of author>++    This program is free software: you can redistribute it and/or modify+    it under the terms of the GNU General Public License as published by+    the Free Software Foundation, either version 3 of the License, or+    (at your option) any later version.++    This program is distributed in the hope that it will be useful,+    but WITHOUT ANY WARRANTY; without even the implied warranty of+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the+    GNU General Public License for more details.++    You should have received a copy of the GNU General Public License+    along with this program.  If not, see <https://www.gnu.org/licenses/>.++Also add information on how to contact you by electronic and paper mail.++  If the program does terminal interaction, make it output a short+notice like this when it starts in an interactive mode:++    <program>  Copyright (C) <year>  <name of author>+    This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'.+    This is free software, and you are welcome to redistribute it+    under certain conditions; type `show c' for details.++The hypothetical commands `show w' and `show c' should show the appropriate+parts of the General Public License.  Of course, your program's commands+might be different; for a GUI interface, you would use an "about box".++  You should also get your employer (if you work as a programmer) or school,+if any, to sign a "copyright disclaimer" for the program, if necessary.+For more information on this, and how to apply and follow the GNU GPL, see+<https://www.gnu.org/licenses/>.++  The GNU General Public License does not permit incorporating your program+into proprietary programs.  If your program is a subroutine library, you+may consider it more useful to permit linking proprietary applications with+the library.  If this is what you want to do, use the GNU Lesser General+Public License instead of this License.  But first, please read+<https://www.gnu.org/licenses/why-not-lgpl.html>.

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,319 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE NoMonomorphismRestriction #-}++module Main where++import qualified Data.Map as Map+import Data.Maybe (catMaybes)+import Data.Text (Text)+import qualified Data.Text as T+import Data.Word (Word32)+import Debug.Trace (trace)+--import Diagrams.Backend.SVG.CmdLine (B, mainWith)+--import Diagrams.Prelude+import GHC.Generics+import Graph.CommonGraph (Channel, CGraph, CGraphL, EdgeType (..), NodeClass (..), EdgeClass (..), UINode)+import Graph.GraphDrawing (fromAdj, layeredGraph)+import qualified Graph.IntMap as Graph+--import Graphics.SVGFonts (textSVG)++-- several papers use this graph+testGraph :: CGraph UINodeLabel UIEdgeLabel+testGraph = fromAdj (extractNodes gr) gr+  where+    gr =+      [ (0, [4, 5, 6, 20, 29], dEdge),+        (17, [3], dEdge),+        (5, [2, 3, 4, 10, 14, 26], dEdge),+        (3, [4], dEdge),+        (26, [18], dEdge),+        (14, [10], dEdge),+        (2, [8, 23], dEdge),+        (18, [13], dEdge),+        (10, [27], dEdge),+        (2, [8, 23], dEdge),+        (23, [24, 9], dEdge),+        (24, [12, 15, 28], dEdge),+        (1, [12], dEdge),+        (12, [6, 9, 19], dEdge),+        (6, [9, 13, 21, 25, 29], dEdge),+        (29, [25], dEdge),+        (21, [22], dEdge),+        (25, [11], dEdge),+        (22, [8, 9], dEdge),+        (15, [27, 16], dEdge),+        (8, [16, 20], dEdge),+        (11, [16, 9], dEdge),+        (16, [27], dEdge),+        (27, [13, 19], dEdge),+        (13, [20], dEdge),+        (19, [9], dEdge),+        (20, [4], dEdge),+        (9, [4, 28], dEdge),+        (28, [7], dEdge)+      ]++testGraph2 :: CGraph UINodeLabel UIEdgeLabel+testGraph2 = fromAdj (extractNodes gr) gr+  where+    gr =+      [ (1, [3, 4, 21, 13], dEdge),+        (2, [3, 20], dEdge),+        (3, [4, 5, 23], dEdge),+        (4, [6], dEdge),+        (5, [7], dEdge),+        (6, [8, 16, 23], dEdge),+        (7, [9], dEdge),+        (8, [10, 11], dEdge),+        (9, [12], dEdge),+        (10, [13, 14, 15], dEdge),+        (11, [15, 16], dEdge),+        (12, [20], dEdge),+        (13, [17], dEdge),+        (14, [17, 18], dEdge),+        (16, [18, 19, 20], dEdge),+        (18, [21], dEdge),+        (19, [22], dEdge),+        (21, [23], dEdge),+        (22, [23], dEdge),+        (23, [24], dEdge),+        (24, [25], dEdge),+        (26, [27], dEdge),+        (27, [28], dEdge),+        (29, [30], dEdge),+        (30, [31], dEdge),+        (32, [31], dEdge),+        (33, [31], dEdge),+        (25, [34], dEdge),+        --           (19, [26],       dEdge),+        (23, [27], vdummyEdge),+        (27, [30], vdummyEdge)+      ]++-- A typical graph of three unconnected functions with one input and output.+-- Should be displayed vertical as options+-- Vertical lines between the function nodes give an order. If the graph grows the vertical nodes should+-- still be in one column+optionsGraph :: CGraph UINodeLabel UIEdgeLabel+optionsGraph = fromAdj (extractNodes gr) gr+  where+    gr =+      [ (1, [2], dEdge),+        (2, [3], dEdge),+        (4, [5], dEdge),+        (5, [6], dEdge),+        (7, [8], dEdge),+        (8, [9], dEdge),+        (9, [10], dEdge),+        (2, [5], vdummyEdge),+        (5, [8], vdummyEdge)+      ]++dEdge :: [UIEdgeLabel]+dEdge = [standard NormalEdge]++-- [UIEdge 2 1 "" Curly "#ff5863" "" 0 False False]++vdummyEdge :: [UIEdgeLabel]+vdummyEdge = [standard VirtualHorEdge]++-- [UIEdge 2 1 "" Curly "#ff5863" "" 0 True False]+extractNodes :: EdgeClass e => [(Word32, [Word32], [e])] -> Map.Map Word32 UINodeLabel+extractNodes adj = Map.fromList (map labelNode nodes)+  where+    nodes = (map sel1 adj) ++ (concat (map sel2 adj))+    sel1 (x, y, z) = x+    sel2 (x, y, z) = y+    labelNode n =+      ( n,+        UINodeLabel+          ( FuN+              ( FunctionNode+                  ""+                  (T.pack (show n))+                  ""+              )+          )+      )++main :: IO ()+main = return () -- mainWith (visualGraph (layeredGraph True testGraph) :: Diagram B)++------------------------------------------------------------------------------------------------++data UINodeLabel = UINodeLabel+  {+    uinode :: SpecialNode [Text]+  }+  deriving (Show)++data UIEdgeLabel = UIEdgeLabel+  { lineClass :: Text,+    strokeWidth :: Maybe Int,+    opacity :: Maybe Double,+    dashArray :: Maybe Text,+    lineColor :: Maybe Text,+    lineName :: Text,+    lineType :: Maybe LineType,+    channelNrIn :: Maybe Channel, -- arg nr x of constructor node++    -- | Me, Colleague-Name to remeber past decisions, but only people you know,+    -- or company, group+    channelNrOut :: Channel, -- function output is connected with input nr x of type node+    edgeType :: EdgeType+  }+  deriving (Show)++data LineType+  = Slanted Int -- a line consisiting of slanted sublines,+  -- (a lot of people did this, but no famous)+  | Curly -- contains a several subpaths+  deriving (Show, Generic, Eq, Ord)++data SpecialNode a+  = FuN FunctionNode+  | SubN [a]+  | DN DummyNode+  | CN ConnectionNode+  | AN ArgNode+  deriving (Eq, Ord, Show, Generic)++data DummyNode = DummyNode {dsize :: Int} deriving (Eq, Ord, Show, Generic)++data ConnectionNode = ConnectionNode {size :: Int} deriving (Eq, Ord, Show, Generic)++data FunctionNode = FunctionNode+  { functionUnique :: Text,+    functionName :: Text,+    functionType :: Text -- maybe not displayed+  }+  deriving (Eq, Ord, Generic, Show)++data ArgNode = ArgNode+  { refFunctionUnique :: Text,+    argName :: Text,+    argNr :: Int,+    isValueArg :: Bool,+    isMainFunctionArg :: Bool,+    argSelected :: Bool+  }+  deriving (Eq, Ord, Show, Generic)++instance NodeClass UINodeLabel where+  isDummy gr n = False -- maybe False isDummyLabel (Graph.lookupNode n gr)+  isConnNode gr n = maybe False isConnLabel (Graph.lookupNode n gr)+  isFunction gr n = maybe False isFuncLabel (Graph.lookupNode n gr)+  isMainArg gr n = False -- maybe False isArgLabel (Graph.lookupNode n gr)+  isSubLabel (UINodeLabel (SubN _)) = True+  isSubLabel _ = False+  isArgLabel (UINodeLabel (AN _)) = True+  isArgLabel _ = False+  subLabels (UINodeLabel (SubN as)) = length as+  connectionNode = UINodeLabel (CN (ConnectionNode 1))+  dummyNode x = UINodeLabel (DN (DummyNode x))+  nestingFeatures _ = Nothing+  updateLayer _ n = n+  verticalNumber _ = Nothing++instance EdgeClass UIEdgeLabel where+  dummyEdge chIn chOut = UIEdgeLabel "" Nothing Nothing Nothing Nothing "" Nothing chIn chOut NormalEdge+  standard edgeType =    UIEdgeLabel "" Nothing Nothing Nothing Nothing "" Nothing Nothing 0 edgeType+  edgeType (UIEdgeLabel _ _ _ _ _ _ _ _ _ e) = e+  channelNrIn (UIEdgeLabel _ _ _ _ _ _ _ channelIn channelOut _) = channelIn+  channelNrOut (UIEdgeLabel _ _ _ _ _ _ _ channelIn channelOut _) = channelOut++isDummyLabel :: UINodeLabel -> Bool+isDummyLabel (UINodeLabel (DN _)) = True+isDummyLabel _ = False++isConnLabel :: UINodeLabel -> Bool+isConnLabel (UINodeLabel (CN _)) = True+isConnLabel _ = False++isFuncLabel :: UINodeLabel -> Bool+isFuncLabel (UINodeLabel (FuN _)) = True+isFuncLabel _ = False++isArgLabel :: UINodeLabel -> Bool+isArgLabel (UINodeLabel (AN _)) = True+isArgLabel _ = False++-----------------------------------------------------------------------------------------------++-- Using diagrams to visualise the graph (this is commented out, so that you only need the quite big diagrams dependency when using this for debugging)+{-+visualGraph :: (NodeClass n, EdgeClass e) => CGraphL n e -> Diagram B+visualGraph (g, nPositions) =+  Debug.Trace.trace (show (length shortEs) ++ " : " ++ show (length longEs) ++ show (Graph.nodes testGraph, Graph.nodes g)) $+    position graphNodes # connections shortEs+      # connectionsWithoutArrow longEs+  where+    graphNodes = catMaybes (map pos (Graph.nodes g))+    pos n = fmap (\(x, y) -> (p2 ((fromIntegral x) * 2, (fromIntegral y)), vNode (fromIntegral n))) lu+      where+        lu = Map.lookup (fromIntegral n) nPositions+    es = Graph.edges g+    shortEs = filter (\(src, tgt) -> not (isConnNode g src) && not (isConnNode g tgt)) es+    longEs = filter (\(src, tgt) -> (isConnNode g src) || (isConnNode g tgt)) es+    vNode :: Int -> Diagram B+    vNode n = visualNode (n > 31) (show n) -- (isDummyNode g (fromIntegral n)) (show n)++connections es+  | (length es) < 2 = id+  | otherwise =+    foldr1 (.) $+      map+        ( \(src, tgt) ->+            connectOutside' arrowStyle2 (show src) (show tgt)+        )+        es++connectionsWithoutArrow es+  | (length es) < 2 = id+  | otherwise =+    foldr1 (.) $+      map+        ( \(src, tgt) ->+            connectOutside' arrowStyle3 (show src) (show tgt)+        )+        es++visualNode l str+  | l -- (stateLabel str <>+    =+    dummy # named str+  | otherwise = (stateLabel str <> state) # named str++text' d s = (strokeP $ textSVG s 0.7) # lw none # fc black # center # showOrigin++stateLabel = text' 0.6++arrowLabel txt size = text' size txt++state = circle 0.4 # fc silver++dummy = circle 0.05 # fc black -- mempty++shaft = arc xDir (-1 / 6 @@ turn)++shaft' = arc xDir (-2.7 / 5 @@ turn)++line = trailFromOffsets [unitX]++arrowStyle1 =+  ( with & arrowHead .~ spike & headLength .~ small+      & arrowShaft .~ shaft+  )++arrowStyle2 =+  ( with & arrowHead .~ spike & headLength .~ small+      & arrowShaft .~ line+  )++arrowStyle3 = (with & arrowHead .~ noHead & arrowShaft .~ line) -- & shaftStyle %~ dashingG [0.1, 0.05] 0)+-}

@@ -0,0 +1,46 @@+name:                layered-graph-drawing+version:             0.1.0.0+synopsis:            Layered Graph Drawing after Sugiyama+description:         Calculates the positions of graph nodes in a table with layered graph drawing+homepage:            https://github.com/BeFunctional/layered-graph-drawing+license:             BSD3+license-file:        LICENSE+author:              Tillmann Vogt+maintainer:          tillk.vogt@gmail.com+copyright:           2023 Tillmann Vogt+category:            graphics, graph+build-type:          Simple+-- extra-source-files:+cabal-version:       >=1.10++library+  hs-source-dirs:      src+  exposed-modules:     Graph.CommonGraph+                     , Graph.GraphDrawing+                     , Graph.SubGraphWindows+  build-depends:       aeson+                     , base >= 4.7 && < 5+                     , containers+                     , data-ordlist+                     , intmap-graph+                     , text+                     , vector+                     , vector-algorithms+  default-language:    Haskell2010++executable graph-drawing-exe+  hs-source-dirs:      app+  main-is:             Main.hs+  ghc-options:         -threaded -rtsopts -with-rtsopts=-N+  build-depends:       base+                     , containers+                     , layered-graph-drawing+--                     , diagrams+--                     , diagrams-lib+--                     , diagrams-svg+                     , intmap-graph+--                     , SVGFonts+                     , text++  default-language:    Haskell2010+

@@ -0,0 +1,226 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE NoMonomorphismRestriction #-}++module Graph.CommonGraph where++import Data.Aeson (FromJSON (..), ToJSON (..))+import qualified Data.IntMap as I+import Data.List (group, sort)+import Data.Map.Strict (Map)+import qualified Data.Map.Strict as Map+import Data.Maybe (fromJust, isJust)+import qualified Data.Vector.Unboxed as VU+import Data.Word (Word32, Word8)+import Debug.Trace (trace)+import GHC.Generics (Generic)+import Graph.IntMap+  ( Edge8 (..),+    EdgeAttribute (..),+    ExtractNodeType (..),+    Graph (..),+    adjacentNodesByAttr,+  )++type UINode = Word32++-- A Graph consists of nodes and edges, graph drawing arranges it from left to right,+-- start to end.+type CGraph n e = Graph n [e]++type CGraphL n e = (Graph n [e], Map UINode (Int, Int))++type Channel = Int -- The nth type of a type node+-- This is path of function and type nodes with spaces that can be filled with options++data EdgeType+  = NormalEdge+  | VerticalEdge -- When having options, they appear continuously in one column+  -- We mark this in the graph with vertical edges from the first+  -- option to the second and so on+  | VirtualHorEdge -- virtual edges are not displayed but used for layouting and+  -- naviagtion with the keyboard+  | SeparatingEdge -- to connect graph components that are separate+  deriving (Show, Generic, Eq, Ord)++type GraphMoveX = Int++type Column = (GraphMoveX, [UINode])++--instance NodeClass n => Eq n where+--  node1 == node2 = uinode node1 == uinode node2++class NodeClass n where+  isDummy :: EdgeClass e => CGraph n e -> UINode -> Bool+  isConnNode :: EdgeClass e => CGraph n e -> UINode -> Bool+  isFunction :: EdgeClass e => CGraph n e -> UINode -> Bool+  isMainArg :: CGraph n e -> UINode -> Bool+  isSubLabel :: n -> Bool+  isArgLabel :: n -> Bool+  subLabels :: n -> Int+  connectionNode :: n+  dummyNode :: Int -> n -- Depth -> n+  nestingFeatures :: n -> Maybe LayerFeatures+  updateLayer :: Maybe LayerFeatures -> n -> n+  verticalNumber :: n -> Maybe Word32 -- we want to keep the order of vertically connected Nodes,++type ChannelNrIn = Maybe Channel++type ChannelNrOut = Channel++class EdgeClass e where+  dummyEdge :: ChannelNrIn -> ChannelNrOut -> e+  standard :: EdgeType -> e+  edgeType :: e -> EdgeType+  channelNrIn :: e -> ChannelNrIn+  channelNrOut :: e -> ChannelNrOut++------------------------------------------------------------------------------------------------------++myFromJust :: Int -> Maybe a -> a+myFromJust i term+  | isJust term -- Debug.Trace.trace ("myFromJustTrue "++ show i)+    =+    fromJust term+  | otherwise =+    Debug.Trace.trace+      ("myFromJust " ++ show i)+      fromJust+      term++myhead :: Int -> [a] -> a+myhead i a+  | null a = error ("head: empty list " ++ show i)+  | otherwise = head a++vhead :: (VU.Unbox a) => Int -> VU.Vector a -> a+vhead i a+  | VU.null a = error ("VU.head: empty list " ++ show i)+  | otherwise = VU.head a++rmdups :: (Ord a) => [a] -> [a]+rmdups = map (myhead 500) . group . sort++------------------------------------------------------------------------------------------------------++vertBit :: Word8+vertBit = 0x1++virtBit :: Word8+virtBit = 0x2++sepBit :: Word8+sepBit = 0x4++instance EdgeClass e => EdgeAttribute [e] where -- Why can two nodes be connected with more than one edge?+-- To connect one function with several input types that are part of one type node+  fastEdgeAttr (e : _) = f (edgeType e)+    where+      f VerticalEdge = vertBit+      f VirtualHorEdge = virtBit+      f _ = 0+  fastEdgeAttr _ = 0+  edgeFromAttr =+    Map.fromList+      [ (vertBit, [standard VerticalEdge]),+        (virtBit, [standard VirtualHorEdge]),+        (0, [standard NormalEdge])+      ]++  -- show_e (Just [UIEdge standard Nothing 0 e]) = show e+  -- show_e _ = "no Edge"+  bases _ = [Edge8 0, Edge8 vertBit, Edge8 virtBit]++childrenSeparating :: EdgeClass e => CGraph n e -> Word32 -> VU.Vector Word32+childrenSeparating gr n = adjacentNodesByAttr gr True n (Edge8 sepBit)++childrenNoVertical :: EdgeClass e => Graph n [e] -> Word32 -> VU.Vector Word32+childrenNoVertical gr n =+  adjacentNodesByAttr gr True n (Edge8 virtBit)+    VU.++ adjacentNodesByAttr gr True n (Edge8 0)++childrenVertical :: EdgeClass e => Graph n [e] -> Word32 -> VU.Vector Word32+childrenVertical gr n = adjacentNodesByAttr gr True n (Edge8 vertBit)++parentsVertical :: EdgeClass e => Graph n [e] -> Word32 -> VU.Vector Word32+parentsVertical gr n = adjacentNodesByAttr gr False n (Edge8 vertBit)++parentsNoVertical :: EdgeClass e => Graph n [e] -> Word32 -> VU.Vector Word32+parentsNoVertical gr n =+  adjacentNodesByAttr gr False n (Edge8 virtBit)+    VU.++ adjacentNodesByAttr gr False n (Edge8 0)++verticallyConnectedNodes :: EdgeClass e => CGraph n e -> UINode -> [UINode]+verticallyConnectedNodes g n =+  VU.toList $+    goUp (parentsVertical g n)+      VU.++ VU.cons n (goDown (childrenVertical g n))+  where+    goUp nodes+      | VU.null nodes = VU.empty+      | otherwise =+        nodes+          VU.++ VU.concatMap (goUp . parentsVertical g) nodes+    goDown nodes+      | VU.null nodes = VU.empty+      | otherwise =+        nodes+          VU.++ VU.concatMap (goDown . childrenVertical g) nodes++------------------------------------------------------------------------------------------------------++data LayerFeatures = LayerFeatures+  { layer :: Int, -- Expanding a fuction generates a new layer+  -- (maybe make every new layer a little bit darker)+    border :: Maybe Border -- To set the right css values (border, boxshadow)+  }+  deriving (Show, Generic)++instance FromJSON LayerFeatures++instance ToJSON LayerFeatures++lb :: Int -> Maybe LayerFeatures+lb n = Just (LayerFeatures n (Just LeftBorder))++rb :: Int -> Maybe LayerFeatures+rb n = Just (LayerFeatures n (Just RightBorder))++tb :: Int -> Maybe LayerFeatures+tb n = Just (LayerFeatures n (Just TopBorder))++bb :: Int -> Maybe LayerFeatures+bb n = Just (LayerFeatures n (Just BottomBorder))++ltb :: Int -> Maybe LayerFeatures+ltb n = Just (LayerFeatures n (Just LeftTopBorder))++rtb :: Int -> Maybe LayerFeatures+rtb n = Just (LayerFeatures n (Just RightTopBorder))++lbb :: Int -> Maybe LayerFeatures+lbb n = Just (LayerFeatures n (Just LeftBottomBorder))++rbb :: Int -> Maybe LayerFeatures+rbb n = Just (LayerFeatures n (Just RightBottomBorder))++mid :: Int -> Maybe LayerFeatures+mid n = Just (LayerFeatures n Nothing)++data Border+  = LeftBorder+  | RightBorder+  | TopBorder+  | BottomBorder+  | LeftTopBorder+  | RightTopBorder+  | LeftBottomBorder+  | RightBottomBorder+  deriving (Show, Generic)++instance FromJSON Border++instance ToJSON Border

@@ -0,0 +1,1478 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}++{-# HLINT ignore "Eta reduce" #-}+{-# HLINT ignore "Use =<<" #-}++module Graph.GraphDrawing where++import qualified Data.IntMap as I+import qualified Data.IntMap.Strict as IM+import Data.List (elemIndex, find, group, groupBy, intercalate, sort, sortBy, sortOn, (\\))+import Data.Map (Map)+import qualified Data.Map as Map+import Data.Maybe (catMaybes, fromMaybe, isJust, isNothing, mapMaybe)+import Data.Set (Set)+import qualified Data.Set as Set+import Data.Tuple (swap)+import qualified Data.Vector.Algorithms.Intro as I+import Data.Vector.Unboxed (Vector)+import qualified Data.Vector.Unboxed as VU+import Data.Word (Word32)+import Debug.Trace (trace)+import Graph.CommonGraph+  ( CGraph,+    CGraphL,+    Channel,+    Column,+    EdgeClass (channelNrIn, channelNrOut, dummyEdge, standard),+    EdgeType (NormalEdge),+    GraphMoveX,+    LayerFeatures (LayerFeatures),+    NodeClass (connectionNode, dummyNode, isConnNode, isDummy, isMainArg, isSubLabel, subLabels),+    UINode,+    childrenNoVertical,+    childrenSeparating,+    childrenVertical,+    isFunction,+    myFromJust,+    myhead,+    parentsNoVertical,+    parentsVertical,+    rmdups,+    verticallyConnectedNodes,+    vhead,+  )+import qualified Graph.CommonGraph as Common+import Graph.IntMap (Graph (..), nodes)+import qualified Graph.IntMap as Graph++-- Also returns a map with Columns to allow navigation with arrows+layeredGraphAndCols ::+  (NodeClass n, Show n, EdgeClass e, Show e) =>+  Bool ->+  CGraph n e ->+  (CGraphL n e, (Map.Map GraphMoveX [UINode], Map.Map Int [Column]))+layeredGraphAndCols cross graph = (g, getColumns g)+  where+    g = layeredGraph cross graph++-- Debug with https://dreampuf.github.io/GraphvizOnline using neato or fdp engine++-- ^ Layout a directed acyclic graph in several steps (Sugiyama)+-- 1. Assign the nodes to several layers (longest path)+-- 2. Dummy vertices for lines that are longer than a layer+-- 3. Reduce crossings, place the longest path on top+-- 4. Assign y-coordinates to the nodes so that long lines that pass several layers are+--    as straight as possible++layeredGraph ::+  (VU.Unbox UINode, NodeClass n, Show n, EdgeClass e, Show e) =>+  Bool ->+  CGraph n e ->+  CGraphL n e+layeredGraph cross graph =+  -- Debug.Trace.trace ("layered "++ show graph ++"\n") -- ++ showEdges graph ++ show (Graph.edgeLabels graph)) $ -- ++"\nnewGraph\n" ++ show newGraph ++"\n") $+  newGraph+  where+    sortLayers (gr, ls) = (gr, map sort ls) -- makes the dummy vertices appear lower+    newGraph =+      ( -- subgraphWindows .+        yCoordinateAssignement+          -- .+          -- primitiveYCoordinateAssignement+          . crossingReduction 1 cross+          . sortLayers+          . addConnectionVertices+          . longestPathAlgo+          . addMissingInputNodes -- does not change the graph, only computes layers+      )+        graph++fr :: (Int, n) -> (UINode, n)+fr (n, nl) = (fromIntegral n, nl)++graphvizNodes :: (CGraph n e, Map.Map Int [Column]) -> String+graphvizNodes (gr, m) = concatMap ((++ "\n") . sh) (I.toList (Graph.nodeLabels gr))+  where+    sh (n, _nl) = show n ++ " [ pos = \"" ++ show (myFromJust 499 $ Map.lookup n m) ++ "!\"]"++primitiveYCoordinateAssignement :: (CGraph n e, [[UINode]]) -> CGraphL n e+primitiveYCoordinateAssignement (graph, layers) =+  --    Debug.Trace.trace ("primitiveY1 "++ show (graph,layers,ns)) $+  (graph, Map.fromList ns)+  where+    ns :: [(UINode, (Int, Int))]+    ns = concat $ zipWith (\layer i -> map (incX i) layer) (map oneLayer layers) ([0 ..] :: [Int])+    oneLayer l = zip (iterate incY (0, 0)) l+    incX i ((x, y), n) = (n, (x - i, y))+    incY (x, y) = (x, y + 1)+{-+primitiveYCoordinateAssignement2 :: (CGraph, [[UINode]]) -> CGraph+primitiveYCoordinateAssignement2 (g, (la:layers)) =+    Debug.Trace.trace ("primitiveY2 "++ show (g, newGraph, ns, la, layers)) $+--                       ++ show (reverse $ oneLayer newLa layers)) $+    newGraph+  where+    newGraph = g { nodeLabels = I.fromList $ map fr2 $ map (positionNode g) (concat ns) }+    ns = zipWith (\layer i -> map (incX i) layer) (oneLayer newLa layers) ([0..] :: [Int])+    newLa = zip (iterate incY (0,0)) la+    oneLayer :: [((Int,Int), UINode)] -> [[UINode]] -> [[((Int,Int), UINode)]]+    oneLayer l0 [] = [l0]+    oneLayer l0 (l1:rest) = l0 : (oneLayer newL1 rest)+      where+        newL1 = childYOrInc 0 (-1) l1++        childYOrInc _ _ [] = []+        childYOrInc y lastY (e:es)+          | isJust cy && (fromJust cy) /= lastY =+--          Debug.Trace.trace ("cy " ++ show (fromJust cy) ++" "++ show e ++ " " ++ show lu) $+                        ((0,fromJust cy),e) : childYOrInc ((fromJust cy)+1) (fromJust cy) es+          | otherwise =+--         Debug.Trace.trace ("other y "++ show y ++" cy "++ show cy ++" "++ show e) $+                        ((0,y),e) : childYOrInc (y+1) (fromMaybe y cy) es+          where cy | VU.null (child e) = Nothing+                   | otherwise = fmap snd lu+                lu = lookup (vhead 500 (child e)) (map (\(a,b) -> (b,a)) l0)+    child el = childrenNoVertical g el+    incX i ((x,y),n) = (x-i,y,n)+    incY (x,y)     = (x,y+1)+-}+{-+positionNode :: CGraph -> (Int, Int, UINode) -> (UINode, UINodeLabel)+positionNode graph (x,y,n) =+  (n, UINodeLabel { option = maybe NoOption option lu,+                    formerNonOption = maybe False formerNonOption lu,+                    uinode = maybe (DN (DummyNode 1)) uinode lu,+                    nestingFeatures = maybe Nothing nestingFeatures lu,+                    verticalNumber = maybe Nothing verticalNumber lu+                  })+    where lu = Graph.lookupNode n graph+-}++-- ^ See "Fast and Simple Horizontal Coordinate Assignment" (Brandes, Köpf)++yCoordinateAssignement :: (NodeClass n, EdgeClass e) => (CGraph n e, [[UINode]]) -> CGraphL n e+yCoordinateAssignement (graph, layers) =+  -- Debug.Trace.trace ("\nyCoordAssign "++ show (layers,graph,pos)) $+  (graph, pos)+  where+    -- newGraph = graph { nodeLabels = I.fromList placedNodes } -- for debugging (Map.fromList edgesToKeep)+    pos :: Map UINode (Int, Int)+    pos = horizontalBalancing lu ld ru rd+    lu = biasedAlignment graph yPos medians (reverse nLayers) (True, True)+    ld = biasedAlignment graph yPos medians (reverse nLayers) (True, False)+    ru = biasedAlignment graph yPos medians (reverse nLayers) (False, True)+    rd = biasedAlignment graph yPos medians (reverse nLayers) (False, False)++    -- for debugging+    --      edgesToKeep :: [(Graph.DirEdge UINode, [UIEdge])]+    --      edgesToKeep = map (\(x,y) -> (Graph.DirEdge x y, fromJust (Graph.lookupEdge (Graph.DirEdge x y) graph))) $+    --                      concat $ map (sweep medians Map.empty 0 (True,True)) (tuples (reverse nLayers))++    yPos = Map.fromList (concat enumLayers)+    enumLayers = map (\l -> zip l [0 ..]) layers+    nLayers = map (map connProp) layers+    connProp n = (n, isConnNode graph n)++    medians = (Map.fromList lowerMedians, Map.fromList upperMedians)+    upperMedians =+      -- Debug.Trace.trace ("upper"++ show (map upper ns, map (getMedian . upper) ns)) $+      mapMaybe (getMedian . upper) ns+    lowerMedians =+      -- Debug.Trace.trace ("lower"++ show (map lower ns)) $+      mapMaybe (getMedian . lower) ns+    ns = map fr $ I.toList (Graph.nodeLabels graph)+    upper (n, _) = (n, VU.toList (childrenNoVertical graph n))+    lower (n, _) = (n, VU.toList (parentsNoVertical graph n))++    getMedian (n, ns1)+      | l == 0 -- Debug.Trace.trace "get l0" $+        =+        Nothing+      | l == 1 = Just (n, Single rightMedian)+      | even l -- Debug.Trace.trace ("get lmod2"++ show (nodeLbls,ns1,(n, (leftMedian, rightMedian)))) $+        =+        Just (n, UpLowMedian leftMedian rightMedian) -- an even list has two medians+      | otherwise -- Debug.Trace.trace ("get other"++ show (nodeLbls,ns1,(n, (rightMedian, rightMedian)))) $+        =+        Just (n, Middle rightMedian) -- an odd list has only one median+      where+        leftMedian =+          -- Debug.Trace.trace ("median "++ show (n,ns1,nodeLbls,sorted,l)) $+          addConnProp (sorted !! ((l `div` 2) - 1))+        rightMedian = addConnProp (sorted !! (l `div` 2))+        l = length ns1+        sorted = sortBy py nodeLbls+        py (y0, _) (y1, _) = compare y0 y1+        nodeLbls = map (\node -> (fromMaybe 0 (Map.lookup node yPos), node)) ns1+        addConnProp (y, node) = (y, (node, isConnNode graph node))++-- the paper suggest to use an average of four alignments (TODO)+horizontalBalancing :: Map UINode (X, Y) -> Map UINode (X, Y) -> Map UINode (X, Y) -> Map UINode (X, Y) -> Map UINode (X, Y)+horizontalBalancing lu _ld _ru _rd =+  -- Debug.Trace.trace ("horizontalBalancing "++ show (lu,ru)) --  ++"\n"++ show ld ++"\n"++ show average)+  -- lu -- ld ru rd+  lu++-- average = zipWith f lu ru+--        f :: (UINode,(X,Y)) -> (UINode,(X,Y)) -> (UINode,(X,Y))+--        f (n0,(x0,y0)) (n1,(x1,y1)) | n0 /= n1 = error "horizontalBalancing n0 /= n1 "+--                                    | otherwise = (n0, (x0, (y0+y1) `div` 2 ))++type X = Int++type Y = Int++type YN = (Y, (UINode, Bool))++data MYN+  = Single (Y, (UINode, Bool)) -- no medians because there is only one connection+  | Middle (Y, (UINode, Bool)) -- an odd number of connections has only one median+  | UpLowMedian (Y, (UINode, Bool)) (Y, (UINode, Bool))+  deriving (Eq, Ord, Show) -- an even number of connections has two medians++type Median = Map UINode MYN++biasedAlignment ::+  (NodeClass n, EdgeClass e) =>+  CGraph n e ->+  Map UINode Y ->+  (Median, Median) ->+  [[(UINode, Bool)]] ->+  (Bool, Bool) ->+  Map UINode (X, Y)+biasedAlignment graph _ medians layers dir =+  -- Debug.Trace.trace ("\nbalign"++ show (layers, balign)) $ --edgesToKeep, map sweep2 (tuples layers)) +++  --                                                                "\nunpositioned " ++ show (map removePositioned (map (map fst) layers))) $+  balign+  where+    (left, _up) = dir+    positioned = Map.keys balign+    _removePositioned ns = ns \\ positioned+    -- see with https://dreampuf.github.io/GraphvizOnline/+    balign =+      -- Debug.Trace.trace ("\n\nedgesToKeep "++ show dir ++ "\ndigraph G {" +++      --                   (concat $ map line edgesToKeep) ++"\n"++ placeNodes ++ "\n}") -- \n\nmedians "++ show medians) $+      align graph (map (map fst) layers) edgesToKeep dir+    edgesToKeep = rmdups $ concatMap (concatMap resolve . sweep2) (tuples layers)+    _line (from, to) = "\n" ++ show from ++ " -> " ++ show to+    _placeNodes = concat $ concatMap (map placeNode) (zipWith (zip . repeat) [1 ..] (map (zip [1 ..]) layers))+      where+        placeNode :: (X, (Y, (UINode, Bool))) -> String+        placeNode (x, (y, (n, _b))) = show n ++ " [pos=\"" ++ show x ++ "," ++ show (-y) ++ "!\"];\n"+    resolve :: [(MYN, MYN)] -> [(UINode, UINode)]+    resolve ts =+      -- Debug.Trace.trace ("\nresolve "++ show (ts, res))+      res+      where+        res = rmdups $ map toNode (resolveConflicts dir ts)++    _sweep :: ([(UINode, Bool)], [(UINode, Bool)]) -> [[(MYN, MYN)]]+    _sweep (layer0, layer1) =+      -- Debug.Trace.trace ("\nsweep "++ show (dir, layer0, layer1) ++"\n"++ show sfiel)+      -- Debug.Trace.trace ("(l0,l1)\n"++ show (layer0, layer1) ++"\n\n"++ show medians ++"\n\n"++ show sfiel) $+      sfiel+      where+        sfiel = sweepForIndependentEdgeLists graph medians allowedEdges dir (Map.empty, Map.empty) (0, 0) (layer0, layer1) Set.empty+        allowedEdges :: Set.Set (UINode, UINode)+        allowedEdges = Set.fromList (mapMaybe f layer0)+        --              f :: UINode -> (UINode, UINode)+        f (n, _b)+          | isJust lu = Just (n, dest)+          | otherwise = Nothing+          where+            dest = fst $ snd $ getYN (fst dir) (myFromJust 500 lu)+            lu = Map.lookup n (snd medians)++    -- sweeping through a layer to find all edges without separating them into independent lists+    -- maybe slower in some cases, faster in others+    sweep2 :: ([(UINode, Bool)], [(UINode, Bool)]) -> [[(MYN, MYN)]]+    sweep2 (layer0, _layer1) =+      -- Debug.Trace.trace ("sweep2 "++ show (layer0, layer1,es))+      es+      where+        es = [catMaybes (zipWith f [0 ..] layer0)]+        f y (n, b)+          | isJust lu && isValidEdge -- Debug.Trace.trace ("sweep2lu0 "++ show lu) $+            =+            Just (Single (y, (n, b)), myFromJust 501 lu)+          | otherwise -- Debug.Trace.trace ("sweep2lu1 "++ show (n,lu))+            =+            Nothing+          where+            lu = Map.lookup n (snd medians)+            luBack = Map.lookup (fst $ snd $ getYN left $ myFromJust 502 lu) (fst medians)+            isValidEdge =+              -- Debug.Trace.trace ("n,lu,luBack "++ show (n,lu,luBack)) $+              isJust luBack && n == fst (snd $ getYN left $ myFromJust 503 luBack)++toNode :: ((a1, (a2, b1)), (a3, (b2, b3))) -> (a2, b2)+toNode ((_, (n0, _)), (_, (n1, _))) = (n0, n1)++tuples :: [a] -> [(a, a)]+tuples (x : y : xs) = (x, y) : tuples (y : xs)+tuples _ = []++type Insp = (Map Int (MYN, MYN), Map Int (MYN, MYN))++-- | Takes two layers and returns a list of lists of independent edges.+--   A list A of edges is independent of a list B of edges if every edge of A does not intersect or connect any edge of B.+--   This sweeping should save some time because graphs often have edges crossing near to each other.+--   The number of intersections has been reduced in crossingreduction.+--   Because of this we can assume that most edges are quite short and rectangular to layer0 and layer1.+--   A sweep in the parallel direction of the two layers should reduce the number of edges that have to be examined.+--   The overall algorithm (sweep + resolve) should have a runtime more like n*log(n) instead of n²,+--   because we only have to search for conflicts inside of these independent lists.+--   The Brandes-Köpf paper is not explaining very well how they find intersections between two layers.+--   I doubt that the whole algorithm is O(n). It seems more like a quadratic runtime in the worst case.+--   Even finding the number of intersections (without giving back the exact edges that intersect) is O(n log n),+--   See:  Simple and Efficient Bilayer Cross Counting by Barth, Mutzel, Jünger+--        or chapter 33 of Cormen: Introduction to algorithms+--   If several edges emanate from a node the algorithm takes (one of the) the median. (e.g. three edges have one median, 4 edges have two)+--   The sweep works by looking at the next node in the two layers, and comparing which node deletes more edges and+--   introduces less new edges from the set of edges to look at. Every edge has a start node (first appearing at its+--   y-position) and an end node. A start node means adding an edge when its source or target node appears in one of+--   the two layers, and the edge disappears when both its nodes have been swept over.+sweepForIndependentEdgeLists ::+  (NodeClass n, EdgeClass e) =>+  CGraph n e ->+  (Median, Median) ->+  Set (UINode, UINode) ->+  (Bool, Bool) ->+  Insp ->+  (Y, Y) ->+  ([(UINode, Bool)], [(UINode, Bool)]) ->+  Set (MYN, MYN) ->+  [[(MYN, MYN)]]+sweepForIndependentEdgeLists graph medians allowedEdges dir inspectionEdges (y0, y1) (layer0, layer1) missingEdges+  | null layer0 && null layer1 = Debug.Trace.trace ("nullnull " ++ show (layer0, layer1)) []+  | y0 >= 10 || y1 >= 10 = Debug.Trace.trace ("1010 " ++ show (y0, y1, layer0, layer1)) []+  | -- node at postion y1 is connected vertically with node at position y1+1+    (length layer1 >= 2) && verticalNode && isFunction graph hl1 =+    -- Debug.Trace.trace "sweep vert node" $+    sweepForIndependentEdgeLists graph medians allowedEdges dir sweepedOver (y0, y1 + 1) (layer0, tl1) Set.empty+  | Map.null sweepedOverFrom && Map.null sweepedOverTo =+    -- Debug.Trace.trace ("res"++ show (y0,y1) ++"\nlayer0 "++ show layer0 ++"\nlayer1 "++ show layer1+    --                    ++"\nresEdges "++ show resEdges ++"\nnewInsFrom "++ show newInsFrom ++"\nnewInsTo "+    --                    ++ show newInsTo ++"\nsweepedOver "++ show sweepedOver ++"\n") $+    resEdges : (sweepForIndependentEdgeLists graph medians allowedEdges dir sweepedOver (y0 + 1, y1 + 1) (tl0, tl1) Set.empty)+  | Map.size sweepedOverFrom < Map.size sweepedOverTo =+    -- Debug.Trace.trace (show (Map.size sweepedOverFrom)++ "<"++ show (Map.size sweepedOverTo) ++"\n"+++    --       show (y0,y1) ++"\nnewInsFrom "++ show newInsFrom ++"\nnewInsTo "++ show newInsTo+    --     ++"\nsweepedOverFrom "++ show sweepedOverFrom ++"\nsweepedOverTo "++ show sweepedOverTo ++"\n") $+    sweepForIndependentEdgeLists+      graph+      medians+      allowedEdges+      dir+      sweepedOver+      (y0 + 1, y1)+      (tl0, layer1)+      (Set.union missingEdges newMissingEdges)+  | otherwise -- Debug.Trace.trace (show (Map.size sweepedOverFrom)++ ">="++ show (Map.size sweepedOverTo) ++"\n"+++  --       show (y0,y1) ++"\nnewInsFrom "++ show newInsFrom ++"\nnewInsTo "++ show newInsTo+  --       ++"\nsweepedOverFrom "++ show sweepedOverFrom ++"\nsweepedOverTo "++ show sweepedOverTo ++"\n") $+    =+    sweepForIndependentEdgeLists+      graph+      medians+      allowedEdges+      dir+      sweepedOver+      (y0, y1 + 1)+      (layer0, tl1)+      (Set.union missingEdges newMissingEdges)+  where+    (inspectEdgesFrom, inspectEdgesTo) = inspectionEdges+    (lowerMedians, upperMedians) = medians+    (left, _up) = dir+    (n0, b0) = myhead 60 layer0+    (n1, b1) = myhead 61 layer1+    tl0+      | null layer0 = []+      | otherwise = tail layer0+    tl1+      | null layer1 = []+      | otherwise = tail layer1+    hl1 = fst (myhead 62 layer1)+    verticalNode = VU.elem (fst (myhead 63 tl1)) (Graph.adjacentNodesByAttr graph True hl1 (Graph.Edge8 Common.vertBit))+    resEdges = myNub (Map.elems newInsFrom ++ Map.elems newInsTo ++ Set.toList missingEdges)++    edgeFrom :: Maybe MYN+    edgeFrom+      | null layer0 = Nothing+      | otherwise -- Debug.Trace.trace ("up2 "++ show (n0, Map.lookup n0 upperMedians)) $+        =+        Map.lookup n0 upperMedians+    edgeTo :: Maybe MYN+    edgeTo+      | null layer1 --  || (not (Set.member (n0,n1) allowedEdges))+        =+        Nothing+      | otherwise -- Debug.Trace.trace ("up4 "++ show (n1, Map.lookup n1 lowerMedians)) $+        =+        Map.lookup n1 lowerMedians++    newInsFrom :: Map Int (MYN, MYN)+    newInsFrom+      | isJust edgeFrom && yy1 >= y1 = Map.insert yy1 (Single (y0, (n0, b0)), myFromJust 504 edgeFrom) inspectEdgesFrom+      | otherwise = inspectEdgesFrom+      where+        yy1 = getY left (myFromJust 505 edgeFrom)++    newInsTo :: Map Int (MYN, MYN)+    newInsTo+      | isJust edgeTo && yy0 >= y0 = Map.insert yy0 (myFromJust 506 edgeTo, Single (y1, (n1, b1))) inspectEdgesTo+      | otherwise = inspectEdgesTo+      where+        yy0 = getY left (myFromJust 506 edgeTo)++    newMissingEdges :: Set.Set (MYN, MYN)+    newMissingEdges+      | isJust edgeFrom && isJust edgeTo =+        Set.fromList+          [ (Single (y0, (n0, b0)), myFromJust 507 edgeFrom),+            (myFromJust 508 edgeTo, Single (y1, (n1, b1)))+          ]+      | isJust edgeFrom = Set.singleton (Single (y0, (n0, b0)), myFromJust 509 edgeFrom)+      | isJust edgeTo = Set.singleton (myFromJust 510 edgeTo, Single (y1, (n1, b1)))+      | otherwise = Set.empty++    sweepedOverFrom = Map.delete y1 newInsFrom+    sweepedOverTo = Map.delete y0 newInsTo+    sweepedOver = (sweepedOverFrom, sweepedOverTo) :: Insp++-- | Either e0 prevails against all e1s or all e1s prevail against e0+data EdgeTy a = E0Prevails a | E1Prevails a | NoIntersect (a, a) deriving (Eq, Show)++resolveConflicts :: (Bool, Bool) -> [(MYN, MYN)] -> [(YN, YN)]+resolveConflicts (_, _) [] = []+resolveConflicts (left, _) [e] = [toYN left e]+resolveConflicts (left, up) es =+  -- Debug.Trace.trace ("resolveConflicts"++ show (es, resolveConfs (left,up) es 0)) $+  map (toYN left) (resolveConfs (left, up) es 0)++toYN :: Bool -> (MYN, MYN) -> ((Y, (UINode, Bool)), (Y, (UINode, Bool)))+toYN left (n0, n1) = (getYN left n0, getYN left n1)++-- | Compare all edges of a layer with each other. Worst case: O(n²).+-- But n can shrink fast in every round and n is small, because of sweepForIndependentEdgeLists+resolveConfs :: (Bool, Bool) -> [(MYN, MYN)] -> Int -> [(MYN, MYN)]+resolveConfs (_, _) [] _ =+  -- Debug.Trace.trace "ch0 "+  []+resolveConfs (left, up) (e0 : edges) i+  | i > 20 -- Debug.Trace.trace ("ch1 "++ show (e0:edges))+    =+    e0 : edges -- avoid endless loop+  | checkE0 consistent -- Debug.Trace.trace ("checkE0 "++ show (map te (e0:edges)) ++"\n"++ show (map _toEdges2 conflictList) ++"\n") $+    =+    e0 : (resolveConfs (left, up) removeInferiorToE0 (i + 1))+  | checkNoIntersect consistent -- Debug.Trace.trace ("check noIntersect "++ show (map te (e0:edges)) ++"\n"++ show (conflictList, consistent, i) ++ "\n") $+    =+    if null conflictList+      then e0 : edges+      else e0 : (resolveConfs (left, up) edges (i + 1)) -- concat (map toEdges conflictList)+  | otherwise -- Debug.Trace.trace ("checkE1 "++ show (map te (e0:edges)) ++"\n"++ show (conflictList, consistent, i, firstE1, edgesE1First) ++ "\n") $+    =+    resolveConfs (left, up) edgesE1First (i + 1)+  where+    conflictList = map (conflict left e0) edges++    edgesE1First = e1 : (filter (\e -> e /= e0 && e /= e1) (concatMap toEdges conflictList))+    e1 = head (toEdges firstE1)+    firstE1 = myFromJust 511 (find e1Prevails conflictList)++    consistent = isConsistent conflictList+    checkE0 (E0Prevails True) = True+    checkE0 _ = False+    _checkE1 (E1Prevails True) = True+    _checkE1 _ = False+    checkNoIntersect (NoIntersect _) = True+    checkNoIntersect _ = False+    removeInferiorToE0 = rmdups $ concatMap toEdges (filter isNoIntersect conflictList)+    isNoIntersect (NoIntersect _) = True+    isNoIntersect _ = False+    e1Prevails (E1Prevails _) = True+    e1Prevails _ = False+    toEdges (E0Prevails e) = [e]+    toEdges (E1Prevails e) = [e]+    toEdges (NoIntersect (edge0, edge1)) = [edge0, edge1]++    _toEdges2 (E0Prevails (n0, n1)) = [te1 (n0, n1)]+    _toEdges2 (E1Prevails (n0, n1)) = [te1 (n0, n1)]+    _toEdges2 (NoIntersect ((n0, n1), (n2, n3))) = [te1 (n0, n1), te1 (n2, n3)]+    te1 (n0, n1) = (getN n0, getN n1)++-- resolveConfs _ _ _ = Debug.Trace.trace "error resolveConfs " []++-- | The resolveConflicts-algorithm has to be constructed in a consistent way+--   It should be impossible that edge e has priority to edge x (keeping e),+--   and another edge y has priority to edge e (deleting e). It would not be clear if e has to be deleted or not+isConsistent :: [EdgeTy (MYN, MYN)] -> EdgeTy Bool+isConsistent (NoIntersect _ : es) = isConsistent es+isConsistent [] = NoIntersect (True, True) -- will only be called if there is no E0Prevails or E1Prevails+isConsistent ((E0Prevails _) : es) = isAllE0OrNoIntersect es+  where+    isAllE0OrNoIntersect [] = E0Prevails True+    isAllE0OrNoIntersect ((E0Prevails _) : edges) = isAllE0OrNoIntersect edges+    isAllE0OrNoIntersect ((NoIntersect _) : edges) = isAllE0OrNoIntersect edges+    isAllE0OrNoIntersect (_ : _) = E0Prevails False -- not consistent+isConsistent ((E1Prevails _) : es) = isAllE1OrNoIntersect es+  where+    isAllE1OrNoIntersect [] = E1Prevails True+    isAllE1OrNoIntersect ((E1Prevails _) : edges) = isAllE1OrNoIntersect edges+    isAllE1OrNoIntersect ((NoIntersect _) : edges) = isAllE1OrNoIntersect edges+    isAllE1OrNoIntersect (_ : _) = E1Prevails False++conflict :: Bool -> (MYN, MYN) -> (MYN, MYN) -> EdgeTy (MYN, MYN)+conflict left (n0, n1) (n2, n3)+  | isIntersecting -- Debug.Trace.trace ("intersecting "++ show (n0,n1,n2,n3)) $+    =+    cases left (n0, n1) (n2, n3)+  | otherwise = NoIntersect ((n0, n1), (n2, n3))+  where+    isIntersecting -- two segments intersect+      =+      (getY left n0 <= getY left n2 && getY left n1 >= getY left n3)+        || (getY left n0 >= getY left n2 && getY left n1 <= getY left n3)++-- | Given two edges that intersect or connect, which one will prevail?+cases :: Bool -> (MYN, MYN) -> (MYN, MYN) -> EdgeTy (MYN, MYN)+cases left (n0, n1) (n2, n3)+  -- type 2 (one segment consists of two connection nodes and is preferred then)+  | connNode n0 && connNode n1 -- Debug.Trace.trace ("type2 0 "++ show (n0,n1,n2,n3)) $+    =+    E0Prevails (n0, n1)+  | connNode n2 && connNode n3 -- Debug.Trace.trace ("type2 1 "++ show (n0,n1,n2,n3)) $+    =+    E1Prevails (n2, n3)+  | (connNode n0 || connNode n1)+      && (connNode n2 || connNode n3) -- one connection node (type 2)+    =+    if (isMedian n0 || isMedian n1) && isSingle n2 && isSingle n3+      then -- Debug.Trace.trace ("type2 2 "++ show (n0,n1,n2,n3)) $+        E0Prevails (n0, n1)+      else E0Prevails (n2, n3)+  -- type 1 (non-inner segment crosses an inner segment)+  | (connNode n0 || connNode n1)+      && not (connNode n2)+      && not (connNode n3) -- Debug.Trace.trace ("type1 0"++ show (n0,n1,n2,n3)) $+    =+    E0Prevails (n0, n1)+  | (connNode n2 || connNode n3)+      && not (connNode n0)+      && not (connNode n1) -- Debug.Trace.trace ("type1 1"++ show (n0,n1,n2,n3)) $+    =+    E1Prevails (n2, n3)+  -- type 0 (a pair of non-inner segments)+  | not (connNode n0) && not (connNode n1)+      && not (connNode n2)+      && not (connNode n3) -- Debug.Trace.trace ("type0 "++ show (preferE0,n0,n1,n2,n3)) $+    =+    if preferE0+      then E0Prevails (n0, n1)+      else E1Prevails (n2, n3)+  | otherwise = Debug.Trace.trace "cases err" $ E0Prevails (n0, n1) -- correct? just to fix a warning+  where+    connNode (Single (_, (_, b))) = b+    connNode (Middle (_, (_, b))) = b+    connNode (UpLowMedian (_, (_, b0)) (_, (_, b1)))+      | left = b0+      | otherwise = b1+    isMedian (Single _) = False+    isMedian (Middle _) = True+    isMedian (UpLowMedian _n0 _n1) = True+    isSingle (Single _) = True+    isSingle _ = False+    preferE0+      | (isMedian n0 || isMedian n1) && not (isMedian n2) && not (isMedian n3) -- Debug.Trace.trace "p0"+        =+        True+      | (isMedian n2 || isMedian n3) && not (isMedian n0) && not (isMedian n1) -- Debug.Trace.trace "p1"+        =+        False+      | abs (getY left n0 - getY left n1) < abs (getY left n2 - getY left n3) -- Debug.Trace.trace "p2"+        =+        True+      | otherwise -- Debug.Trace.trace "p3"+        =+        False++getYN :: Bool -> MYN -> (Y, (UINode, Bool))+getYN _ (Single (y, (n, b))) = (y, (n, b))+getYN _ (Middle (y, (n, b))) = (y, (n, b))+getYN left (UpLowMedian (y0, (n0, b0)) (y1, (n1, b1)))+  | left = (y0, (n0, b0))+  | otherwise = (y1, (n1, b1))++getY :: Bool -> MYN -> Y+getY _ (Single (y, _)) = y+getY _ (Middle (y, _)) = y+getY left (UpLowMedian (y0, (_n0, _b0)) (y1, (_n1, _b1)))+  | left = y0+  | otherwise = y1++getN :: MYN -> [UINode]+getN (Single (_y, (n, _b))) = [n]+getN (Middle (_y, (n, _b))) = [n]+getN (UpLowMedian (_y0, (n0, _b0)) (_y1, (n1, _b1))) = [n0, n1]++ranksame :: [[UINode]] -> String+ranksame ls = "{ rank=same; " ++ intercalate "," (map show ls) ++ " }\n"++col :: Int -> UINode -> String+col i n = show n ++ " " ++ c (i `mod` 5) ++ "\n"+  where+    c m+      | m == 0 = "[color = red" ++ width+      | m == 1 = "[color = green" ++ width+      | m == 2 = "[color = blue" ++ width+      | m == 3 = "[color = yellow" ++ width+      | m == 4 = "[color = turquoise" ++ width+    c _ = "[color = black" ++ width+    width = ",penwidth=" ++ show (1 + (i `div` 2)) ++ "]"++--------------------------------------------------------------------------------------------------------------------++-- Similar to Brandes-Köpf but without arrays and no placement of blocks+-- The basic algorithm is longest path.+-- debugging can be done with graphviz, also uncomment line 533 in longestPath | otherwise+align :: EdgeClass e => CGraph n e -> [[UINode]] -> [(UINode, UINode)] -> (Bool, Bool) -> Map UINode (Int, Int)+align graph layers edges (_alignLeft, _up) =+  {-Debug.Trace.trace ("\nalign\ndigraph{\n"++ (concat $ map ranksame layers)+                      ++ (concat (map ((++ "\n") . (intercalate " -> ") . (map show)) layers))+                      ++ (graphviz "[color=red,penwidth=2];" edges)+                      ++ (graphviz "" es) ++ "}\n"+                      ++ show (startNs, map last (zipWith f [0..] layers))+                      ++"\nblocks\n"++ show blocks ++ "\nnextInLayerMap" ++ show nextInLayerMap+                    )-}+  mb2+  where+    --  | up = lp+    --  | otherwise = lpBackwards+    -- mb = Debug.Trace.trace ("lp\n" ++ show lp ++ "\nmb\n" ++ show (moveBlocks (Map.fromList lp))) $+    --     moveBlocks (Map.fromList lp)+    mb2 =+      -- Debug.Trace.trace ("lp\n" ++ show lp ++ "\nmb\n" ++ show (moveBlocks (Map.fromList lp), moveBlocksAgain (Map.fromList lp)) ++ "\n") $+      moveBlocksAgain (Map.fromList lp)+    lp = longestPath (map blockChildren startNs) [] 0+    --        globalYMin = minimum (map (snd . snd) lp)+    --        lpBackwards = longestPath (map blockChildren startNsBackwards) [] 0+    layerConnections = Map.fromList $ concatMap tuples layers+    reverseLayerConnections = Map.fromList $ concatMap (tuples . reverse) layers+    edgeMap = Map.fromList edges+    reverseBlocks = Map.fromList (map swap edges)+    _es = Map.keys (Graph.edgeLabels graph) \\ edges++    startNs = mapMaybe (nodeWithoutParent . last) (zipWith f [0 ..] layers)+    --        startNsBackwards = catMaybes $ map (nodeWithoutParent . head) (zipWith f [0..] layers)+    f i ns = map (i,) ns++    nodeWithoutParent (x, n)+      | isNothing (Map.lookup n reverseBlocks)+          && noParentInLayer (x, n) -- no parent in block+        =+        --  Debug.Trace.trace ("nodeWoPar0 "++ show (n, Map.lookup n reverseBlocks, noParentInLayer (x,n))) $+        Just (x, n)+      | otherwise =+        --  Debug.Trace.trace ("nodeWoPar1 "++ show (n, Map.lookup n reverseBlocks, noParentInLayer (x,n))) $+        Nothing+      where+        noParentInLayer root =+          -- Debug.Trace.trace ("noParInLayer "++ show (root, blockChildren root,+          --                   map hasNoLayerParent (blockChildren root))) $+          all hasNoLayerParent (blockChildren root)++        hasNoLayerParent (_, _n) = isNothing (Map.lookup n layerConnections)++    blockChildren :: (X, UINode) -> [(X, UINode)]+    blockChildren (x, n)+      | isJust lu = (x, n) : blockChildren (x + 1, myFromJust 513 lu)+      | otherwise = [(x, n)]+      where+        lu = Map.lookup n edgeMap++    longestPath :: [[(X, UINode)]] -> [UINode] -> Int -> [(UINode, (Int, Int))]+    longestPath [] _ _ =+      -- Debug.Trace.trace "finish"+      []+    longestPath blockNodes used i+      | i > 100 -- Debug.Trace.trace ("reverseBlocks " ++ show (edges, reverseBlocks)) $+        =+        []+      | otherwise -- Debug.Trace.trace ((concat $ map (col i) blns) ++ "\n") $+      --      ++ "map layerChild " ++ show (map layerChild (concat blockNodes)) ++ "\n"+      --      ++ "nextLayerRoots " ++ show nextLayerRoots ++ "\n"+      --      ++ "map blockChildren nextLayerRoots " ++ show (map blockChildren nextLayerRoots) ++ "\n"+      --      ++ "blocksWithOnlyUsedParents " ++ show blocksWithOnlyUsedParents ++ "\n"+      --      ++ "newUsed " ++ show newUsed+      --                ) $+        =+        newLayer ++ longestPath blocksWithOnlyUsedParents newUsed (i + 1)+      where+        newLayer = concatMap (oneLayer i) blockNodes+        blocksWithOnlyUsedParents = rmdups $ filter noParentOrUsed (map blockChildren nextLayerRoots)+        --                                          | otherwise = rmdups $ filter noParentOrUsed (map blockChildren nextLayerRootsBackwards)+        nextLayerRoots = myNub2 (map findRoot nextPossibleLayerNodes)+        --                nextLayerRootsBackwards = myNub2 (map findRoot nextPossibleLayerNodesBackwards)+        nextPossibleLayerNodes = mapMaybe layerChild (concat blockNodes)+        --                nextPossibleLayerNodesBackwards = catMaybes (map layerParent (concat blockNodes))+        layerChild (x, n) = maybe Nothing (\node -> Just (x, node)) (Map.lookup n reverseLayerConnections)+        --                layerParent (x,n) = maybe Nothing (\node -> Just (x,node)) (Map.lookup n layerConnections)+        newUsed = used ++ blns+        blns = map snd (concat blockNodes)+        noParentOrUsed block =+          -- Debug.Trace.trace ("noParentOrUsed "++ show (block, map noParOrUsed block, newUsed)) $+          all noParOrUsed block+        noParOrUsed (_, n) =+          -- Debug.Trace.trace ("noParOrUsed "++ show (n,lu)) $+          isNothing lu || (isJust lu && elem (myFromJust 514 lu) newUsed)+          where+            lu = Map.lookup n layerConnections++    oneLayer :: Y -> [(X, UINode)] -> [(UINode, (Int, Int))]+    oneLayer y ns = map (\(x, n) -> (n, (x, -y))) ns++    findRoot :: (X, UINode) -> (X, UINode)+    findRoot (x, n)+      | isJust lu && x >= 0 -- Debug.Trace.trace ("findRoot " ++ show (x,n)) $+        =+        findRoot (x - 1, myFromJust 515 lu)+      | otherwise = (x, n)+      where+        lu = Map.lookup n reverseBlocks++    blocks = extr ++ (map (\x -> [x]) rest)+      where+        extr = extractBlocks edgeMap+        rest = (concat layers \\ allNodes) \\ concat extr+        allNodes = Map.keys edgeMap ++ Map.elems edgeMap++    extractBlocks :: Map UINode UINode -> [[UINode]]+    extractBlocks m+      | Map.null m = []+      | otherwise = oneBlock ++ extractBlocks newEdgeMap -- extract one block and remove keys from the edge map+      where+        newEdgeMap =+          -- Debug.Trace.trace ("oneBlock " ++ show oneBlock) $+          foldr Map.delete m (concat oneBlock)+        oneBlock =+          filter+            (not . null)+            ( merge1 (map (fst . snd) oneBlockWithVerts)+                ++ [map fst oneBlockWithVerts]+                ++ merge1 (map (snd . snd) oneBlockWithVerts)+            )+        merge1 [] = []+        merge1 xs = (map head fil) : (merge1 (map tail fil))+          where+            fil = filter (not . null) xs+        oneBlockWithVerts =+          -- Debug.Trace.trace ("oneBlock " ++ show (reverse (blockNodesDown (head ks)), tail (blockNodesUp (head ks)))) $+          reverse (blockNodesDown (head ks))+            ++ tail (blockNodesUp (head ks))++        ks = Map.keys m ++ Map.elems m++        blockNodesDown :: UINode -> [(UINode, ([UINode], [UINode]))]+        blockNodesDown n+          | isJust lu = (n, (vertup, vertdown)) : (blockNodesDown (myFromJust 513 lu))+          | otherwise = [(n, (vertup, vertdown))]+          where+            lu = Map.lookup n edgeMap+            vertup = VU.toList (parentsVertical graph n)+            vertdown = VU.toList (childrenVertical graph n)++        blockNodesUp :: UINode -> [(UINode, ([UINode], [UINode]))]+        blockNodesUp n+          | isJust lu = (n, (vertup, vertdown)) : (blockNodesUp (myFromJust 513 lu))+          | otherwise = [(n, (vertup, vertdown))]+          where+            lu = Map.lookup n reverseBlocks+            vertup = VU.toList (parentsVertical graph n)+            vertdown = VU.toList (childrenVertical graph n)++    moveBlocks m =+      -- Debug.Trace.trace ("blocks" ++ show blocks ++ "\nm\n" ++ show (foldr moveToShortestConnection m (reverse blocks)))+      foldr moveToShortestConnection m (reverse blocks)+    moveBlocksAgain m =+      -- Debug.Trace.trace ("blocks" ++ show blocks ++ "\nm\n" ++ show (foldr moveToShortestConnection m (reverse blocks)))+      foldr moveToShortestConnection (moveBlocks m) (reverse blocks)++    moveToShortestConnection block m+      | null bs = m+      | otherwise = -- Debug.Trace.trace ("\nblock " ++ show block +++      --       "\nbounds " ++ show bounds +++      --       "\nnewY " ++ show newY +++      --       "\nadjustY block newY m\n" ++ show (adjustY block newY m))+        adjustY block newY m+      where+        -- newY = ( (fromJust (fst (head bounds))) + (fromJust (snd (head bounds))) ) `div` 2+        bs = mapMaybe fst bounds+        newY = maximum bs + 1 -- TODO look at block connections+        bounds = map blockBound block+        blockBound b =+          -- Debug.Trace.trace ("blockBound " ++ show (b,n,(yTop,yBottom),m))+          (yTop, yBottom)+          where+            -- yTop = fmap snd (maybe (Just (0,globalYMin)) (\node -> Map.lookup node m) n)+            yTop = fmap snd (maybe Nothing (`Map.lookup` m) n)+            yBottom = fmap snd (Map.lookup b m)+            n = Map.lookup b nextInLayerMap++    nextInLayerMap = foldr addLayerEdges Map.empty layers+      where+        addLayerEdges layer m = foldr addEdge m (tuples layer)+        addEdge (from, to) m = Map.insert to from m++    adjustY block newY m = foldr adj m block+      where+        adj b mp = Map.adjust (\(x, _y) -> (x, newY)) b mp++---------------------------------------------------------------------------------------------------------++-- The idea behind the following heuristic:+-- Very frequent chaining of functions are obvious and need no attention, e.g. Data.Text.pack str+-- unusual chainings need the highest attention+-- a long path means it is the main path of activity, like a table of contents in a book that+-- is a guide where to go. This long path should be a straight line at the top of the page.++-- Sort nodes in the layers by:+--   Finding the longest path with the most infrequent connections, make these nodes appear+--   first (y=0) use dfs to find the second longest/infrequent path+-- longestinfrequentPaths :: CGraph -> [[Node]] -> [Node]++type YNode = (YPos, Channel, UINode, IsDummy)++type YPos = Word32++type IsDummy = Bool++data Dir = LeftToRight | RightToLeft deriving (Show)++leftToRight :: Dir -> Bool+leftToRight LeftToRight = True+leftToRight RightToLeft = False++longestinfrequentPaths :: EdgeClass e => NodeClass n => CGraph n e -> [[UINode]] -> Vector Int+longestinfrequentPaths _ [] = VU.empty+longestinfrequentPaths _ [_] = VU.empty+longestinfrequentPaths g (l0 : l1 : layers)+  | null r = VU.empty+  | otherwise = VU.take (length layers + 2) $ myhead 64 r+  where+    r = map (liPaths g (l1 : layers) []) (startNodes g l0 l1)++startNodes :: EdgeClass e => CGraph n e -> [Word32] -> [Word32] -> [Word32]+startNodes g l0 l1 = mapMaybe (nodeWithChildInLayer l1) l0+  where+    nodeWithChildInLayer layer1 node+      | VU.null $+          VU.filter+            (`elem` layer1)+            (childrenNoVertical g node) =+        Nothing+      | otherwise = Just node++liPaths :: EdgeClass e => NodeClass n => CGraph n e -> [[UINode]] -> [UINode] -> UINode -> Vector Int+liPaths _ [] ns node = VU.fromList (map fromIntegral (node : ns))+liPaths g (l0 : layers) ns node = VU.concatMap (liPaths g layers (node : ns)) cs+  where+    cs =+      VU.filter+        --        (\x -> (maybe False (not . isDummyLabel) (Graph.lookupNode x g)) && elem x l0)+        (\x -> not (isDummy g x) && elem x l0)+        (childrenNoVertical g node)++myNub :: Ord a => [a] -> [a]+myNub = map (myhead 65) . group . sort++myNub2 :: [(Int, UINode)] -> [(Int, UINode)]+myNub2 = map (myhead 66) . groupBy nnn . sortBy nn+  where+    nn (_, n0) (_, n1) = compare n0 n1+    nnn (_, n0) (_, n1) = n0 == n1++type UnconnectedChildren = [UINode]++-- | Every graph has a longest path, which is the center of attention for us+-- Return layers of node ids+-- This algorithm is a little bit more complicated because we can connect nodes "vertically",+-- so that they are guaranteed to be all in one vertical layer+-- All nodes before this vertical layer have to be placed in layers before we can proceed+longestPathAlgo :: (NodeClass n, EdgeClass e) => CGraph n e -> (CGraph n e, [[UINode]])+longestPathAlgo g =+  -- Debug.Trace.trace ("\nlongestPathAlgo\n" ++ show (g, newLayers, moveFinalNodesLeftToVert newLayers)) $+  --  Debug.Trace.trace ("\nlongestPathAlgo " ++ show g +++  --                     "\nnewLayers" ++ show newLayers +++  --                     "\nnodesWithoutChildren" ++ show nodesWithoutChildren +++  --                     "\nverticalLayers" ++ show verticalLayers +++  --                     "\noptionNodes" ++ show optionNodes +++  --                     "\nnodesWithoutChildrenVertLayer" ++ show nodesWithoutChildrenVertLayer +++  --                     "\n"++ showEdges g)+  (g, moveFinalNodesLeftToVert (map rmdups newLayers))+  where+    moveFinalNodesLeftToVert :: [[UINode]] -> [[UINode]]+    moveFinalNodesLeftToVert ls =+      -- Debug.Trace.trace ("nodesToMove "++ show (nodesToMove, nodesAndPrevious)) $+      (myhead 67 ls \\ nodesToMove) : (foldr insert (tail ls) nodesAndPrevious)+      where+        nodesToMove+          | length ls < 2 = []+          | otherwise = filter (notEl . VU.toList . parentsNoVertical g) (myhead 68 ls)+        notEl [n] = n `notElem` myhead 69 (tail ls)+        notEl _ = False+        insert (n, p) lays+          | null fpl = lays -- Debug.Trace.trace ("insert "++ show lays ++"\n\n"++ show (add lays (find p lays) n)) $+          | otherwise = add lays (head fpl) n+          where+            fpl = findn p lays+        nodesAndPrevious = zip nodesToMove (map (VU.head . parentsNoVertical g) nodesToMove)+        add list pos n = take (pos - 1) list ++ ((list !! (pos - 1)) ++ [n]) : (drop pos list)+        findn p l = [fst il | il <- zip [0 ..] l, p `elem` snd il]++    newLayers = layersrec (rmdups $ VU.toList nodesWithoutChildrenVertLayer) fil []+    fil = filter (not . null . sel2) verticalLayers+    sel1 (x, _, _) = x+    sel2 (_, y, _) = y+    ns = VU.map fromIntegral (VU.fromList (nodes g))+    nodesWithoutChildren = VU.filter (VU.null . cs) ns+    nodesWithoutChildrenVertLayer :: VU.Vector UINode+    nodesWithoutChildrenVertLayer =+      -- Debug.Trace.trace ("nwcvl "++ show (nodesWithoutChildren, nwcvl))+      nwcvl+      where+        nwcvl = VU.concatMap (findLayers (map sel1 verticalLayers)) nodesWithoutChildren+    findLayers :: [[UINode]] -> UINode -> VU.Vector UINode+    findLayers ls n+      | null ls = VU.singleton n+      | otherwise = VU.fromList (concat (map findL ls))+      where+        findL l+          | elem n l = l+          | otherwise = [n]+    cs node = Graph.children g node [dummyEdge Nothing 0]+    (_, optionNodes) = partitionNodes g ns -- nonOptionNodes+    verticalLayers =+      -- Debug.Trace.trace (show ("verticalLayers", VU.toList optionNodes, vLayers (VU.toList optionNodes))) $+      vLayers (VU.toList optionNodes)++    vLayers [] = []+    vLayers (n : ns1) =+      -- Debug.Trace.trace (show ("vLayers", n, newLayer, addUnconnectedChildren newLayer)) $+      (addUnconnectedChildren newLayer) : (vLayers (ns1 \\ newLayer))+      where+        newLayer = sort $ verticallyConnectedNodes g n+        addUnconnectedChildren :: [UINode] -> ([UINode], UnconnectedChildren, Bool)+        addUnconnectedChildren layer1 = (layer1, myNub $ VU.toList (VU.concat (map nonVertChildren layer1)), False)+        nonVertChildren node = childrenNoVertical g node++    -- the idea of this recursion is to go backwards from the final node and add non-vertical nodes that are fully connected at the input+    -- if there is only a vertical layer possible, add it+    layersrec :: [UINode] -> [([UINode], UnconnectedChildren, Bool)] -> [UINode] -> [[UINode]]+    layersrec curLayer vertLayers usedNodes+      | null curLayer -- Debug.Trace.trace "\n§§1 "+        =+        []+      | length usedNodes + length curLayer > length (nodes g) =+        Debug.Trace.trace+          ("\n§§2 " ++ show (curLayer, length usedNodes, usedNodes, length curLayer, length (nodes g)))+          [curLayer] -- should not happen+      | otherwise {-Debug.Trace.trace ("\n§§3 curLayer "++ show curLayer +++                                     "\nfullyConnectedVertNodes2 " ++ show fullyConnectedVertNodes2 +++                                     "\nnewCurLayerOrVert " ++ show newCurLayerOrVert +++                                     "\nusedNodes " ++ show usedNodes +++                                     "\nlayerParents curLayer " ++ show (layerParents curLayer) +++                                     "\nvertLayers    " ++ show vertLayers +++                                     "\nnewVertLayers " ++ show newVertLayers +++                                     "\nfil" ++ show fil)-} =+        curLayer : (layersrec newCurLayerOrVert filtered (usedNodes ++ curLayer))+      where+        newVertLayers = map adjustConnected vertLayers+        adjustConnected (someLayer, unconnectedChildren, _) =+          -- Debug.Trace.trace ("adjustConnected " ++ show (someLayer, unconnectedChildren, newun, map (isNotMainFunctionArg g) someLayer)) $+          (someLayer, newun, null newun && all (isNotMainFunctionArg g) someLayer)+          where+            newun = unconnectedChildren \\ curLayer++        filtered+          | not (null newCurLayer) -- Debug.Trace.trace ("fil0 "++ show (newVertLayers)) $+            =+            filter (not . changed) newVertLayers+          | not (null fullyConnectedVertNodes2) -- Debug.Trace.trace ("fil1 "++ show (filter (not . isFullyConnected) newVertLayers)) $+            =+            filter (not . isFullyConnected) newVertLayers --remove fully connected vertical layers+          | otherwise -- Debug.Trace.trace ("fil2 "++ show (filter (not . isFullyConnected) newVertLayers)) $+            =+            filter (not . isFullyConnected) newVertLayers --remove fully connected vertical layers+            --        fullyConnectedVertNodes = concat (map fst (filter isFullyConnectedAndNotArg newVertLayers))+        fullyConnectedVertNodes2 = concatMap sel1 (filter isFullyConnected newVertLayers)+        --        isFullyConnectedAndNotArg (someLayer,unconnectedChildren) = Debug.Trace.trace ("isfully "++ show (null unconnectedChildren, map (isMainFunctionArg g) someLayer)) $+        --                                                                    null unconnectedChildren &&+        --                                                                    not (or (map (isMainFunctionArg g) someLayer))++        isFullyConnected (_someLayer, unconnectedChildren, _) = null unconnectedChildren++        newCurLayer =+          -- Debug.Trace.trace ("curParents"++ show (layerParents curLayer, filter shouldNodeBeAdded (layerParents curLayer))) $+          myNub (filter shouldNodeBeAdded (layerParents curLayer)) ++ concatMap sel1 (filter changed newVertLayers)+        changed (_, _, b) = b+        layerParents l = VU.toList (VU.concatMap (parentsNoVertical g) (VU.fromList l))+        newCurLayerOrVert+          | not (null newCurLayer) -- Debug.Trace.trace "not (null newCurLayer)" $ --prefer normal nodes to vertical nodes+            =+            myNub newCurLayer+          | not (null fullyConnectedVertNodes2) -- Debug.Trace.trace "not (null fullyConnectedVertNodes2)" $ --if no normal nodes are left+            =+            myNub fullyConnectedVertNodes2+          | otherwise = []+        shouldNodeBeAdded :: UINode -> Bool -- have all children been added, then node should be added+        shouldNodeBeAdded node+          | VU.null chs -- Debug.Trace.trace ("should0 "++ show (node, chs, VU.map isChildUsed chs)) $+            =+            False+          | otherwise -- Debug.Trace.trace ("should1 "++ show (node, chs, VU.map isChildUsed chs)) $+            =+            VU.and (VU.map isChildUsed chs)+              && not (isInVertLayer node)+          where+            chs = childrenNoVertical g node+            isChildUsed :: UINode -> Bool+            isChildUsed child = child `elem` (usedNodes ++ curLayer)+            isInVertLayer :: UINode -> Bool+            isInVertLayer n = any (elem n . sel1) vertLayers++-- Some functions don't have an input (e.g. True).+-- But a function without input can only appear directly after a case node+-- That's why we insert a connection node between this case node and the function node+addMissingInputNodes :: (NodeClass n, Show n, EdgeClass e) => CGraph n e -> CGraph n e+addMissingInputNodes graph =+  -- Debug.Trace.trace ("\naddConnectionNodes"++ show (foldl addConnNode graph (map fromIntegral (nodes graph)))) $+  foldl addConnNode graph (map fromIntegral (nodes graph))+  where+    addConnNode :: (NodeClass n, Show n, EdgeClass e) => CGraph n e -> UINode -> CGraph n e+    addConnNode g n+      | VU.null ps = g+      | isFunction graph n =+        --        && isCase graph (vhead 501 ps) -- Debug.Trace.trace ("caseconn"++ show (n, VU.head ps)) $++        insertConnNode g n (vhead 502 ps) Nothing 0+      | otherwise = g+      where+        ps = parentsNoVertical graph n++-- | partition nodes into non-vertically connected nodes and vertically connected nodes+partitionNodes :: EdgeClass e => CGraph n e -> VU.Vector UINode -> (VU.Vector UINode, VU.Vector UINode)+partitionNodes g =+  VU.partition+    ( \n ->+        VU.null (parentsVertical g n)+          && VU.null (childrenVertical g n)+    )++-- coffmanGrahamAlgo :: Graph -> [[Int]]+-- coffmanGrahamAlgo g =++addConnectionVertices :: (NodeClass n, Show n, EdgeClass e, Show e) => (CGraph n e, [[UINode]]) -> (CGraph n e, [[UINode]])+addConnectionVertices (g, ls) =+  -- Debug.Trace.trace ("acv"++ show (ls, addConnectionVs (g,ls))) $+  addConnectionVs (g, ls)++addConnectionVs :: (NodeClass n, Show n, EdgeClass e, Show e) => (CGraph n e, [[UINode]]) -> (CGraph n e, [[UINode]])+addConnectionVs (graph, []) = (graph, [])+addConnectionVs (graph, [l0]) = (graph, [l0])+addConnectionVs (graph, l0 : l1 : layers) = (fst adv, l0 : (snd adv))+  where+    adv = addConnectionVs (newGraph, (newLayer : layers))++    (newGraph, newLayer) = foldl dummyNodeEdge (graph, l1) (zip [(fromIntegral (m + 1)) ..] innerSs)+    m = maximum (nodes graph)++    innerSs = concatMap innerSegments l0+    innerSegments n =+      -- Debug.Trace.trace ("ps"++ show ps) $+      zip3 (repeat n) notInLayerL1Parents chans+      where+        notInLayerL1Parents = VU.toList (VU.filter isNotInLayerL1 ps)+        ps = parentsNoVertical graph n+        isNotInLayerL1 = not . (`elem` l1)+        chans = map (\e -> maybe (Nothing, 0) f e) edges+        f x = (channelNrIn (myhead 71 x), channelNrOut (myhead 72 x))+        edges = map (`lue` n) notInLayerL1Parents+        lue x y = Graph.lookupEdge (x, y) graph++    dummyNodeEdge :: (NodeClass n, Show n, EdgeClass e) => (CGraph n e, [UINode]) -> (UINode, (UINode, UINode, (Maybe Int, Int))) -> (CGraph n e, [UINode])+    dummyNodeEdge (g, l) (v, (from, to, (chanIn, chanOut))) =+      -- Debug.Trace.trace ("dummyNodeEdge"++ show (v,(from,to,chan)))+      (insertConnNode g from to chanIn chanOut, v : l)++insertConnNode :: (NodeClass n, Show n, EdgeClass e) => CGraph n e -> UINode -> UINode -> Maybe Channel -> Channel -> CGraph n e+insertConnNode graph from to chanIn chanOut =+  -- Debug.Trace.trace ("dummyNodeEdge"++ show (to, fromIntegral (m+1), chanIn, 0, chanOut, fromIntegral (m+1), from))+  Graph.deleteEdge (Just True) (to, from) $+    Graph.insertEdge (Just True) (to, fromIntegral (m + 1)) [dummyEdge chanIn 0] $+      Graph.insertEdge+        (Just True)+        (fromIntegral (m + 1), from)+        [dummyEdge Nothing chanOut]+        (Graph.insertNode (fromIntegral (m + 1)) connectionNode graph)+  where+    m = maximum (nodes graph)+    nest+      | isJust lu = Common.nestingFeatures (myFromJust 516 lu)+      | otherwise = Nothing+    lu = Graph.lookupNode from graph+    depth = maybe 1 Common.layer nest++-- UIEdge 2 1 "" Curly "#ff5863" "" i False False]++crossingReduction :: (NodeClass n, Show n, EdgeClass e, Show e) => Int -> Bool -> (CGraph n e, [[UINode]]) -> (CGraph n e, [[UINode]])+crossingReduction i longestP (graph, layers)+  | i > 0 -- Debug.Trace.trace ("crossingReduction\nlayers    " ++ show layers +++  --         "\nc         "++ show c +++  --         "\nnewlayers "++ show newLayers) $+    =+    crossingReduction (i - 1) longestP (graph, newLayers)+  | otherwise = (graph, layers)+  where+    -- nodes that are at the center of attention+    priorityNodes = VU.toList $ longestinfrequentPaths graph revLayers+    revLayers = reverse (map (map fromIntegral) layers)++    --  c = -- Debug.Trace.trace ("|r ") $ -- ++ show (layers, priorityNodes))+    --      (crossR graph LeftToRight (map (map fromIntegral) layers) priorityNodes longestP)+    --  newLayers = -- Debug.Trace.trace ("|l ") $ -- ++ show (layers, priorityNodes))+    --              map (map fromIntegral)+    --                  (reverse (crossR graph RightToLeft (reverse c) (reverse priorityNodes) longestP))++    c =+      -- Debug.Trace.trace ("|l ") $ -- ++ show (layers, priorityNodes))+      reverse (crossR graph RightToLeft (reverse (map (map fromIntegral) layers)) (reverse priorityNodes) longestP)++    newLayers =+      --      Debug.Trace.trace ("|r ") $ -- ++ show (layers, priorityNodes))+      map+        (map fromIntegral)+        (crossR graph LeftToRight c priorityNodes longestP)++crossR :: (NodeClass n, Show n, EdgeClass e, Show e) => CGraph n e -> Dir -> [[Int]] -> [Int] -> Bool -> [[Int]]+crossR _ _ [] _ _ = []+crossR g dir (l0 : l1 : layers) (n0 : n1 : ns) longestP+  | crossings l0Enum bEnum <= crossings l0Enum l1Enum =+    --          Debug.Trace.trace ("a0 " ++ show (dir,l0p, b, l1p, (n0:n1:ns), crossings l0Enum bEnum, crossings l0Enum l1Enum,l0,l1)+    --                                   ++ "\n   " ++ show (nl0,nl1)) $+    l0p : (crossR g dir (bv : layers) (n1 : ns) longestP)+  | otherwise -- map (lv g) $+  --        Debug.Trace.trace ("a1 " ++ show (dir,l0p, b, l1p,l0Enum,l1Enum,bEnum,crossings l0Enum bEnum,crossings l0Enum l1Enum)+  --                                 ++ "\n " ++ show (nl0,nl1)) $+    =+    l0p : (crossR g dir (l1p : layers) (n1 : ns) longestP)+  where+    nl0 = map fst (lv g l0)+    nl1 = map fst (lv g l1)+    --    isNoVert0 = not (or (map snd (lv g l0)))+    --    isNoVert1 = not (or (map snd (lv g l1)))+    b = barycenter g dir l0 l1 n1+    bv = map fst (lv g b)+    --    m = median     g nl0 nl1+    l0p+      | isJust (vertNum n0) || longestP = nl0+      | otherwise = nl0 -- n0 : (delete n0 nl0)+    l1p+      | isJust (vertNum n1) || longestP = nl1+      | otherwise = nl1 -- n1 : (delete n1 nl1)+    getY1 ((_, _, _, _), (y1, chan, _, _)) = (fromIntegral y1) * 10 + chan+    crossings en0 en1 =+      -- Debug.Trace.trace (if nl0 == [9] then "ee " ++ show (lexicographicSort ee) +++      -- show (VU.map getY1 $ lexicographicSort ee) +++      -- show (primitiveInversionCount (VU.map getY1 $ lexifromJustcographicSort ee)) else "") $+      primitiveInversionCount (VU.map getY1 $ lexicographicSort ee)+      where+        ee = VU.fromList (edgesEnum en0 en1 g dir (map fromIntegral nl0))+    l0Enum = IM.fromList (zip nl0 [0 ..])+    l1Enum = IM.fromList (zip nl1 [0 ..])+    bEnum = IM.fromList (zip b [0 ..])+    --    mEnum  = IM.fromList (zip m  [0..])++    lu n = Graph.lookupNode (fromIntegral n) g+    vertNum n = maybe Nothing Common.verticalNumber (lu n)+crossR _ _ ls ns _ = ls++-- arrange vertical nodes directly below each other,+-- returns Nothing if there are no vertical nodes in this layer+lv :: EdgeClass e => CGraph n e -> [Int] -> [(Int, Bool)]+lv _ [] = []+lv g (l : ls) =+  -- Debug.Trace.trace ("vertConnected "++ show ((l,ls,ls \\ vertConnected),(goUp ps),l,(goDown cs))) $+  vertConnected ++ (lv g (ls \\ (map fst vertConnected)))+  where+    vertConnected :: [(Int, Bool)]+    vertConnected+      | null up && null down = [(l, False)]+      | otherwise = map tr (up ++ [l] ++ down)+    tr ll = (ll, True)+    up = goUp ps+    down = goDown cs+    ps = map fromIntegral $ VU.toList $ parentsVertical g (fromIntegral l)+    goUp :: [Int] -> [Int]+    goUp n+      | null n = []+      | otherwise = goUp (map fromIntegral $ VU.toList $ parentsVertical g (fromIntegral (head n))) ++ [fromIntegral (head n)]++    cs = map fromIntegral $ VU.toList $ childrenVertical g (fromIntegral l)+    goDown :: [Int] -> [Int]+    goDown n+      | null n = []+      | otherwise = (fromIntegral (head n)) : (goDown (map fromIntegral $ VU.toList $ childrenVertical g (fromIntegral (head n))))++-- type YNode = (YPos,Channel,UINode,IsDummy)+edgesEnum :: (NodeClass n, EdgeClass e, Show e) => IM.IntMap UINode -> IM.IntMap UINode -> CGraph n e -> Dir -> [UINode] -> [(YNode, YNode)]+edgesEnum en0 en1 gr dir l0 = catMaybes edges+  where+    edges :: [Maybe (YNode, YNode)]+    edges = map (edge en0 en1) (edgesOfLayer gr l0)+    edge :: IM.IntMap UINode -> IM.IntMap UINode -> (UINode, UINode) -> Maybe (YNode, YNode)+    edge e0 e1 (src, tgt)+      | isNothing s || isNothing t = Nothing+      | otherwise =+        Just+          ( (myFromJust 517 s, chanNr, src, isDummy gr src),+            (myFromJust 518 t, 0, tgt, isDummy gr tgt)+          )+      where+        s = IM.lookup (fromIntegral src) e0+        t = IM.lookup (fromIntegral tgt) e1+        chanNr+          | isJust lu && null (myFromJust 519 lu) = 0+          | isJust lu = channelNrOut (myhead 73 (myFromJust 520 lu))+          | otherwise = 0+        lu = Graph.lookupEdge (tgt, src) gr++    edgesOfLayer :: EdgeClass e => CGraph n e -> [UINode] -> [(UINode, UINode)]+    edgesOfLayer g l = concatMap (adjEdges g) l+    adjEdges :: EdgeClass e => CGraph n e -> Word32 -> [(UINode, UINode)]+    adjEdges g n+      | leftToRight dir = map (n,) (VU.toList (parentsNoVertical g n))+      | otherwise = map (n,) (VU.toList (childrenNoVertical g n))++-- type YPos = Int+-- type YNode = (YPos,Channel,UINode,IsDummy)++isNotMainFunctionArg :: NodeClass n => CGraph n e -> UINode -> Bool+isNotMainFunctionArg g node =+  -- not (maybe False isMainArg (Graph.lookupNode node g))+  not (isMainArg g node)++-- Assign every node in l1 a number thats the barycenter of its neighbours in l0, then sort.+-- If the node is marked as a vertical node with a number, this number has precedence in sorting+barycenter :: (NodeClass n, Show n, EdgeClass e, Show e) => CGraph n e -> Dir -> [Int] -> [Int] -> Int -> [Int]+barycenter g dir l0 l1 _ =+  -- Debug.Trace.trace ("bary " ++ show (map bc l1, sortOn snd (map bc l1))) $+  map fst (sortOn snd (map bc l1))+  where+    bc :: Int -> (Int, Double)+    bc node =+      -- Debug.Trace.trace ("bc" ++ show (dir, node, ps, cs, l0, l1, nodeWeight dir))+      (node, nodeWeight dir)+      where+        lenCs = VU.length cs+        lenPs = VU.length ps+        cs = VU.map fromIntegral (childrenNoVertical g (fromIntegral node))+        ps = VU.map fromIntegral (parentsNoVertical g (fromIntegral node))+        nodeWeight :: Dir -> Double+        nodeWeight LeftToRight+          | isJust vertNum -- Debug.Trace.trace ("bvert lr "++ show vertNum)+            =+            (fromIntegral (myFromJust 521 vertNum)) + (if VU.null cs then 0 else (subPos (VU.head cs)) * 10000)+          | lenCs == 0 =+            -- Debug.Trace.trace "bry -1"+            (-1)+          --                | node == prioNode = -2+          | otherwise =+            -- Debug.Trace.trace ("bsum lr "++ show (VU.map xpos cs)) $+            ((VU.sum (VU.map xpos cs)) / (fromIntegral lenCs)) + (if VU.null cs then 0 else (subPos (VU.head cs)) * 10000)+        nodeWeight RightToLeft+          | isJust vertNum =+            -- Debug.Trace.trace ("bvert rl "++ show vertNum)+            (fromIntegral (myFromJust 522 vertNum)) + (if VU.null cs then 0 else (subPos (VU.head cs)) * 10000)+          | lenPs == 0 -- Debug.Trace.trace "bry -1"+            =+            (-1)+          --                | node == prioNode = -2+          | otherwise -- Debug.Trace.trace ("bsum rl "++ show (VU.map xpos ps)) $+            =+            ((VU.sum (VU.map xpos ps)) / (fromIntegral lenPs)) + (if VU.null cs then 0 else (subPos (VU.head cs)) * 10000)++        lu = Graph.lookupNode (fromIntegral node) g+        vertNum = maybe Nothing Common.verticalNumber lu+        xpos :: Int -> Double+        xpos c =+          -- Debug.Trace.trace (show (c, l0,maybe 0 fromIntegral (elemIndex c l0), subPos c)) $+          (maybe 0 fromIntegral (elemIndex c l0))++        subPos :: Int -> Double+        subPos c =+          -- Debug.Trace.trace (show channel ++ " : " ++ show channels) $+          (fromIntegral channel) / (fromIntegral channels)+          where+            channel = maybe 0 channelNrOut edgeLabel+            channels = maybe 1 nrTypes (Graph.lookupNode (fromIntegral c) g)+            nrTypes x+              | isSubLabel x = subLabels x+              | otherwise = 1+            edgeLabel+              | isNothing (Graph.lookupEdge dEdge g) = Nothing+              | null (myFromJust 523 (Graph.lookupEdge dEdge g)) = Nothing+              | otherwise = fmap (myhead 74) (Graph.lookupEdge dEdge g)+            dEdge = (fromIntegral node, fromIntegral c)++-- Assign every node in l0 a number thats the median of its neighbours in l1, then sort+median :: EdgeClass e => CGraph n e -> [Int] -> [Int] -> [Int]+median g l0 l1 = map fst $ sortOn snd $ map bc l0+  where+    bc :: Int -> (Int, Int)+    bc node = (node, if len == 0 then 0 else m VU.! (len `div` 2))+      where+        len = VU.length cs+        cs :: Vector Int+        cs =+          VU.map+            (\x -> fromMaybe 0 (elemIndex (fromIntegral x) l1))+            (childrenNoVertical g (fromIntegral node))+        m = VU.modify I.sort cs++--TODO: radix sort+--https://hackage.haskell.org/package/uvector-algorithms-0.2/docs/Data-Array-Vector-Algorithms-Radix.html++-- Sort two edges lexicographically after their y-position in the layer+-- An edge has two points, each point has a y-position (e.g. e0y0)+-- and a node number (e.g. e0n0)+lexicographicSort :: Vector (YNode, YNode) -> VU.Vector (YNode, YNode)+lexicographicSort es = VU.modify (I.sortBy lexicographicOrdering) es+  where+    lexicographicOrdering+      ((e0y0, e0n0, _, _), (e0y1, e0n1, _, _))+      ((e1y0, e1n0, _, _), (e1y1, e1n1, _, _))+        | (e0y0 > e1y0)+            || (e0y0 == e1y0 && e0n0 > e1n0)+            || (e0y0 == e1y0 && e0n0 == e1n0 && e0y1 > e1y1)+            || (e0y0 == e1y0 && e0n0 == e1n0 && e0y1 == e1y1 && e0n1 > e1n1) =+          GT+        | e0y0 == e1y0 && e0n0 == e1n0 && e0y1 == e1y1 && e0n1 == e1n1 = EQ+        | otherwise = LT++-- | See:  Simple and Efficient Bilayer Cross Counting by Barth, Mutzel, Jünger+primitiveInversionCount :: VU.Vector Int -> Int+primitiveInversionCount xs =+  sum+    [ if (xs VU.! i) > (xs VU.! j) then 1 else 0 | i <- [0 .. ((VU.length xs) - 1)], j <- [i .. ((VU.length xs) - 1)]+    ]++--  where l = VU.length xs++-- Modified merge sort for counting of edge crossings+-- which is the same as counting inversions (see)+-- http://www.geeksforgeeks.org/counting-inversions/++merge :: ([Int], Int) -> ([Int], Int) -> ([Int], Int)+merge ([], _) (ys, inv) = (ys, inv)+merge (xs, inv) ([], _) = (xs, inv)+merge (xs@(x : xt), inv0) (ys@(y : yt), inv1)+  | x <= y = (x : (fst (merge (xt, inv0) (ys, inv1))), inv0 + inv1)+  | otherwise = (y : (fst (merge (xs, inv0) (yt, inv1))), inv0 + inv1 + length xs)++split :: [a] -> ([a], [a])+split (x : y : zs) = let (xs, ys) = split zs in (x : xs, y : ys)+split [x] = ([x], [])+split [] = ([], [])++mergeSort :: ([Int], Int) -> ([Int], Int)+mergeSort ([], _) = ([], 0)+mergeSort ([x], _) = ([x], 0)+mergeSort (xs, _) =+  let (as, bs) = split xs -- num_inv+   in merge (mergeSort (as, 0)) (mergeSort (bs, 0))++-- https://hackage.haskell.org/package/splaytree+-- https://hackage.haskell.org/package/TreeStructures-0.0.1/docs/Data-Tree-Splay.html++fromAdj :: EdgeClass e => Map Word32 nl -> [(Word32, [Word32], [e])] -> Graph nl [e]+fromAdj nodesMap adj = foldl (newNodes nodesMap) Graph.empty adj+  where+    newNodes :: -- (Ord n, VU.Unbox n) =>+      EdgeClass e =>+      Map Word32 nl ->+      Graph nl [e] ->+      (Word32, [Word32], [e]) ->+      Graph nl [e]+    newNodes nm g (n, ns, eLabel) =+      Graph.insertEdges (Just True) edges $+        maybe id (Graph.insertNode (fromIntegral n)) (Map.lookup n nm) $+          Graph.insertNodes lookedUpNodes g+      where+        lookedUpNodes = mapMaybe addLabel ns+        addLabel n1 = fmap (n1,) (Map.lookup n nm)+        edges = zip es edgeLbls+        es = map (n,) ns+        edgeLbls = repeat eLabel++------------------------------------------------------------------------------------------------------------------------------++-- | To be able to jump vertically between nodes in an interactive ui+getColumns :: EdgeClass e => CGraphL n e -> (Map X [UINode], Map.Map Int [Column])+getColumns (gr, m) = (Map.fromList cols, Map.fromList (zip [0 ..] (divideTables cols)))+  where+    cols =+      map+        tupleWithX+        ( ( (map (sortBy sorty))+              . (groupBy groupx)+              . (sortBy sortx)+          )+            (map fromIntegral (Graph.nodes gr))+        )+    tupleWithX :: [UINode] -> (X, [UINode])+    tupleWithX ls = (maybe 0 fst (Map.lookup (myhead 504 ls) m), ls)+    groupx n0 n1 = maybe 0 fst (Map.lookup n0 m) == maybe 0 fst (Map.lookup n1 m)+    sortx n0 n1 = compare (maybe 0 fst (Map.lookup n0 m)) (maybe 0 fst (Map.lookup n1 m))+    sorty n0 n1 = compare (maybe 0 snd (Map.lookup n0 m)) (maybe 0 snd (Map.lookup n1 m))++    -- There can be several graphs on the screen that are connected with separating edges+    divideTables :: [Column] -> [[Column]]+    divideTables [] = []+    divideTables layers = layersWithoutSep : divideTables rest+      where+        (layersWithoutSep, rest) = sumLayers ([], layers)+        sumLayers :: ([Column], [Column]) -> ([Column], [Column])+        sumLayers (s, []) = (s, [])+        sumLayers (s, l : ls)+          | containsSeparatingEdge (snd l) = (s ++ [l], ls)+          | otherwise = sumLayers (s ++ [l], ls)+        containsSeparatingEdge ns = any cs ns+        cs n = VU.length (childrenSeparating gr n) > 0++-- | To be able to jump horizontally between nodes in an interactive ui+getRows :: CGraphL n e -> Map Y [UINode]+getRows (gr, m) =+  Map.fromList $+    map+      tupleWithY+      ( ( (map (sortBy sortx))+            . (groupBy groupy)+            . (sortBy sorty)+        )+          (map fromIntegral (Graph.nodes gr))+      )+  where+    tupleWithY :: [UINode] -> (Y, [UINode])+    tupleWithY ls = (maybe 0 snd (Map.lookup (myhead 504 ls) m), ls)+    groupy n0 n1 = maybe 0 snd (Map.lookup n0 m) == maybe 0 snd (Map.lookup n1 m)+    sortx n0 n1 = compare (maybe 0 fst (Map.lookup n0 m)) (maybe 0 fst (Map.lookup n1 m))+    sorty n0 n1 = compare (maybe 0 snd (Map.lookup n0 m)) (maybe 0 snd (Map.lookup n1 m))

@@ -0,0 +1,241 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE NoMonomorphismRestriction #-}++module Graph.SubGraphWindows (subgraphWindows, getColumns, getRows) where++import qualified Data.IntMap as I+import Data.List (groupBy, sortBy, (\\))+import Data.Map (Map)+import qualified Data.Map as Map+import Data.Maybe (fromJust, fromMaybe, isJust)+import qualified Data.Vector.Unboxed as VU+import Debug.Trace ( trace )+import Graph.CommonGraph+  ( CGraph,+    CGraphL,+    Column,+    LayerFeatures (..),+    NodeClass (dummyNode, isArgLabel, updateLayer),+    EdgeClass,+    UINode,+    bb,+    childrenSeparating,+    layer,+    lb,+    lbb,+    ltb,+    mid,+    myhead,+    nestingFeatures,+    parentsVertical,+    rb,+    rbb,+    rtb,+    tb,+  )+import Graph.GraphDrawing (getColumns, getRows)+import Graph.IntMap (nodes)+import qualified Graph.IntMap as Graph++data Span = SpanLeftBorder | SpanMiddle | SpanRightBorder | SpanOutside deriving (Show)++data SpanInOut = Outside | Inside++type Layer = Int -- the nesting of the window:+-- 0 -> dummy node+-- 1 -> not part of a window+-- 2 -> first window layer++type X = Int++type Y = Int++type Min = Int++type Max = Int++subgraphWindows :: (EdgeClass e, NodeClass n, Show n, VU.Unbox UINode) => CGraphL n e -> CGraphL n e+subgraphWindows (graph, pos)+  | null ns = (graph, pos)+  | otherwise -- Debug.Trace.trace ("subgraphWindows "++ show (graph,pos,newGraph,normalisedPos) ++"\n") -- ++ -- show newGraph ++"\n"+++  --                                      show pos ++"\n"++ show (rows,zRows,spans zRows) ++"\n"++ show (fst columns,zColumns, spans zColumns)) $+    =+    (newGraph, normalisedPos)+  where+    newGraph =+      Graph.mapNodeWithKey+        changeNode+        filledGraph++    changeNode :: NodeClass n => I.Key -> n -> n+    changeNode n node = changeLayer nf n node+      where nf = nestingFeatures node++    changeLayer :: NodeClass n => Maybe LayerFeatures -> I.Key -> n -> n+    changeLayer Nothing n node+      | isArgLabel node = updateLayer (changeStyle l defaultFeatures) node+      | otherwise =       updateLayer (changeStyle l defaultFeatures) node+      where+        l = highestLayer xy (spans zRows) (spans zColumns)+        xy = fromMaybe (0, 0) (Map.lookup (fromIntegral n) normalisedPos)+        _xy2 = fromMaybe (0, 0) (Map.lookup (fromIntegral root) normalisedPos)+        root = rootOf graph (fromIntegral n)++    changeLayer nestingFeats n node+      | isArgLabel node = updateLayer (changeStyle l (Just ((fromJust nestingFeats) {layer = fst l}))) node+      | otherwise = updateLayer (changeStyle l nestingFeats) node+      where+        l = highestLayer xy (spans zRows) (spans zColumns)+        xy = fromMaybe (0, 0) (Map.lookup (fromIntegral n) normalisedPos)++    rootOf :: EdgeClass e => CGraph n e -> UINode -> UINode+    rootOf gr node+      | VU.null psVert = node+      | otherwise = rootOf gr (VU.head psVert)+      where+        psVert = parentsVertical gr node++    defaultFeatures = Just (LayerFeatures 0 Nothing)++    changeStyle :: (Int, (Span, Span)) -> Maybe LayerFeatures -> Maybe LayerFeatures+    changeStyle (n, (SpanLeftBorder, SpanLeftBorder)) style = maybeReplace style n lbb -- LeftBottomBorder+    changeStyle (n, (SpanLeftBorder, SpanMiddle)) style -- n >= 2    = maybeReplace style n mid+      =+      maybeReplace style n bb -- BottomBorder+    changeStyle (n, (SpanLeftBorder, SpanRightBorder)) style -- n >= 2    = maybeReplace style n mid+      =+      maybeReplace style n rbb -- RightBottomBorder+    changeStyle (n, (SpanMiddle, SpanLeftBorder)) style = maybeReplace style n lb -- LeftBorder+    changeStyle (n, (SpanMiddle, SpanMiddle)) style = maybeReplace style n mid+    changeStyle (n, (SpanMiddle, SpanRightBorder)) style -- n >= 2    = maybeReplace style n mid+      =+      maybeReplace style n rb -- RightBorder+    changeStyle (n, (SpanRightBorder, SpanLeftBorder)) style -- n >= 4    = maybeReplace style n mid+      =+      maybeReplace style n ltb -- LeftTopBorder+    changeStyle (n, (SpanRightBorder, SpanMiddle)) style -- n >= 4    = maybeReplace style n mid+      =+      maybeReplace style n tb -- TopBorder+    changeStyle (n, (SpanRightBorder, SpanRightBorder)) style -- n >= 4    = maybeReplace style n mid+      =+      maybeReplace style n rtb -- RightTopBorder+    changeStyle (_, _) style = style++    maybeReplace :: Maybe LayerFeatures -> Int -> (Int -> Maybe LayerFeatures) -> Maybe LayerFeatures+    maybeReplace (Just (LayerFeatures 0 _)) n lf = lf n+    maybeReplace (Just (LayerFeatures x _)) _ lf = lf x+    maybeReplace _ n lf = Debug.Trace.trace "_" lf n++    filledGraph = Graph.insertNodes (map fr newNodes) graph+    fr (n, nl) = (fromIntegral n, nl)+    normalisedPos = Map.map (\(x, y) -> (x - minX, y - minY)) (Map.union pos newPos)++    newNodes = zipWith dNode [(m + 1) ..] holes+    newPos = Map.fromList (zip (map fromIntegral [(m + 1) ..]) holes)+    dNode n _ = (n, dummyNode 1)+    m = maximum (nodes graph)++    holes :: [(Int, Int)]+    holes = [(x, y) | x <- [minX .. maxX], y <- [minY .. maxY]] \\ nodePositions++    nodePositions = Map.elems pos++    ns = I.toList (Graph.nodeLabels graph)++    minX = minimum (map fst nodePositions)+    minY = minimum (map snd nodePositions)+    maxX = maximum (map fst nodePositions)+    maxY = maximum (map snd nodePositions)++    rows :: Map Y [UINode]+    rows = getRows (filledGraph, normalisedPos)+    columns = getColumns (filledGraph, normalisedPos)++    maxZCoord = maximum $ map (\(_, nl) -> zOfNode nl) ns+    zOfNode nl = maybe 0 layer (nestingFeatures nl)++    zLayers :: [(X, [UINode])] -> [(Layer, [(X, [Layer])])]+    zLayers xs = map getLayer (reverse [1 .. maxZCoord])+      where+        getLayer l = (l, map zOfNodes xs)+          where+            zOfNodes (x, ns1) = (x, map zLayer ns1)+            zLayer n+              | isJust lu && zOfNode (fromJust lu) >= l = l+              | otherwise = 0+              where+                lu = Graph.lookupNode n graph++    zRows :: [(Layer, [(X, [Layer])])]+    zRows = zLayers (Map.toList rows)+    zColumns = zLayers (Map.toList (fst columns))++    spans :: [(Layer, [(X, [Layer])])] -> Map Layer (Map X [(Min, Max)])+    spans ls = Map.fromList (map zSpans ls)+      where+        zSpans (z, rs) = (z, Map.fromList (map rowsColums rs))+          where+            rowsColums (x, layers) = (x, minMax layers 0 0 Outside)++            minMax :: [Layer] -> Int -> Int -> SpanInOut -> [(Min, Max)]+            minMax [] start i Inside = [(start, i - 1)]+            minMax [] _ _ _ = []+            minMax (l : layers) start i Outside+              | l == z = minMax layers i (i + 1) Inside+              | otherwise = minMax layers start (i + 1) Outside+            minMax (l : layers) start i Inside+              | l == z = minMax layers start (i + 1) Inside+              | otherwise = (start, i - 1) : minMax layers start (i + 1) Outside++    highestLayer ::+      (X, Y) ->+      Map Layer (Map X [(Min, Max)]) ->+      Map Layer (Map X [(Min, Max)]) ->+      (Layer, (Span, Span))+    highestLayer (x, y) hrows cols = findFirstWindow maxZCoord+      where+        findFirstWindow 0 = (0, (SpanOutside, SpanOutside))+        findFirstWindow z+          | found c r = (z, (c, r))+          | otherwise = findFirstWindow (z - 1)+          where+            c = maybe SpanOutside (overlappedByNeighbouringSpans (x, y) True) (Map.lookup z cols)+            r = maybe SpanOutside (overlappedByNeighbouringSpans (x, y) False) (Map.lookup z hrows)+            found SpanOutside _ = False+            found _ SpanOutside = False+            found _ _ = True++    -- Is there at least one neighboring row/column that includes the X/Y coordinate in its span+    overlappedByNeighbouringSpans :: (X, Y) -> Bool -> Map X [(Min, Max)] -> Span+    overlappedByNeighbouringSpans (x, y) isColumn nspans+      | isColumn = maybe SpanOutside spanPositionColumn (minmax (goLeft x ++ goRight (x + 1)))+      | otherwise = maybe SpanOutside spanPositionRow (minmax (goLeft y ++ goRight (y + 1)))+      where+        spanPositionColumn (smin, smax)+          | y == smin = SpanRightBorder+          | y == smax = SpanLeftBorder+          | y > smin && y < smax = SpanMiddle+          | otherwise = SpanOutside+        spanPositionRow (smin, smax)+          | x == smin = SpanLeftBorder+          | x == smax = SpanRightBorder+          | x > smin && x < smax = SpanMiddle+          | otherwise = SpanOutside+        minmax xs+          | null xs = Nothing+          | otherwise = Just (minimum (map fst xs), maximum (map snd xs))++        goLeft p+          | null mm = mm+          | otherwise = mm ++ goLeft (p - 1)+          where+            mm = fromMaybe [] (Map.lookup p nspans)++        goRight p+          | null mm = mm+          | otherwise = mm ++ goRight (p + 1)+          where+            mm = fromMaybe [] (Map.lookup p nspans)