ideas 1.3.1 → 1.4

raw patch · 114 files changed

+2667/−2449 lines, 114 filesdep +HDBCdep +HDBC-sqlite3dep +network-uridep ~networkPVP ok

version bump matches the API change (PVP)

Dependencies added: HDBC, HDBC-sqlite3, network-uri

Dependency ranges changed: network

API changes (from Hackage documentation)

Files

• CHANGELOG.txt +24/−0
• CREDITS.txt +0/−15
• LICENSE.txt +169/−641
• NOTICE.txt +44/−0
• ideas.cabal +42/−12
• src/Ideas/Common/Algebra/Boolean.hs +4/−4
• src/Ideas/Common/Algebra/BooleanLaws.hs +4/−4
• src/Ideas/Common/Algebra/Field.hs +31/−26
• src/Ideas/Common/Algebra/FieldLaws.hs +9/−9
• src/Ideas/Common/Algebra/Group.hs +4/−4
• src/Ideas/Common/Algebra/GroupLaws.hs +4/−4
• src/Ideas/Common/Algebra/Law.hs +26/−14
• src/Ideas/Common/Algebra/SmartGroup.hs +22/−23
• src/Ideas/Common/Classes.hs +17/−7
• src/Ideas/Common/Context.hs +4/−4
• src/Ideas/Common/CyclicTree.hs +221/−0
• src/Ideas/Common/Derivation.hs +4/−4
• src/Ideas/Common/DerivationTree.hs +4/−4
• src/Ideas/Common/Environment.hs +4/−4
• src/Ideas/Common/Exercise.hs +18/−4
• src/Ideas/Common/ExerciseTests.hs +4/−4
• src/Ideas/Common/Id.hs +4/−4
• src/Ideas/Common/Library.hs +4/−4
• src/Ideas/Common/Predicate.hs +4/−4
• src/Ideas/Common/Rewriting.hs +4/−4
• src/Ideas/Common/Rewriting/AC.hs +4/−4
• src/Ideas/Common/Rewriting/Confluence.hs +4/−4
• src/Ideas/Common/Rewriting/Difference.hs +4/−4
• src/Ideas/Common/Rewriting/RewriteRule.hs +4/−4
• src/Ideas/Common/Rewriting/Substitution.hs +4/−4
• src/Ideas/Common/Rewriting/Term.hs +4/−4
• src/Ideas/Common/Rewriting/Unification.hs +4/−4
• src/Ideas/Common/Rule.hs +4/−4
• src/Ideas/Common/Rule/Abstract.hs +4/−4
• src/Ideas/Common/Rule/EnvironmentMonad.hs +16/−4
• src/Ideas/Common/Rule/Parameter.hs +4/−4
• src/Ideas/Common/Rule/Recognizer.hs +4/−4
• src/Ideas/Common/Rule/Transformation.hs +4/−4
• src/Ideas/Common/Strategy.hs +15/−14
• src/Ideas/Common/Strategy/Abstract.hs +106/−54
• src/Ideas/Common/Strategy/Choice.hs +144/−129
• src/Ideas/Common/Strategy/Combinators.hs +65/−59
• src/Ideas/Common/Strategy/Configuration.hs +85/−43
• src/Ideas/Common/Strategy/Core.hs +0/−166
• src/Ideas/Common/Strategy/Derived.hs +110/−26
• src/Ideas/Common/Strategy/Legacy.hs +37/−0
• src/Ideas/Common/Strategy/Location.hs +14/−17
• src/Ideas/Common/Strategy/Parsing.hs +0/−261
• src/Ideas/Common/Strategy/Prefix.hs +173/−0
• src/Ideas/Common/Strategy/Process.hs +49/−112
• src/Ideas/Common/Strategy/Sequence.hs +30/−61
• src/Ideas/Common/Strategy/StrategyTree.hs +115/−0
• src/Ideas/Common/Strategy/Symbol.hs +62/−0
• src/Ideas/Common/Strategy/Traversal.hs +51/−38
• src/Ideas/Common/Traversal/Iterator.hs +4/−4
• src/Ideas/Common/Traversal/Navigator.hs +4/−4
• src/Ideas/Common/Traversal/Tests.hs +4/−4
• src/Ideas/Common/Traversal/Utils.hs +4/−4
• src/Ideas/Common/Utils.hs +4/−4
• src/Ideas/Common/Utils/QuickCheck.hs +4/−4
• src/Ideas/Common/Utils/StringRef.hs +4/−5
• src/Ideas/Common/Utils/TestSuite.hs +4/−4
• src/Ideas/Common/Utils/Uniplate.hs +4/−4
• src/Ideas/Common/View.hs +4/−4
• src/Ideas/Encoding/DecoderJSON.hs +14/−6
• src/Ideas/Encoding/DecoderXML.hs +5/−5
• src/Ideas/Encoding/Encoder.hs +19/−4
• src/Ideas/Encoding/EncoderHTML.hs +16/−10
• src/Ideas/Encoding/EncoderJSON.hs +13/−8
• src/Ideas/Encoding/EncoderXML.hs +5/−4
• src/Ideas/Encoding/Evaluator.hs +52/−27
• src/Ideas/Encoding/LinkManager.hs +4/−4
• src/Ideas/Encoding/ModeJSON.hs +37/−33
• src/Ideas/Encoding/ModeXML.hs +23/−23
• src/Ideas/Encoding/OpenMathSupport.hs +4/−4
• src/Ideas/Encoding/RulePresenter.hs +4/−4
• src/Ideas/Encoding/RulesInfo.hs +4/−4
• src/Ideas/Encoding/StrategyInfo.hs +45/−77
• src/Ideas/Main/BlackBoxTests.hs +7/−6
• src/Ideas/Main/Default.hs +38/−20
• src/Ideas/Main/Documentation.hs +4/−4
• src/Ideas/Main/Logging.hs +188/−0
• src/Ideas/Main/LoggingDatabase.hs +0/−81
• src/Ideas/Main/Options.hs +17/−14
• src/Ideas/Main/Revision.hs +3/−3
• src/Ideas/Service/BasicServices.hs +21/−21
• src/Ideas/Service/Diagnose.hs +33/−49
• src/Ideas/Service/DomainReasoner.hs +4/−5
• src/Ideas/Service/FeedbackScript/Analysis.hs +4/−4
• src/Ideas/Service/FeedbackScript/Parser.hs +4/−4
• src/Ideas/Service/FeedbackScript/Run.hs +5/−4
• src/Ideas/Service/FeedbackScript/Syntax.hs +4/−4
• src/Ideas/Service/FeedbackText.hs +5/−4
• src/Ideas/Service/ProblemDecomposition.hs +30/−21
• src/Ideas/Service/Request.hs +22/−6
• src/Ideas/Service/ServiceList.hs +35/−15
• src/Ideas/Service/State.hs +66/−27
• src/Ideas/Service/Submit.hs +5/−4
• src/Ideas/Service/Types.hs +34/−7
• src/Ideas/Text/HTML.hs +4/−4
• src/Ideas/Text/JSON.hs +8/−7
• src/Ideas/Text/OpenMath/FMP.hs +4/−4
• src/Ideas/Text/OpenMath/Object.hs +4/−4
• src/Ideas/Text/OpenMath/Symbol.hs +4/−4
• src/Ideas/Text/OpenMath/Tests.hs +4/−4
• src/Ideas/Text/Parsing.hs +4/−4
• src/Ideas/Text/UTF8.hs +4/−4
• src/Ideas/Text/XML.hs +4/−4
• src/Ideas/Text/XML/Document.hs +4/−4
• src/Ideas/Text/XML/Interface.hs +4/−4
• src/Ideas/Text/XML/Parser.hs +4/−4
• src/Ideas/Text/XML/Unicode.hs +4/−4
• src/Network/CGI.hs +1/−1
• src/Network/CGI/Compat.hs +1/−1

@@ -0,0 +1,24 @@+Changelog ideas-1.3.1 => ideas.1.4+-----------------------------------------------------------------------------++* refactoring of strategies+  - strategies are now represented cyclic trees (that preserve fixpoints)+  - new strategy combinators can be defined outside the framework+  - simpler interfaces: no more Builder, Step, and Core datatypes+  - nice speed-up for constructing and running strategies+  +* support for new database schema (v2) with more columns+  - request can have an optional 'logging' attribute (false, v1, v2)+  - command-line flag for seeing information that is logged +  - userid, sessionid, and taskid are stored in a state++* changing license to Apache License version 2.0 (was: GPL)+* renaming strategy combinators (eg .*.) to solve clash with Applicative.<*> +* adding SyntaxError constructor to Diagnose datatype+* added read instance for Difficulty+* changed newline and tab escaping in JSON+* re-implemented atomic combinator+* introduced inits combinator  (initial prefixes) and atomic prefix (!~>)+* introduced somewhereWhen traversal combinator+* added cabal flag to resolve dependency on network >= 2.6+* added cabal flag to enable support for logging

@@ -1,15 +0,0 @@-AUTHORS--Bastiaan Heeren, Alex Gerdes, Johan Jeuring--CREDITS--Harrie Passier, Arthur van Leeuwen, Josje Lodder, Hieke Keuning---This package contains a verbatim copy of the cgi-3001.2.2.0 package, with-minor modifications to resolve conflicting dependencies. The original package,-together with its BSD3 license and further information about copyright, author-and maintainer, can be found at:--   http://hackage.haskell.org/package/cgi-3001.2.2.0

@@ -1,674 +1,202 @@-                    GNU GENERAL PUBLIC LICENSE
-                       Version 3, 29 June 2007
 
- Copyright (C) 2007 Free Software Foundation, Inc. <http://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.
+                                 Apache License
+                           Version 2.0, January 2004
+                        http://www.apache.org/licenses/
 
-  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.
+   TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION
 
-  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.
+   1. Definitions.
 
-  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.
+      "License" shall mean the terms and conditions for use, reproduction,
+      and distribution as defined by Sections 1 through 9 of this document.
 
-  12. No Surrender of Others' Freedom.
+      "Licensor" shall mean the copyright owner or entity authorized by
+      the copyright owner that is granting the License.
 
-  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.
+      "Legal Entity" shall mean the union of the acting entity and all
+      other entities that control, are controlled by, or are under common
+      control with that entity. For the purposes of this definition,
+      "control" means (i) the power, direct or indirect, to cause the
+      direction or management of such entity, whether by contract or
+      otherwise, or (ii) ownership of fifty percent (50%) or more of the
+      outstanding shares, or (iii) beneficial ownership of such entity.
 
-  13. Use with the GNU Affero General Public License.
+      "You" (or "Your") shall mean an individual or Legal Entity
+      exercising permissions granted by this 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.
+      "Source" form shall mean the preferred form for making modifications,
+      including but not limited to software source code, documentation
+      source, and configuration files.
 
-  14. Revised Versions of this License.
+      "Object" form shall mean any form resulting from mechanical
+      transformation or translation of a Source form, including but
+      not limited to compiled object code, generated documentation,
+      and conversions to other media types.
 
-  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.
+      "Work" shall mean the work of authorship, whether in Source or
+      Object form, made available under the License, as indicated by a
+      copyright notice that is included in or attached to the work
+      (an example is provided in the Appendix below).
 
-  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.
+      "Derivative Works" shall mean any work, whether in Source or Object
+      form, that is based on (or derived from) the Work and for which the
+      editorial revisions, annotations, elaborations, or other modifications
+      represent, as a whole, an original work of authorship. For the purposes
+      of this License, Derivative Works shall not include works that remain
+      separable from, or merely link (or bind by name) to the interfaces of,
+      the Work and Derivative Works thereof.
 
-  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.
+      "Contribution" shall mean any work of authorship, including
+      the original version of the Work and any modifications or additions
+      to that Work or Derivative Works thereof, that is intentionally
+      submitted to Licensor for inclusion in the Work by the copyright owner
+      or by an individual or Legal Entity authorized to submit on behalf of
+      the copyright owner. For the purposes of this definition, "submitted"
+      means any form of electronic, verbal, or written communication sent
+      to the Licensor or its representatives, including but not limited to
+      communication on electronic mailing lists, source code control systems,
+      and issue tracking systems that are managed by, or on behalf of, the
+      Licensor for the purpose of discussing and improving the Work, but
+      excluding communication that is conspicuously marked or otherwise
+      designated in writing by the copyright owner as "Not a Contribution."
 
-  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.
+      "Contributor" shall mean Licensor and any individual or Legal Entity
+      on behalf of whom a Contribution has been received by Licensor and
+      subsequently incorporated within the Work.
 
-  15. Disclaimer of Warranty.
+   2. Grant of Copyright License. Subject to the terms and conditions of
+      this License, each Contributor hereby grants to You a perpetual,
+      worldwide, non-exclusive, no-charge, royalty-free, irrevocable
+      copyright license to reproduce, prepare Derivative Works of,
+      publicly display, publicly perform, sublicense, and distribute the
+      Work and such Derivative Works in Source or Object form.
 
-  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.
+   3. Grant of Patent License. Subject to the terms and conditions of
+      this License, each Contributor hereby grants to You a perpetual,
+      worldwide, non-exclusive, no-charge, royalty-free, irrevocable
+      (except as stated in this section) patent license to make, have made,
+      use, offer to sell, sell, import, and otherwise transfer the Work,
+      where such license applies only to those patent claims licensable
+      by such Contributor that are necessarily infringed by their
+      Contribution(s) alone or by combination of their Contribution(s)
+      with the Work to which such Contribution(s) was submitted. If You
+      institute patent litigation against any entity (including a
+      cross-claim or counterclaim in a lawsuit) alleging that the Work
+      or a Contribution incorporated within the Work constitutes direct
+      or contributory patent infringement, then any patent licenses
+      granted to You under this License for that Work shall terminate
+      as of the date such litigation is filed.
 
-  16. Limitation of Liability.
+   4. Redistribution. You may reproduce and distribute copies of the
+      Work or Derivative Works thereof in any medium, with or without
+      modifications, and in Source or Object form, provided that You
+      meet the following conditions:
 
-  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.
+      (a) You must give any other recipients of the Work or
+          Derivative Works a copy of this License; and
 
-  17. Interpretation of Sections 15 and 16.
+      (b) You must cause any modified files to carry prominent notices
+          stating that You changed the files; and
 
-  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.
+      (c) You must retain, in the Source form of any Derivative Works
+          that You distribute, all copyright, patent, trademark, and
+          attribution notices from the Source form of the Work,
+          excluding those notices that do not pertain to any part of
+          the Derivative Works; and
 
-                     END OF TERMS AND CONDITIONS
+      (d) If the Work includes a "NOTICE" text file as part of its
+          distribution, then any Derivative Works that You distribute must
+          include a readable copy of the attribution notices contained
+          within such NOTICE file, excluding those notices that do not
+          pertain to any part of the Derivative Works, in at least one
+          of the following places: within a NOTICE text file distributed
+          as part of the Derivative Works; within the Source form or
+          documentation, if provided along with the Derivative Works; or,
+          within a display generated by the Derivative Works, if and
+          wherever such third-party notices normally appear. The contents
+          of the NOTICE file are for informational purposes only and
+          do not modify the License. You may add Your own attribution
+          notices within Derivative Works that You distribute, alongside
+          or as an addendum to the NOTICE text from the Work, provided
+          that such additional attribution notices cannot be construed
+          as modifying the License.
 
-            How to Apply These Terms to Your New Programs
+      You may add Your own copyright statement to Your modifications and
+      may provide additional or different license terms and conditions
+      for use, reproduction, or distribution of Your modifications, or
+      for any such Derivative Works as a whole, provided Your use,
+      reproduction, and distribution of the Work otherwise complies with
+      the conditions stated in this License.
 
-  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.
+   5. Submission of Contributions. Unless You explicitly state otherwise,
+      any Contribution intentionally submitted for inclusion in the Work
+      by You to the Licensor shall be under the terms and conditions of
+      this License, without any additional terms or conditions.
+      Notwithstanding the above, nothing herein shall supersede or modify
+      the terms of any separate license agreement you may have executed
+      with Licensor regarding such Contributions.
 
-  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.
+   6. Trademarks. This License does not grant permission to use the trade
+      names, trademarks, service marks, or product names of the Licensor,
+      except as required for reasonable and customary use in describing the
+      origin of the Work and reproducing the content of the NOTICE file.
 
-    <one line to give the program's name and a brief idea of what it does.>
-    Copyright (C) <year>  <name of author>
+   7. Disclaimer of Warranty. Unless required by applicable law or
+      agreed to in writing, Licensor provides the Work (and each
+      Contributor provides its Contributions) on an "AS IS" BASIS,
+      WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or
+      implied, including, without limitation, any warranties or conditions
+      of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A
+      PARTICULAR PURPOSE. You are solely responsible for determining the
+      appropriateness of using or redistributing the Work and assume any
+      risks associated with Your exercise of permissions under this License.
 
-    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.
+   8. Limitation of Liability. In no event and under no legal theory,
+      whether in tort (including negligence), contract, or otherwise,
+      unless required by applicable law (such as deliberate and grossly
+      negligent acts) or agreed to in writing, shall any Contributor be
+      liable to You for damages, including any direct, indirect, special,
+      incidental, or consequential damages of any character arising as a
+      result of this License or out of the use or inability to use the
+      Work (including but not limited to damages for loss of goodwill,
+      work stoppage, computer failure or malfunction, or any and all
+      other commercial damages or losses), even if such Contributor
+      has been advised of the possibility of such damages.
 
-    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.
+   9. Accepting Warranty or Additional Liability. While redistributing
+      the Work or Derivative Works thereof, You may choose to offer,
+      and charge a fee for, acceptance of support, warranty, indemnity,
+      or other liability obligations and/or rights consistent with this
+      License. However, in accepting such obligations, You may act only
+      on Your own behalf and on Your sole responsibility, not on behalf
+      of any other Contributor, and only if You agree to indemnify,
+      defend, and hold each Contributor harmless for any liability
+      incurred by, or claims asserted against, such Contributor by reason
+      of your accepting any such warranty or additional liability.
 
-    You should have received a copy of the GNU General Public License
-    along with this program.  If not, see <http://www.gnu.org/licenses/>.
+   END OF TERMS AND CONDITIONS
 
-Also add information on how to contact you by electronic and paper mail.
+   APPENDIX: How to apply the Apache License to your work.
 
-  If the program does terminal interaction, make it output a short
-notice like this when it starts in an interactive mode:
+      To apply the Apache License to your work, attach the following
+      boilerplate notice, with the fields enclosed by brackets "[]"
+      replaced with your own identifying information. (Don't include
+      the brackets!)  The text should be enclosed in the appropriate
+      comment syntax for the file format. We also recommend that a
+      file or class name and description of purpose be included on the
+      same "printed page" as the copyright notice for easier
+      identification within third-party archives.
 
-    <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.
+   Copyright [yyyy] [name of copyright owner]
 
-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".
+   Licensed under the Apache License, Version 2.0 (the "License");
+   you may not use this file except in compliance with the License.
+   You may obtain a copy of the License at
 
-  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
-<http://www.gnu.org/licenses/>.
+       http://www.apache.org/licenses/LICENSE-2.0
 
-  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
-<http://www.gnu.org/philosophy/why-not-lgpl.html>.
+   Unless required by applicable law or agreed to in writing, software
+   distributed under the License is distributed on an "AS IS" BASIS,
+   WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+   See the License for the specific language governing permissions and
+   limitations under the License.

@@ -0,0 +1,44 @@+Copyright 2015 Ideas project team++   Licensed under the Apache License, Version 2.0 (the "License");+   you may not use this file except in compliance with the License.+   You may obtain a copy of the License at++       http://www.apache.org/licenses/LICENSE-2.0++   Unless required by applicable law or agreed to in writing, software+   distributed under the License is distributed on an "AS IS" BASIS,+   WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+   See the License for the specific language governing permissions and+   limitations under the License.+   +PROJECT++   Ideas (Interactive Domain-specific Exercise Assistants) is a joint research+   project between the Open University of the Netherlands and Utrecht+   University. The project's goal is to use software and compiler technology to+   build state-of-the-art components of intelligent tutoring systems (ITS) and+   learning environments. The 'ideas' software package provides a generic+   framework for constructing the expert knowledge module (also known as a+   domain reasoner) for an ITS or learning environment. More information about+   the project can be found on the project's homepage:+   +       http://ideas.cs.uu.nl/www/+       +AUTHORS++   The authors and copyright holders of the 'ideas' software package are:+   - Bastiaan Heeren   (bastiaan.heeren@ou.nl, maintainer)+   - Alex Gerdes       (agerdes@me.com)+   - Johan Jeuring     (J.T.Jeuring@uu.nl)++CREDITS++   Harrie Passier, Arthur van Leeuwen, Josje Lodder, Hieke Keuning++   This package contains a verbatim copy of the cgi-3001.2.2.0 package, with+   minor modifications to resolve conflicting dependencies. The original +   package, together with its BSD3 license and further information about +   copyright, author and maintainer, can be found at:++       http://hackage.haskell.org/package/cgi-3001.2.2.0

@@ -1,35 +1,59 @@ name:                   ideas-version:                1.3.1+version:                1.4 synopsis:               Feedback services for intelligent tutoring systems homepage:               http://ideas.cs.uu.nl/www/ description: -  ideas provides feedback services to intelligent tutoring systems such as -  the digital mathematical environment of the Freudenthal Institute, MathDox,-  and Activemath. +  Ideas (Interactive Domain-specific Exercise Assistants) is a joint research +  project between the Open University of the Netherlands and Utrecht +  University. The project's goal is to use software and compiler technology to +  build state-of-the-art components for intelligent tutoring systems (ITS) and +  learning environments. The 'ideas' software package provides a generic +  framework for constructing the expert knowledge module (also known as a +  domain reasoner) for an ITS or learning environment. Domain knowledge is +  offered as a set of feedback services that are used by external tools such +  as the digital mathematical environment (DME), MathDox, and the Math-Bridge +  system. We have developed several domain reasoners based on this framework, +  including reasoners for mathematics, linear algebra, logic, learning Haskell +  (the Ask-Elle programming tutor) and evaluating Haskell expressions, and for +  practicing communication skills (the serious game Communicate!).  category:               Education copyright:              (c) 2015-license:                GPL+license:                Apache-2.0 license-file:           LICENSE.txt author:                 Bastiaan Heeren, Alex Gerdes, Johan Jeuring maintainer:             bastiaan.heeren@ou.nl stability:              provisional-extra-source-files:     CREDITS.txt+extra-source-files:     NOTICE.txt, CHANGELOG.txt build-type:             Simple cabal-version:          >= 1.8.0.2-tested-with:            GHC == 7.4.1, GHC == 7.6.3, GHC == 7.8.3+tested-with:            GHC == 7.4.1, GHC == 7.8.3, GHC == 7.8.4  source-repository head   type:     svn   location: https://ideas.cs.uu.nl/svn/Feedback/trunk/ +flag network-uri+  description: Get Network.URI from the network-uri package+  default: True++flag logging+  description: enable support for logging interactions to a sqlite3 database+  default: False+ --------------------------------------------------------------------------------  Library+  if flag(logging) {+    cpp-options:     -DDB+    Build-Depends:   HDBC, HDBC-sqlite3+  }+   ghc-options:       -Wall   hs-source-dirs:    src   Build-Depends:     base >= 4.2 && < 5, +                     mtl == 2.1.*,                      QuickCheck >= 2.4.1 && < 2.7,                       Diff,                      containers, @@ -41,8 +65,6 @@                      parsec,                      wl-pprint,                      array,-                     mtl == 2.1.*,-                     network < 2.6,                      exceptions,                      multipart,                      bytestring,@@ -50,6 +72,11 @@                      old-locale,                      xhtml +  if flag(network-uri)+    build-depends: network-uri >= 2.6, network >= 2.6+  else+    build-depends: network < 2.6+   Exposed-modules:     Ideas.Common.Algebra.Boolean     Ideas.Common.Algebra.BooleanLaws@@ -61,6 +88,7 @@     Ideas.Common.Algebra.SmartGroup     Ideas.Common.Classes     Ideas.Common.Context+    Ideas.Common.CyclicTree     Ideas.Common.Derivation     Ideas.Common.DerivationTree     Ideas.Common.Environment@@ -88,12 +116,14 @@     Ideas.Common.Strategy.Choice     Ideas.Common.Strategy.Combinators     Ideas.Common.Strategy.Configuration-    Ideas.Common.Strategy.Core     Ideas.Common.Strategy.Derived+    Ideas.Common.Strategy.Legacy     Ideas.Common.Strategy.Location-    Ideas.Common.Strategy.Parsing+    Ideas.Common.Strategy.Prefix     Ideas.Common.Strategy.Process     Ideas.Common.Strategy.Sequence+    Ideas.Common.Strategy.StrategyTree+    Ideas.Common.Strategy.Symbol     Ideas.Common.Strategy.Traversal     Ideas.Common.Traversal.Iterator     Ideas.Common.Traversal.Navigator@@ -122,7 +152,7 @@     Ideas.Main.BlackBoxTests     Ideas.Main.Default     Ideas.Main.Documentation-    Ideas.Main.LoggingDatabase+    Ideas.Main.Logging     Ideas.Main.Options     Ideas.Main.Revision     Ideas.Service.BasicServices

@@ -1,8 +1,8 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 -----------------------------------------------------------------------------
--- Copyright 2015, Open Universiteit Nederland. This file is distributed
--- under the terms of the GNU General Public License. For more information,
--- see the file "LICENSE.txt", which is included in the distribution.
+-- Copyright 2015, Ideas project team. This file is distributed under the
+-- terms of the Apache License 2.0. For more information, see the files
+-- "LICENSE.txt" and "NOTICE.txt", which are included in the distribution.
 -----------------------------------------------------------------------------
 -- |
 -- Maintainer  :  bastiaan.heeren@ou.nl
@@ -10,7 +10,7 @@ -- Portability :  portable (depends on ghc)
 --
 -----------------------------------------------------------------------------
---  $Id: Boolean.hs 7524 2015-04-08 07:31:15Z bastiaan $
+--  $Id: Boolean.hs 8740 2015-10-14 19:26:22Z bastiaan $
 
 module Ideas.Common.Algebra.Boolean
    ( -- * Boolean algebra

@@ -1,7 +1,7 @@ -----------------------------------------------------------------------------
--- Copyright 2015, Open Universiteit Nederland. This file is distributed
--- under the terms of the GNU General Public License. For more information,
--- see the file "LICENSE.txt", which is included in the distribution.
+-- Copyright 2015, Ideas project team. This file is distributed under the
+-- terms of the Apache License 2.0. For more information, see the files
+-- "LICENSE.txt" and "NOTICE.txt", which are included in the distribution.
 -----------------------------------------------------------------------------
 -- |
 -- Maintainer  :  bastiaan.heeren@ou.nl
@@ -9,7 +9,7 @@ -- Portability :  portable (depends on ghc)
 --
 -----------------------------------------------------------------------------
---  $Id: BooleanLaws.hs 7524 2015-04-08 07:31:15Z bastiaan $
+--  $Id: BooleanLaws.hs 8740 2015-10-14 19:26:22Z bastiaan $
 
 module Ideas.Common.Algebra.BooleanLaws
    ( -- * Boolean laws

@@ -1,8 +1,8 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 -----------------------------------------------------------------------------
--- Copyright 2015, Open Universiteit Nederland. This file is distributed
--- under the terms of the GNU General Public License. For more information,
--- see the file "LICENSE.txt", which is included in the distribution.
+-- Copyright 2015, Ideas project team. This file is distributed under the
+-- terms of the Apache License 2.0. For more information, see the files
+-- "LICENSE.txt" and "NOTICE.txt", which are included in the distribution.
 -----------------------------------------------------------------------------
 -- |
 -- Maintainer  :  bastiaan.heeren@ou.nl
@@ -10,7 +10,7 @@ -- Portability :  portable (depends on ghc)
 --
 -----------------------------------------------------------------------------
---  $Id: Field.hs 7524 2015-04-08 07:31:15Z bastiaan $
+--  $Id: Field.hs 8743 2015-10-14 19:48:13Z bastiaan $
 
 module Ideas.Common.Algebra.Field
    ( -- * Semi-ring
@@ -34,53 +34,54 @@ import Ideas.Common.Classes (mapBoth)
 import Test.QuickCheck
 import qualified Control.Applicative as A
+import qualified Control.Applicative as Applicative
 
 --------------------------------------------------------
 -- Semi-ring
 
-infixl 6 <+>
-infixl 7 <*>
+infixl 6 |+|
+infixl 7 |*|
 
 class SemiRing a where
    -- additive
-   (<+>) :: a -> a -> a
+   (|+|) :: a -> a -> a
    zero  :: a
    sum   :: [a] -> a
    -- multiplicative
-   (<*>)   :: a -> a -> a
+   (|*|)   :: a -> a -> a
    one     :: a
    product :: [a] -> a
    -- default implementation
    sum     [] = zero
-   sum     xs = foldl1 (<+>) xs
+   sum     xs = foldl1 (|+|) xs
    product [] = one
-   product xs = foldl1 (<*>) xs
+   product xs = foldl1 (|*|) xs
 
 --------------------------------------------------------
 -- Ring
 
-infixl 6 <->
+infixl 6 |-|
 
 -- Minimal complete definition: plusInverse or <->
 class SemiRing a => Ring a where
    plusInverse :: a -> a
-   (<->)       :: a -> a -> a
+   (|-|)       :: a -> a -> a
    -- default definitions
-   plusInverse = (zero <->)
-   a <-> b     = a <+> plusInverse b
+   plusInverse = (zero |-|)
+   a |-| b     = a |+| plusInverse b
 
 --------------------------------------------------------
 -- Field
 
-infixl 7 </>
+infixl 7 |/|
 
 -- Minimal complete definition: mulInverse or </>
 class Ring a => Field a where
    timesInverse :: a -> a
-   (</>)        :: a -> a -> a
+   (|/|)        :: a -> a -> a
    -- default definitions
-   timesInverse = (one </>)
-   a </> b      = a <*> timesInverse b
+   timesInverse = (one |/|)
+   a |/| b      = a |*| timesInverse b
 
 --------------------------------------------------------
 -- Additive monoid
@@ -97,11 +98,11 @@ 
 instance SemiRing a => Monoid (Additive a) where
    mempty  = A.pure zero
-   mappend = A.liftA2 (<+>)
+   mappend = A.liftA2 (|+|)
 
 instance Ring a => Group (Additive a) where
    inverse   = A.liftA plusInverse
-   appendInv = A.liftA2 (<->)
+   appendInv = A.liftA2 (|-|)
 
 --------------------------------------------------------
 -- Multiplicative monoid
@@ -118,11 +119,11 @@ 
 instance SemiRing a => Monoid (Multiplicative a) where
    mempty  = A.pure one
-   mappend = A.liftA2 (<*>)
+   mappend = A.liftA2 (|*|)
 
 instance Field a => Group (Multiplicative a) where
    inverse   = A.liftA timesInverse
-   appendInv = A.liftA2 (</>)
+   appendInv = A.liftA2 (|/|)
 
 instance SemiRing a => MonoidZero (Multiplicative a) where
    mzero = Multiplicative zero
@@ -153,6 +154,10 @@ instance Functor SafeNum where
    fmap f = either Exception (return . f) . safeNum
 
+instance Applicative.Applicative SafeNum where
+   pure  = return
+   (<*>) = ap
+
 instance Monad SafeNum where
    return  = Ok
    fail    = Exception
@@ -173,18 +178,18 @@    fromRational = return . fromRational
 
 instance Num a => SemiRing (SafeNum a) where
-   (<+>) = (+)
-   (<*>) = (*)
+   (|+|) = (+)
+   (|*|) = (*)
    zero  = 0
    one   = 1
 
 instance Num a => Ring (SafeNum a) where
    plusInverse = negate
-   (<->)       = (-)
+   (|-|)       = (-)
 
 instance (Eq a, Fractional a) => Field (SafeNum a) where
    timesInverse = recip
-   (</>)        = (/)
+   (|/|)        = (/)
 
 safeDivisor :: (Eq a, Num a) => SafeNum a -> SafeNum a
 safeDivisor m = m >>= \a ->

@@ -1,7 +1,7 @@ -----------------------------------------------------------------------------
--- Copyright 2015, Open Universiteit Nederland. This file is distributed
--- under the terms of the GNU General Public License. For more information,
--- see the file "LICENSE.txt", which is included in the distribution.
+-- Copyright 2015, Ideas project team. This file is distributed under the
+-- terms of the Apache License 2.0. For more information, see the files
+-- "LICENSE.txt" and "NOTICE.txt", which are included in the distribution.
 -----------------------------------------------------------------------------
 -- |
 -- Maintainer  :  bastiaan.heeren@ou.nl
@@ -9,7 +9,7 @@ -- Portability :  portable (depends on ghc)
 --
 -----------------------------------------------------------------------------
---  $Id: FieldLaws.hs 7524 2015-04-08 07:31:15Z bastiaan $
+--  $Id: FieldLaws.hs 8740 2015-10-14 19:26:22Z bastiaan $
 
 module Ideas.Common.Algebra.FieldLaws
    ( -- * Semi-ring laws
@@ -38,10 +38,10 @@ -- Semi-ring laws
 
 leftDistributive :: SemiRing a => Law a
-leftDistributive = leftDistributiveFor (<*>) (<+>)
+leftDistributive = leftDistributiveFor (|*|) (|+|)
 
 rightDistributive :: SemiRing a => Law a
-rightDistributive = rightDistributiveFor (<*>) (<+>)
+rightDistributive = rightDistributiveFor (|*|) (|+|)
 
 distributiveLaws :: SemiRing a => [Law a]
 distributiveLaws = [leftDistributive, rightDistributive]
@@ -57,11 +57,11 @@ 
 leftNegateTimes :: Ring a => Law a
 leftNegateTimes = law "left-negate-times" $ \a b ->
-   plusInverse a <*> b :==: plusInverse (a <*> b)
+   plusInverse a |*| b :==: plusInverse (a |*| b)
 
 rightNegateTimes :: Ring a => Law a
 rightNegateTimes = law "right-negate-times" $ \a b ->
-   a <*> plusInverse b :==: plusInverse (a <*> b)
+   a |*| plusInverse b :==: plusInverse (a |*| b)
 
 negateTimesLaws :: Ring a => [Law a]
 negateTimesLaws = [leftNegateTimes, rightNegateTimes]
@@ -78,7 +78,7 @@ 
 distributiveSubtractionLaws :: Ring a => [Law a]
 distributiveSubtractionLaws =
-   [leftDistributiveFor (<*>) (<->), rightDistributiveFor (<*>) (<->)]
+   [leftDistributiveFor (|*|) (|-|), rightDistributiveFor (|*|) (|-|)]
 
 --------------------------------------------------------
 -- Field laws

@@ -1,8 +1,8 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 -----------------------------------------------------------------------------
--- Copyright 2015, Open Universiteit Nederland. This file is distributed
--- under the terms of the GNU General Public License. For more information,
--- see the file "LICENSE.txt", which is included in the distribution.
+-- Copyright 2015, Ideas project team. This file is distributed under the
+-- terms of the Apache License 2.0. For more information, see the files
+-- "LICENSE.txt" and "NOTICE.txt", which are included in the distribution.
 -----------------------------------------------------------------------------
 -- |
 -- Maintainer  :  bastiaan.heeren@ou.nl
@@ -10,7 +10,7 @@ -- Portability :  portable (depends on ghc)
 --
 -----------------------------------------------------------------------------
---  $Id: Group.hs 7524 2015-04-08 07:31:15Z bastiaan $
+--  $Id: Group.hs 8740 2015-10-14 19:26:22Z bastiaan $
 
 module Ideas.Common.Algebra.Group
    ( -- * Monoids

@@ -1,7 +1,7 @@ -----------------------------------------------------------------------------
--- Copyright 2015, Open Universiteit Nederland. This file is distributed
--- under the terms of the GNU General Public License. For more information,
--- see the file "LICENSE.txt", which is included in the distribution.
+-- Copyright 2015, Ideas project team. This file is distributed under the
+-- terms of the Apache License 2.0. For more information, see the files
+-- "LICENSE.txt" and "NOTICE.txt", which are included in the distribution.
 -----------------------------------------------------------------------------
 -- |
 -- Maintainer  :  bastiaan.heeren@ou.nl
@@ -9,7 +9,7 @@ -- Portability :  portable (depends on ghc)
 --
 -----------------------------------------------------------------------------
---  $Id: GroupLaws.hs 7524 2015-04-08 07:31:15Z bastiaan $
+--  $Id: GroupLaws.hs 8740 2015-10-14 19:26:22Z bastiaan $
 
 module Ideas.Common.Algebra.GroupLaws
    ( -- * Monoid laws

@@ -1,8 +1,8 @@-{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances, ExistentialQuantification #-}
 -----------------------------------------------------------------------------
--- Copyright 2015, Open Universiteit Nederland. This file is distributed
--- under the terms of the GNU General Public License. For more information,
--- see the file "LICENSE.txt", which is included in the distribution.
+-- Copyright 2015, Ideas project team. This file is distributed under the
+-- terms of the Apache License 2.0. For more information, see the files
+-- "LICENSE.txt" and "NOTICE.txt", which are included in the distribution.
 -----------------------------------------------------------------------------
 -- |
 -- Maintainer  :  bastiaan.heeren@ou.nl
@@ -10,10 +10,10 @@ -- Portability :  portable (depends on ghc)
 --
 -----------------------------------------------------------------------------
---  $Id: Law.hs 7524 2015-04-08 07:31:15Z bastiaan $
+--  $Id: Law.hs 8743 2015-10-14 19:48:13Z bastiaan $
 
 module Ideas.Common.Algebra.Law
-   ( Law, LawSpec((:==:)), law, mapLaw
+   ( Law, LawSpec((:==:)), law, lawAbs, mapLaw
    , propertyLaw, rewriteLaw
    ) where
 
@@ -27,19 +27,28 @@ instance Show (Law a) where
    show (Law s _) = s
 
-data LawSpec a = Abs (a -> LawSpec a) | a :==: a
+data LawSpec a
+   = AbsMono (a -> LawSpec a) -- simple abstraction (fewer classes needed)
+   | forall b . (Arbitrary b, Show b, Different b) => Abs (b -> LawSpec a) -- generalized abstraction
+   | a :==: a
 
 law :: LawBuilder l a => String -> l -> Law a
 law s l = Law s (lawSpec l)
 
+lawAbs :: (Different b, Arbitrary b, Show b) => (b -> LawSpec a) -> LawSpec a
+lawAbs = Abs
+
 class LawBuilder l a | l -> a where
    lawSpec :: l -> LawSpec a
 
 instance LawBuilder (LawSpec a) a where
    lawSpec = id
 
+instance LawBuilder (Law a) a where
+   lawSpec = getLawSpec
+
 instance LawBuilder b a => LawBuilder (a -> b) a where
-   lawSpec f = Abs (lawSpec . f)
+   lawSpec f = AbsMono (lawSpec . f)
 
 instance (Show a, Eq a, Arbitrary a) => Testable (Law a) where
    property = propertyLaw (==)
@@ -47,21 +56,24 @@ mapLaw :: (b -> a) -> (a -> b) -> Law a -> Law b
 mapLaw to from (Law s l) = Law s (rec l)
  where
-   rec (Abs f)    = Abs (rec . f . to)
-   rec (a :==: b) = from a :==: from b
+   rec (AbsMono f) = AbsMono (rec . f . to)
+   rec (Abs f)     = Abs (rec . f)
+   rec (a :==: b)  = from a :==: from b
 
 propertyLaw :: (Arbitrary a, Show a, Testable b) => (a -> a -> b) -> Law a -> Property
 propertyLaw eq = rec . getLawSpec
  where
-   rec (Abs f)    = property (rec . f)
-   rec (a :==: b) = property (eq a b)
+   rec (AbsMono f) = property (rec . f)
+   rec (Abs f)     = property (rec . f)
+   rec (a :==: b)  = property (eq a b)
 
 rewriteLaw :: (Different a, IsTerm a, Arbitrary a, Show a) => Law a -> RewriteRule a
 rewriteLaw (Law s l) = makeRewriteRule s l
 
 instance (Arbitrary a, IsTerm a, Show a, Different a) => RuleBuilder (LawSpec a) a where
-   buildRuleSpec i (a :==: b) = buildRuleSpec i (a :~> b)
-   buildRuleSpec i (Abs f)    = buildRuleSpec i f
+   buildRuleSpec i (a :==: b)  = buildRuleSpec i (a :~> b)
+   buildRuleSpec i (AbsMono f) = buildRuleSpec i f
+   buildRuleSpec i (Abs f)     = buildRuleSpec i f
 
 getLawSpec :: Law a -> LawSpec a
 getLawSpec (Law _ l) = l

@@ -1,8 +1,8 @@ {-# LANGUAGE GeneralizedNewtypeDeriving, PatternGuards #-}
 -----------------------------------------------------------------------------
--- Copyright 2015, Open Universiteit Nederland. This file is distributed
--- under the terms of the GNU General Public License. For more information,
--- see the file "LICENSE.txt", which is included in the distribution.
+-- Copyright 2015, Ideas project team. This file is distributed under the
+-- terms of the Apache License 2.0. For more information, see the files
+-- "LICENSE.txt" and "NOTICE.txt", which are included in the distribution.
 -----------------------------------------------------------------------------
 -- |
 -- Maintainer  :  bastiaan.heeren@ou.nl
@@ -10,7 +10,7 @@ -- Portability :  portable (depends on ghc)
 --
 -----------------------------------------------------------------------------
---  $Id: SmartGroup.hs 7524 2015-04-08 07:31:15Z bastiaan $
+--  $Id: SmartGroup.hs 8740 2015-10-14 19:26:22Z bastiaan $
 
 module Ideas.Common.Algebra.SmartGroup
    ( -- * Smart datatypes
@@ -25,9 +25,8 @@ import Control.Monad (mplus)
 import Data.Maybe
 import Ideas.Common.Algebra.Boolean
-import Ideas.Common.Algebra.Field hiding ((<*>))
+import Ideas.Common.Algebra.Field
 import Ideas.Common.Algebra.Group
-import qualified Ideas.Common.Algebra.Field as Field
 
 newtype Smart a = Smart {fromSmart :: a}
    deriving (Show, Eq, Ord, CoMonoid, MonoidZero, CoMonoidZero)
@@ -121,22 +120,22 @@ instance (CoField a, Field a) => SemiRing (SmartField a) where
    zero = SmartField zero
    one  = SmartField one
-   SmartField a <+> SmartField b = SmartField $ fromAdditive $ fromSmartGroup $
+   SmartField a |+| SmartField b = SmartField $ fromAdditive $ fromSmartGroup $
       SmartGroup (Additive a) <> SmartGroup (Additive b)
-   a <*> b
-      | Just x <- isNegate a = plusInverse (x Field.<*> b)
-      | Just x <- isNegate b = plusInverse (a Field.<*> x)
+   a |*| b
+      | Just x <- isNegate a = plusInverse (x |*| b)
+      | Just x <- isNegate b = plusInverse (a |*| x)
       | isZero a || isZero b = zero
       | isOne a = b
       | isOne b = a
-      | Just (x, y) <- isTimes b = (a Field.<*> x) Field.<*> y
-      | Just (x, y) <- isDivision b = (a Field.<*> x) </> y
-      | otherwise = liftA2 (Field.<*>) a b
+      | Just (x, y) <- isTimes b = (a |*| x) |*| y
+      | Just (x, y) <- isDivision b = (a |*| x) |/| y
+      | otherwise = liftA2 (|*|) a b
 
 instance (CoField a, Field a) => Ring (SmartField a) where
    plusInverse = SmartField . fromAdditive . fromSmartGroup . inverse
                . SmartGroup . Additive . fromSmartField
-   SmartField a <-> SmartField b = SmartField $ fromAdditive $ fromSmartGroup $
+   SmartField a |-| SmartField b = SmartField $ fromAdditive $ fromSmartGroup $
       SmartGroup (Additive a) <>- SmartGroup (Additive b)
 
 instance (CoField a, Field a) => Field (SmartField a) where
@@ -144,12 +143,12 @@       | Just x <- isNegate a = plusInverse (timesInverse x)
       | Just (x, y) <- isDivision a, isOne y = x
       | otherwise = liftA timesInverse a
-   a </> b
-      | Just x <- isNegate a = plusInverse (x </> b)
-      | Just x <- isNegate b = plusInverse (a </> x)
+   a |/| b
+      | Just x <- isNegate a = plusInverse (x |/| b)
+      | Just x <- isNegate b = plusInverse (a |/| x)
       | isOne b = a
-      | Just (x, y) <- isDivision a = x </> (y Field.<*> b)
-      | otherwise = liftA2 (</>) a b
+      | Just (x, y) <- isDivision a = x |/| (y |*| b)
+      | otherwise = liftA2 (|/|) a b
 
 ------------------------------------------------------------------
 
@@ -157,19 +156,19 @@ infixl 6 .-., .+.
 
 (.+.) :: (CoField a, Field a) => a -> a -> a
-a .+. b = fromSmartField $ SmartField a <+> SmartField b
+a .+. b = fromSmartField $ SmartField a |+| SmartField b
 
 (.-.) :: (CoField a, Field a) => a -> a -> a
-a .-. b = fromSmartField $ SmartField a <-> SmartField b
+a .-. b = fromSmartField $ SmartField a |-| SmartField b
 
 neg :: (CoField a, Field a) => a -> a
 neg = fromSmartField . plusInverse . SmartField
 
 (.*.) :: (CoField a, Field a) => a -> a -> a
-a .*. b = fromSmartField $ SmartField a Field.<*> SmartField b
+a .*. b = fromSmartField $ SmartField a |*| SmartField b
 
 (./.) :: (CoField a, Field a) => a -> a -> a
-a ./. b = fromSmartField $ SmartField a </> SmartField b
+a ./. b = fromSmartField $ SmartField a |/| SmartField b
 
 -- myrecip :: (CoField a, Field a) => a -> a
 -- myrecip = fromSmartField . timesInverse . SmartField

@@ -1,7 +1,7 @@ -----------------------------------------------------------------------------
--- Copyright 2015, Open Universiteit Nederland. This file is distributed
--- under the terms of the GNU General Public License. For more information,
--- see the file "LICENSE.txt", which is included in the distribution.
+-- Copyright 2015, Ideas project team. This file is distributed under the
+-- terms of the Apache License 2.0. For more information, see the files
+-- "LICENSE.txt" and "NOTICE.txt", which are included in the distribution.
 -----------------------------------------------------------------------------
 -- |
 -- Maintainer  :  bastiaan.heeren@ou.nl
@@ -11,17 +11,19 @@ -- Type classes and instances.
 --
 -----------------------------------------------------------------------------
---  $Id: Classes.hs 7524 2015-04-08 07:31:15Z bastiaan $
+--  $Id: Classes.hs 8763 2015-10-23 06:46:32Z bastiaan $
 
 module Ideas.Common.Classes
    ( -- * Type class Apply
-     Apply, apply, applyAll, applicable, applyD, applyM, applyList
+     Apply(applyAll), apply, applicable, applyD, applyM, applyList
      -- * Type class Container
-   , Container, singleton, getSingleton
+   , Container(singleton, getSingleton)
      -- * Type class BiArrow
    , BiArrow(..)
      -- * Type class BiFunctor
-   , BiFunctor, biMap, mapFirst, mapSecond, mapBoth
+   , BiFunctor(biMap, mapFirst, mapSecond), mapBoth
+     -- * Type class Fix
+   , Fix(..)
      -- * Buggy and Minor properties
    , Buggy(..), Minor(..)
    ) where
@@ -111,6 +113,14 @@ 
 mapBoth :: BiFunctor f => (a -> b) -> f a a -> f b b
 mapBoth f = biMap f f
+
+-----------------------------------------------------------
+-- Type class BiFunctor
+
+class Fix a where
+  fix :: (a -> a) -> a
+  -- default implementation
+  fix f = let a = f a in a
 
 -----------------------------------------------------------
 -- Buggy and Minor properties

@@ -1,8 +1,8 @@ {-# LANGUAGE GADTs, RankNTypes #-}
 -----------------------------------------------------------------------------
--- Copyright 2015, Open Universiteit Nederland. This file is distributed
--- under the terms of the GNU General Public License. For more information,
--- see the file "LICENSE.txt", which is included in the distribution.
+-- Copyright 2015, Ideas project team. This file is distributed under the
+-- terms of the Apache License 2.0. For more information, see the files
+-- "LICENSE.txt" and "NOTICE.txt", which are included in the distribution.
 -----------------------------------------------------------------------------
 -- |
 -- Maintainer  :  bastiaan.heeren@ou.nl
@@ -16,7 +16,7 @@ -- the 'Navigator' type class (for traversing the term).
 --
 -----------------------------------------------------------------------------
---  $Id: Context.hs 7524 2015-04-08 07:31:15Z bastiaan $
+--  $Id: Context.hs 8740 2015-10-14 19:26:22Z bastiaan $
 
 module Ideas.Common.Context
    ( -- * Abstract data type

@@ -0,0 +1,221 @@+-----------------------------------------------------------------------------
+-- Copyright 2015, Ideas project team. This file is distributed under the
+-- terms of the Apache License 2.0. For more information, see the files
+-- "LICENSE.txt" and "NOTICE.txt", which are included in the distribution.
+-----------------------------------------------------------------------------
+-- |
+-- Maintainer  :  bastiaan.heeren@ou.nl
+-- Stability   :  provisional
+-- Portability :  portable (depends on ghc)
+--
+-----------------------------------------------------------------------------
+--  $Id: CyclicTree.hs 8747 2015-10-15 14:54:48Z bastiaan $
+
+module Ideas.Common.CyclicTree
+   ( -- * Data type
+     CyclicTree
+     -- * Constructor functions
+   , node, node0, node1, node2, leaf, label
+     -- * Querying
+   , isNode, isLeaf, isLabel
+     -- * Replace functions
+   , replaceNode, replaceLeaf, replaceLabel, shrinkTree
+     -- * Fold and algebra
+   , fold, foldUnwind
+   , CyclicTreeAlg, fNode, fLeaf, fLabel, fRec, fVar
+   , emptyAlg, monoidAlg
+   ) where
+
+import Control.Applicative
+import Control.Monad
+import Data.Foldable (Foldable, foldMap)
+import Data.List (intercalate)
+import Data.Traversable (Traversable, traverse, sequenceA)
+import Ideas.Common.Classes
+import Ideas.Common.Id
+import Test.QuickCheck hiding (label)
+
+--------------------------------------------------------------
+-- Data type
+
+data CyclicTree a b
+   = Node a [CyclicTree a b]
+   | Leaf b
+   | Label Id (CyclicTree a b)
+   | Rec Int (CyclicTree a b)
+   | Var Int
+
+instance (Show a, Show b) => Show (CyclicTree a b) where
+   show = fold Alg
+      { fNode  = \a xs -> show a ++ par xs
+      , fLeaf  = show
+      , fLabel = \l s -> show l ++ ":" ++ s
+      , fRec   = \n s -> '#' : show n ++ "=" ++ s
+      , fVar   = \n   -> '#' : show n
+      }
+
+instance BiFunctor CyclicTree where
+   biMap f g = fold idAlg {fNode = Node . f, fLeaf = Leaf . g}
+
+instance Functor (CyclicTree d) where
+   fmap = mapSecond
+
+instance Applicative (CyclicTree d) where
+   pure    = leaf
+   p <*> q = fold idAlg {fLeaf = (`fmap` q)} p
+
+instance Monad (CyclicTree d) where
+   return = leaf
+   (>>=)  = flip replaceLeaf
+
+instance Foldable (CyclicTree d) where
+   foldMap f = fold monoidAlg {fLeaf = f}
+
+instance Traversable (CyclicTree d) where
+   traverse f = fold emptyAlg
+      { fNode  = \a -> liftA (node a) . sequenceA
+      , fLeaf  = liftA leaf . f
+      , fLabel = liftA . label
+      , fRec   = liftA . Rec
+      , fVar   = pure . Var
+      }
+
+instance Fix (CyclicTree a b) where
+   fix f = Rec n (f (Var n))
+    where
+      vs = vars (f (Var (-1)))
+      n  = maximum (-1 : vs) + 1
+
+instance (Arbitrary a, Arbitrary b) => Arbitrary (CyclicTree a b) where
+   arbitrary = sized arbTree
+   shrink    = shrinkTree
+
+arbTree :: (Arbitrary a, Arbitrary b) => Int -> Gen (CyclicTree a b)
+arbTree = rec 0
+ where
+   rec vi 0 = frequency $
+      (3, liftM leaf arbitrary)
+      : [ (1, elements (map Var [1..vi])) | vi > 0 ]
+   rec vi n = frequency
+      [ (3, liftM2 node arbitrary ms)
+      , (2, rec vi 0)
+      , (1, liftM2 label genId m)
+      , (1, liftM (Rec (vi+1)) (rec (vi+1) (n `div` 2)))
+      ]
+    where
+      m = rec vi (n `div` 2)
+      genId = elements [ newId [c] | c <- ['A' .. 'Z']]
+      ms = choose (0, 3) >>= \i -> replicateM i m
+
+shrinkTree :: CyclicTree a b -> [CyclicTree a b]
+shrinkTree tree =
+   case tree of
+      Node a ts -> ts ++ map (node a) (shrinkTrees ts)
+      Label l t -> t : map (Label l) (shrinkTree t)
+      Rec n t   -> map (Rec n) (shrinkTree t)
+      _ -> []
+
+-- shrink exactly one tree
+shrinkTrees :: [CyclicTree a b] -> [[CyclicTree a b]]
+shrinkTrees []    = []
+shrinkTrees (t:ts) = map (:ts) (shrinkTree t) ++ map (t:) (shrinkTrees ts)
+
+-- local helpers
+par :: [String] -> String
+par xs | null xs   = ""
+       | otherwise = "(" ++ intercalate ", " xs ++ ")"
+
+vars :: CyclicTree a b -> [Int]
+vars = fold monoidAlg {fVar = return}
+
+--------------------------------------------------------------
+-- Constructor functions
+
+node :: a -> [CyclicTree a b] -> CyclicTree a b
+node = Node
+
+node0 :: a -> CyclicTree a b
+node0 a = node a []
+
+node1 :: a -> CyclicTree a b -> CyclicTree a b
+node1 a x = node a [x]
+
+node2 :: a -> CyclicTree a b -> CyclicTree a b -> CyclicTree a b
+node2 a x y = node a [x, y]
+
+leaf :: b -> CyclicTree a b
+leaf = Leaf
+
+label :: IsId n => n -> CyclicTree a b -> CyclicTree a b
+label = Label . newId
+
+--------------------------------------------------------------
+-- Querying
+
+isNode :: CyclicTree a b -> Maybe (a, [CyclicTree a b])
+isNode (Node a xs) = Just (a, xs)
+isNode _ = Nothing
+
+isLeaf :: CyclicTree a b -> Maybe b
+isLeaf (Leaf b) = Just b
+isLeaf _ = Nothing
+
+isLabel :: CyclicTree a b -> Maybe (Id, CyclicTree a b)
+isLabel (Label l t) = Just (l, t)
+isLabel _ = Nothing
+
+--------------------------------------------------------------
+-- Replace functions
+
+replaceNode :: (a -> [CyclicTree a b] -> CyclicTree a b) -> CyclicTree a b -> CyclicTree a b
+replaceNode f = fold idAlg {fNode = f}
+
+replaceLabel :: (Id -> CyclicTree a b -> CyclicTree a b) -> CyclicTree a b -> CyclicTree a b
+replaceLabel f = fold idAlg {fLabel = f}
+
+replaceLeaf :: (b -> CyclicTree a c) -> CyclicTree a b -> CyclicTree a c
+replaceLeaf f = fold idAlg {fLeaf = f}
+
+--------------------------------------------------------------
+-- Fold and algebra
+
+fold :: CyclicTreeAlg a b t -> CyclicTree a b -> t
+fold alg = rec
+ where
+   rec (Node a ts) = fNode alg a (map rec ts)
+   rec (Leaf b)    = fLeaf alg b
+   rec (Label l t) = fLabel alg l (rec t)
+   rec (Rec n t)   = fRec alg n (rec t)
+   rec (Var n)     = fVar alg n
+
+foldUnwind :: CyclicTreeAlg a b t -> CyclicTree a b -> t
+foldUnwind alg = start . fold Alg
+   { fNode  = \a fs sub -> fNode alg a (map ($ sub) fs)
+   , fLeaf  = \b _      -> fLeaf alg b
+   , fLabel = \l f sub  -> fLabel alg l (f sub)
+   , fRec   = \n f sub  -> let this = f (extend n this sub)
+                           in this
+   , fVar   = \n sub    -> sub n
+   }
+ where
+   start f = f (error "foldUnwind: unbound var")
+   extend n a sub i
+      | i == n    = a
+      | otherwise = sub i
+
+data CyclicTreeAlg a b t = Alg
+   { fNode  :: a -> [t] -> t
+   , fLeaf  :: b -> t
+   , fLabel :: Id -> t -> t
+   , fRec   :: Int -> t -> t
+   , fVar   :: Int -> t
+   }
+
+idAlg :: CyclicTreeAlg a b (CyclicTree a b)
+idAlg = Alg Node Leaf Label Rec Var
+
+emptyAlg :: CyclicTreeAlg a b t
+emptyAlg = let f = error "emptyAlg: uninitialized" in Alg f f f f f
+
+monoidAlg :: Monoid m => CyclicTreeAlg a b m
+monoidAlg = Alg (const mconcat) mempty (const id) (const id) mempty

@@ -1,7 +1,7 @@ -----------------------------------------------------------------------------
--- Copyright 2015, Open Universiteit Nederland. This file is distributed
--- under the terms of the GNU General Public License. For more information,
--- see the file "LICENSE.txt", which is included in the distribution.
+-- Copyright 2015, Ideas project team. This file is distributed under the
+-- terms of the Apache License 2.0. For more information, see the files
+-- "LICENSE.txt" and "NOTICE.txt", which are included in the distribution.
 -----------------------------------------------------------------------------
 -- |
 -- Maintainer  :  bastiaan.heeren@ou.nl
@@ -12,7 +12,7 @@ -- and the steps)
 --
 -----------------------------------------------------------------------------
---  $Id: Derivation.hs 7524 2015-04-08 07:31:15Z bastiaan $
+--  $Id: Derivation.hs 8740 2015-10-14 19:26:22Z bastiaan $
 
 module Ideas.Common.Derivation
    ( -- * Data type

@@ -1,7 +1,7 @@ -----------------------------------------------------------------------------
--- Copyright 2015, Open Universiteit Nederland. This file is distributed
--- under the terms of the GNU General Public License. For more information,
--- see the file "LICENSE.txt", which is included in the distribution.
+-- Copyright 2015, Ideas project team. This file is distributed under the
+-- terms of the Apache License 2.0. For more information, see the files
+-- "LICENSE.txt" and "NOTICE.txt", which are included in the distribution.
 -----------------------------------------------------------------------------
 -- |
 -- Maintainer  :  bastiaan.heeren@ou.nl
@@ -12,7 +12,7 @@ -- intermediate results as well as annotations for the steps.
 --
 -----------------------------------------------------------------------------
---  $Id: DerivationTree.hs 7524 2015-04-08 07:31:15Z bastiaan $
+--  $Id: DerivationTree.hs 8740 2015-10-14 19:26:22Z bastiaan $
 
 module Ideas.Common.DerivationTree
    ( -- * Data types

@@ -1,8 +1,8 @@ {-# LANGUAGE ExistentialQuantification #-}
 -----------------------------------------------------------------------------
--- Copyright 2015, Open Universiteit Nederland. This file is distributed
--- under the terms of the GNU General Public License. For more information,
--- see the file "LICENSE.txt", which is included in the distribution.
+-- Copyright 2015, Ideas project team. This file is distributed under the
+-- terms of the Apache License 2.0. For more information, see the files
+-- "LICENSE.txt" and "NOTICE.txt", which are included in the distribution.
 -----------------------------------------------------------------------------
 -- |
 -- Maintainer  :  bastiaan.heeren@ou.nl
@@ -12,7 +12,7 @@ -- References, bindings, and heterogenous environments
 --
 -----------------------------------------------------------------------------
---  $Id: Environment.hs 7524 2015-04-08 07:31:15Z bastiaan $
+--  $Id: Environment.hs 8740 2015-10-14 19:26:22Z bastiaan $
 
 module Ideas.Common.Environment
    ( -- * Reference

@@ -1,8 +1,8 @@ {-# LANGUAGE Rank2Types, DeriveDataTypeable #-}
 -----------------------------------------------------------------------------
--- Copyright 2015, Open Universiteit Nederland. This file is distributed
--- under the terms of the GNU General Public License. For more information,
--- see the file "LICENSE.txt", which is included in the distribution.
+-- Copyright 2015, Ideas project team. This file is distributed under the
+-- terms of the Apache License 2.0. For more information, see the files
+-- "LICENSE.txt" and "NOTICE.txt", which are included in the distribution.
 -----------------------------------------------------------------------------
 -- |
 -- Maintainer  :  bastiaan.heeren@ou.nl
@@ -15,7 +15,7 @@ -- "Ideas.Common.ExerciseTests" module.
 --
 -----------------------------------------------------------------------------
---  $Id: Exercise.hs 7524 2015-04-08 07:31:15Z bastiaan $
+--  $Id: Exercise.hs 8758 2015-10-22 06:48:52Z bastiaan $
 
 module Ideas.Common.Exercise
    ( -- * Exercise record
@@ -258,6 +258,20 @@    show = (xs !!) . fromEnum
     where
       xs = ["very_easy", "easy", "medium", "difficult", "very_difficult"]
+
+instance Read Difficulty where
+   readsPrec _ s =
+      case concatMap f txt of
+         "veryeasy"      -> [(VeryEasy, xs)]
+         "easy"          -> [(Easy, xs)]
+         "medium"        -> [(Medium, xs)]
+         "difficult"     -> [(Difficult, xs)]
+         "verydifficult" -> [(VeryDifficult, xs)]
+         _               -> []
+    where
+      (txt, xs) = span p (dropWhile isSpace s)
+      p c   = isAlpha c || c `elem` "_-"
+      f c   = [toLower c | c `notElem` "_-"]
 
 -- | Parser for difficulty levels, which ignores non-alpha charactes (including
 -- spaces) and upper/lower case distinction.

@@ -1,7 +1,7 @@ -----------------------------------------------------------------------------
--- Copyright 2015, Open Universiteit Nederland. This file is distributed
--- under the terms of the GNU General Public License. For more information,
--- see the file "LICENSE.txt", which is included in the distribution.
+-- Copyright 2015, Ideas project team. This file is distributed under the
+-- terms of the Apache License 2.0. For more information, see the files
+-- "LICENSE.txt" and "NOTICE.txt", which are included in the distribution.
 -----------------------------------------------------------------------------
 -- |
 -- Maintainer  :  bastiaan.heeren@ou.nl
@@ -9,7 +9,7 @@ -- Portability :  portable (depends on ghc)
 --
 -----------------------------------------------------------------------------
---  $Id: ExerciseTests.hs 7524 2015-04-08 07:31:15Z bastiaan $
+--  $Id: ExerciseTests.hs 8740 2015-10-14 19:26:22Z bastiaan $
 
 module Ideas.Common.ExerciseTests where
 

@@ -1,8 +1,8 @@ {-# LANGUAGE DeriveDataTypeable #-}
 -----------------------------------------------------------------------------
--- Copyright 2015, Open Universiteit Nederland. This file is distributed
--- under the terms of the GNU General Public License. For more information,
--- see the file "LICENSE.txt", which is included in the distribution.
+-- Copyright 2015, Ideas project team. This file is distributed under the
+-- terms of the Apache License 2.0. For more information, see the files
+-- "LICENSE.txt" and "NOTICE.txt", which are included in the distribution.
 -----------------------------------------------------------------------------
 -- |
 -- Maintainer  :  bastiaan.heeren@ou.nl
@@ -30,7 +30,7 @@ -- The 'Id' datatype implements and re-exports the Monoid interface.
 --
 -----------------------------------------------------------------------------
---  $Id: Id.hs 7524 2015-04-08 07:31:15Z bastiaan $
+--  $Id: Id.hs 8740 2015-10-14 19:26:22Z bastiaan $
 
 module Ideas.Common.Id
    ( -- * Constructing identifiers

@@ -1,7 +1,7 @@ -----------------------------------------------------------------------------
--- Copyright 2015, Open Universiteit Nederland. This file is distributed
--- under the terms of the GNU General Public License. For more information,
--- see the file "LICENSE.txt", which is included in the distribution.
+-- Copyright 2015, Ideas project team. This file is distributed under the
+-- terms of the Apache License 2.0. For more information, see the files
+-- "LICENSE.txt" and "NOTICE.txt", which are included in the distribution.
 -----------------------------------------------------------------------------
 -- |
 -- Maintainer  :  bastiaan.heeren@ou.nl
@@ -11,7 +11,7 @@ -- Exports most from package Common
 --
 -----------------------------------------------------------------------------
---  $Id: Library.hs 7524 2015-04-08 07:31:15Z bastiaan $
+--  $Id: Library.hs 8740 2015-10-14 19:26:22Z bastiaan $
 
 module Ideas.Common.Library
    ( module Export

@@ -1,8 +1,8 @@ {-# LANGUAGE ExistentialQuantification #-}
 -----------------------------------------------------------------------------
--- Copyright 2015, Open Universiteit Nederland. This file is distributed
--- under the terms of the GNU General Public License. For more information,
--- see the file "LICENSE.txt", which is included in the distribution.
+-- Copyright 2015, Ideas project team. This file is distributed under the
+-- terms of the Apache License 2.0. For more information, see the files
+-- "LICENSE.txt" and "NOTICE.txt", which are included in the distribution.
 -----------------------------------------------------------------------------
 -- |
 -- Maintainer  :  bastiaan.heeren@ou.nl
@@ -12,7 +12,7 @@ -- Representation for predicates
 --
 -----------------------------------------------------------------------------
---  $Id: Predicate.hs 7524 2015-04-08 07:31:15Z bastiaan $
+--  $Id: Predicate.hs 8740 2015-10-14 19:26:22Z bastiaan $
 
 module Ideas.Common.Predicate
    ( -- * Predicate representation

@@ -1,7 +1,7 @@ -----------------------------------------------------------------------------
--- Copyright 2015, Open Universiteit Nederland. This file is distributed
--- under the terms of the GNU General Public License. For more information,
--- see the file "LICENSE.txt", which is included in the distribution.
+-- Copyright 2015, Ideas project team. This file is distributed under the
+-- terms of the Apache License 2.0. For more information, see the files
+-- "LICENSE.txt" and "NOTICE.txt", which are included in the distribution.
 -----------------------------------------------------------------------------
 -- |
 -- Maintainer  :  bastiaan.heeren@ou.nl
@@ -9,7 +9,7 @@ -- Portability :  portable (depends on ghc)
 --
 -----------------------------------------------------------------------------
---  $Id: Rewriting.hs 7524 2015-04-08 07:31:15Z bastiaan $
+--  $Id: Rewriting.hs 8740 2015-10-14 19:26:22Z bastiaan $
 
 module Ideas.Common.Rewriting (module Export) where
 

@@ -1,7 +1,7 @@ -----------------------------------------------------------------------------
--- Copyright 2015, Open Universiteit Nederland. This file is distributed
--- under the terms of the GNU General Public License. For more information,
--- see the file "LICENSE.txt", which is included in the distribution.
+-- Copyright 2015, Ideas project team. This file is distributed under the
+-- terms of the Apache License 2.0. For more information, see the files
+-- "LICENSE.txt" and "NOTICE.txt", which are included in the distribution.
 -----------------------------------------------------------------------------
 -- |
 -- Maintainer  :  bastiaan.heeren@ou.nl
@@ -9,7 +9,7 @@ -- Portability :  portable (depends on ghc)
 --
 -----------------------------------------------------------------------------
---  $Id: AC.hs 7524 2015-04-08 07:31:15Z bastiaan $
+--  $Id: AC.hs 8740 2015-10-14 19:26:22Z bastiaan $
 
 module Ideas.Common.Rewriting.AC
    ( -- * Types

@@ -1,7 +1,7 @@ -----------------------------------------------------------------------------
--- Copyright 2015, Open Universiteit Nederland. This file is distributed
--- under the terms of the GNU General Public License. For more information,
--- see the file "LICENSE.txt", which is included in the distribution.
+-- Copyright 2015, Ideas project team. This file is distributed under the
+-- terms of the Apache License 2.0. For more information, see the files
+-- "LICENSE.txt" and "NOTICE.txt", which are included in the distribution.
 -----------------------------------------------------------------------------
 -- |
 -- Maintainer  :  bastiaan.heeren@ou.nl
@@ -9,7 +9,7 @@ -- Portability :  portable (depends on ghc)
 --
 -----------------------------------------------------------------------------
---  $Id: Confluence.hs 7524 2015-04-08 07:31:15Z bastiaan $
+--  $Id: Confluence.hs 8740 2015-10-14 19:26:22Z bastiaan $
 
 module Ideas.Common.Rewriting.Confluence
    ( isConfluent, checkConfluence, checkConfluenceWith

@@ -1,7 +1,7 @@ -----------------------------------------------------------------------------
--- Copyright 2015, Open Universiteit Nederland. This file is distributed
--- under the terms of the GNU General Public License. For more information,
--- see the file "LICENSE.txt", which is included in the distribution.
+-- Copyright 2015, Ideas project team. This file is distributed under the
+-- terms of the Apache License 2.0. For more information, see the files
+-- "LICENSE.txt" and "NOTICE.txt", which are included in the distribution.
 -----------------------------------------------------------------------------
 -- |
 -- Maintainer  :  bastiaan.heeren@ou.nl
@@ -12,7 +12,7 @@ -- into account.
 --
 -----------------------------------------------------------------------------
---  $Id: Difference.hs 7524 2015-04-08 07:31:15Z bastiaan $
+--  $Id: Difference.hs 8740 2015-10-14 19:26:22Z bastiaan $
 
 module Ideas.Common.Rewriting.Difference
    ( difference, differenceEqual

@@ -1,9 +1,9 @@ {-# LANGUAGE ExistentialQuantification, MultiParamTypeClasses,
        FunctionalDependencies, FlexibleInstances, UndecidableInstances #-}
 -----------------------------------------------------------------------------
--- Copyright 2015, Open Universiteit Nederland. This file is distributed
--- under the terms of the GNU General Public License. For more information,
--- see the file "LICENSE.txt", which is included in the distribution.
+-- Copyright 2015, Ideas project team. This file is distributed under the
+-- terms of the Apache License 2.0. For more information, see the files
+-- "LICENSE.txt" and "NOTICE.txt", which are included in the distribution.
 -----------------------------------------------------------------------------
 -- |
 -- Maintainer  :  bastiaan.heeren@ou.nl
@@ -11,7 +11,7 @@ -- Portability :  portable (depends on ghc)
 --
 -----------------------------------------------------------------------------
---  $Id: RewriteRule.hs 7524 2015-04-08 07:31:15Z bastiaan $
+--  $Id: RewriteRule.hs 8740 2015-10-14 19:26:22Z bastiaan $
 
 module Ideas.Common.Rewriting.RewriteRule
    ( -- * Supporting type class

@@ -1,7 +1,7 @@ -----------------------------------------------------------------------------
--- Copyright 2015, Open Universiteit Nederland. This file is distributed
--- under the terms of the GNU General Public License. For more information,
--- see the file "LICENSE.txt", which is included in the distribution.
+-- Copyright 2015, Ideas project team. This file is distributed under the
+-- terms of the Apache License 2.0. For more information, see the files
+-- "LICENSE.txt" and "NOTICE.txt", which are included in the distribution.
 -----------------------------------------------------------------------------
 -- |
 -- Maintainer  :  bastiaan.heeren@ou.nl
@@ -11,7 +11,7 @@ -- Substitutions on terms. Substitutions are idempotent, and non-cyclic.
 --
 -----------------------------------------------------------------------------
---  $Id: Substitution.hs 7524 2015-04-08 07:31:15Z bastiaan $
+--  $Id: Substitution.hs 8740 2015-10-14 19:26:22Z bastiaan $
 
 module Ideas.Common.Rewriting.Substitution
    ( Substitution, emptySubst, singletonSubst, dom, lookupVar

@@ -1,9 +1,9 @@ {-# LANGUAGE DeriveDataTypeable #-}
 {-# OPTIONS -fno-warn-orphans #-}
 -----------------------------------------------------------------------------
--- Copyright 2015, Open Universiteit Nederland. This file is distributed
--- under the terms of the GNU General Public License. For more information,
--- see the file "LICENSE.txt", which is included in the distribution.
+-- Copyright 2015, Ideas project team. This file is distributed under the
+-- terms of the Apache License 2.0. For more information, see the files
+-- "LICENSE.txt" and "NOTICE.txt", which are included in the distribution.
 -----------------------------------------------------------------------------
 -- |
 -- Maintainer  :  bastiaan.heeren@ou.nl
@@ -13,7 +13,7 @@ -- A simple data type for term rewriting
 --
 -----------------------------------------------------------------------------
---  $Id: Term.hs 7524 2015-04-08 07:31:15Z bastiaan $
+--  $Id: Term.hs 8740 2015-10-14 19:26:22Z bastiaan $
 
 module Ideas.Common.Rewriting.Term
    ( -- * Symbols

@@ -1,7 +1,7 @@ -----------------------------------------------------------------------------
--- Copyright 2015, Open Universiteit Nederland. This file is distributed
--- under the terms of the GNU General Public License. For more information,
--- see the file "LICENSE.txt", which is included in the distribution.
+-- Copyright 2015, Ideas project team. This file is distributed under the
+-- terms of the Apache License 2.0. For more information, see the files
+-- "LICENSE.txt" and "NOTICE.txt", which are included in the distribution.
 -----------------------------------------------------------------------------
 -- |
 -- Maintainer  :  bastiaan.heeren@ou.nl
@@ -9,7 +9,7 @@ -- Portability :  portable (depends on ghc)
 --
 -----------------------------------------------------------------------------
---  $Id: Unification.hs 7524 2015-04-08 07:31:15Z bastiaan $
+--  $Id: Unification.hs 8740 2015-10-14 19:26:22Z bastiaan $
 
 module Ideas.Common.Rewriting.Unification
    ( unify, match, matchExtended, matchList

@@ -1,7 +1,7 @@ -----------------------------------------------------------------------------
--- Copyright 2015, Open Universiteit Nederland. This file is distributed
--- under the terms of the GNU General Public License. For more information,
--- see the file "LICENSE.txt", which is included in the distribution.
+-- Copyright 2015, Ideas project team. This file is distributed under the
+-- terms of the Apache License 2.0. For more information, see the files
+-- "LICENSE.txt" and "NOTICE.txt", which are included in the distribution.
 -----------------------------------------------------------------------------
 -- |
 -- Maintainer  :  bastiaan.heeren@ou.nl
@@ -9,7 +9,7 @@ -- Portability :  portable (depends on ghc)
 --
 -----------------------------------------------------------------------------
---  $Id: Rule.hs 7524 2015-04-08 07:31:15Z bastiaan $
+--  $Id: Rule.hs 8740 2015-10-14 19:26:22Z bastiaan $
 
 module Ideas.Common.Rule (module Export) where
 

@@ -1,8 +1,8 @@ {-# LANGUAGE MultiParamTypeClasses #-}
 -----------------------------------------------------------------------------
--- Copyright 2015, Open Universiteit Nederland. This file is distributed
--- under the terms of the GNU General Public License. For more information,
--- see the file "LICENSE.txt", which is included in the distribution.
+-- Copyright 2015, Ideas project team. This file is distributed under the
+-- terms of the Apache License 2.0. For more information, see the files
+-- "LICENSE.txt" and "NOTICE.txt", which are included in the distribution.
 -----------------------------------------------------------------------------
 -- |
 -- Maintainer  :  bastiaan.heeren@ou.nl
@@ -14,7 +14,7 @@ -- can be lifted with a view using the LiftView type class.
 --
 -----------------------------------------------------------------------------
---  $Id: Abstract.hs 7524 2015-04-08 07:31:15Z bastiaan $
+--  $Id: Abstract.hs 8740 2015-10-14 19:26:22Z bastiaan $
 
 module Ideas.Common.Rule.Abstract
    ( -- * Rule data type and accessors

@@ -1,8 +1,8 @@ {-# LANGUAGE GADTs #-}
 -----------------------------------------------------------------------------
--- Copyright 2015, Open Universiteit Nederland. This file is distributed
--- under the terms of the GNU General Public License. For more information,
--- see the file "LICENSE.txt", which is included in the distribution.
+-- Copyright 2015, Ideas project team. This file is distributed under the
+-- terms of the Apache License 2.0. For more information, see the files
+-- "LICENSE.txt" and "NOTICE.txt", which are included in the distribution.
 -----------------------------------------------------------------------------
 -- |
 -- Maintainer  :  bastiaan.heeren@ou.nl
@@ -12,7 +12,7 @@ -- State monad for environments
 --
 -----------------------------------------------------------------------------
---  $Id: EnvironmentMonad.hs 7524 2015-04-08 07:31:15Z bastiaan $
+--  $Id: EnvironmentMonad.hs 8740 2015-10-14 19:26:22Z bastiaan $
 
 module Ideas.Common.Rule.EnvironmentMonad
    ( -- * Environment Monad
@@ -24,6 +24,7 @@    , envMonadRefs, envMonadFunctionRefs
    ) where
 
+import Control.Applicative (Applicative(..), Alternative(..))
 import Control.Monad
 import Data.Maybe
 import Data.Typeable
@@ -51,6 +52,17 @@    (:~)   :: Typeable a => Ref a -> (a -> a) -> EnvMonad ()
    (:?)   :: Typeable a => Ref a -> a -> EnvMonad a
    GetRef :: Typeable a => Ref a -> EnvMonad a
+
+instance Functor EnvMonad where
+   fmap = liftM
+
+instance Applicative EnvMonad where
+   pure  = return
+   (<*>) = ap
+
+instance Alternative EnvMonad where
+   empty = Zero
+   (<|>) = Plus
 
 instance Monad EnvMonad where
    return = Return

@@ -1,7 +1,7 @@ -----------------------------------------------------------------------------
--- Copyright 2015, Open Universiteit Nederland. This file is distributed
--- under the terms of the GNU General Public License. For more information,
--- see the file "LICENSE.txt", which is included in the distribution.
+-- Copyright 2015, Ideas project team. This file is distributed under the
+-- terms of the Apache License 2.0. For more information, see the files
+-- "LICENSE.txt" and "NOTICE.txt", which are included in the distribution.
 -----------------------------------------------------------------------------
 -- |
 -- Maintainer  :  bastiaan.heeren@ou.nl
@@ -15,7 +15,7 @@ -- the LiftView type class.
 --
 -----------------------------------------------------------------------------
---  $Id: Parameter.hs 7524 2015-04-08 07:31:15Z bastiaan $
+--  $Id: Parameter.hs 8740 2015-10-14 19:26:22Z bastiaan $
 
 module Ideas.Common.Rule.Parameter
    ( ParamTrans

@@ -1,7 +1,7 @@ -----------------------------------------------------------------------------
--- Copyright 2015, Open Universiteit Nederland. This file is distributed
--- under the terms of the GNU General Public License. For more information,
--- see the file "LICENSE.txt", which is included in the distribution.
+-- Copyright 2015, Ideas project team. This file is distributed under the
+-- terms of the Apache License 2.0. For more information, see the files
+-- "LICENSE.txt" and "NOTICE.txt", which are included in the distribution.
 -----------------------------------------------------------------------------
 -- |
 -- Maintainer  :  bastiaan.heeren@ou.nl
@@ -9,7 +9,7 @@ -- Portability :  portable (depends on ghc)
 --
 -----------------------------------------------------------------------------
---  $Id: Recognizer.hs 7524 2015-04-08 07:31:15Z bastiaan $
+--  $Id: Recognizer.hs 8740 2015-10-14 19:26:22Z bastiaan $
 
 module Ideas.Common.Rule.Recognizer
    ( -- * data type and type class

@@ -1,8 +1,8 @@ {-# LANGUAGE GADTs, Rank2Types #-}
 -----------------------------------------------------------------------------
--- Copyright 2015, Open Universiteit Nederland. This file is distributed
--- under the terms of the GNU General Public License. For more information,
--- see the file "LICENSE.txt", which is included in the distribution.
+-- Copyright 2015, Ideas project team. This file is distributed under the
+-- terms of the Apache License 2.0. For more information, see the files
+-- "LICENSE.txt" and "NOTICE.txt", which are included in the distribution.
 -----------------------------------------------------------------------------
 -- |
 -- Maintainer  :  bastiaan.heeren@ou.nl
@@ -13,7 +13,7 @@ -- a list of results (often a singleton list or the empty list).
 --
 -----------------------------------------------------------------------------
---  $Id: Transformation.hs 7524 2015-04-08 07:31:15Z bastiaan $
+--  $Id: Transformation.hs 8740 2015-10-14 19:26:22Z bastiaan $
 
 module Ideas.Common.Rule.Transformation
    ( -- * Trans data type

@@ -1,7 +1,7 @@ -----------------------------------------------------------------------------
--- Copyright 2015, Open Universiteit Nederland. This file is distributed
--- under the terms of the GNU General Public License. For more information,
--- see the file "LICENSE.txt", which is included in the distribution.
+-- Copyright 2015, Ideas project team. This file is distributed under the
+-- terms of the Apache License 2.0. For more information, see the files
+-- "LICENSE.txt" and "NOTICE.txt", which are included in the distribution.
 -----------------------------------------------------------------------------
 -- |
 -- Maintainer  :  bastiaan.heeren@ou.nl
@@ -9,12 +9,13 @@ -- Portability :  portable (depends on ghc)
 --
 -- A strategy is a context-free grammar with rules as symbols. Strategies can be
--- labeled with strings. A type class is introduced to lift all the combinators
--- that work on strategies, only to prevent that you have to insert these lifting
--- functions yourself.
+-- labeled with strings. The type class 'IsStrategy' is introduced to lift
+-- functions and combinators that work on strategies to also accept rules and
+-- labeled strategies. This module re-exports the most important functionality
+-- of the underlying modules.
 --
 -----------------------------------------------------------------------------
---  $Id: Strategy.hs 7524 2015-04-08 07:31:15Z bastiaan $
+--  $Id: Strategy.hs 8758 2015-10-22 06:48:52Z bastiaan $
 
 module Ideas.Common.Strategy
    ( -- * Data types and type classes
@@ -24,27 +25,26 @@    , derivationList
      -- * Strategy combinators
      -- ** Basic combinators
-   , (<*>), (<|>), (<%>), succeed, fail, atomic, label
-   , sequence, alternatives, interleave, permute, fix
+   , (.*.), (.|.), (.%.), (.@.), (!~>)
+   , succeed, fail, atomic, label, inits
+   , sequence, choice, alternatives, interleave, permute
      -- ** EBNF combinators
    , many, many1, replicate, option
      -- ** Negation and greedy combinators
-   , check, not, repeat, repeat1, try, (|>), (>|>), exhaustive
-   , while, until, multi
+   , check, not, repeat, repeat1, try, (|>), (./.)
+   , exhaustive, while, until
      -- ** Graph
    , DependencyGraph, dependencyGraph
      -- ** Traversal combinators
    , module Ideas.Common.Strategy.Traversal
      -- * Configuration combinators
    , module Ideas.Common.Strategy.Configuration
-   , remove, collapse, hide
      -- * Strategy locations
    , strategyLocations, checkLocation
    , subTaskLocation, nextTaskLocation
      -- * Prefixes
    , Prefix, emptyPrefix, noPrefix
    , replayPath, replayPaths, replayStrategy
-   , Step(..), stepRule, stepEnvironment
    , Path, emptyPath, readPath, readPaths
    , prefixPaths, majorPrefix, isEmptyPrefix
      -- * Misc
@@ -55,7 +55,8 @@ import Ideas.Common.Strategy.Abstract
 import Ideas.Common.Strategy.Combinators
 import Ideas.Common.Strategy.Configuration
+import Ideas.Common.Strategy.Legacy (alternatives)
 import Ideas.Common.Strategy.Location
-import Ideas.Common.Strategy.Parsing
+import Ideas.Common.Strategy.Prefix
 import Ideas.Common.Strategy.Traversal hiding (full, spine, stop, once)
 import Prelude ()

@@ -1,55 +1,91 @@-{-# LANGUAGE FlexibleContexts, UndecidableInstances #-}
+{-# LANGUAGE TypeFamilies, RankNTypes #-}
 -----------------------------------------------------------------------------
--- Copyright 2015, Open Universiteit Nederland. This file is distributed
--- under the terms of the GNU General Public License. For more information,
--- see the file "LICENSE.txt", which is included in the distribution.
+-- Copyright 2015, Ideas project team. This file is distributed under the
+-- terms of the Apache License 2.0. For more information, see the files
+-- "LICENSE.txt" and "NOTICE.txt", which are included in the distribution.
 -----------------------------------------------------------------------------
 -- |
 -- Maintainer  :  bastiaan.heeren@ou.nl
 -- Stability   :  provisional
 -- Portability :  portable (depends on ghc)
 --
+-- Abstract data type for a 'Strategy' and a 'LabeledStrategy'.
+--
 -----------------------------------------------------------------------------
---  $Id: Abstract.hs 7524 2015-04-08 07:31:15Z bastiaan $
+--  $Id: Abstract.hs 8758 2015-10-22 06:48:52Z bastiaan $
 
 module Ideas.Common.Strategy.Abstract
-   ( Strategy, IsStrategy(..)
+   ( -- * Strategy data type
+     Strategy
+     -- * Labeled strategies
    , LabeledStrategy, label, unlabel
-   , derivationList
+     -- * Lifting to strategies
+   , IsStrategy(..), liftS, liftS2, liftSn
+    -- * Prefixes
    , emptyPrefix, replayPath, replayPaths, replayStrategy
-   , rulesInStrategy
-   , mapRules, mapRulesS
+    -- * Rules
+   , rulesInStrategy, mapRules, mapRulesS
    , cleanUpStrategy, cleanUpStrategyAfter
-     -- Accessors to the underlying representation
-   , toCore, fromCore, liftCore, liftCore2
-   , noInterleaving
+   , derivationList
+     -- * Access to underlying representation
+   , toStrategyTree, onStrategyTree
+     -- * Strategy declarations
+   , useDecl, decl0, decl1, decl2, declN
    ) where
 
-import Data.Function
+import Data.Foldable (toList)
 import Ideas.Common.Classes
+import Ideas.Common.CyclicTree hiding (label)
 import Ideas.Common.Derivation
 import Ideas.Common.Environment
 import Ideas.Common.Id
 import Ideas.Common.Rewriting (RewriteRule)
 import Ideas.Common.Rule
-import Ideas.Common.Strategy.Core
-import Ideas.Common.Strategy.Parsing
-import Ideas.Common.Strategy.Sequence (Firsts(..), firstsOrdered)
-import Ideas.Common.Utils.Uniplate hiding (rewriteM)
+import Ideas.Common.Strategy.Choice
+import Ideas.Common.Strategy.Prefix
+import Ideas.Common.Strategy.Process
+import Ideas.Common.Strategy.Sequence (Sequence(..), ready)
+import Ideas.Common.Strategy.StrategyTree
+import Ideas.Common.Strategy.Symbol
 import Ideas.Common.View
+import Prelude hiding (sequence)
+import qualified Ideas.Common.CyclicTree as Tree
 
 -----------------------------------------------------------
 --- Strategy data-type
 
 -- | Abstract data type for strategies
-newtype Strategy a = S (Core a)
+newtype Strategy a = S { unS :: StrategyTree a }
 
 instance Show (Strategy a) where
-   show = show . toCore
+   show = show . unS
 
 instance Apply Strategy where
-   applyAll = runCore . toCore
+   applyAll = runProcess . getProcess
 
+instance Choice (Strategy a) where
+   empty   = decl0 ("fail" .=. Nullary empty)
+   s .|. t = choice [s, t]
+
+   s |>  t = orelse [s, t]
+   s ./. t = preference [s, t]
+
+   choice     = declN (associative ("choice" .=. Nary choice))
+   preference = declN (associative ("preference" .=. Nary preference))
+   orelse     = declN (associative ("orelse" .=. Nary orelse))
+
+instance Sequence (Strategy a) where
+   type Sym (Strategy a) = Rule a
+
+   done     = decl0 ("succeed" .=. Nullary done)
+   a ~> s   = sequence [toStrategy a, s]
+   s .*. t  = sequence [s, t]
+   single   = toStrategy
+   sequence = declN (associative ("sequence" .=. Nary sequence))
+
+instance Fix (Strategy a) where
+   fix f = S (fix (unS . f . S))
+
 -----------------------------------------------------------
 --- Type class
 
@@ -60,15 +96,25 @@ instance IsStrategy Strategy where
    toStrategy = id
 
-instance IsStrategy (LabeledStrategy) where
-  toStrategy (LS info (S core)) = S (Label info core)
+instance IsStrategy LabeledStrategy where
+  toStrategy (LS info (S t)) = S (Tree.label info t)
 
 instance IsStrategy Rule where
-   toStrategy = S . Rule
+   toStrategy = S . leaf
 
 instance IsStrategy RewriteRule where
    toStrategy = toStrategy . ruleRewrite
 
+liftS :: IsStrategy f => (Strategy a -> Strategy a) -> f a -> Strategy a
+liftS f = f . toStrategy
+
+liftS2 :: (IsStrategy f, IsStrategy g)
+       => (Strategy a -> Strategy a -> Strategy a) -> f a -> g a -> Strategy a
+liftS2 f = liftS . f . toStrategy
+
+liftSn :: IsStrategy f => ([Strategy a] -> Strategy a) -> [f a] -> Strategy a
+liftSn f = f . map toStrategy
+
 -----------------------------------------------------------
 --- Labeled Strategy data-type
 
@@ -98,13 +144,13 @@ 
 -- | Construct the empty prefix for a labeled strategy
 emptyPrefix :: IsStrategy f => f a -> a -> Prefix a
-emptyPrefix = makePrefix . toCore
+emptyPrefix = makePrefix . getProcess
 
 -- | Construct a prefix for a path and a labeled strategy. The third argument
 -- is the current term.
-replayPath :: IsStrategy f => Path -> f a -> a -> ([Step a], Prefix a)
+replayPath :: IsStrategy f => Path -> f a -> a -> ([Rule a], Prefix a)
 replayPath path s a =
-   let (xs, f) = replayCore path (toCore s)
+   let (xs, f) = replayProcess path (getProcess s)
    in (xs, f a)
 
 -- | Construct a prefix for a list of paths and a labeled strategy. The third
@@ -117,7 +163,7 @@ -- is the initial term.
 replayStrategy :: (Monad m, IsStrategy f) => Path -> f a -> a -> m (a, Prefix a)
 replayStrategy path s a =
-   let (xs, f) = replayCore path (toCore s)
+   let (xs, f) = replayProcess path (getProcess s)
    in case applyList xs a of
          Just b  -> return (b, f b)
          Nothing -> fail "Cannot replay strategy"
@@ -128,22 +174,18 @@ derivationList :: IsStrategy f => (Rule a -> Rule a -> Ordering) -> f a -> a -> [Derivation (Rule a, Environment) a]
 derivationList cmpRule s a0 = rec a0 (toPrefix s)
  where
-   toPrefix = majorPrefix . flip makePrefix a0 . toCore
+   toPrefix = majorPrefix . flip makePrefix a0 . getProcess
 
    rec a prfx = (if ready prfx then (emptyDerivation a:) else id)
       [ prepend (a, rEnv) d | (rEnv, b, new) <- firstsOrd prfx, d <- rec b new ]
 
-   firstsOrd = map f . firstsOrdered cmp
+   firstsOrd = map f . firstsOrdered cmpRule
     where
-      cmp = cmpRule `on` (fst . g . fst)
-
-      f ((stp, b), new) = (g stp, b, new)
-
-      g stp = (stepRule stp, stepEnvironment stp)
+      f ((stp, b, env), new) = ((stp, env), b, new)
 
 -- | Returns a list of all major rules that are part of a labeled strategy
 rulesInStrategy :: IsStrategy f => f a -> [Rule a]
-rulesInStrategy s = [ r | Rule r <- universe (toCore s), isMajor r ]
+rulesInStrategy s = [ r | r <- toList (toStrategyTree s), isMajor r ]
 
 instance LiftView LabeledStrategy where
    liftViewIn = mapRules . liftViewIn
@@ -156,38 +198,48 @@ mapRules f (LS n s) = LS n (mapRulesS f s)
 
 mapRulesS :: (Rule a -> Rule b) -> Strategy a -> Strategy b
-mapRulesS f = S . fmap f . toCore
+mapRulesS f = S . fmap f . unS
 
 -- | Use a function as do-after hook for all rules in a labeled strategy, but
 -- also use the function beforehand
 cleanUpStrategy :: (a -> a) -> LabeledStrategy a -> LabeledStrategy a
-cleanUpStrategy f (LS n s) = cleanUpStrategyAfter f (LS n (make s))
- where
-   make = liftCore2 (:*:) (doAfter f (idRule ()))
+cleanUpStrategy f (LS n s) = cleanUpStrategyAfter f $
+   LS n (doAfter f (idRule ()) ~> s)
 
 -- | Use a function as do-after hook for all rules in a labeled strategy
 cleanUpStrategyAfter :: (a -> a) -> LabeledStrategy a -> LabeledStrategy a
 cleanUpStrategyAfter f = mapRules $ \r ->
    if isMajor r then doAfter f r else r
 
-noInterleaving :: IsStrategy f => f a -> Strategy a
-noInterleaving = liftCore $ transform f
-   where
-      f (a :%:  b) = a :*: b
-      f (Atomic a) = a
-      f s          = s
-
 -----------------------------------------------------------
 --- Functions to lift the core combinators
 
-toCore :: IsStrategy f => f a -> Core a
-toCore s = let S core = toStrategy s in core
+toStrategyTree :: IsStrategy f => f a -> StrategyTree a
+toStrategyTree = unS . toStrategy
 
-fromCore :: Core a -> Strategy a
-fromCore = S
+onStrategyTree :: IsStrategy f => (StrategyTree a -> StrategyTree a) -> f a -> Strategy a
+onStrategyTree f = S . f . toStrategyTree
 
-liftCore :: IsStrategy f => (Core a -> Core a) -> f a -> Strategy a
-liftCore f = fromCore . f . toCore
+getProcess :: IsStrategy f => f a -> Process (Rule a)
+getProcess = foldUnwind emptyAlg
+   { fNode  = fromNary . combinator
+   , fLeaf  = single
+   , fLabel = \l p -> enterRule l ~> p .*. (exitRule l ~> done)
+   } . toStrategyTree
 
-liftCore2 :: (IsStrategy f, IsStrategy g) => (Core a -> Core a -> Core a) -> f a -> g a -> Strategy a
-liftCore2 f = liftCore . f . toCore+-------------------------
+
+decl0 :: Decl Nullary -> Strategy a
+decl0 = fromNullary . useDecl
+
+decl1 :: IsStrategy f => Decl Unary -> f a -> Strategy a
+decl1 = liftS . fromUnary . useDecl
+
+decl2 :: (IsStrategy f, IsStrategy g) => Decl Binary -> f a -> g a -> Strategy a
+decl2 = liftS2 . fromBinary . useDecl
+
+declN :: IsStrategy f => Decl Nary -> [f a] -> Strategy a
+declN = liftSn . fromNary . useDecl
+
+useDecl :: Arity f => Decl f -> f (Strategy a)
+useDecl = liftIso (S <-> unS) . applyDecl

@@ -1,69 +1,73 @@ -----------------------------------------------------------------------------
--- Copyright 2015, Open Universiteit Nederland. This file is distributed
--- under the terms of the GNU General Public License. For more information,
--- see the file "LICENSE.txt", which is included in the distribution.
+-- Copyright 2015, Ideas project team. This file is distributed under the
+-- terms of the Apache License 2.0. For more information, see the files
+-- "LICENSE.txt" and "NOTICE.txt", which are included in the distribution.
 -----------------------------------------------------------------------------
 -- |
 -- Maintainer  :  bastiaan.heeren@ou.nl
 -- Stability   :  provisional
 -- Portability :  portable (depends on ghc)
 --
--- A type class with an implementation for expressing choice and left-biased
--- choice.
+-- A type class for expressing choice, preference, and left-biased choice.
+-- The 'Menu' datatype implements the type class by keeping all the
+-- alternatives.
 --
 -----------------------------------------------------------------------------
---  $Id: Sequential.hs 6598 2014-06-04 14:59:01Z bastiaan $
+--  $Id: Choice.hs 8758 2015-10-22 06:48:52Z bastiaan $
 
 module Ideas.Common.Strategy.Choice
    ( -- * Choice type class
      Choice(..)
      -- * Menu data type
-   , Menu, eqMenuBy
+   , Menu, (|->), doneMenu, eqMenuBy
      -- * Queries
-   , elems, bests, bestsOrdered, isEmpty, getByIndex
+   , elems, bests, bestsOrdered
+   , isEmpty, hasDone, getByIndex, cut
      -- * Generalized functions
-   , onMenu, cut, cutOn, mapWithIndex
+   , onMenu, onMenuWithIndex
    ) where
 
-import Data.Maybe (listToMaybe)
+import Data.Maybe
 
-infixr 3 <|>, >|>, |>, :|:, :>|, :|>
+infixr 3 .|., ./., |>, :|:, :/:, :|>
+infixr 5 |->, :->
 
 ------------------------------------------------------------------------
 -- Choice type class
 
--- | Laws: '<|>', '>|>' '|>' are all associative, and have 'empty' as their
+-- | Laws: '.|.', './.' '|>' are all associative, and have 'empty' as their
 -- unit element.
-class Choice f where
+class Choice a where
    -- | Nothing to choose from.
-   empty :: f a
-   -- | One element.
-   single :: a -> f a
+   empty :: a
    -- | Normal (unbiased) choice.
-   (<|>) :: f a -> f a -> f a
+   (.|.) :: a -> a -> a
    -- | Left-preference.
-   (>|>) :: f a -> f a -> f a
+   (./.) :: a -> a -> a
    -- | Left-biased choice.
-   (|>) :: f a -> f a -> f a
-   -- | One element from a list (unbiased).
-   oneof :: [a]   -> f a
+   (|>) :: a -> a -> a
    -- | One of the alternatives in a list (unbiased).
-   choice :: [f a] -> f a
+   choice     :: [a] -> a
+   preference :: [a] -> a
+   orelse     :: [a] -> a
    -- default implementation
-   oneof = choice . map single
-   choice xs
-      | null xs   = empty
-      | otherwise = foldr1 (<|>) xs
+   choice     xs = if null xs then empty else foldr1 (.|.) xs
+   preference xs = if null xs then empty else foldr1 (./.) xs
+   orelse     xs = if null xs then empty else foldr1 (|>)  xs
 
-instance Choice [] where
+instance Choice [a] where
    empty    = []
-   single   = return
-   (<|>)    = (++)
-   (>|>)    = (++)
+   (.|.)    = (++)
+   (./.)    = (++)
    xs |> ys = if null xs then ys else xs
-   oneof    = id
    choice   = concat
 
+instance Choice b => Choice (a -> b) where
+   empty       = const empty
+   (f .|. g) a = f a .|. g a
+   (f ./. g) a = f a ./. g a
+   (f |> g)  a = f a  |> g a
+
 ------------------------------------------------------------------------
 -- Menu data type
 
@@ -71,22 +75,23 @@ -- (Unit) The left-hand side of :|: and :|> cannot be Empty
 -- (Asso) :|: and :|> are balanced to the right
 
--- | A menu offers choices and preferences. It is an instance of the 'Functor'
--- and 'Monad' type classes.
-data Menu a = Single a
-            | Empty
-            | Menu a :|: Menu a
-            | Menu a :>| Menu a -- left-preference
-            | Menu a :|> Menu a -- left-biased
+-- | A menu offers choices and preferences. It stores singleton bindings (thus
+-- acting as a finite map) and one special element ('doneMenu'). It is an
+-- instance of the 'Functor' and 'Monad' type classes.
+data Menu k a = k :-> a
+              | Done
+              | Empty
+              | Menu k a :|: Menu k a
+              | Menu k a :/: Menu k a -- left-preference
+              | Menu k a :|> Menu k a -- left-biased
 
-instance Eq a => Eq (Menu a) where
-   (==) = eqMenuBy (==)
+instance (Eq k, Eq a) => Eq (Menu k a) where
+   (==) = eqMenuBy (==) (==)
 
-instance Choice Menu where
+instance Choice (Menu k a) where
    empty  = Empty
-   single = Single
 
-   p0 <|> rest = rec p0 -- maintain invariant
+   p0 .|. rest = rec p0 -- maintain invariant
     where
      rec Empty     = rest
      rec (p :|: q) = p :|: rec q
@@ -94,11 +99,11 @@                         Empty -> p
                         _     -> p :|: rest
 
-   p0 >|> rest = rec p0 -- maintain invariant
+   p0 ./. rest = rec p0 -- maintain invariant
     where
      rec Empty     = rest
-     rec (p :>| q) = p :>| rec q
-     rec p         = p :>| rest
+     rec (p :/: q) = p :/: rec q
+     rec p         = p :/: rest
 
    p0 |> rest = rec p0 -- maintain invariant
     where
@@ -106,26 +111,45 @@      rec (p :|> q) = p :|> rec q
      rec p         = p :|> rest
 
-instance Functor Menu where
-   fmap f p = p >>= (Single . f)
+instance Functor (Menu k) where
+   fmap f = rec
+    where
+      rec (p :|: q) = rec p :|: rec q
+      rec (p :/: q) = rec p :/: rec q
+      rec (p :|> q) = rec p :|> rec q
+      rec (k :-> a) = k :-> f a
+      rec Done      = Done
+      rec Empty     = Empty
 
-instance Monad Menu where
-   return = single
-   fail _ = empty
-   (>>=)  = flip onMenu
+-- | Singleton binding
+(|->) :: a -> s -> Menu a s
+(|->) = (:->)
 
+-- | Special element for denoting success
+doneMenu :: Menu k a
+doneMenu = Done
+
+hasDone :: Menu k a -> Bool
+hasDone (p :|: q) = hasDone p || hasDone q
+hasDone (p :/: q) = hasDone p || hasDone q
+hasDone (p :|> _) = hasDone p
+hasDone (_ :-> _) = False
+hasDone Done      = True
+hasDone Empty     = False
+
 -- | Equality with a comparison function for the elements
-eqMenuBy :: (a -> a -> Bool) -> Menu a -> Menu a -> Bool
-eqMenuBy eq = test
+eqMenuBy :: (k -> k -> Bool) -> (a -> a -> Bool) -> Menu k a -> Menu k a -> Bool
+eqMenuBy eqK eqA = test
  where
    test (p1 :|: p2) (q1 :|: q2) = test p1 q1 && test p2 q2
-   test (p1 :>| p2) (q1 :>| q2) = test p1 q1 && test p2 q2
+   test (p1 :/: p2) (q1 :/: q2) = test p1 q1 && test p2 q2
    test (p1 :|> p2) (q1 :|> q2) = test p1 q1 && test p2 q2
-   test (Single a)  (Single b)  = eq a b
+   test (k1 :-> a1) (k2 :-> a2) = eqK k1 k2 && eqA a1 a2
+   test Done        Done        = True
    test Empty       Empty       = True
-   test (p :>| Empty) q = test p q
+   test (p :/: Empty) q = test p q
    test (p :|> Empty) q = test p q
-   test p (q :>| Empty) = test p q
+   test p (q :/: Empty) = test p q
    test p (q :|> Empty) = test p q
    test _ _ = False
 
@@ -133,100 +157,91 @@ -- Queries
 
 -- | Returns all elements that are in the menu.
-elems :: Menu a -> [a]
+elems :: Menu k a -> [(k, a)]
 elems = ($ []) . rec
  where
-   rec (p :|: q)  = rec p . rec q
-   rec (p :>| q)  = rec p . rec q
-   rec (p :|> q)  = rec p . rec q
-   rec (Single p) = (p:)
-   rec Empty      = id
+   rec (p :|: q) = rec p . rec q
+   rec (p :/: q) = rec p . rec q
+   rec (p :|> q) = rec p . rec q
+   rec (k :-> a) = ((k, a):)
+   rec Done      = id
+   rec Empty     = id
 
--- | Returns only the best elements that are in the menu.
-bests :: Menu a -> [a]
-bests (p :|: q)  = bests p ++ bests q
-bests (p :>| q)  = bests p ++ bests q
-bests (p :|> q)  = bests p |> bests q
-bests (Single a) = [a]
-bests Empty      = []
+-- | Returns only the best elements that are in the menu with respect to
+-- left-biased choices.
+bests :: Menu k a -> [(k, a)]
+bests = bestsWith (++)
 
 -- | Returns only the best elements that are in the menu, with a given ordering.
-bestsOrdered :: (a -> a -> Ordering) -> Menu a -> [a]
-bestsOrdered cmp = rec
+bestsOrdered :: (k -> k -> Ordering) -> Menu k a -> [(k, a)]
+bestsOrdered cmp = bestsWith merge
  where
-   rec (p :|: q)  = merge (rec p) (rec q)
-   rec (p :>| q)  = rec p ++ rec q
-   rec (p :|> q)  = rec p |> rec q
-   rec (Single a) = [a]
-   rec Empty      = []
-
    -- merge two lists with comparison function
-   merge lx@(x:xs) ly@(y:ys)
-      | cmp x y == GT = y : merge lx ys
-      | otherwise     = x : merge xs ly
+   merge lx@(x:xs) ly@(y:ys) =
+      case cmp (fst x) (fst y) of
+         GT -> y : merge lx ys
+         _  -> x : merge xs ly
    merge [] ys = ys
    merge xs [] = xs
 
+-- helper: takes combinator for (:|:)
+bestsWith:: ([(k, a)] -> [(k, a)] -> [(k, a)]) -> Menu k a -> [(k, a)]
+bestsWith f = rec
+ where
+   rec (p :|: q) = f (rec p) (rec q)
+   rec (p :/: q) = rec p ++ rec q
+   rec (p :|> _) = rec p
+   rec (k :-> a) = [(k, a)]
+   rec Done      = []
+   rec Empty     = []
+
 -- | Is the menu empty?
-isEmpty :: Menu a -> Bool
+isEmpty :: Menu k a -> Bool
 isEmpty Empty = True
 isEmpty _     = False -- because of invariant
 
 -- | Get an element from the menu by its index.
-getByIndex :: Int -> Menu a -> Maybe a
+getByIndex :: Int -> Menu k a -> Maybe (k, a)
 getByIndex n = listToMaybe . drop n . elems
 
+-- | Only keep the best elements in the menu.
+cut :: Menu k a -> Menu k a
+cut (p :|: q) = cut p .|. cut q
+cut (p :/: q) = cut p ./. cut q
+cut (p :|> _) = cut p
+cut (k :-> a) = k |-> a
+cut Done      = doneMenu
+cut Empty     = empty
+
 ------------------------------------------------------------------------
 -- Generalized functions
 
 -- | Generalized monadic bind, with the arguments flipped.
 {-# INLINE onMenu #-}
-onMenu :: Choice f => (a -> f b) -> Menu a -> f b
-onMenu f = rec
- where
-   rec (p :|: q)  = rec p <|> rec q
-   rec (p :>| q)  = rec p >|> rec q
-   rec (p :|> q)  = rec p  |> rec q
-   rec (Single a) = f a
-   rec Empty      = empty
-
--- | Only keep the best elements in the menu.
-{-# INLINE cut #-}
-cut :: Choice f => Menu a -> f a
-cut (p :|: q)  = cut p <|> cut q
-cut (p :>| q)  = cut p >|> cut q
-cut (p :|> _)  = cut p
-cut (Single a) = single a
-cut Empty      = empty
-
-cutOn :: Choice f => (a -> Bool) -> Menu a -> f a
-cutOn f = snd . rec
+onMenu :: Choice b => (k -> a -> b) -> b -> Menu k a -> b
+onMenu f e = rec
  where
-   rec (p :|: q)  = let (b1, cp) = rec p
-                        (b2, cq) = rec q
-                    in (b1 || b2, cp <|> cq)
-   rec (p :>| q)  = let (b1, cp) = rec p
-                        (b2, cq) = rec q
-                    in (b1 || b2, cp >|> cq)
-   rec (p :|> q)  = let (b1, cp) = rec p
-                        (b2, cq) = rec q
-                    in (b1 || b2, if b1 then cp else cp |> cq)
-   rec (Single a) = (f a, single a)
-   rec Empty      = (False, empty)
+   rec (p :|: q) = rec p .|. rec q
+   rec (p :/: q) = rec p ./. rec q
+   rec (p :|> q) = rec p  |> rec q
+   rec (k :-> a) = f k a
+   rec Done      = e
+   rec Empty     = empty
 
 -- | Maps a function over a menu that also takes the index of an element.
-{-# INLINE mapWithIndex #-}
-mapWithIndex :: Choice f => (Int -> a -> f b) -> Menu a -> f b
-mapWithIndex f = snd . rec 0
+{-# INLINE onMenuWithIndex #-}
+onMenuWithIndex :: Choice b => (Int -> k -> a -> b) -> b -> Menu k a -> b
+onMenuWithIndex f e = snd . rec 0
  where
-   rec n (p :|: q)  = let (n1, pn) = rec n p
-                          (n2, qn) = rec n1 q
-                      in (n2, pn <|> qn)
-   rec n (p :>| q)  = let (n1, pn) = rec n p
-                          (n2, qn) = rec n1 q
-                      in (n2, pn >|> qn)
-   rec n (p :|> q)  = let (n1, pn) = rec n p
-                          (n2, qn) = rec n1 q
-                      in (n2, pn |> qn)
-   rec n (Single a) = (n+1, f n a)
-   rec n Empty      = (n, empty)+   rec n (p :|: q) = let (n1, pn) = rec n p
+                         (n2, qn) = rec n1 q
+                     in (n2, pn .|. qn)
+   rec n (p :/: q) = let (n1, pn) = rec n p
+                         (n2, qn) = rec n1 q
+                     in (n2, pn ./. qn)
+   rec n (p :|> q) = let (n1, pn) = rec n p
+                         (n2, qn) = rec n1 q
+                     in (n2, pn |> qn)
+   rec n (k :-> a) = (n+1, f n k a)
+   rec n Done      = (n, e)
+   rec n Empty     = (n, empty)

@@ -1,7 +1,7 @@ -----------------------------------------------------------------------------
--- Copyright 2015, Open Universiteit Nederland. This file is distributed
--- under the terms of the GNU General Public License. For more information,
--- see the file "LICENSE.txt", which is included in the distribution.
+-- Copyright 2015, Ideas project team. This file is distributed under the
+-- terms of the Apache License 2.0. For more information, see the files
+-- "LICENSE.txt" and "NOTICE.txt", which are included in the distribution.
 -----------------------------------------------------------------------------
 -- |
 -- Maintainer  :  bastiaan.heeren@ou.nl
@@ -12,19 +12,24 @@ -- data types
 --
 -----------------------------------------------------------------------------
---  $Id: Combinators.hs 7524 2015-04-08 07:31:15Z bastiaan $
+--  $Id: Combinators.hs 8745 2015-10-15 14:45:46Z bastiaan $
 
 module Ideas.Common.Strategy.Combinators where
 
 import Data.Array
 import Data.Graph
 import Data.List ((\\))
+import Ideas.Common.CyclicTree hiding (label)
 import Ideas.Common.Id
 import Ideas.Common.Rule
 import Ideas.Common.Strategy.Abstract
-import Ideas.Common.Strategy.Core
+import Ideas.Common.Strategy.Process
+import Ideas.Common.Strategy.StrategyTree
 import Ideas.Common.Utils (fst3)
 import Prelude hiding (not, repeat, fail, sequence)
+import qualified Ideas.Common.Strategy.Choice as Choice
+import qualified Ideas.Common.Strategy.Derived as Derived
+import qualified Ideas.Common.Strategy.Sequence as Sequence
 import qualified Prelude
 
 -----------------------------------------------------------
@@ -32,72 +37,90 @@ 
 -- Basic combinators --------------------------------------
 
-infixr 2 <%>, <@>
-infixr 3 <|>
-infixr 4 >|>, |>
-infixr 5 <*>
+infixr 2 .%., .@.
+infixr 3 .|.
+infixr 4 ./., |>
+infixr 5 .*., !~>
 
 -- | Put two strategies in sequence (first do this, then do that)
-(<*>) :: (IsStrategy f, IsStrategy g) => f a -> g a -> Strategy a
-(<*>) = liftCore2 (:*:)
+(.*.) :: (IsStrategy f, IsStrategy g) => f a -> g a -> Strategy a
+(.*.) = liftS2 (Sequence..*.)
 
 -- | Choose between the two strategies (either do this or do that)
-(<|>) :: (IsStrategy f, IsStrategy g) => f a -> g a -> Strategy a
-(<|>) = liftCore2 (:|:)
+(.|.) :: (IsStrategy f, IsStrategy g) => f a -> g a -> Strategy a
+(.|.) = liftS2 (Choice..|.)
 
 -- | Interleave two strategies
-(<%>) :: (IsStrategy f, IsStrategy g) => f a -> g a -> Strategy a
-(<%>) = liftCore2 (:%:)
+(.%.) :: (IsStrategy f, IsStrategy g) => f a -> g a -> Strategy a
+s .%. t = interleave [toStrategy s, toStrategy t]
 
 -- | Alternate two strategies
-(<@>) :: (IsStrategy f, IsStrategy g) => f a -> g a -> Strategy a
-(<@>) = liftCore2 (:@:)
+(.@.) :: (IsStrategy f, IsStrategy g) => f a -> g a -> Strategy a
+(.@.) = decl2 $ "alternate" .=. Binary (Derived.<@>)
 
+-- | Prefixing a basic rule to a strategy atomically
+(!~>) :: IsStrategy f => Rule a -> f a -> Strategy a
+(!~>) = decl2 $ "atomicprefix" .=. Binary (Derived.!*>)
+
+-- | Initial prefixes (allows the strategy to stop succesfully at any time)
+inits :: IsStrategy f => f a -> Strategy a
+inits = decl1 $ "inits" .=. Unary Derived.inits
+
 -- | The strategy that always succeeds (without doing anything)
 succeed :: Strategy a
-succeed = fromCore Succeed
+succeed = Sequence.done
 
 -- | The strategy that always fails
 fail :: Strategy a
-fail = fromCore Fail
+fail = Choice.empty
 
 -- | Makes a strategy atomic (w.r.t. parallel composition)
 atomic :: IsStrategy f => f a -> Strategy a
-atomic = liftCore Atomic
+atomic = decl1 $ "atomic" .=. Unary Derived.atomic
 
 -- | Puts a list of strategies into a sequence
 sequence :: IsStrategy f => [f a] -> Strategy a
-sequence = foldr ((<*>) . toStrategy) succeed
+sequence = Sequence.sequence . map toStrategy
 
 -- | Combines a list of alternative strategies
-alternatives :: IsStrategy f => [f a] -> Strategy a
-alternatives = foldr ((<|>) . toStrategy) fail
+choice :: IsStrategy f => [f a] -> Strategy a
+choice = Choice.choice . map toStrategy
 
 -- | Merges a list of strategies (in parallel)
 interleave :: IsStrategy f => [f a] -> Strategy a
-interleave = foldr ((<%>) . toStrategy) succeed
+interleave = declN $ associative (interleaveId .=. Nary Derived.interleave)
 
+noInterleaving :: IsStrategy f => f a -> Strategy a
+noInterleaving = onStrategyTree (replaceNode f)
+ where
+   f d = if getId d == interleaveId
+         then fromNary (applyDecl ("sequence" .=. Nary Sequence.sequence)) -- fix me
+         else node d
+
+interleaveId :: Id
+interleaveId = newId "interleave"
+
 -- | Allows all permutations of the list
 permute :: IsStrategy f => [f a] -> Strategy a
-permute = foldr ((<%>) . atomic) succeed
+permute = declN $ "permute" .=. Nary Derived.permute
 
 -- EBNF combinators --------------------------------------
 
 -- | Repeat a strategy zero or more times (non-greedy)
 many :: IsStrategy f => f a -> Strategy a
-many a = fix $ \x -> succeed <|> (a <*> x)
+many = decl1 $ "many" .=. Unary Derived.many
 
 -- | Apply a certain strategy at least once (non-greedy)
 many1 :: IsStrategy f => f a -> Strategy a
-many1 s = s <*> many s
+many1 = decl1 $ "many1" .=. Unary Derived.many1
 
 -- | Apply a strategy a certain number of times
 replicate :: IsStrategy f => Int -> f a -> Strategy a
-replicate n = sequence . Prelude.replicate n
+replicate n = decl1 $ ("replicate" # show n) .=. Unary (Derived.replicate n)
 
 -- | Apply a certain strategy or do nothing (non-greedy)
 option :: IsStrategy f => f a -> Strategy a
-option s = s <|> succeed
+option = decl1 $ "option" .=. Unary Derived.option
 
 -- Negation and greedy combinators ----------------------
 
@@ -109,60 +132,43 @@ -- | Check whether or not the argument strategy cannot be applied: the result
 --   strategy only succeeds if this is not the case (otherwise it fails).
 not :: IsStrategy f => f a -> Strategy a
-not = liftCore Not
+not = decl1 $ "not" .=. Unary (\x ->
+   Sequence.single $ checkRule "core.not" $ null . runProcess x)
 
 -- | Repeat a strategy zero or more times (greedy version of 'many')
 repeat :: IsStrategy f => f a -> Strategy a
-repeat a = fix $ \x -> (a <*> x) |> succeed
+repeat = decl1 $ "repeat" .=. Unary Derived.repeat
 
 -- | Apply a certain strategy at least once (greedy version of 'many1')
 repeat1 :: IsStrategy f => f a -> Strategy a
-repeat1 s = s <*> repeat s
+repeat1 = decl1 $ "repeat1" .=. Unary Derived.repeat1
 
 -- | Apply a certain strategy if this is possible (greedy version of 'option')
 try :: IsStrategy f => f a -> Strategy a
-try s = s |> succeed
+try = decl1 $ "try" .=. Unary Derived.try
 
 -- | Choose between the two strategies, with a preference for steps from the
 -- left hand-side strategy.
-(>|>) :: (IsStrategy f, IsStrategy g) => f a -> g a -> Strategy a
-(>|>) = liftCore2 (:>|>)
+(./.) :: (IsStrategy f, IsStrategy g) => f a -> g a -> Strategy a
+(./.) = liftS2 (Choice../.)
 
 -- | Left-biased choice: if the left-operand strategy can be applied, do so. Otherwise,
 --   try the right-operand strategy
 (|>) :: (IsStrategy f, IsStrategy g) => f a -> g a -> Strategy a
-(|>) = liftCore2 (:|>:)
--- s |> t = s <|> (not s <*> t)
+(|>) = liftS2 (Choice.|>)
+-- s |> t = s <|> (not s .*. t)
 
 -- | Repeat the strategy as long as the predicate holds
 while :: IsStrategy f => (a -> Bool) -> f a -> Strategy a
-while p s = repeat (check p <*> s)
+while p s = repeat (check p .*. s)
 
 -- | Repeat the strategy until the predicate holds
 until :: IsStrategy f => (a -> Bool) -> f a -> Strategy a
 until p = while (Prelude.not . p)
 
--- | Apply a strategy at least once, but collapse into a single step
-multi :: (IsId l, IsStrategy f) => l -> f a -> Strategy a
-multi l = collapse . label l . repeat1
-
 -- | Apply the strategies from the list exhaustively (until this is no longer possible)
 exhaustive :: IsStrategy f => [f a] -> Strategy a
-exhaustive = repeat . alternatives
-
--- | A fix-point combinator on strategies (to model recursion). Powerful
--- (but dangerous) combinator
-fix :: (Strategy a -> Strategy a) -> Strategy a
-fix f = fromCore (coreFix (toCore . f . fromCore))
-
-remove :: IsStrategy f => f a -> Strategy a
-remove = liftCore Remove
-
-collapse :: IsStrategy f => f a -> Strategy a
-collapse = liftCore Collapse
-
-hide :: IsStrategy f => f a -> Strategy a
-hide = liftCore Hide
+exhaustive = declN $ "exhaustive" .=. Nary Derived.exhaustive
 
 -- Graph to strategy ----------------------
 
@@ -175,8 +181,8 @@     where
         g2s seen
             | null reachables   = succeed
-            | otherwise         = alternatives $ map makePath reachables
+            | otherwise         = choice $ map makePath reachables
             where
                reachables      = filter isReachable $ vertices graph \\ seen
                isReachable     = null . (\\ seen) . (graph!)
-               makePath vertex = (fst3 . vertex2data) vertex <*> g2s (vertex:seen)+               makePath vertex = (fst3 . vertex2data) vertex .*. g2s (vertex:seen)

@@ -1,29 +1,40 @@ -----------------------------------------------------------------------------
--- Copyright 2015, Open Universiteit Nederland. This file is distributed
--- under the terms of the GNU General Public License. For more information,
--- see the file "LICENSE.txt", which is included in the distribution.
+-- Copyright 2015, Ideas project team. This file is distributed under the
+-- terms of the Apache License 2.0. For more information, see the files
+-- "LICENSE.txt" and "NOTICE.txt", which are included in the distribution.
 -----------------------------------------------------------------------------
 -- |
 -- Maintainer  :  bastiaan.heeren@ou.nl
 -- Stability   :  provisional
 -- Portability :  portable (depends on ghc)
 --
+-- Strategies can be configured at their labeled positions. Possible actions
+-- are remove/reinsert, collapse/expand, and hide/reveal.
+--
 -----------------------------------------------------------------------------
---  $Id: Configuration.hs 7524 2015-04-08 07:31:15Z bastiaan $
+--  $Id: Configuration.hs 8758 2015-10-22 06:48:52Z bastiaan $
 
 module Ideas.Common.Strategy.Configuration
    ( StrategyCfg, byName, ConfigAction(..)
    , configure, configureS
-   , module Data.Monoid
+   , remove, collapse, hide, multi
+   , isConfigId
    ) where
 
 import Data.Char
 import Data.Monoid
+import Ideas.Common.Classes
+import Ideas.Common.CyclicTree hiding (label)
 import Ideas.Common.Id
+import Ideas.Common.Rule
 import Ideas.Common.Strategy.Abstract
-import Ideas.Common.Strategy.Core hiding (Remove, Collapse, Hide)
-import Ideas.Common.Utils.Uniplate
-import qualified Ideas.Common.Strategy.Core as Core
+import Ideas.Common.Strategy.Choice
+import Ideas.Common.Strategy.Derived (repeat1)
+import Ideas.Common.Strategy.Process hiding (fold)
+import Ideas.Common.Strategy.Sequence
+import Ideas.Common.Strategy.StrategyTree
+import Ideas.Common.Strategy.Symbol
+import qualified Ideas.Common.CyclicTree as Tree
 
 ---------------------------------------------------------------------
 -- Types and constructors
@@ -64,45 +75,76 @@ configure cfg ls = label (getId ls) (configureS cfg (unlabel ls))
 
 configureS :: StrategyCfg -> Strategy a -> Strategy a
-configureS cfg = fromCore . configureCore cfg . toCore
+configureS = onStrategyTree . configureStrategyTree
 
-configureCore :: StrategyCfg -> Core a -> Core a
-configureCore (Cfg pairs) = rec
+configureStrategyTree :: StrategyCfg -> StrategyTree a -> StrategyTree a
+configureStrategyTree (Cfg pairs) tree = foldr handle tree pairs
  where
-   rec core =
-      case core of
-         Core.Remove s   | has Reinsert -> rec s
-         Core.Collapse s | has Expand   -> rec s
-         Core.Hide s     | has Reveal   -> rec s
-         Label l s -> props (Label l (rec s))
-         Rule r    -> props (Rule r)
-         _ -> descend rec core
-    where
-      myLabel  = getLabel core
-      actions  = cancel [ a | (loc, a) <- pairs, maybe False (here loc) myLabel ]
-      has      = (`elem` actions)
-      make x g = if has x then g else id
+   handle (ByName l, action) =
+      case action of
+         Remove   -> insertAtLabel l removeDecl
+         Reinsert -> removeAtLabel l removeDecl
+         Collapse -> insertAtLabel l collapseDecl
+         Expand   -> removeAtLabel l collapseDecl
+         Hide     -> insertAtLabel l hideDecl
+         Reveal   -> removeAtLabel l hideDecl
 
-      props    = make Remove   Core.Remove
-               . make Hide     Core.Hide
-               . make Collapse Core.Collapse
+insertAtLabel :: Id -> Decl Unary -> StrategyTree a -> StrategyTree a
+insertAtLabel n comb = replaceLeaf f . replaceLabel g
+ where
+   f a | n == getId a = fromUnary (applyDecl comb) (leaf a)
+       | otherwise    = leaf a
 
-here :: ConfigLocation -> Id -> Bool
-here (ByName a) info = getId info == a
+   g l a | n == l    = fromUnary (applyDecl comb) (Tree.label l a)
+         | otherwise = Tree.label l a
 
-getLabel :: Core a -> Maybe Id
-getLabel (Label l _)       = Just l
-getLabel (Rule r)          = Just (getId r)
-getLabel (Core.Remove s)   = getLabel s
-getLabel (Core.Collapse s) = getLabel s
-getLabel (Core.Hide s)     = getLabel s
-getLabel _                 = Nothing
+removeAtLabel :: Id -> Decl Unary -> StrategyTree a -> StrategyTree a
+removeAtLabel n _decl = replaceNode $ \d xs -> -- fix me: use decl
+   case map nextId xs of
+      [Just l] | n == l -> head xs
+      _ -> node d xs
 
-cancel :: [ConfigAction] -> [ConfigAction]
-cancel [] = []
-cancel (x:xs) = x : cancel (rec actionGroups)
+nextId :: StrategyTree a -> Maybe Id
+nextId = fold monoidAlg
+   { fNode  = \d xs -> if isConfigId d && length xs == 1
+                       then head xs
+                       else Nothing
+   , fLeaf  = Just . getId
+   , fLabel = \l _  -> Just l
+   }
+
+isConfigId :: HasId a => a -> Bool
+isConfigId = (`elem` map getId configIds) . getId
+
+---------------------------------------------------------------------
+-- Combinator definitions
+
+remove, collapse, hide :: IsStrategy f => f a -> Strategy a
+remove   = decl1 removeDecl
+collapse = decl1 collapseDecl
+hide     = decl1 hideDecl
+
+-- | Apply a strategy at least once, but collapse into a single step
+multi :: (IsId l, IsStrategy f) => l -> f a -> Strategy a
+multi l = collapse . label l . decl1 repeatDecl . toStrategy
+
+repeatDecl :: Decl Unary -- fix me: overlap with combinators
+repeatDecl = "repeat1" .=. Unary repeat1
+
+configIds :: [Id]
+configIds = map getId [removeDecl, collapseDecl, hideDecl]
+
+removeDecl :: Decl Unary
+removeDecl = "removed" .=. Unary (const empty)
+
+collapseDecl :: Decl Unary
+collapseDecl = "collapsed" .=. Unary (\a ->
+   case firsts a of
+      [(r, _)] -> maybe empty (`collapseWith` a) (isEnterRule r)
+      _        -> empty)
  where
-   rec (g:gs)
-      | x `elem` g = filter (`notElem` g) xs
-      | otherwise  = rec gs
-   rec [] = xs+   collapseWith l =
+      single . makeRule l . runProcess
+
+hideDecl :: Decl Unary
+hideDecl = "hidden" .=. Unary (fmap minor)

@@ -1,166 +0,0 @@------------------------------------------------------------------------------
--- Copyright 2015, Open Universiteit Nederland. This file is distributed
--- under the terms of the GNU General Public License. For more information,
--- see the file "LICENSE.txt", which is included in the distribution.
------------------------------------------------------------------------------
--- |
--- Maintainer  :  bastiaan.heeren@ou.nl
--- Stability   :  provisional
--- Portability :  portable (depends on ghc)
---
--- The core strategy combinators. This module defines the interal data
--- structure of a strategy, and some utility functions that operate
--- directly on it.
---
------------------------------------------------------------------------------
---  $Id: Core.hs 7524 2015-04-08 07:31:15Z bastiaan $
-
-module Ideas.Common.Strategy.Core
-   ( GCore(..), Core
-   , coreFix, coreSubstAll, substCoreVar
-   ) where
-
-import Data.Maybe
-import Ideas.Common.Classes
-import Ideas.Common.Id
-import Ideas.Common.Rule
-import Ideas.Common.Strategy.Choice
-import Ideas.Common.Strategy.Sequence
-import Ideas.Common.Utils.Uniplate
-
------------------------------------------------------------------
--- Strategy (internal) data structure, containing a selection
--- of combinators
-
-infixr 2 :%:, :@:
-infixr 3 :|:, :>|>, :|>:
-infixr 5 :*:
-
--- | Core expression, with rules
-type Core a = GCore (Rule a)
-
--- | An environment with generalized Core expressions
-type CoreEnv a = [(Int, GCore a)]
-
--- | A generalized Core expression, not restricted to rules. This makes GCore
--- a (traversable and foldable) functor.
-data GCore a
-   = GCore a :*:  GCore a
-   | GCore a :|:  GCore a
-   | GCore a :>|> GCore a -- left-preference (choice)
-   | GCore a :|>: GCore a -- left-biased choice
-   | GCore a :%:  GCore a -- interleave
-   | GCore a :@:  GCore a -- alternate
-   | Label Id (GCore a)
-   | Atomic   (GCore a)
-   | Not      (GCore a)
-   | Remove   (GCore a) -- config: replaced by fail
-   | Collapse (GCore a) -- config: execute labeled sub-strategy as 1 step
-   | Hide     (GCore a) -- config: make all steps invisible/minor
-   | Succeed
-   | Fail
-   | Rule a -- ^ Generalized constructor (not restricted to rules)
-   | Var Int
-   | Let (CoreEnv a) (GCore a)
- deriving Show
-
-instance Choice GCore where
-   empty  = Fail
-   single = Rule
-   (<|>)  = (:|:)
-   (>|>)  = (:>|>)
-   (|>)   = (:|>:)
-
-instance Sequence GCore where
-   done  = Succeed
-   (~>)  = (:*:) . Rule
-   (<*>) = (:*:)
-
------------------------------------------------------------------
--- Useful instances
-
-instance Functor GCore where
-   fmap f = rec
-    where
-      rec core =
-         case core of
-            a :*: b    -> rec a :*:  rec b
-            a :|: b    -> rec a :|:  rec b
-            a :>|> b   -> rec a :>|> rec b
-            a :|>: b   -> rec a :|>: rec b
-            a :%: b    -> rec a :%:  rec b
-            a :@: b    -> rec a :@:  rec b
-            Atomic a   -> Atomic   (rec a)
-            Not a      -> Not      (rec a)
-            Remove a   -> Remove   (rec a)
-            Collapse a -> Collapse (rec a)
-            Hide a     -> Hide     (rec a)
-            Let ds a   -> Let (map (mapSecond rec) ds) (rec a)
-            Label l a  -> Label l (rec a)
-            Rule a     -> Rule (f a)
-            Var n      -> Var n
-            Succeed    -> Succeed
-            Fail       -> Fail
-
-instance Uniplate (GCore a) where
-   uniplate core =
-      case core of
-         a :*: b    -> plate (:*:)  |* a |* b
-         a :|: b    -> plate (:|:)  |* a |* b
-         a :>|> b   -> plate (:>|>) |* a |* b
-         a :|>: b   -> plate (:|>:) |* a |* b
-         a :%: b    -> plate (:%:)  |* a |* b
-         a :@: b    -> plate (:@:)  |* a |* b
-         Label l a  -> plate Label  |- l |* a
-         Atomic a   -> plate Atomic   |* a
-         Not a      -> plate Not      |* a
-         Remove a   -> plate Remove   |* a
-         Collapse a -> plate Collapse |* a
-         Hide a     -> plate Hide     |* a
-         Let ds a   -> let (ns, bs) = unzip ds
-                           make     = Let . zip ns
-                       in plate make ||* bs |* a
-         _          -> plate core
-
------------------------------------------------------------------
--- Definitions
-
-coreFix :: (GCore a -> GCore a) -> GCore a
-coreFix f = -- disadvantage: function f is applied twice
-   let i = nextVar (f (Var (-1)))
-   in coreRec i (f (Var i))
-
-coreRec :: Int -> GCore a -> GCore a
-coreRec n a = Let [(n, a)] (Var n)
-
-coreSubstAll :: GCore a -> GCore a
-coreSubstAll = rec []
- where
-   rec xs (Var i)    = fromMaybe (error "coreInf") (lookup i xs)
-   rec xs (Let ds a) = let this = [ (n, rec this b) | (n, b) <- ds ] ++ xs
-                       in rec this a
-   rec xs core       = descend (rec xs) core
-
------------------------------------------------------------------
--- Utility functions
-
-substCoreVar :: Int -> GCore a -> GCore a -> GCore a
-substCoreVar i a core =
-   case core of
-      Var j    | i==j -> a
-      Let ds _ | i `elem` map fst ds -> core
-      _               -> descend (substCoreVar i a) core
-
-nextVar :: GCore a -> Int
-nextVar p
-   | null xs   = 0
-   | otherwise = maximum xs + 1
- where xs = coreVars p
-
-coreVars :: GCore a -> [Int]
-coreVars core =
-   case core of
-      Var n    -> [n]
-      Let ds a -> let (ns, bs) = unzip ds
-                  in ns ++ concatMap coreVars (bs ++ [a])
-      _        -> concatMap coreVars (children core)

@@ -1,62 +1,146 @@ -----------------------------------------------------------------------------
--- Copyright 2015, Open Universiteit Nederland. This file is distributed
--- under the terms of the GNU General Public License. For more information,
--- see the file "LICENSE.txt", which is included in the distribution.
+-- Copyright 2015, Ideas project team. This file is distributed under the
+-- terms of the Apache License 2.0. For more information, see the files
+-- "LICENSE.txt" and "NOTICE.txt", which are included in the distribution.
 -----------------------------------------------------------------------------
 -- |
 -- Maintainer  :  bastiaan.heeren@ou.nl
 -- Stability   :  provisional
 -- Portability :  portable (depends on ghc)
 --
+-- This module defines extra combinators.
+--
 -----------------------------------------------------------------------------
---  $Id: Sequential.hs 6612 2014-06-12 07:57:59Z bastiaan $
+--  $Id: Derived.hs 8747 2015-10-15 14:54:48Z bastiaan $
 
 module Ideas.Common.Strategy.Derived
-   ( filterP, hide
-   , fromAtoms, Sym(..), atomic, concurrent, (<@>)
+   ( -- * General combinators
+     permute, many, many1, replicate, option, try
+   , repeat, repeat1, exhaustive
+     -- * Process-specific combinators
+   , atomic, (<%>), interleave, concurrent
+   , (<@>), (!*>), inits, filterP, hide
    ) where
 
+import Ideas.Common.Classes
 import Ideas.Common.Strategy.Choice
 import Ideas.Common.Strategy.Process
 import Ideas.Common.Strategy.Sequence
+import Ideas.Common.Strategy.Symbol
+import Prelude hiding (sequence, replicate, repeat)
+import qualified Prelude
 
-useFirst :: Choice f => (a -> Process a -> f b) -> f b -> Process a -> f b
-useFirst op e = onMenu (menuItem e op) . menu
+split :: (AtomicSymbol a, Choice b)
+      => (Process a -> Process a -> b) -> b -> Process a -> b
+split op = split2 (op . single) op
 
+-- Specialized version of split that also takes an operator for the special case
+-- that the left part of the split is a single symbol.
+split2 :: (AtomicSymbol a, Choice b)
+       => (a -> Process a -> b) -> (Process a -> Process a -> b) -> b -> Process a -> b
+split2 op1 op2 = withMenu f
+ where
+   f a | a == atomicOpen = rec (op2 . (a ~>)) 1
+       | otherwise       = op1 a
+
+   rec acc n
+      | n == 0    = acc done
+      | otherwise = withMenu g empty
+    where
+      g a = rec (acc . (a ~>)) (pm a n)
+
+   pm :: AtomicSymbol a => a -> Int -> Int
+   pm a | a == atomicOpen  = succ
+        | a == atomicClose = pred
+        | otherwise        = id
+
+-- atomic prefix
+(!*>) :: AtomicSymbol a => Process a -> Process a -> Process a
+a !*> p = split op (atomic a) p
+ where
+   op b q = atomic (a .*. b) .*. q
+
 filterP :: (a -> Bool) -> Process a -> Process a
 filterP cond = fold (\a q -> if cond a then a ~> q else empty) done
 
 hide :: (a -> Bool) -> Process a -> Process a
 hide cond = fold (\a q -> if cond a then a ~> q else q) done
 
-data Sym a = Single a | Composed (Process a)
+atomic :: AtomicSymbol a => Process a -> Process a
+atomic p = atomicOpen ~> (p .*. single atomicClose)
 
-fromAtoms :: Process (Sym a) -> Process a
-fromAtoms = fold f done
- where
-   f (Single a)   = (a ~>)
-   f (Composed p) = (p <*>)
+interleave :: (AtomicSymbol a, LabelSymbol a) => [Process a] -> Process a
+interleave xs = if null xs then done else foldr1 (<%>) xs
 
-atomic :: IsProcess f => f (Sym a) -> f (Sym a)
-atomic = single . Composed . fromAtoms . toProcess
+(<%>) :: (AtomicSymbol a, LabelSymbol a) => Process a -> Process a -> Process a
+(<%>) = concurrent (not . isEnterSymbol)
 
-concurrent :: IsProcess f => (a -> Bool) -> f a -> f a -> f a
-concurrent switch x y = normal (toProcess x) (toProcess y)
+concurrent :: AtomicSymbol a => (a -> Bool) -> Process a -> Process a -> Process a
+concurrent switch = normal
  where
-   normal p q = stepBoth q p <|> (stepRight q p <|> stepRight p q)
+   normal p q = stepBoth q p .|. (stepRight q p .|. stepRight p q)
 
-   stepBoth  = useFirst stop2 . useFirst stop2 done
+   stepBoth  = withMenu stop2 . withMenu stop2 done
    stop2 _ _ = empty
 
-   stepRight p = useFirst op empty
+   stepRight p = split2 op1 op2 empty
     where
-      op a = (a ~>) . (if switch a then normal else stepRight) p
+      op1 a q2
+         | switch a  = a ~> normal p q2
+         | otherwise = a ~> stepRight p q2
+      op2 q1 q2 = q1 .*. normal p q2
 
+-- | Allows all permutations of the list
+permute :: (Choice a, Sequence a) => [a] -> a
+permute as
+   | null as   = done
+   | otherwise = choice [ s .*. permute ys | (s, ys) <- pickOne as ]
+ where
+   pickOne :: [a] -> [(a, [a])]
+   pickOne []     = []
+   pickOne (x:xs) = (x, xs) : [ (y, x:ys) | (y, ys) <- pickOne xs ]
+
 -- Alternate combinator
-(<@>) :: IsProcess f => f a -> f a -> f a
-p0 <@> q0 = rec (toProcess q0) (toProcess p0)
+(<@>) :: AtomicSymbol a => Process a -> Process a -> Process a
+p0 <@> q0 = rec q0 p0
  where
-   rec q  = useFirst (\a r -> a ~> rec r q) (bothOk q)
-   bothOk = useFirst (\_ _ -> empty) done
+   rec q  = let op b r = b .*. rec r q
+            in split op (bothOk q)
+   bothOk = withMenu (\_ _ -> empty) done
+
+inits :: AtomicSymbol a => Process a -> Process a
+inits = rec
+ where
+   rec p = done .|. split op empty p
+   op x  = (x .*.) . rec
+
+many :: (Sequence a, Fix a, Choice a) => a -> a
+many s = fix $ \x -> done .|. (s .*. x)
+
+many1 :: (Sequence a, Fix a, Choice a) => a -> a
+many1 s = s .*. many s
+
+replicate :: Sequence a => Int -> a -> a
+replicate n = sequence . Prelude.replicate n
+
+-- | Apply a certain strategy or do nothing (non-greedy)
+option :: (Choice a, Sequence a) => a -> a
+option s = s .|. done
+
+-- | Apply a certain strategy if this is possible (greedy version of 'option')
+try :: (Choice a, Sequence a) => a -> a
+try s = s |> done
+
+-- | Repeat a strategy zero or more times (greedy version of 'many')
+repeat :: (Sequence a, Fix a, Choice a) => a -> a
+repeat s = fix $ \x -> try (s .*. x)
+
+-- | Apply a certain strategy at least once (greedy version of 'many1')
+repeat1 :: (Sequence a, Fix a, Choice a) => a -> a
+repeat1 s = s .*. repeat s
+
+-- | Apply the strategies from the list exhaustively (until this is no longer possible)
+exhaustive :: (Sequence a, Fix a, Choice a) => [a] -> a
+exhaustive = repeat . choice
 
 ---------------------------------------------------------------------------

@@ -0,0 +1,37 @@+-----------------------------------------------------------------------------
+-- Copyright 2015, Ideas project team. This file is distributed under the
+-- terms of the Apache License 2.0. For more information, see the files
+-- "LICENSE.txt" and "NOTICE.txt", which are included in the distribution.
+-----------------------------------------------------------------------------
+-- |
+-- Maintainer  :  bastiaan.heeren@ou.nl
+-- Stability   :  provisional
+-- Portability :  portable (depends on ghc)
+--
+-- Legacy strategy combinators (before the Functor-Applicative-Monad proposal)
+--
+-----------------------------------------------------------------------------
+--  $Id: Legacy.hs 8747 2015-10-15 14:54:48Z bastiaan $
+
+module Ideas.Common.Strategy.Legacy where
+
+import Ideas.Common.Strategy.Abstract
+import Ideas.Common.Strategy.Combinators
+import qualified Prelude
+
+infixr 2 <%>, <@>
+infixr 3 <|>
+infixr 4 >|>
+infixr 5 <*>
+
+(<%>), (<@>), (<|>), (>|>), (<*>) ::
+   (IsStrategy f, IsStrategy g) => f a -> g a -> Strategy a
+
+(<%>) = (.%.)
+(<@>) = (.@.)
+(<|>) = (.|.)
+(>|>) = (./.)
+(<*>) = (.*.)
+
+alternatives :: IsStrategy f => [f a] -> Strategy a
+alternatives = choice

@@ -1,17 +1,17 @@ -----------------------------------------------------------------------------
--- Copyright 2015, Open Universiteit Nederland. This file is distributed
--- under the terms of the GNU General Public License. For more information,
--- see the file "LICENSE.txt", which is included in the distribution.
+-- Copyright 2015, Ideas project team. This file is distributed under the
+-- terms of the Apache License 2.0. For more information, see the files
+-- "LICENSE.txt" and "NOTICE.txt", which are included in the distribution.
 -----------------------------------------------------------------------------
 -- |
 -- Maintainer  :  bastiaan.heeren@ou.nl
 -- Stability   :  provisional
 -- Portability :  portable (depends on ghc)
 --
--- Locations in a strategy
+-- Locations that correspond to the labels in a strategy
 --
 -----------------------------------------------------------------------------
---  $Id: Location.hs 7524 2015-04-08 07:31:15Z bastiaan $
+--  $Id: Location.hs 8745 2015-10-15 14:45:46Z bastiaan $
 
 module Ideas.Common.Strategy.Location
    ( checkLocation, subTaskLocation, nextTaskLocation
@@ -19,11 +19,9 @@    ) where
 
 import Data.Maybe
-import Ideas.Common.Classes
+import Ideas.Common.CyclicTree
 import Ideas.Common.Id
 import Ideas.Common.Strategy.Abstract
-import Ideas.Common.Strategy.Core
-import Ideas.Common.Utils.Uniplate
 
 -----------------------------------------------------------
 --- Strategy locations
@@ -57,17 +55,16 @@ 
 -- | Returns a list of all strategy locations, paired with the label
 strategyLocations :: LabeledStrategy a -> [([Int], Id)]
-strategyLocations s = ([], getId s) : rec [] (toCore (unlabel s))
+strategyLocations s = ([], getId s) : make s
  where
-   rec is = concat . zipWith make (map (:is) [0..]) . collect
-
-   make is (l, mc) = (is, l) : maybe [] (rec is) mc
+   make = nrs . fold alg . toStrategyTree . unlabel
+   alg  = monoidAlg
+      { fLeaf  = \a   -> [(getId a, [])]
+      , fLabel = \l x -> [(l, nrs x)]
+      }
+   nrs  = concat . zipWith f [0..]
 
-   collect core =
-      case core of
-         Label l c -> [(l, Just c)]
-         Rule r | isMajor r -> [(getId r, Nothing)]
-         _         -> concatMap collect (children core)
+   f i (l, xs) = ([i], l) : [ (i:is, l2) | (is, l2) <- xs ]
 
 fromLoc :: LabeledStrategy a -> [Int] -> Maybe Id
 fromLoc s loc = fmap getId (lookup loc (strategyLocations s))

@@ -1,261 +0,0 @@-{-# LANGUAGE TypeFamilies #-}
------------------------------------------------------------------------------
--- Copyright 2015, Open Universiteit Nederland. This file is distributed
--- under the terms of the GNU General Public License. For more information,
--- see the file "LICENSE.txt", which is included in the distribution.
------------------------------------------------------------------------------
--- |
--- Maintainer  :  bastiaan.heeren@ou.nl
--- Stability   :  provisional
--- Portability :  portable (depends on ghc)
---
--- Basic machinery for fully executing a core strategy expression, or only
--- partially. Partial execution results in a prefix that keeps the current
--- locations in the strategy (a list of @Path@s) for continuing the execution
--- later on. A path can be used to reconstruct the sequence of steps already
--- performed (a so-called trace). Prefixes can be merged with the Monoid
--- operation.
---
------------------------------------------------------------------------------
---  $Id: Parsing.hs 7524 2015-04-08 07:31:15Z bastiaan $
-
-module Ideas.Common.Strategy.Parsing
-   ( -- * Running @Core@ strategies
-     runCore
-     -- * Prefix
-   , Prefix, noPrefix, makePrefix, replayCore
-   , isEmptyPrefix, majorPrefix, searchModePrefix, prefixPaths
-     -- * Step
-   , Step(..), stepRule, stepEnvironment
-     -- * Path
-   , Path, emptyPath, readPath, readPaths
-   ) where
-
-import Control.Monad
-import Data.Function
-import Data.List
-import Ideas.Common.Classes
-import Ideas.Common.Environment
-import Ideas.Common.Id
-import Ideas.Common.Rule
-import Ideas.Common.Strategy.Choice
-import Ideas.Common.Strategy.Core
-import Ideas.Common.Strategy.Derived
-import Ideas.Common.Strategy.Process
-import Ideas.Common.Strategy.Sequence
-import Ideas.Common.Utils (fst3, splitsWithElem, readM)
-import Ideas.Common.Utils.Uniplate
-
---------------------------------------------------------------------------------
--- Running Core strategies
-
--- | Run a @Core@ strategy and return all results.
-runCore :: Core a -> a -> [a]
-runCore core a = bests $ accum applyAll a $ coreToProcess False core
-
-coreToProcess :: Bool -> Core a -> Process (Step a)
-coreToProcess useLabels = fromAtoms . toProcess . rec . coreSubstAll
- where
-   rec :: Core a -> Builder (Sym (Step a))
-   rec core =
-      case core of
-         a :*: b    -> rec a <*> rec b
-         a :|: b    -> rec a <|> rec b
-         a :>|> b   -> rec a >|> rec b
-         a :|>: b   -> rec a |> rec b
-         Rule r     -> single (Single (RuleStep mempty r))
-         Fail       -> empty
-         Succeed    -> done
-         Label l a
-            | useLabels -> Single (Enter l) ~> rec a
-                           <*> single (Single (Exit l))
-            | otherwise -> rec a
-         a :%: b    -> concurrent switch (rec a) (rec b)
-         a :@: b    -> rec a <@> rec b
-         Atomic a   -> atomic (rec a)
-         Not a      -> notCore a
-         Remove _   -> empty
-         Collapse a -> rec (collapse a)
-         Hide a     -> rec (fmap minor a)
-         Let _ _    -> error "not substituted: let"
-         Var _      -> error "not substituted: var"
-
-   switch (Single (Enter _)) = False
-   switch _ = True
-
-collapse :: Core a -> Core a
-collapse (Label l s) = Rule $ makeRule l (runCore s)
-collapse core = descend collapse core
-
-notCore :: Core a -> Builder (Sym (Step a))
-notCore core = single $ Single $ RuleStep mempty $
-   checkRule "core.not" $ null . runCore core
-
---------------------------------------------------------------------------------
--- Prefix datatype
-
-data Prefix a = Prefix
-   { getPaths  :: [Path]
-   , remainder :: Process (Step a, a, Path)
-   }
-
-instance Show (Prefix a) where
-   show = intercalate ";" . map show . prefixPaths
-
-instance Monoid (Prefix a) where
-   mempty = noPrefix
-   mappend (Prefix xs p) (Prefix ys q) = Prefix (xs ++ ys) (p <|> q)
-
-instance Firsts (Prefix a) where
-   type Elem (Prefix a) = (Step a, a)
-
-   menu = fmap f . menu . remainder
-    where
-      f Done = Done
-      f ((st, a, path) :~> p) = (st, a) :~> Prefix [path] p
-
---------------------------------------------------------------------------------
--- Constructing a prefix
-
--- | The error prefix (i.e., without a location in the strategy).
-noPrefix :: Prefix a
-noPrefix = Prefix [] empty
-
--- | Make a prefix from a core strategy and a start term.
-makePrefix :: Core a -> a -> Prefix a
-makePrefix = snd . replayCore emptyPath
-
--- | Construct a prefix by replaying a path in a core strategy: the third
--- argument is the current term.
-replayCore :: Path -> Core a -> ([Step a], a -> Prefix a)
-replayCore path core =
-   let (acc, p) = runPath path (withPath (coreToProcess True core))
-   in (map fst acc, Prefix [path] . applySteps p)
-
-runPath :: Path -> Process a -> ([a], Process a)
-runPath (Path is) = rec [] is
- where
-   rec acc []     p = (reverse acc, p)
-   rec acc (n:ns) p =
-      case getByIndex n (menu p) of
-         Just (a :~> r) -> rec (a:acc) ns r
-         _ -> ([], empty)
-
-applySteps :: Process (Step a, Path) -> a -> Process (Step a, a, Path)
-applySteps p a0 = prune (isMajor . fst3) (scan f a0 p)
- where
-   f a (RuleStep _ r, path) =
-      [ (b, (RuleStep env r, b, path))
-      | (b, env) <- transApply (transformation r) a
-      ]
-   f a (st, path) = [(a, (st, a, path))]
-
-withPath :: Process a -> Process (a, Path)
-withPath = rec []
- where
-   rec ns = mapWithIndex (menuItem done . f ns) . menu
-
-   f ns n a p =
-      let ms = n:ns
-      in (a, Path (reverse ms)) ~> rec ms p
-
---------------------------------------------------------------------------------
--- Prefix fuctions
-
-isEmptyPrefix :: Prefix a -> Bool
-isEmptyPrefix = all (== emptyPath) . getPaths
-
--- | Transforms the prefix such that only major steps are kept in the remaining
--- strategy.
-majorPrefix :: Prefix a -> Prefix a
-majorPrefix prfx = prfx { remainder = hide (isMajor . fst3) (remainder prfx) }
-
--- | The searchModePrefix transformation changes the process in such a way that
---   all intermediate states can only be reached by one path. A prerequisite is
---   that symbols are unique (or only used once).
-searchModePrefix :: (Step a -> Step a -> Bool) -> Prefix a -> Prefix a
-searchModePrefix eq prfx =
-   prfx { remainder = rec (remainder (majorPrefix prfx)) }
- where
-   eq3 = eq `on` fst3
-
-   rec p | ready p   = done
-         | otherwise = process (firsts p)
-
-   process [] = empty
-   process ((a, p):xs) =
-      let ys = map fst $ firsts (a ~> p)
-      in (a ~> rec p) <|> process (concatMap (change ys) xs)
-
-   change ys (a, q) =
-      let f x = all (not . eq3 x) ys
-      in firsts $ filterP f (a ~> q)
-
--- | Returns the current @Path@.
-prefixPaths :: Prefix a -> [Path]
-prefixPaths = getPaths
-
---------------------------------------------------------------------------------
--- Step
-
--- | The steps during the parsing process: enter (or exit) a labeled
--- sub-strategy, or a rule.
-data Step a = Enter Id                      -- ^ Enter a labeled sub-strategy
-            | Exit Id                       -- ^ Exit a labeled sub-strategy
-            | RuleStep Environment (Rule a) -- ^ Rule that was applied
-   deriving Eq
-
-instance Show (Step a) where
-   show (Enter l) = "enter " ++ showId l
-   show (Exit l)  = "exit " ++ showId l
-   show (RuleStep _ r) = show r
-
-instance Apply Step where
-   applyAll (RuleStep _ r) = applyAll r
-   applyAll _              = return
-
-instance HasId (Step a) where
-   getId (Enter l)      = getId l
-   getId (Exit l)       = getId l
-   getId (RuleStep _ r) = getId r
-
-   changeId f (Enter l)        = Enter (changeId f l)
-   changeId f (Exit l)         = Exit  (changeId f l)
-   changeId f (RuleStep env r) = RuleStep env (changeId f r)
-
-instance Minor (Step a) where
-   setMinor b (RuleStep env r) = RuleStep env (setMinor b r)
-   setMinor _ st = st
-
-   isMinor (RuleStep _ r) = isMinor r
-   isMinor _ = True
-
-stepRule :: Step a -> Rule a
-stepRule (RuleStep _ r) = r
-stepRule (Enter l)      = idRule (l # "enter")
-stepRule (Exit l)       = idRule (l # "exit")
-
-stepEnvironment :: Step a -> Environment
-stepEnvironment (RuleStep env _) = env
-stepEnvironment _ = mempty
-
---------------------------------------------------------------------------------
--- Path
-
--- | A path encodes a location in a strategy. Paths are represented as a list
--- of integers.
-newtype Path = Path [Int]
-   deriving Eq
-
-instance Show Path where
-   show (Path is) = show is
-
--- | The empty path.
-emptyPath :: Path
-emptyPath = Path []
-
-readPath :: Monad m => String -> m Path
-readPath = liftM Path . readM
-
-readPaths :: Monad m => String -> m [Path]
-readPaths = mapM readPath . splitsWithElem ';'

@@ -0,0 +1,173 @@+{-# LANGUAGE TypeFamilies #-}
+-----------------------------------------------------------------------------
+-- Copyright 2015, Ideas project team. This file is distributed under the
+-- terms of the Apache License 2.0. For more information, see the files
+-- "LICENSE.txt" and "NOTICE.txt", which are included in the distribution.
+-----------------------------------------------------------------------------
+-- |
+-- Maintainer  :  bastiaan.heeren@ou.nl
+-- Stability   :  provisional
+-- Portability :  portable (depends on ghc)
+--
+-- Basic machinery for fully executing a strategy expression, or only
+-- partially. Partial execution results in a prefix that keeps the current
+-- locations in the strategy (a list of @Path@s) for continuing the execution
+-- later on. A path can be used to reconstruct the sequence of steps already
+-- performed (a so-called trace). Prefixes can be merged with the Monoid
+-- operation.
+--
+-----------------------------------------------------------------------------
+--  $Id: Prefix.hs 8745 2015-10-15 14:45:46Z bastiaan $
+
+module Ideas.Common.Strategy.Prefix
+   ( -- * Prefix
+     Prefix, noPrefix, makePrefix, firstsOrdered
+   , replayProcess
+   , isEmptyPrefix, majorPrefix, searchModePrefix, prefixPaths
+     -- * Path
+   , Path, emptyPath, readPath, readPaths
+   ) where
+
+import Control.Monad
+import Data.List (intercalate)
+import Ideas.Common.Classes
+import Ideas.Common.Environment
+import Ideas.Common.Id
+import Ideas.Common.Rule
+import Ideas.Common.Strategy.Choice
+import Ideas.Common.Strategy.Process
+import Ideas.Common.Strategy.Sequence
+import Ideas.Common.Utils (splitsWithElem, readM)
+
+--------------------------------------------------------------------------------
+-- Prefix datatype
+
+data Prefix a = Prefix
+   { getPaths  :: [Path]
+   , remainder :: Menu (Rule a) (a, Environment, Prefix a)
+   }
+
+instance Show (Prefix a) where
+   show = intercalate ";" . map show . prefixPaths
+
+instance Monoid (Prefix a) where
+   mempty = noPrefix
+   mappend (Prefix xs p) (Prefix ys q) = Prefix (xs ++ ys) (p .|. q)
+
+instance Firsts (Prefix a) where
+   type Elem (Prefix a) = (Rule a, a, Environment)
+
+   ready  = hasDone . remainder
+   firsts = map reorder . bests . remainder
+
+firstsOrdered :: (Rule a -> Rule a -> Ordering) -> Prefix a -> [((Rule a, a, Environment), Prefix a)]
+firstsOrdered cmp = map reorder . bestsOrdered cmp . remainder
+
+reorder :: (a, (b, env, c)) -> ((a, b, env), c)
+reorder (x, (y, env, z)) = ((x, y, env), z)
+
+--------------------------------------------------------------------------------
+-- Constructing a prefix
+
+-- | The error prefix (i.e., without a location in the strategy).
+noPrefix :: Prefix a
+noPrefix = Prefix [] empty
+
+-- | Make a prefix from a core strategy and a start term.
+makePrefix :: Process (Rule a) -> a -> Prefix a
+makePrefix = snd . replayProcess emptyPath
+
+-- | Construct a prefix by replaying a path in a core strategy: the third
+-- argument is the current term.
+replayProcess :: Path -> Process (Rule a) -> ([Rule a], a -> Prefix a)
+replayProcess (Path is) = replay [] is
+ where
+   replay acc []     p = (reverse acc, createPrefix p)
+   replay acc (n:ns) p =
+      case getByIndex n (menu p) of
+         Just (a, r) -> replay (a:acc) ns r
+         _ -> ([], const noPrefix)
+
+   createPrefix p = Prefix [Path is] . flip (rec []) p
+
+   rec ns a = cut . onMenuWithIndex f doneMenu . menu
+    where
+      f n r p = choice
+         [ r ?~> (b, env, mk b)
+         | (b, env) <- transApply (transformation r) a
+         ]
+       where
+         ms   = n:ns
+         path = Path (is ++ reverse ms)
+         mk b = Prefix [path] (rec ms b p)
+
+         x ?~> y@(_, _, q)
+            | isMinor r && stopped q = empty
+            | otherwise = x |-> y
+
+stopped :: Prefix a -> Bool
+stopped = isEmpty . remainder
+
+--------------------------------------------------------------------------------
+-- Prefix fuctions
+
+isEmptyPrefix :: Prefix a -> Bool
+isEmptyPrefix = all (== emptyPath) . getPaths
+
+-- | Transforms the prefix such that only major steps are kept in the remaining
+-- strategy.
+majorPrefix :: Prefix a -> Prefix a
+majorPrefix prfx = prfx { remainder = onMenu f doneMenu (remainder prfx) }
+ where
+   f r (a, env, p)
+      | isMajor r = r |-> (a, env, majorPrefix p)
+      | otherwise = remainder (majorPrefix p)
+
+-- | The searchModePrefix transformation changes the process in such a way that
+--   all intermediate states can only be reached by one path. A prerequisite is
+--   that symbols are unique (or only used once).
+searchModePrefix :: Prefix a -> Prefix a
+searchModePrefix prfx =
+   prfx { remainder = rec (remainder (majorPrefix prfx)) }
+ where
+   rec m | hasDone m = doneMenu
+         | otherwise = process (bests m)
+
+   process [] = empty
+   process ((r, (a, env, pr)):xs) =
+      (r |-> (a, env, pr { remainder = rec (remainder pr) }))
+      .|. process (concatMap (change r) xs)
+
+   change y (r, pair) =
+      bests (filterPrefix (/= y) r pair)
+
+filterPrefix :: (Rule a -> Bool) -> Rule a -> (a, Environment, Prefix a) -> Menu (Rule a) (a, Environment, Prefix a)
+filterPrefix cond = f
+ where
+   rec = onMenu f doneMenu
+   f r (a, env, pr) = if cond r then r |-> (a, env, pr { remainder = rec (remainder pr) }) else empty
+
+-- | Returns the current @Path@.
+prefixPaths :: Prefix a -> [Path]
+prefixPaths = getPaths
+
+--------------------------------------------------------------------------------
+-- Path
+
+-- | A path encodes a location in a strategy. Paths are represented as a list
+-- of integers.
+newtype Path = Path [Int]
+   deriving Eq
+
+instance Show Path where
+   show (Path is) = show is
+
+-- | The empty path.
+emptyPath :: Path
+emptyPath = Path []
+
+readPath :: Monad m => String -> m Path
+readPath = liftM Path . readM
+
+readPaths :: Monad m => String -> m [Path]
+readPaths = mapM readPath . splitsWithElem ';'

@@ -1,156 +1,93 @@ {-# LANGUAGE TypeFamilies #-}
 -----------------------------------------------------------------------------
--- Copyright 2015, Open Universiteit Nederland. This file is distributed
--- under the terms of the GNU General Public License. For more information,
--- see the file "LICENSE.txt", which is included in the distribution.
+-- Copyright 2015, Ideas project team. This file is distributed under the
+-- terms of the Apache License 2.0. For more information, see the files
+-- "LICENSE.txt" and "NOTICE.txt", which are included in the distribution.
 -----------------------------------------------------------------------------
 -- |
 -- Maintainer  :  bastiaan.heeren@ou.nl
 -- Stability   :  provisional
 -- Portability :  portable (depends on ghc)
 --
--- Processes must support choices and sequences. This module defines a type
--- class, an implementation, and utility functions.
+-- Processes support choices and sequences and are modelled after Hoare's CSP
+-- calculus.
 --
 -----------------------------------------------------------------------------
---  $Id: Process.hs 7524 2015-04-08 07:31:15Z bastiaan $
+--  $Id: Process.hs 8758 2015-10-22 06:48:52Z bastiaan $
 
 module Ideas.Common.Strategy.Process
-   ( -- * IsProcess type class
-     IsProcess(..)
-     -- * Process data type
-   , Process, menu, eqProcessBy
-     -- * Building sequences
-   , Builder
-     -- * Query functions on a Process
-   , ready, stopped, firsts
-     -- * Higher-order functions for iterating over a Process
-   , fold, accum, scan, prune
+   ( Process, eqProcessBy, menu, withMenu
+   , fold, runProcess
    ) where
 
+import Ideas.Common.Classes
 import Ideas.Common.Strategy.Choice
 import Ideas.Common.Strategy.Sequence
 
 ------------------------------------------------------------------------
--- IsProcess type class
-
-class (Choice f, Sequence f) => IsProcess f where
-   -- | Convert to the 'Process' data type.
-   toProcess :: f a -> Process a
-
-------------------------------------------------------------------------
 -- Process data type
 
--- | This datatype implements choices and sequences, but is slow for
--- building sequences with the '<*>' combinator. See the 'Builder' data
--- type for a faster alternative.
-newtype Process a = P (Menu (MenuItem a (Process a)))
+-- | Process data type with efficient support for sequences
+newtype Process a = P [Menu a (Process a)]
 
 instance Eq a => Eq (Process a) where
    (==) = eqProcessBy (==)
 
 instance Functor Process where
-   fmap f (P m) = P (fmap g m)
+   fmap f = rec
     where
-      g Done = Done
-      g (a :~> p) = f a :~> fmap f p
+      rec (P xs) = P (map g xs)
+      g = onMenu (\a q -> f a |-> rec q) doneMenu
 
-instance Choice Process where
-   single a = P (single (a :~> P (single Done)))
-   empty    = P empty
-   P x <|> P y = P (x <|> y)
-   P x >|> P y = P (x >|> y)
-   P x  |> P y = P (x |> y)
+instance Choice (Process a) where
+   empty   = P [empty]
+   x .|. y = P [menu x .|. menu y]
+   x ./. y = P [menu x ./. menu y]
+   x |>  y = P [menu x |>  menu y]
 
-instance Sequence Process where
-   done   = P (return Done)
-   a ~> p = P (return (a :~> p))
+instance Sequence (Process a) where
+   type Sym (Process a) = a
 
-   p0 <*> P rest = rec p0
-    where
-      rec (P m) = P $ do
-         st <- m -- cutOn (menuItem True (\_ _ -> False)) m
-         case st of
-            a :~> p -> return (a :~> rec p)
-            Done    -> rest
+   done = P []
+   a ~> b = P [a |-> b]
+   P xs .*. P ys = P (xs ++ ys)
+   sequence ps = P [ x | P xs <- ps, x <- xs ]
 
-instance IsProcess Process where
-   toProcess = id
+instance Fix (Process a)
 
 instance Firsts (Process a) where
    type Elem (Process a) = a
 
-   menu (P m) = m
+   firsts = bests . menu
+   ready  = hasDone . menu
 
--- | Generalized equality of processes, which takes an equality function for
--- the symbols.
-eqProcessBy :: (a -> a -> Bool) -> Process a -> Process a -> Bool
-eqProcessBy eq = rec
+runProcess :: Apply f => Process (f a) -> a -> [a]
+runProcess p a = withMenu op [a] p
  where
-   rec p q = eqMenuBy eqStep (menu p) (menu q)
-
-   eqStep (a :~> p) (b :~> q) = eq a b && rec p q
-   eqStep Done      Done      = True
-   eqStep _         _         = False
-
-------------------------------------------------------------------------
--- Building sequences
-
--- | The 'Builder' data type offers a fast implementation for building
--- sequences. The data type implements the 'IsProcess' type class.
--- A 'Builder' value must be converted to a 'Process' (with 'toProcess')
--- it can be inspected in any way.
-
-newtype Builder a = B (Process a -> Process a)
-
-instance Choice Builder where
-   single a = B (a ~>)
-   empty    = B (const empty)
-   B f <|> B g = B (\p -> f p <|> g p)
-   B f >|> B g = B (\p -> f p >|> g p)
-   B f  |> B g = B (\p -> f p  |> g p)
-
-instance Sequence Builder where
-   done        = B id
-   a ~> B f    = B ((a ~>) . f)
-   B f <*> B g = B (f . g)
-
-instance IsProcess Builder where
-   toProcess (B f) = f done
-
-------------------------------------------------------------------------
--- Higher-order functions for iterating over a Process
+   op f x = [ c | b <- applyAll f a, c <- runProcess x b ]
 
--- | Folding over a process takes a function for single steps and for 'done'.
-{-# INLINE fold #-}
-fold :: Choice f => (a -> f b -> f b) -> f b -> Process a -> f b
-fold op e = rec
+menu :: Process a -> Menu a (Process a)
+menu (P zs) = rec zs
  where
-   rec = onMenu (menuItem e (\a -> op a . rec)) . menu
+   rec []     = doneMenu
+   rec [x]    = x
+   rec (x:xs) = onMenu (\a (P ys) -> a |-> P (ys ++ xs)) (rec xs) x
 
-{-# INLINE accum #-}
-accum :: (a -> b -> [b]) -> b -> Process a -> Menu b
-accum f = rec
+withMenu :: Choice b => (a -> Process a -> b) -> b -> Process a -> b
+withMenu op e (P zs) = rec zs
  where
-   rec b p = menu p >>= g
-    where
-      g Done      = single b
-      g (a :~> q) = choice [ rec b2 q  | b2 <- f a b ]
+   rec []     = e
+   rec [x]    = onMenu op e x
+   rec (x:xs) = onMenu (\a (P ys) -> op a (P (ys ++ xs))) (rec xs) x
 
-{-# INLINE scan #-}
-scan :: (s -> a -> [(s, b)]) -> s -> Process a -> Process b
-scan op = rec
+-- | Generalized equality of processes, which takes an equality function for
+-- the symbols.
+eqProcessBy :: (a -> a -> Bool) -> Process a -> Process a -> Bool
+eqProcessBy eq = rec
  where
-   rec s =
-      let f a q = choice [ b ~> rec s2 q | (s2, b) <- op s a ]
-      in onMenu (menuItem done f) . menu
+   rec p q = eqMenuBy eq rec (menu p) (menu q)
 
--- fail early
-prune :: (a -> Bool) -> Process a -> Process a
-prune f = fold op done
+fold :: Choice b => (a -> b -> b) -> b -> Process a -> b
+fold op e = rec
  where
-   op a p
-      | not (f a) && stopped np = empty
-      | otherwise               = a ~> np
-    where
-      np = P (cut (menu p))+   rec = withMenu (\a -> op a . rec) e

@@ -1,46 +1,57 @@ {-# LANGUAGE TypeFamilies #-}
 -----------------------------------------------------------------------------
--- Copyright 2015, Open Universiteit Nederland. This file is distributed
--- under the terms of the GNU General Public License. For more information,
--- see the file "LICENSE.txt", which is included in the distribution.
+-- Copyright 2015, Ideas project team. This file is distributed under the
+-- terms of the Apache License 2.0. For more information, see the files
+-- "LICENSE.txt" and "NOTICE.txt", which are included in the distribution.
 -----------------------------------------------------------------------------
 -- |
 -- Maintainer  :  bastiaan.heeren@ou.nl
 -- Stability   :  provisional
 -- Portability :  portable (depends on ghc)
 --
--- A type class for sequences together with the 'Step' datatype.
+-- A type class for sequences together with the 'Firsts' type class for
+-- accessing the firsts set and ready predicate.
 --
 -----------------------------------------------------------------------------
---  $Id: Sequential.hs 6612 2014-06-12 07:57:59Z bastiaan $
+--  $Id: Sequence.hs 8758 2015-10-22 06:48:52Z bastiaan $
 
 module Ideas.Common.Strategy.Sequence
    ( -- * Sequence type class
      Sequence(..)
      -- * Firsts type class
-   , Firsts(..), firstsMenu, firstsOrdered, firstsTree, stopped
-     -- * MenuItem data type with some utility functions
-   , MenuItem(..), menuItem, isDone
+   , Firsts(..), firstsTree
    ) where
 
-import Data.Function
-import Ideas.Common.Classes
 import Ideas.Common.DerivationTree
-import Ideas.Common.Strategy.Choice
 
-infixr 5 :~>, ~>, <*>
+infixr 5 .*., ~>
 
 ------------------------------------------------------------------------
 -- Sequence type class
 
-class Sequence f where
+class Sequence a where
+   type Sym a
    -- | The empty sequence.
-   done :: f a
-   -- | Prefix a sequence with one element.
-   (~>) :: a -> f a -> f a
+   done :: a
+   -- | Prepend a symbol to a sequence.
+   (~>) :: Sym a -> a -> a
    -- | Append two sequences.
-   (<*>) :: f a -> f a -> f a
+   (.*.) :: a -> a -> a
+   -- | Singleton sequence.
+   single :: Sym a -> a
+   single s = s ~> done
+   -- | Sequential composition.
+   sequence :: [a] -> a
+   sequence xs = if null xs then done else foldr1 (.*.) xs
 
+instance Sequence b => Sequence (a -> b) where
+   type Sym (a -> b) = Sym b
+
+   done   = const done
+   single = const . single
+   a ~> f = (a ~>) . f
+   (f .*. g) x = f x .*. g x
+
 ------------------------------------------------------------------------
 -- Firsts type class
 
@@ -49,53 +60,11 @@    type Elem s
    -- | The ready predicate (we are done).
    ready :: s -> Bool
-   ready = any isDone . bests . menu
-   -- | The first set.
+   -- | The firsts set.
    firsts :: s -> [(Elem s, s)]
-   firsts = bests . firstsMenu
-   -- | The menu offers single steps (with the remainder) and 'done' steps.
-   menu :: s -> Menu (MenuItem (Elem s) s)
 
-firstsMenu :: Firsts s => s -> Menu (Elem s, s)
-firstsMenu s = do
-   item <- cut (menu s)
-   case item of
-      a :~> t -> return (a, t)
-      Done    -> empty
-
-firstsOrdered :: Firsts s => (Elem s -> Elem s -> Ordering)
-              -> s -> [(Elem s, s)]
-firstsOrdered cmp = bestsOrdered (cmp `on` fst) . firstsMenu
-
 firstsTree :: Firsts s => s -> DerivationTree (Elem s) s
 firstsTree x = addBranches bs tr
  where
    tr = singleNode x (ready x)
-   bs = [ (a, firstsTree y) | (a, y) <- firsts x ]
-
--- | Not ready and no further steps to take.
-stopped :: Firsts s => s -> Bool
-stopped = isEmpty . menu
-
-------------------------------------------------------------------------
--- MenuItem data type with some utility functions
-
-data MenuItem a s = a :~> s   -- ^ A single step.
-                  | Done      -- ^ No step (we are done).
-
-instance Functor (MenuItem a) where
-   fmap = mapSecond
-
-instance BiFunctor MenuItem where
-   biMap f g = menuItem Done (\a s -> f a :~> g s)
-
--- | The 'menuItem' function takes a default value for 'Done' and a function
--- to combine the values for a single step.
-menuItem :: b -> (a -> s -> b) -> MenuItem a s -> b
-menuItem b _ Done      = b
-menuItem _ f (a :~> x) = f a x
-
--- | Is the item 'done'?
-isDone :: MenuItem a s -> Bool
-isDone Done = True
-isDone _    = False+   bs = [ (a, firstsTree y) | (a, y) <- firsts x ]

@@ -0,0 +1,115 @@+{-# LANGUAGE RankNTypes #-}
+-----------------------------------------------------------------------------
+-- Copyright 2015, Ideas project team. This file is distributed under the
+-- terms of the Apache License 2.0. For more information, see the files
+-- "LICENSE.txt" and "NOTICE.txt", which are included in the distribution.
+-----------------------------------------------------------------------------
+-- |
+-- Maintainer  :  bastiaan.heeren@ou.nl
+-- Stability   :  provisional
+-- Portability :  portable (depends on ghc)
+--
+-- Representation of a strategy as a cyclic tree with explicit fixed-points.
+-- The nodes in the tree are named strategy combinators. The leafs are rules.
+--
+-----------------------------------------------------------------------------
+--  $Id: StrategyTree.hs 8758 2015-10-22 06:48:52Z bastiaan $
+
+module Ideas.Common.Strategy.StrategyTree
+   ( -- * StrategyTree type synonym
+     StrategyTree
+     -- * Declarations (named combinators)
+   , Decl, Combinator, associative, isAssociative, combinator
+   ,  (.=.), applyDecl
+     -- * Arities
+   , Arity(..), Nullary(..), Unary(..), Binary(..), Nary(..)
+   ) where
+
+import Data.Function
+import Data.Maybe
+import Ideas.Common.CyclicTree
+import Ideas.Common.Id
+import Ideas.Common.Rule
+import Ideas.Common.Strategy.Choice
+import Ideas.Common.Strategy.Process
+import Ideas.Common.View
+
+infix 1 .=.
+
+------------------------------------------------------------------------------
+
+type StrategyTree a = CyclicTree (Decl Nary) (Rule a)
+
+applyDecl :: Arity f => Decl f -> f (StrategyTree a)
+applyDecl d = toArity (node (d {combinator = op}) . make)
+ where
+   op = Nary $ fromMaybe empty . listify (combinator d)
+
+   make | isAssociative d = concatMap collect
+        | otherwise       = id
+
+   collect a  =
+      case isNode a of
+         Just (da, as) | getId da == getId d -> as
+         _ -> [a]
+
+------------------------------------------------------------------------------
+
+type Combinator f = forall a . f (Process (Rule a))
+
+data Decl f = C
+   { declId        :: Id
+   , combinator    :: Combinator f
+   , isAssociative :: Bool
+   }
+
+instance Show (Decl f) where
+   show = showId
+
+instance Eq (Decl f) where
+   (==) = (==) `on` getId
+
+instance HasId (Decl f) where
+   getId = declId
+   changeId f d = d { declId = f (declId d) }
+
+(.=.) :: IsId n => n -> Combinator f -> Decl f
+n .=. f = C (newId n) f False
+
+associative :: Decl f -> Decl f
+associative c = c {isAssociative = True}
+
+------------------------------------------------------------------------------
+
+class Arity f where
+   listify :: f a -> [a] -> Maybe a
+   toArity :: ([a] -> a) -> f a
+   liftIso :: Isomorphism a b -> f a -> f b
+
+data Nullary a = Nullary { fromNullary :: a }
+data Unary   a = Unary   { fromUnary   :: a -> a }
+data Binary  a = Binary  { fromBinary  :: a -> a -> a }
+data Nary    a = Nary    { fromNary    :: [a] -> a }
+
+instance Arity Nullary where
+   listify (Nullary a) [] = Just a
+   listify _ _ = Nothing
+   toArity f = Nullary (f [])
+   liftIso p (Nullary a) = Nullary (from p a)
+
+instance Arity Unary where
+   listify (Unary f) [x] = Just (f x)
+   listify _ _ = Nothing
+   toArity f = Unary (\x -> f [x])
+   liftIso p (Unary f) = Unary (from p . f . to p)
+
+instance Arity Binary where
+   listify (Binary f) [x, y] = Just (f x y)
+   listify _ _ = Nothing
+   toArity f = Binary (\x y -> f [x, y])
+   liftIso p (Binary f) = Binary (\x y -> from p (f (to p x) (to p y)))
+
+instance Arity Nary where
+   listify (Nary f) = Just . f
+   toArity = Nary
+   liftIso p (Nary f) = Nary (from p . f . map (to p))

@@ -0,0 +1,62 @@+-----------------------------------------------------------------------------
+-- Copyright 2015, Ideas project team. This file is distributed under the
+-- terms of the Apache License 2.0. For more information, see the files
+-- "LICENSE.txt" and "NOTICE.txt", which are included in the distribution.
+-----------------------------------------------------------------------------
+-- |
+-- Maintainer  :  bastiaan.heeren@ou.nl
+-- Stability   :  provisional
+-- Portability :  portable (depends on ghc)
+--
+-- This module defines special symbols for labeling and atomicity.
+--
+-----------------------------------------------------------------------------
+--  $Id: Symbol.hs 8747 2015-10-15 14:54:48Z bastiaan $
+
+module Ideas.Common.Strategy.Symbol
+   ( AtomicSymbol(..), LabelSymbol(..)
+   , enterRule, exitRule, isEnterRule, isExitRule
+   ) where
+
+import Control.Monad
+import Data.List
+import Data.Maybe
+import Ideas.Common.Id
+import Ideas.Common.Rule
+
+--------------------------------------------------------------------------------
+-- Step
+
+class Eq a => AtomicSymbol a where
+   atomicOpen, atomicClose :: a
+
+instance AtomicSymbol (Rule a) where
+   atomicOpen  = idRule "atomic.open"
+   atomicClose = idRule "atomic.close"
+
+class Eq a => LabelSymbol a where
+   isEnterSymbol :: a -> Bool
+
+instance LabelSymbol (Rule a) where
+   isEnterSymbol = isJust . isEnterRule
+
+enterRule :: Id -> Rule a
+enterRule l = idRule (l # "enter")
+
+exitRule :: Id -> Rule a
+exitRule l = idRule (l # "exit")
+
+isEnterRule :: Rule a -> Maybe Id
+isEnterRule st = do
+   let n = getId st
+   guard (unqualified n == "enter")
+   return (initId n)
+
+isExitRule :: Rule a -> Maybe Id
+isExitRule st = do
+   let n = getId st
+   guard (unqualified n == "exit")
+   return (initId n)
+
+initId :: Id -> Id
+initId = newId . intercalate "." . qualifiers

@@ -1,36 +1,44 @@ -----------------------------------------------------------------------------
--- Copyright 2015, Open Universiteit Nederland. This file is distributed
--- under the terms of the GNU General Public License. For more information,
--- see the file "LICENSE.txt", which is included in the distribution.
+-- Copyright 2015, Ideas project team. This file is distributed under the
+-- terms of the Apache License 2.0. For more information, see the files
+-- "LICENSE.txt" and "NOTICE.txt", which are included in the distribution.
 -----------------------------------------------------------------------------
 -- |
 -- Maintainer  :  bastiaan.heeren@ou.nl
 -- Stability   :  provisional
 -- Portability :  portable (depends on ghc)
 --
+-- Parameterized traversals based on the strategy language.
+--
 -----------------------------------------------------------------------------
---  $Id: Traversal.hs 7524 2015-04-08 07:31:15Z bastiaan $
+--  $Id: Traversal.hs 8745 2015-10-15 14:45:46Z bastiaan $
 
 module Ideas.Common.Strategy.Traversal
-   ( layer, traverse, Option
+   ( -- * Parameterized traversals
+     layer, traverse
      -- * Options
+   , Option
    , topdown, bottomup, leftToRight, rightToLeft
    , full, spine, stop, once, leftmost, rightmost
    , traversalFilter, parentFilter
      -- * One-pass traversals
-   , fulltd, fullbu, oncetd, oncebu, leftmostbu, leftmosttd, somewhere
+   , fulltd, fullbu, oncetd, oncebu, leftmostbu, leftmosttd
+   , somewhere, somewhereWhen
    , oncetdPref, oncebuPref
      -- * Fixpoint traversals
    , innermost, outermost
-   , ruleDown, ruleDownLast, ruleUp
+     -- * Navigator rules
+   , ruleUp, ruleDown, ruleDownLast, ruleLeft, ruleRight
    ) where
 
 import Data.Monoid
+import Ideas.Common.Classes
 import Ideas.Common.Rule
 import Ideas.Common.Strategy.Abstract
 import Ideas.Common.Strategy.Combinators
 import Ideas.Common.Traversal.Navigator
 import Prelude hiding (repeat, not)
+import qualified Prelude
 
 ----------------------------------------------------------------------
 -- One-layer combinators
@@ -40,11 +48,11 @@ visit :: (IsStrategy f, IsStrategy g) => Visit -> f a -> g a -> Strategy a
 visit v next s = fix $ \a ->
    case v of
-      VisitFirst -> s  |> next <*> a
-      VisitOne   -> s <|> next <*> a
-      VisitSome  -> s <*> try (next <*> visit VisitMany next s) <|> next <*> a
-      VisitAll   -> s <*> (not next |> (next <*> a))
-      VisitMany  -> try s <*> (not next |> (next <*> a))
+      VisitFirst -> s  |> next .*. a
+      VisitOne   -> s .|. next .*. a
+      VisitSome  -> s .*. try (next .*. visit VisitMany next s) .|. next .*. a
+      VisitAll   -> s .*. (not next |> (next .*. a))
+      VisitMany  -> try s .*. (not next |> (next .*. a))
 
 ----------------------------------------------------------------------
 -- Parameterized traversals
@@ -54,7 +62,7 @@ 
 layerWith :: (IsStrategy f, Navigator a) => Info a -> f a -> Strategy a
 layerWith tr s =
-   goDown <*> findOk <*> visit (getVisit tr) (next <*> findOk) s <*> try ruleUp
+   goDown .*. findOk .*. visit (getVisit tr) (next .*. findOk) s .*. try ruleUp
  where
    (next, goDown)
       | getReversed tr = (ruleLeft, ruleDownLast)
@@ -63,7 +71,7 @@    findOk =
       case getFilters tr of
          [] -> succeed
-         ps -> fix $ \a -> check (\x -> all ($ x) ps) |> (next <*> a)
+         ps -> fix $ \a -> check (\x -> all ($ x) ps) |> (next .*. a)
 
 traverse :: (IsStrategy f, Navigator a) => [Option a] -> f a -> Strategy a
 traverse = traverseWith . fromOptions
@@ -71,30 +79,30 @@ traverseWith :: (IsStrategy f, Navigator a) => Info a -> f a -> Strategy a
 traverseWith tr s =
    fix $ \a ->
-   case getCombinator tr of
+   case getOp tr of
       Sequence
-         | getTopDown tr -> s <*> (descend a <|> check isLeaf)
-         | otherwise     -> (descend a <|> check isLeaf) <*> s
+         | getTopDown tr -> s .*. (descend a .|. check isLeaf)
+         | otherwise     -> (descend a .|. check isLeaf) .*. s
       OrElse
          | getTopDown tr -> s |> descend a
          | otherwise     -> descend a |> s
       Prefer
-         | getTopDown tr -> s >|> descend a
-         | otherwise     -> descend a >|> s
-      Choice             -> s <|> descend a
+         | getTopDown tr -> s ./. descend a
+         | otherwise     -> descend a ./. s
+      Choice             -> s .|. descend a
  where
    descend = layerWith tr
 
 -----------------------------------------------------------------------
 
-data Combinator = Sequence | OrElse | Choice | Prefer
+data Op = Sequence | OrElse | Choice | Prefer
 
 data Info a = Info
-   { getVisit      :: Visit
-   , getCombinator :: Combinator
-   , getFilters    :: [a -> Bool]
-   , getTopDown    :: Bool
-   , getReversed   :: Bool
+   { getVisit    :: Visit
+   , getOp       :: Op
+   , getFilters  :: [a -> Bool]
+   , getTopDown  :: Bool
+   , getReversed :: Bool
    }
 
 newtype Option a = O { unO :: Info a -> Info a }
@@ -115,20 +123,20 @@ rightToLeft = O $ \t -> t {getReversed = True}
 
 full, spine, stop, once :: Option a
-full  = setCombinator Sequence `mappend` setVisit VisitAll
-spine = setCombinator Sequence `mappend` setVisit VisitOne
-stop  = setCombinator OrElse   `mappend` setVisit VisitAll
-once  = setCombinator OrElse   `mappend` setVisit VisitOne
+full  = setOp Sequence `mappend` setVisit VisitAll
+spine = setOp Sequence `mappend` setVisit VisitOne
+stop  = setOp OrElse   `mappend` setVisit VisitAll
+once  = setOp OrElse   `mappend` setVisit VisitOne
 
 leftmost, rightmost :: Option a
-leftmost  = leftToRight <> setCombinator OrElse
-rightmost = rightToLeft <> setCombinator OrElse
+leftmost  = leftToRight <> setOp OrElse
+rightmost = rightToLeft <> setOp OrElse
 
 setVisit :: Visit -> Option a
 setVisit v = O $ \t -> t {getVisit = v}
 
-setCombinator :: Combinator -> Option a
-setCombinator c = O $ \t -> t {getCombinator = c}
+setOp :: Op -> Option a
+setOp c = O $ \t -> t {getOp = c}
 
 traversalFilter :: (a -> Bool) -> Option a
 traversalFilter ok = O $ \t -> t {getFilters = ok:getFilters t}
@@ -151,22 +159,27 @@ oncetd = traverse [once, topdown]
 
 oncetdPref :: (IsStrategy f, Navigator a) => f a -> Strategy a
-oncetdPref = traverse [setCombinator Prefer, once, topdown]
+oncetdPref = traverse [setOp Prefer, once, topdown]
 
 oncebu :: (IsStrategy f, Navigator a) => f a -> Strategy a
 oncebu = traverse [once, bottomup]
 
 oncebuPref :: (IsStrategy f, Navigator a) => f a -> Strategy a
-oncebuPref = traverse [setCombinator Prefer, once, bottomup]
+oncebuPref = traverse [setOp Prefer, once, bottomup]
 
 leftmostbu :: (IsStrategy f, Navigator a) => f a -> Strategy a
-leftmostbu = traverse [setCombinator OrElse, setVisit VisitFirst, bottomup]
+leftmostbu = traverse [setOp OrElse, setVisit VisitFirst, bottomup]
 
 leftmosttd :: (IsStrategy f, Navigator a) => f a -> Strategy a
-leftmosttd = traverse [setCombinator OrElse, setVisit VisitFirst, topdown]
+leftmosttd = traverse [setOp OrElse, setVisit VisitFirst, topdown]
 
 somewhere :: (IsStrategy f, Navigator a) => f a -> Strategy a
 somewhere = traverse []
+
+-- as long as the predicate does not hold, go to the next layer
+somewhereWhen :: (IsStrategy g, Navigator a) => (a -> Bool) -> g a -> Strategy a
+somewhereWhen p s = fix $ \this ->
+   check p .*. s .|. check (Prelude.not . p) .*. layer [] this
 
 ----------------------------------------------------------------------
 -- fixpoint traverses

@@ -1,8 +1,8 @@ {-# LANGUAGE TypeFamilies #-}
 -----------------------------------------------------------------------------
--- Copyright 2015, Open Universiteit Nederland. This file is distributed
--- under the terms of the GNU General Public License. For more information,
--- see the file "LICENSE.txt", which is included in the distribution.
+-- Copyright 2015, Ideas project team. This file is distributed under the
+-- terms of the Apache License 2.0. For more information, see the files
+-- "LICENSE.txt" and "NOTICE.txt", which are included in the distribution.
 -----------------------------------------------------------------------------
 -- |
 -- Maintainer  :  bastiaan.heeren@ou.nl
@@ -10,7 +10,7 @@ -- Portability :  portable (depends on ghc)
 --
 -----------------------------------------------------------------------------
---  $Id: Iterator.hs 7524 2015-04-08 07:31:15Z bastiaan $
+--  $Id: Iterator.hs 8740 2015-10-14 19:26:22Z bastiaan $
 
 module Ideas.Common.Traversal.Iterator
    ( -- * Iterator type class

@@ -1,8 +1,8 @@ {-# LANGUAGE TypeFamilies, GeneralizedNewtypeDeriving #-}
 -----------------------------------------------------------------------------
--- Copyright 2015, Open Universiteit Nederland. This file is distributed
--- under the terms of the GNU General Public License. For more information,
--- see the file "LICENSE.txt", which is included in the distribution.
+-- Copyright 2015, Ideas project team. This file is distributed under the
+-- terms of the Apache License 2.0. For more information, see the files
+-- "LICENSE.txt" and "NOTICE.txt", which are included in the distribution.
 -----------------------------------------------------------------------------
 -- |
 -- Maintainer  :  bastiaan.heeren@ou.nl
@@ -10,7 +10,7 @@ -- Portability :  portable (depends on ghc)
 --
 -----------------------------------------------------------------------------
---  $Id: Navigator.hs 7524 2015-04-08 07:31:15Z bastiaan $
+--  $Id: Navigator.hs 8740 2015-10-14 19:26:22Z bastiaan $
 
 module Ideas.Common.Traversal.Navigator
    ( -- * Location information

@@ -1,7 +1,7 @@ -----------------------------------------------------------------------------
--- Copyright 2015, Open Universiteit Nederland. This file is distributed
--- under the terms of the GNU General Public License. For more information,
--- see the file "LICENSE.txt", which is included in the distribution.
+-- Copyright 2015, Ideas project team. This file is distributed under the
+-- terms of the Apache License 2.0. For more information, see the files
+-- "LICENSE.txt" and "NOTICE.txt", which are included in the distribution.
 -----------------------------------------------------------------------------
 -- |
 -- Maintainer  :  bastiaan.heeren@ou.nl
@@ -9,7 +9,7 @@ -- Portability :  portable (depends on ghc)
 --
 -----------------------------------------------------------------------------
---  $Id: Tests.hs 7524 2015-04-08 07:31:15Z bastiaan $
+--  $Id: Tests.hs 8740 2015-10-14 19:26:22Z bastiaan $
 
 module Ideas.Common.Traversal.Tests
    ( testIterator, testNavigator, tests

@@ -1,8 +1,8 @@ {-# LANGUAGE TypeFamilies #-}
 -----------------------------------------------------------------------------
--- Copyright 2015, Open Universiteit Nederland. This file is distributed
--- under the terms of the GNU General Public License. For more information,
--- see the file "LICENSE.txt", which is included in the distribution.
+-- Copyright 2015, Ideas project team. This file is distributed under the
+-- terms of the Apache License 2.0. For more information, see the files
+-- "LICENSE.txt" and "NOTICE.txt", which are included in the distribution.
 -----------------------------------------------------------------------------
 -- |
 -- Maintainer  :  bastiaan.heeren@ou.nl
@@ -10,7 +10,7 @@ -- Portability :  portable (depends on ghc)
 --
 -----------------------------------------------------------------------------
---  $Id: Utils.hs 7524 2015-04-08 07:31:15Z bastiaan $
+--  $Id: Utils.hs 8740 2015-10-14 19:26:22Z bastiaan $
 
 module Ideas.Common.Traversal.Utils
    ( -- * Update type class

@@ -1,8 +1,8 @@ {-# LANGUAGE ExistentialQuantification #-}
 -----------------------------------------------------------------------------
--- Copyright 2015, Open Universiteit Nederland. This file is distributed
--- under the terms of the GNU General Public License. For more information,
--- see the file "LICENSE.txt", which is included in the distribution.
+-- Copyright 2015, Ideas project team. This file is distributed under the
+-- terms of the Apache License 2.0. For more information, see the files
+-- "LICENSE.txt" and "NOTICE.txt", which are included in the distribution.
 -----------------------------------------------------------------------------
 -- |
 -- Maintainer  :  bastiaan.heeren@ou.nl
@@ -12,7 +12,7 @@ -- A collection of general utility functions
 --
 -----------------------------------------------------------------------------
---  $Id: Utils.hs 7524 2015-04-08 07:31:15Z bastiaan $
+--  $Id: Utils.hs 8740 2015-10-14 19:26:22Z bastiaan $
 
 module Ideas.Common.Utils
    ( Some(..), ShowString(..), readInt, readM

@@ -1,7 +1,7 @@ -----------------------------------------------------------------------------
--- Copyright 2015, Open Universiteit Nederland. This file is distributed
--- under the terms of the GNU General Public License. For more information,
--- see the file "LICENSE.txt", which is included in the distribution.
+-- Copyright 2015, Ideas project team. This file is distributed under the
+-- terms of the Apache License 2.0. For more information, see the files
+-- "LICENSE.txt" and "NOTICE.txt", which are included in the distribution.
 -----------------------------------------------------------------------------
 -- |
 -- Maintainer  :  bastiaan.heeren@ou.nl
@@ -11,7 +11,7 @@ -- Extensions to the QuickCheck library
 --
 -----------------------------------------------------------------------------
---  $Id: QuickCheck.hs 7524 2015-04-08 07:31:15Z bastiaan $
+--  $Id: QuickCheck.hs 8740 2015-10-14 19:26:22Z bastiaan $
 
 module Ideas.Common.Utils.QuickCheck
    ( module Test.QuickCheck

@@ -1,9 +1,8 @@ {-# LANGUAGE DeriveDataTypeable #-}
-
 -----------------------------------------------------------------------------
--- Copyright 2015, Open Universiteit Nederland. This file is distributed
--- under the terms of the GNU General Public License. For more information,
--- see the file "LICENSE.txt", which is included in the distribution.
+-- Copyright 2015, Ideas project team. This file is distributed under the
+-- terms of the Apache License 2.0. For more information, see the files
+-- "LICENSE.txt" and "NOTICE.txt", which are included in the distribution.
 -----------------------------------------------------------------------------
 -- |
 -- Maintainer  :  bastiaan.heeren@ou.nl
@@ -15,7 +14,7 @@ -- Virutal Machine (LVM) identifiers.
 --
 -----------------------------------------------------------------------------
---  $Id: StringRef.hs 7524 2015-04-08 07:31:15Z bastiaan $
+--  $Id: StringRef.hs 8740 2015-10-14 19:26:22Z bastiaan $
 
 module Ideas.Common.Utils.StringRef
    ( StringRef, stringRef, toString, tableStatus

@@ -1,7 +1,7 @@ -----------------------------------------------------------------------------
--- Copyright 2015, Open Universiteit Nederland. This file is distributed
--- under the terms of the GNU General Public License. For more information,
--- see the file "LICENSE.txt", which is included in the distribution.
+-- Copyright 2015, Ideas project team. This file is distributed under the
+-- terms of the Apache License 2.0. For more information, see the files
+-- "LICENSE.txt" and "NOTICE.txt", which are included in the distribution.
 -----------------------------------------------------------------------------
 -- |
 -- Maintainer  :  bastiaan.heeren@ou.nl
@@ -14,7 +14,7 @@ -- is a monoid.
 --
 -----------------------------------------------------------------------------
---  $Id: TestSuite.hs 7524 2015-04-08 07:31:15Z bastiaan $
+--  $Id: TestSuite.hs 8740 2015-10-14 19:26:22Z bastiaan $
 
 module Ideas.Common.Utils.TestSuite
    ( -- * TestSuite

@@ -1,7 +1,7 @@ -----------------------------------------------------------------------------
--- Copyright 2015, Open Universiteit Nederland. This file is distributed
--- under the terms of the GNU General Public License. For more information,
--- see the file "LICENSE.txt", which is included in the distribution.
+-- Copyright 2015, Ideas project team. This file is distributed under the
+-- terms of the Apache License 2.0. For more information, see the files
+-- "LICENSE.txt" and "NOTICE.txt", which are included in the distribution.
 -----------------------------------------------------------------------------
 -- |
 -- Maintainer  :  bastiaan.heeren@ou.nl
@@ -12,7 +12,7 @@ -- class and its utility plus constructor functions)
 --
 -----------------------------------------------------------------------------
---  $Id: Uniplate.hs 7524 2015-04-08 07:31:15Z bastiaan $
+--  $Id: Uniplate.hs 8740 2015-10-14 19:26:22Z bastiaan $
 
 module Ideas.Common.Utils.Uniplate
    ( -- * Uniplate type class and utility functions

@@ -1,8 +1,8 @@ {-# LANGUAGE GADTs, GeneralizedNewtypeDeriving #-}
 -----------------------------------------------------------------------------
--- Copyright 2015, Open Universiteit Nederland. This file is distributed
--- under the terms of the GNU General Public License. For more information,
--- see the file "LICENSE.txt", which is included in the distribution.
+-- Copyright 2015, Ideas project team. This file is distributed under the
+-- terms of the Apache License 2.0. For more information, see the files
+-- "LICENSE.txt" and "NOTICE.txt", which are included in the distribution.
 -----------------------------------------------------------------------------
 -- |
 -- Maintainer  :  bastiaan.heeren@ou.nl
@@ -13,7 +13,7 @@ -- in Interactive Exercise Assistants"
 --
 -----------------------------------------------------------------------------
---  $Id: View.hs 7524 2015-04-08 07:31:15Z bastiaan $
+--  $Id: View.hs 8740 2015-10-14 19:26:22Z bastiaan $
 
 module Ideas.Common.View
    ( Control.Arrow.Arrow(..), Control.Arrow.ArrowChoice(..)

@@ -1,8 +1,8 @@ {-# LANGUAGE GADTs #-}
 -----------------------------------------------------------------------------
--- Copyright 2015, Open Universiteit Nederland. This file is distributed
--- under the terms of the GNU General Public License. For more information,
--- see the file "LICENSE.txt", which is included in the distribution.
+-- Copyright 2015, Ideas project team. This file is distributed under the
+-- terms of the Apache License 2.0. For more information, see the files
+-- "LICENSE.txt" and "NOTICE.txt", which are included in the distribution.
 -----------------------------------------------------------------------------
 -- |
 -- Maintainer  :  bastiaan.heeren@ou.nl
@@ -12,7 +12,7 @@ -- Services using JSON notation
 --
 -----------------------------------------------------------------------------
---  $Id: DecoderJSON.hs 7524 2015-04-08 07:31:15Z bastiaan $
+--  $Id: DecoderJSON.hs 8743 2015-10-14 19:48:13Z bastiaan $
 
 module Ideas.Encoding.DecoderJSON
    ( JSONDecoder, jsonDecoder
@@ -94,7 +94,7 @@    decoderFor $ \json ->
       case json of
          Array [a] -> setInput a >> decodeState
-         Array [String _code, pref, term, jsonContext] -> do
+         Array (String _code : pref : term : jsonContext : rest) -> do
             pts  <- decodePaths       // pref
             a    <- decodeTerm        // term
             env  <- decodeEnvironment // jsonContext
@@ -102,7 +102,15 @@                 ctx = navigateTowards loc $ deleteRef locRef $
                          setEnvironment env $ inContext ex a
                 prfx = replayPaths pts (strategy ex) ctx
-            return $ makeState ex prfx ctx
+            case rest of
+               [] -> return $ makeState ex prfx ctx
+               [Array [String user, String session, String startterm]] ->
+                  return (makeState ex prfx ctx)
+                     { stateUser      = Just user
+                     , stateSession   = Just session
+                     , stateStartTerm = Just startterm
+                     }
+               _  -> fail $ "invalid state" ++ show json
          _ -> fail $ "invalid state" ++ show json
 
 envToLoc :: Environment -> Location

@@ -1,8 +1,8 @@ {-# LANGUAGE GADTs #-}
 -----------------------------------------------------------------------------
--- Copyright 2015, Open Universiteit Nederland. This file is distributed
--- under the terms of the GNU General Public License. For more information,
--- see the file "LICENSE.txt", which is included in the distribution.
+-- Copyright 2015, Ideas project team. This file is distributed under the
+-- terms of the Apache License 2.0. For more information, see the files
+-- "LICENSE.txt" and "NOTICE.txt", which are included in the distribution.
 -----------------------------------------------------------------------------
 -- |
 -- Maintainer  :  bastiaan.heeren@ou.nl
@@ -12,7 +12,7 @@ -- Services using XML notation
 --
 -----------------------------------------------------------------------------
---  $Id: DecoderXML.hs 7524 2015-04-08 07:31:15Z bastiaan $
+--  $Id: DecoderXML.hs 8740 2015-10-14 19:26:22Z bastiaan $
 
 module Ideas.Encoding.DecoderXML
    ( XMLDecoder, xmlDecoder
@@ -20,7 +20,7 @@ 
 import Control.Monad
 import Data.Char
-import Ideas.Common.Library hiding ((<|>))
+import Ideas.Common.Library
 import Ideas.Common.Traversal.Navigator
 import Ideas.Encoding.Encoder
 import Ideas.Encoding.OpenMathSupport

@@ -1,8 +1,8 @@ {-# LANGUAGE RankNTypes #-}
 -----------------------------------------------------------------------------
--- Copyright 2015, Open Universiteit Nederland. This file is distributed
--- under the terms of the GNU General Public License. For more information,
--- see the file "LICENSE.txt", which is included in the distribution.
+-- Copyright 2015, Ideas project team. This file is distributed under the
+-- terms of the Apache License 2.0. For more information, see the files
+-- "LICENSE.txt" and "NOTICE.txt", which are included in the distribution.
 -----------------------------------------------------------------------------
 -- |
 -- Maintainer  :  bastiaan.heeren@ou.nl
@@ -10,7 +10,7 @@ -- Portability :  portable (depends on ghc)
 --
 -----------------------------------------------------------------------------
---  $Id: Evaluator.hs 6535 2014-05-14 11:05:06Z bastiaan $
+--  $Id: Encoder.hs 8747 2015-10-15 14:54:48Z bastiaan $
 
 module Ideas.Encoding.Encoder
    ( -- * Converter type class
@@ -126,6 +126,10 @@    arr   f = Enc $ \_ -> return . f
    first f = Enc $ \xs (a, b) -> runEnc f xs a >>= \c -> return (c, b)
 
+instance Alternative (Encoder a s) where
+   empty = mzero
+   (<|>) = mplus
+
 instance Monad (Encoder a s) where
    return a = Enc $ \_ _ -> return a
    fail s   = Enc $ \_ _ -> fail s
@@ -243,6 +247,17 @@ -- Error monad (helper)
 
 newtype Error a = Error { runError :: Either String a }
+
+instance Functor Error where
+   fmap = (<$>)
+
+instance Applicative Error where
+   pure  = return
+   (<*>) = ap
+
+instance Alternative Error where
+   empty = mzero
+   (<|>) = mplus
 
 instance Monad Error where
    fail    = Error . Left

@@ -1,8 +1,8 @@ {-# LANGUAGE GADTs #-}
 -----------------------------------------------------------------------------
--- Copyright 2015, Open Universiteit Nederland. This file is distributed
--- under the terms of the GNU General Public License. For more information,
--- see the file "LICENSE.txt", which is included in the distribution.
+-- Copyright 2015, Ideas project team. This file is distributed under the
+-- terms of the Apache License 2.0. For more information, see the files
+-- "LICENSE.txt" and "NOTICE.txt", which are included in the distribution.
 -----------------------------------------------------------------------------
 -- |
 -- Maintainer  :  bastiaan.heeren@ou.nl
@@ -12,7 +12,7 @@ -- Encoding in HTML
 --
 -----------------------------------------------------------------------------
---  $Id: EncoderHTML.hs 7524 2015-04-08 07:31:15Z bastiaan $
+--  $Id: EncoderHTML.hs 8745 2015-10-15 14:45:46Z bastiaan $
 
 module Ideas.Encoding.EncoderHTML (htmlEncoder, htmlEncoderAt) where
 
@@ -21,6 +21,7 @@ import Data.Maybe
 import Data.Ord
 import Ideas.Common.Library hiding (alternatives)
+import Ideas.Common.Strategy.Symbol
 import Ideas.Common.Utils
 import Ideas.Common.Utils.TestSuite
 import Ideas.Encoding.Encoder
@@ -456,8 +457,9 @@              , showEnv env1 -- local environment
              , showEnv env2 -- global environment (diff)
              ]
+       textLines = mconcat . intersperse br . map string . lines
        forTerm a =
-          divClass "term" $ string $ prettyPrinterContext ex a
+          divClass "term" $ textLines $ prettyPrinterContext ex a
    in htmlDerivationWith before forStep forTerm (diffEnvironment d)
 
 htmlState :: LinkManager -> HTMLEncoder a (State a)
@@ -530,11 +532,13 @@       ctx = stateContext st
       prSteps = fst $ replayPath path (strategy ex) ctx
 
-htmlStep :: Step a -> HTMLBuilder
-htmlStep (Enter l)      = spanClass "step-enter" $ string $ "enter " ++ show l
-htmlStep (Exit  l)      = spanClass "step-exit"  $ string $ "exit " ++ show l
-htmlStep (RuleStep _ r) = let s = if isMinor r then "minor" else "major"
-                          in spanClass ("step-"++s) $ string $ showId r
+htmlStep :: Rule a -> HTMLBuilder
+htmlStep r =
+   case (isEnterRule r, isExitRule r) of
+      (Just l, _) -> spanClass "step-enter" $ string $ "enter " ++ show l
+      (_, Just l) -> spanClass "step-exit"  $ string $ "exit " ++ show l
+      _ -> let s = if isMinor r then "minor" else "major"
+           in spanClass ("step-"++s) $ string $ showId r
 
 htmlDerivationWith :: HTMLBuilder -> (s -> HTMLBuilder) -> (t -> HTMLBuilder) -> Derivation s t -> HTMLBuilder
 htmlDerivationWith before forStep forTerm d =
@@ -568,6 +572,8 @@ htmlDiagnosis :: LinkManager -> DomainReasoner -> HTMLEncoder a (Diagnosis a)
 htmlDiagnosis lm dr = encoderFor $ \diagnosis ->
    case diagnosis of
+      SyntaxError s ->
+         spanClass "error" $ string s
       Buggy _ r ->
          spanClass "error" $ string $ "Not equivalent: buggy rule " ++ show r
       NotEquivalent s ->

@@ -1,8 +1,8 @@ {-# LANGUAGE GADTs #-}
 -----------------------------------------------------------------------------
--- Copyright 2015, Open Universiteit Nederland. This file is distributed
--- under the terms of the GNU General Public License. For more information,
--- see the file "LICENSE.txt", which is included in the distribution.
+-- Copyright 2015, Ideas project team. This file is distributed under the
+-- terms of the Apache License 2.0. For more information, see the files
+-- "LICENSE.txt" and "NOTICE.txt", which are included in the distribution.
 -----------------------------------------------------------------------------
 -- |
 -- Maintainer  :  bastiaan.heeren@ou.nl
@@ -12,11 +12,12 @@ -- Services using JSON notation
 --
 -----------------------------------------------------------------------------
---  $Id: EncoderJSON.hs 7524 2015-04-08 07:31:15Z bastiaan $
+--  $Id: EncoderJSON.hs 8743 2015-10-14 19:48:13Z bastiaan $
 
 module Ideas.Encoding.EncoderJSON (jsonEncoder) where
 
-import Ideas.Common.Library hiding (exerciseId, (<|>), (<*>))
+import Data.Maybe
+import Ideas.Common.Library hiding (exerciseId)
 import Ideas.Common.Utils (Some(..), distinct)
 import Ideas.Encoding.Encoder
 import Ideas.Service.State
@@ -96,15 +97,17 @@ 
 encodeState :: JSONEncoder a (State a)
 encodeState = encoderFor $ \st ->
-   let ctx = stateContext st
-       make pp env = Array
+   let ctx   = stateContext st
+       get f = String (fromMaybe "" (f st))
+       make pp env = Array $
           [ String $ showId (exercise st)
           , String $ if withoutPrefix st
                      then "NoPrefix"
                      else show (statePrefix st)
           , pp
           , env
-          ]
+          ] ++ if isNothing (stateUser st) then [] else
+          [ Array [get stateUser, get stateSession, get stateStartTerm] ]
    in make <$> (encodeContext // ctx) <*> (encodeStateEnvironment // ctx)
 
 encodeStateEnvironment :: JSONEncoder a (Context a)
@@ -158,6 +161,8 @@ encodeDiagnosis :: JSONEncoder a (Diagnose.Diagnosis a)
 encodeDiagnosis = encoderFor $ \diagnosis ->
    case diagnosis of
+      Diagnose.SyntaxError s ->
+         pure $ Object [("syntaxerror", String s)]
       Diagnose.NotEquivalent s ->
          if null s then pure (Object [("notequiv", Null)])
                    else make "notequiv" [fromReason s]

@@ -1,8 +1,8 @@ {-# LANGUAGE GADTs #-}
 -----------------------------------------------------------------------------
--- Copyright 2015, Open Universiteit Nederland. This file is distributed
--- under the terms of the GNU General Public License. For more information,
--- see the file "LICENSE.txt", which is included in the distribution.
+-- Copyright 2015, Ideas project team. This file is distributed under the
+-- terms of the Apache License 2.0. For more information, see the files
+-- "LICENSE.txt" and "NOTICE.txt", which are included in the distribution.
 -----------------------------------------------------------------------------
 -- |
 -- Maintainer  :  bastiaan.heeren@ou.nl
@@ -12,7 +12,7 @@ -- Services using XML notation
 --
 -----------------------------------------------------------------------------
---  $Id: EncoderXML.hs 7524 2015-04-08 07:31:15Z bastiaan $
+--  $Id: EncoderXML.hs 8740 2015-10-14 19:26:22Z bastiaan $
 
 module Ideas.Encoding.EncoderXML
    ( XMLEncoder
@@ -192,6 +192,7 @@ encodeDiagnosis :: XMLEncoder a (Diagnosis a)
 encodeDiagnosis = encoderFor $ \diagnosis ->
    case diagnosis of
+      SyntaxError s -> element "syntaxerror" [string s]
       Buggy env r -> element "buggy"
          [encodeEnvironment // env, "ruleid" .=. showId r]
       NotEquivalent s ->

@@ -1,8 +1,8 @@ {-# LANGUAGE GADTs, RankNTypes #-}
 -----------------------------------------------------------------------------
--- Copyright 2015, Open Universiteit Nederland. This file is distributed
--- under the terms of the GNU General Public License. For more information,
--- see the file "LICENSE.txt", which is included in the distribution.
+-- Copyright 2015, Ideas project team. This file is distributed under the
+-- terms of the Apache License 2.0. For more information, see the files
+-- "LICENSE.txt" and "NOTICE.txt", which are included in the distribution.
 -----------------------------------------------------------------------------
 -- |
 -- Maintainer  :  bastiaan.heeren@ou.nl
@@ -10,35 +10,60 @@ -- Portability :  portable (depends on ghc)
 --
 -----------------------------------------------------------------------------
---  $Id: Evaluator.hs 7524 2015-04-08 07:31:15Z bastiaan $
+--  $Id: Evaluator.hs 8743 2015-10-14 19:48:13Z bastiaan $
 
-module Ideas.Encoding.Evaluator
-   ( Evaluator(..), evalService
-   ) where
+module Ideas.Encoding.Evaluator (Evaluator(..), evalService) where
 
+import Ideas.Common.Library
 import Ideas.Encoding.Encoder
+import Ideas.Main.Logging
+import Ideas.Service.Diagnose
 import Ideas.Service.Types
 
 data Evaluator a b c = Evaluator (TypedDecoder a b) (TypedEncoder a c)
 
-evalService :: Options a -> Evaluator a b c -> Service -> b -> IO c
-evalService opts f = eval opts f . serviceFunction
+data EvalResult a c = EvalResult
+   { inputValues :: [TypedValue (Type a)]
+   , outputValue :: TypedValue (Type a)
+   , evalResult  :: c
+   }
 
-eval :: Options a -> Evaluator a b c -> TypedValue (Type a) -> b -> IO c
-eval opts f@(Evaluator dec enc) tv@(val ::: tp) b =
-   case tp of
-      -- handle exceptions
-      Const String :|: t ->
-         either fail (\a -> eval opts f (a ::: t) b) val
-      -- uncurry function if possible
-      t1 :-> t2 :-> t3 ->
-         eval opts f (uncurry val ::: Pair t1 t2 :-> t3) b
-      t1 :-> t2 -> do
-         a <- run (dec t1) opts b
-         eval opts f (val a ::: t2) b
-      -- perform IO
-      IO t -> do
-         a <- val
-         eval opts f (a ::: t) b
-      _ ->
-         run enc opts tv+values :: EvalResult a c -> [TypedValue (Type a)]
+values result = outputValue result : inputValues result
+
+logType :: LogRef -> EvalResult a c -> Type a b -> (b -> Record -> Record) -> IO ()
+logType logRef res tp f =
+   case concatMap (findValuesOfType tp) (values res) of
+      []   -> return ()
+      hd:_ -> changeLog logRef (f hd)
+
+evalService :: LogRef -> Options a -> Evaluator a b c -> Service -> b -> IO c
+evalService logRef opts f srv b = do
+   res <- eval opts f b (serviceFunction srv)
+   logType logRef res tState addState
+   logType logRef res tRule $ \rl r -> r {ruleid = showId rl}
+   logType logRef res tDiagnosis $ \d r -> r {serviceinfo = show d}
+   return (evalResult res)
+
+eval :: Options a -> Evaluator a b c -> b -> TypedValue (Type a) -> IO (EvalResult a c)
+eval opts (Evaluator dec enc) b = rec
+ where
+   rec tv@(val ::: tp) =
+      case tp of
+         -- handle exceptions
+         Const String :|: t ->
+            either fail (\a -> rec (a ::: t)) val
+         -- uncurry function if possible
+         t1 :-> t2 :-> t3 ->
+            rec (uncurry val ::: Pair t1 t2 :-> t3)
+         t1 :-> t2 -> do
+            a   <- run (dec t1) opts b
+            res <- rec (val a ::: t2)
+            return res { inputValues = (a ::: t1) : inputValues res }
+         -- perform IO
+         IO t -> do
+            a <- val
+            rec (a ::: t)
+         _ -> do
+            c <- run enc opts tv
+            return $ EvalResult [] tv c

@@ -1,8 +1,8 @@ {-# LANGUAGE RankNTypes #-}
 -----------------------------------------------------------------------------
--- Copyright 2015, Open Universiteit Nederland. This file is distributed
--- under the terms of the GNU General Public License. For more information,
--- see the file "LICENSE.txt", which is included in the distribution.
+-- Copyright 2015, Ideas project team. This file is distributed under the
+-- terms of the Apache License 2.0. For more information, see the files
+-- "LICENSE.txt" and "NOTICE.txt", which are included in the distribution.
 -----------------------------------------------------------------------------
 -- |
 -- Maintainer  :  bastiaan.heeren@ou.nl
@@ -12,7 +12,7 @@ -- Manages links to information
 --
 -----------------------------------------------------------------------------
---  $Id: LinkManager.hs 7524 2015-04-08 07:31:15Z bastiaan $
+--  $Id: LinkManager.hs 8740 2015-10-14 19:26:22Z bastiaan $
 
 module Ideas.Encoding.LinkManager
    ( LinkManager(..)

@@ -1,7 +1,7 @@ -----------------------------------------------------------------------------
--- Copyright 2015, Open Universiteit Nederland. This file is distributed
--- under the terms of the GNU General Public License. For more information,
--- see the file "LICENSE.txt", which is included in the distribution.
+-- Copyright 2015, Ideas project team. This file is distributed under the
+-- terms of the Apache License 2.0. For more information, see the files
+-- "LICENSE.txt" and "NOTICE.txt", which are included in the distribution.
 -----------------------------------------------------------------------------
 -- |
 -- Maintainer  :  bastiaan.heeren@ou.nl
@@ -11,10 +11,11 @@ -- Services using JSON notation
 --
 -----------------------------------------------------------------------------
---  $Id: ModeJSON.hs 7524 2015-04-08 07:31:15Z bastiaan $
+--  $Id: ModeJSON.hs 8743 2015-10-14 19:48:13Z bastiaan $
 
 module Ideas.Encoding.ModeJSON (processJSON) where
 
+import Control.Monad
 import Data.Char
 import Ideas.Common.Library hiding (exerciseId)
 import Ideas.Common.Utils (Some(..), timedSeconds)
@@ -22,16 +23,19 @@ import Ideas.Encoding.Encoder (makeOptions)
 import Ideas.Encoding.EncoderJSON
 import Ideas.Encoding.Evaluator
+import Ideas.Main.Logging (LogRef, changeLog, errormsg)
 import Ideas.Service.DomainReasoner
 import Ideas.Service.Request
 import Ideas.Text.JSON
 
-processJSON :: Maybe Int -> Maybe String -> DomainReasoner -> String -> IO (Request, String, String)
-processJSON maxTime cgiBin dr input = do
+processJSON :: Maybe Int -> Maybe String -> DomainReasoner -> LogRef -> String -> IO (Request, String, String)
+processJSON maxTime cgiBin dr logRef input = do
    json <- either fail return (parseJSON input)
    req  <- jsonRequest cgiBin json
    resp <- jsonRPC json $ \fun arg ->
-              maybe id timedSeconds maxTime (myHandler dr req fun arg)
+              maybe id timedSeconds maxTime (myHandler dr logRef req fun arg)
+   unless (responseError resp == Null) $
+      changeLog logRef (\r -> r {errormsg = show (responseError resp)})
    let f   = if compactOutput req then compactJSON else show
        out = addVersion (version dr) (toJSON resp)
    return (req, f out, "application/json")
@@ -59,38 +63,38 @@ 
 jsonRequest :: Monad m => Maybe String -> JSON -> m Request
 jsonRequest cgiBin json = do
-   srv  <- case lookupM "method" json of
-              Just (String s) -> return (Just (newId s))
-              Nothing         -> return Nothing
-              _               -> fail "Invalid method"
    let exId = lookupM "params" json >>= extractExerciseId
-   enc  <- case lookupM "encoding" json of
-              Nothing         -> return []
-              Just (String s) -> readEncoding s
-              _               -> fail "Invalid encoding"
-   src  <- case lookupM "source" json of
-              Nothing         -> return Nothing
-              Just (String s) -> return (Just s)
-              _               -> fail "Invalid source"
-   let uid = case lookupM "id" json of
-                Just (String s)     -> Just s
-                Just (Number (I n)) -> Just (show n)
-                _                   -> Nothing
+   srv  <- stringOption  "method"      json newId
+   src  <- stringOption  "source"      json id
+   rinf <- stringOption  "requestinfo" json id
+   enc  <- stringOptionM "encoding"    json [] readEncoding
+   sch  <- stringOptionM "logging"     json Nothing (liftM Just . readSchema)
    return emptyRequest
-      { serviceId  = srv
-      , exerciseId = exId
-      , user       = uid
-      , source     = src
-      , cgiBinary  = cgiBin
-      , dataformat = JSON
-      , encoding   = enc
+      { serviceId   = srv
+      , exerciseId  = exId
+      , source      = src
+      , cgiBinary   = cgiBin
+      , requestInfo = rinf
+      , logSchema   = sch
+      , dataformat  = JSON
+      , encoding    = enc
       }
 
-myHandler :: DomainReasoner -> Request -> RPCHandler
-myHandler dr request fun json = do
+stringOption :: Monad m => String -> JSON -> (String -> a) -> m (Maybe a)
+stringOption attr json f = stringOptionM attr json Nothing (return . Just . f)
+
+stringOptionM :: Monad m => String -> JSON -> a -> (String -> m a) -> m a
+stringOptionM attr json a f =
+   case lookupM attr json of
+      Just (String s) -> f s
+      Just _  -> fail $ "Invalid value for " ++ attr ++ " (expecting string)"
+      Nothing -> return a
+
+myHandler :: DomainReasoner -> LogRef -> Request -> RPCHandler
+myHandler dr logRef request fun json = do
    srv <- findService dr (newId fun)
    Some options <- makeOptions dr request
-   evalService options jsonEvaluator srv json
+   evalService logRef options jsonEvaluator srv json
 
 jsonEvaluator :: Evaluator a JSON JSON
 jsonEvaluator = Evaluator jsonDecoder jsonEncoder

@@ -1,7 +1,7 @@ -----------------------------------------------------------------------------
--- Copyright 2015, Open Universiteit Nederland. This file is distributed
--- under the terms of the GNU General Public License. For more information,
--- see the file "LICENSE.txt", which is included in the distribution.
+-- Copyright 2015, Ideas project team. This file is distributed under the
+-- terms of the Apache License 2.0. For more information, see the files
+-- "LICENSE.txt" and "NOTICE.txt", which are included in the distribution.
 -----------------------------------------------------------------------------
 -- |
 -- Maintainer  :  bastiaan.heeren@ou.nl
@@ -11,7 +11,7 @@ -- Services using XML notation
 --
 -----------------------------------------------------------------------------
---  $Id: ModeXML.hs 7524 2015-04-08 07:31:15Z bastiaan $
+--  $Id: ModeXML.hs 8743 2015-10-14 19:48:13Z bastiaan $
 
 module Ideas.Encoding.ModeXML (processXML) where
 
@@ -25,6 +25,7 @@ import Ideas.Encoding.EncoderHTML
 import Ideas.Encoding.EncoderXML
 import Ideas.Encoding.Evaluator
+import Ideas.Main.Logging (LogRef, changeLog, errormsg)
 import Ideas.Service.DomainReasoner
 import Ideas.Service.Request
 import Ideas.Text.HTML
@@ -32,11 +33,11 @@ import Prelude hiding (catch)
 import System.IO.Error hiding (catch)
 
-processXML :: Maybe Int -> Maybe String -> DomainReasoner -> String -> IO (Request, String, String)
-processXML maxTime cgiBin dr input = do
+processXML :: Maybe Int -> Maybe String -> DomainReasoner -> LogRef -> String -> IO (Request, String, String)
+processXML maxTime cgiBin dr logRef input = do
    xml  <- either fail return (parseXML input)
    req  <- xmlRequest cgiBin xml
-   resp <- maybe id timedSeconds maxTime (xmlReply dr req xml)
+   resp <- maybe id timedSeconds maxTime (xmlReply dr logRef req xml)
     `catch` handler
    let showXML | compactOutput req = compactXML
                | otherwise = show
@@ -46,7 +47,7 @@            in return (req, showXML out, "application/xml")
  where
    handler :: IOException -> IO XML
-   handler = return . resultError . ioeGetErrorString
+   handler = resultError logRef . ioeGetErrorString
 
 addVersion :: String -> XML -> XML
 addVersion s xml =
@@ -63,31 +64,28 @@    return emptyRequest
       { serviceId      = fmap newId $ findAttribute "service" xml
       , exerciseId     = extractExerciseId xml
-      , user           = findAttribute "userid" xml
       , source         = findAttribute "source" xml
-      , feedbackScript = findAttribute "script" xml
       , cgiBinary      = cgiBin
+      , requestInfo    = findAttribute "requestinfo" xml
+      , logSchema      = findAttribute "logging" xml >>= readSchema
+      , feedbackScript = findAttribute "script" xml
       , dataformat     = XML
       , encoding       = enc
       }
 
-xmlReply :: DomainReasoner -> Request -> XML -> IO XML
-xmlReply dr request xml = do
+xmlReply :: DomainReasoner -> LogRef -> Request -> XML -> IO XML
+xmlReply dr logRef request xml = do
    srv <- case serviceId request of
              Just a  -> findService dr a
              Nothing -> fail "No service"
 
    Some options <- makeOptions dr request
 
-   -- HTML evaluator
    if htmlOutput request
-      then do
-         res <- evalService options (htmlEvaluator dr) srv xml
-         return (toXML res)
+      -- HTML evaluator
+      then liftM toXML $ evalService logRef options (htmlEvaluator dr) srv xml
       -- xml evaluator
-      else do
-         res <- evalService options xmlEvaluator srv xml
-         return (resultOk res)
+      else liftM resultOk $ evalService logRef options xmlEvaluator srv xml
 
 extractExerciseId :: Monad m => XML -> m Id
 extractExerciseId = liftM newId . findAttribute "exerciseid"
@@ -97,10 +95,12 @@    ("result" .=. "ok")
    <> body
 
-resultError :: String -> XML
-resultError txt = makeXML "reply" $
-   ("result" .=. "error")
-   <> tag "message" (string txt)
+resultError :: LogRef -> String -> IO XML
+resultError logRef msg = do
+   changeLog logRef (\r -> r {errormsg = msg})
+   return $ makeXML "reply" $
+      ("result" .=. "error")
+      <> tag "message" (string msg)
 
 ------------------------------------------------------------
 

@@ -1,8 +1,8 @@ {-# LANGUAGE Rank2Types #-}
 -----------------------------------------------------------------------------
--- Copyright 2015, Open Universiteit Nederland. This file is distributed
--- under the terms of the GNU General Public License. For more information,
--- see the file "LICENSE.txt", which is included in the distribution.
+-- Copyright 2015, Ideas project team. This file is distributed under the
+-- terms of the Apache License 2.0. For more information, see the files
+-- "LICENSE.txt" and "NOTICE.txt", which are included in the distribution.
 -----------------------------------------------------------------------------
 -- |
 -- Maintainer  :  bastiaan.heeren@ou.nl
@@ -10,7 +10,7 @@ -- Portability :  portable (depends on ghc)
 --
 -----------------------------------------------------------------------------
---  $Id: OpenMathSupport.hs 7524 2015-04-08 07:31:15Z bastiaan $
+--  $Id: OpenMathSupport.hs 8740 2015-10-14 19:26:22Z bastiaan $
 
 module Ideas.Encoding.OpenMathSupport
    ( -- * Conversion functions to/from OpenMath

@@ -1,7 +1,7 @@ -----------------------------------------------------------------------------
--- Copyright 2015, Open Universiteit Nederland. This file is distributed
--- under the terms of the GNU General Public License. For more information,
--- see the file "LICENSE.txt", which is included in the distribution.
+-- Copyright 2015, Ideas project team. This file is distributed under the
+-- terms of the Apache License 2.0. For more information, see the files
+-- "LICENSE.txt" and "NOTICE.txt", which are included in the distribution.
 -----------------------------------------------------------------------------
 -- |
 -- Maintainer  :  bastiaan.heeren@ou.nl
@@ -9,7 +9,7 @@ -- Portability :  portable (depends on ghc)
 --
 -----------------------------------------------------------------------------
---  $Id: RulePresenter.hs 7524 2015-04-08 07:31:15Z bastiaan $
+--  $Id: RulePresenter.hs 8740 2015-10-14 19:26:22Z bastiaan $
 
 module Ideas.Encoding.RulePresenter (ruleToHTML) where
 

@@ -1,7 +1,7 @@ -----------------------------------------------------------------------------
--- Copyright 2015, Open Universiteit Nederland. This file is distributed
--- under the terms of the GNU General Public License. For more information,
--- see the file "LICENSE.txt", which is included in the distribution.
+-- Copyright 2015, Ideas project team. This file is distributed under the
+-- terms of the Apache License 2.0. For more information, see the files
+-- "LICENSE.txt" and "NOTICE.txt", which are included in the distribution.
 -----------------------------------------------------------------------------
 -- |
 -- Maintainer  :  bastiaan.heeren@ou.nl
@@ -9,7 +9,7 @@ -- Portability :  portable (depends on ghc)
 --
 -----------------------------------------------------------------------------
---  $Id: RulesInfo.hs 7524 2015-04-08 07:31:15Z bastiaan $
+--  $Id: RulesInfo.hs 8740 2015-10-14 19:26:22Z bastiaan $
 
 module Ideas.Encoding.RulesInfo
    ( rulesInfoXML, rewriteRuleToFMP, collectExamples, ExampleMap

@@ -1,7 +1,7 @@ -----------------------------------------------------------------------------
--- Copyright 2015, Open Universiteit Nederland. This file is distributed
--- under the terms of the GNU General Public License. For more information,
--- see the file "LICENSE.txt", which is included in the distribution.
+-- Copyright 2015, Ideas project team. This file is distributed under the
+-- terms of the Apache License 2.0. For more information, see the files
+-- "LICENSE.txt" and "NOTICE.txt", which are included in the distribution.
 -----------------------------------------------------------------------------
 -- |
 -- Maintainer  :  bastiaan.heeren@ou.nl
@@ -11,94 +11,60 @@ -- Converting a strategy to XML, and the other way around.
 --
 -----------------------------------------------------------------------------
---  $Id: StrategyInfo.hs 7524 2015-04-08 07:31:15Z bastiaan $
+--  $Id: StrategyInfo.hs 8743 2015-10-14 19:48:13Z bastiaan $
 
-module Ideas.Encoding.StrategyInfo (strategyToXML, xmlToStrategy) where
+module Ideas.Encoding.StrategyInfo (strategyToXML) where
 
-import Control.Monad
-import Ideas.Common.Library hiding (Remove, Collapse, Hide, (:=))
+import Ideas.Common.CyclicTree
+import Ideas.Common.Id
 import Ideas.Common.Strategy.Abstract
-import Ideas.Common.Strategy.Core
-import Ideas.Common.Utils (readInt)
+import Ideas.Common.Strategy.Configuration
+import Ideas.Common.Strategy.StrategyTree (StrategyTree)
 import Ideas.Text.XML
 
 -----------------------------------------------------------------------
 -- Strategy to XML
 
 strategyToXML :: IsStrategy f => f a -> XML
-strategyToXML = coreToXML . toCore . toStrategy
+strategyToXML = strategyTreeToXML . toStrategyTree
 
 nameAttr :: Id -> XMLBuilder
 nameAttr info = "name" .=. showId info
 
-coreToXML :: Core a -> XML
-coreToXML core = makeXML "label" $
-   case core of
-      Label l a -> nameAttr l <> coreBuilder a
-      _         -> coreBuilder core
+strategyTreeToXML :: StrategyTree a -> XML
+strategyTreeToXML tree = makeXML "label" $
+   case isLabel tree of
+      Just (l, a) -> nameAttr l <> strategyTreeBuilder a
+      _ -> strategyTreeBuilder tree
 
-coreBuilder :: Core a -> XMLBuilder
-coreBuilder core =
-   case core of
-      _ :*:  _   -> asList "sequence"   isSequence
-      _ :|:  _   -> asList "choice"     isChoice
-      _ :>|> _   -> asList "preference" isPreference
-      _ :|>: _   -> asList "orelse"     isOrElse
-      _ :%: _    -> asList "interleave" isInterleave
-      a :@: b    -> tag "alternate" (coreBuilder a <> coreBuilder b)
-      Label l (Rule r) | getId l == getId r
-                 -> tag "rule"       (nameAttr l)
-      Label l a  -> tag "label"      (nameAttr l <> coreBuilder a)
-      Atomic a   -> tag "atomic"     (coreBuilder a)
-      Not a      -> tag "not"        (coreBuilder a)
-      Remove a   -> cfgItem "removed"     (coreBuilder a)
-      Collapse a -> cfgItem "collapsed" (coreBuilder a)
-      Hide a     -> cfgItem "hidden"      (coreBuilder a)
-      Let ds a   -> tag "let"        (decls ds <> coreBuilder a)
-      Rule r     -> tag "rule"       ("name" .=. show r)
-      Var n      -> tag "var"        ("var" .=. show n)
-      Succeed    -> emptyTag "succeed"
-      Fail       -> emptyTag "fail"
- where
-   asList s g = element s (map coreBuilder (collect g core))
-   decls ds   = mconcat [ tag "decl" (("var" .=. show n) <> coreBuilder a)
-                        | (n, a) <- ds
-                        ]
+strategyTreeBuilder :: StrategyTree a -> XMLBuilder
+strategyTreeBuilder = fold emptyAlg
+   { fNode = \def xs ->
+        case xs of
+           [x] | isConfigId def
+             -> addProperty (show def) x
+           _ -> tag (show def) (mconcat xs)
+   , fLeaf = \r ->
+        tag "rule" ("name" .=. show r)
+   , fLabel = \l a ->
+        tag "label" (nameAttr l <> a)
+   , fRec = \n a ->
+        tag "rec" (("var" .=. show n) <> a)
+   , fVar = \n ->
+        tag "var" ("var" .=. show n)
+   }
 
-cfgItem :: String -> XMLBuilder -> XMLBuilder
-cfgItem s a =
+addProperty :: String -> XMLBuilder -> XMLBuilder
+addProperty s a =
    case fromBuilder a of
       Just e | name e `elem` ["label", "rule"] ->
          builder e { attributes = attributes e ++ [s := "true"] }
       _      -> tag s a
 
-collect :: (a -> Maybe (a, a)) -> a -> [a]
-collect f = ($ []) . rec
- where rec a = maybe (a:) (\(x, y) -> rec x . rec y) (f a)
-
-isSequence :: Core a -> Maybe (Core a, Core a)
-isSequence (a :*: b) = Just (a, b)
-isSequence _ = Nothing
-
-isChoice :: Core a -> Maybe (Core a, Core a)
-isChoice (a :|: b) = Just (a, b)
-isChoice _ = Nothing
-
-isPreference :: Core a -> Maybe (Core a, Core a)
-isPreference (a :>|> b) = Just (a, b)
-isPreference _ = Nothing
-
-isOrElse :: Core a -> Maybe (Core a, Core a)
-isOrElse (a :|>: b) = Just (a, b)
-isOrElse _ = Nothing
-
-isInterleave :: Core a -> Maybe (Core a, Core a)
-isInterleave (a :%: b) = Just (a, b)
-isInterleave _ = Nothing
-
 -----------------------------------------------------------------------
 -- XML to strategy
 
+{-
 xmlToStrategy :: Monad m => (String -> Maybe (Rule a)) ->  XML -> m (Strategy a)
 xmlToStrategy f = liftM fromCore . readStrategy xmlToInfo g
  where
@@ -111,17 +77,17 @@    n <- findAttribute "name" xml
    -- let boolAttr s = fromMaybe False (findBool s xml)
    return (newId n)
-{-
+
 findBool :: Monad m => String -> XML -> m Bool
 findBool attr xml = do
    s <- findAttribute attr xml
    case map toLower s of
       "true"  -> return True
       "false" -> return False
-      _       -> fail "not a boolean" -}
+      _       -> fail "not a boolean"
 
 readStrategy :: Monad m => (XML -> m Id) -> (Id -> m (Rule a)) -> XML -> m (Core a)
-readStrategy toLabel findRule xml = do
+readStrategy toLabel findRule xml = error "not implemented" do
    xs <- mapM (readStrategy toLabel findRule) (children xml)
    let s = name xml
    case lookup s table of
@@ -139,7 +105,7 @@       | null xs   = return Fail
       | otherwise = return (foldr1 (:|>:) xs)
    buildInterleave _ xs
-      | null xs   = return Succeed
+      | null xs   = return succeedCore
       | otherwise = return (foldr1 (:%:) xs)
    buildLabel x = do
       info <- toLabel xml
@@ -147,7 +113,7 @@    buildRule = do
       info <- toLabel xml
       r    <- findRule info
-      return (Label info (Rule r))
+      return (Label info (Sym r))
    buildVar = do
       s <- findAttribute "var" xml
       i <- maybe (fail "var: not an int") return (readInt s)
@@ -167,9 +133,11 @@       , ("orelse",     buildOrElse)
       , ("interleave", buildInterleave)
       , ("label",      join2 comb1 buildLabel)
-      , ("atomic",     comb1 Atomic)
+     -- , ("atomic",     comb1 Atomic)
       , ("rule",       join2 comb0 buildRule)
       , ("var",        join2 comb0 buildVar)
-      , ("succeed",    comb0 Succeed)
-      , ("fail",       comb0 Fail)
-      ]+--      , ("succeed",    comb0 Succeed)
+      --, ("fail",       comb0 Fail)
+      ]
+
+-}

@@ -1,7 +1,7 @@ -----------------------------------------------------------------------------
--- Copyright 2015, Open Universiteit Nederland. This file is distributed
--- under the terms of the GNU General Public License. For more information,
--- see the file "LICENSE.txt", which is included in the distribution.
+-- Copyright 2015, Ideas project team. This file is distributed under the
+-- terms of the Apache License 2.0. For more information, see the files
+-- "LICENSE.txt" and "NOTICE.txt", which are included in the distribution.
 -----------------------------------------------------------------------------
 -- |
 -- Maintainer  :  bastiaan.heeren@ou.nl
@@ -9,7 +9,7 @@ -- Portability :  portable (depends on ghc)
 --
 -----------------------------------------------------------------------------
---  $Id: BlackBoxTests.hs 7528 2015-04-08 09:44:10Z bastiaan $
+--  $Id: BlackBoxTests.hs 8743 2015-10-14 19:48:13Z bastiaan $
 
 module Ideas.Main.BlackBoxTests (blackBoxTests) where
 
@@ -20,6 +20,7 @@ import Ideas.Common.Utils.TestSuite
 import Ideas.Encoding.ModeJSON
 import Ideas.Encoding.ModeXML
+import Ideas.Main.Logging
 import Ideas.Service.DomainReasoner
 import Ideas.Service.Request
 import System.Directory
@@ -55,8 +56,8 @@          hSetBinaryMode h1 True
          txt <- hGetContents h1
          out  <- case format of
-                    JSON -> liftM snd3 (processJSON Nothing Nothing dr txt)
-                    XML  -> liftM snd3 (processXML  Nothing Nothing dr txt)
+                    JSON -> liftM snd3 (processJSON Nothing Nothing dr noLogRef txt)
+                    XML  -> liftM snd3 (processXML  Nothing Nothing dr noLogRef txt)
          withFile expPath ReadMode $ \h2 -> do
             hSetBinaryMode h2 True
             expt <- hGetContents h2

@@ -1,7 +1,7 @@ -----------------------------------------------------------------------------
--- Copyright 2015, Open Universiteit Nederland. This file is distributed
--- under the terms of the GNU General Public License. For more information,
--- see the file "LICENSE.txt", which is included in the distribution.
+-- Copyright 2015, Ideas project team. This file is distributed under the
+-- terms of the Apache License 2.0. For more information, see the files
+-- "LICENSE.txt" and "NOTICE.txt", which are included in the distribution.
 -----------------------------------------------------------------------------
 -- |
 -- Maintainer  :  bastiaan.heeren@ou.nl
@@ -11,7 +11,7 @@ -- Main module for feedback services
 --
 -----------------------------------------------------------------------------
---  $Id: Default.hs 7524 2015-04-08 07:31:15Z bastiaan $
+--  $Id: Default.hs 8743 2015-10-14 19:48:13Z bastiaan $
 
 module Ideas.Main.Default
    ( defaultMain, defaultCGI
@@ -23,14 +23,12 @@ import Control.Exception
 import Control.Monad
 import Data.Maybe
-import Data.Time
 import Ideas.Common.Utils (useFixedStdGen, Some(..))
 import Ideas.Common.Utils.TestSuite
 import Ideas.Encoding.ModeJSON (processJSON)
 import Ideas.Encoding.ModeXML (processXML)
 import Ideas.Main.BlackBoxTests
 import Ideas.Main.Documentation
-import Ideas.Main.LoggingDatabase
 import Ideas.Main.Options hiding (fullVersion)
 import Ideas.Service.DomainReasoner
 import Ideas.Service.FeedbackScript.Analysis
@@ -41,6 +39,7 @@ import Prelude hiding (catch)
 import System.IO
 import System.IO.Error (ioeGetErrorString)
+import qualified Ideas.Main.Logging as Log
 
 defaultMain :: DomainReasoner -> IO ()
 defaultMain dr = do
@@ -52,17 +51,25 @@ -- Invoked as a cgi binary
 defaultCGI :: DomainReasoner -> IO ()
 defaultCGI dr = runCGI $ handleErrors $ do
+   -- create a record for logging
+   logRef  <- liftIO Log.newLogRef
    -- query environment
-   startTime <- liftIO getCurrentTime
-   addr      <- remoteAddr       -- the IP address of the remote host
-   cgiBin    <- scriptName       -- get name of binary
-   input     <- inputOrDefault
+   addr    <- remoteAddr       -- the IP address of the remote host
+   cgiBin  <- scriptName       -- get name of binary
+   input   <- inputOrDefault
    -- process request
    (req, txt, ctp) <- liftIO $
-      process dr (Just cgiBin) input
+      process dr logRef (Just cgiBin) input
    -- log request to database
-   when (useLogging req) $
-      liftIO $ logMessage req input txt addr startTime
+   when (useLogging req) $ liftIO $ do
+      Log.changeLog logRef $ \r -> Log.addRequest req r
+         { Log.ipaddress = addr
+         , Log.version   = shortVersion
+         , Log.input     = input
+         , Log.output    = txt
+         }
+      Log.logRecord (getSchema req) logRef
+
    -- write header and output
    setHeader "Content-type" ctp
    -- Cross-Origin Resource Sharing (CORS) prevents browser warnings
@@ -106,9 +113,18 @@          -- process input file
          InputFile file ->
             withBinaryFile file ReadMode $ \h -> do
-               input <- hGetContents h
-               (_, txt, _) <- process dr Nothing input
+               logRef <- liftIO Log.newLogRef
+               input  <- hGetContents h
+               (req, txt, _) <- process dr logRef Nothing input
                putStrLn txt
+               when (PrintLog `elem` flags) $ do
+                  Log.changeLog logRef $ \r -> Log.addRequest req r
+                     { Log.ipaddress = "command-line"
+                     , Log.version   = shortVersion
+                     , Log.input     = input
+                     , Log.output    = txt
+                     }
+                  Log.printLog logRef
          -- blackbox tests
          Test dir -> do
             tests  <- blackBoxTests dr dir
@@ -120,14 +136,16 @@          -- feedback scripts
          MakeScriptFor s    -> makeScriptFor dr s
          AnalyzeScript file -> parseAndAnalyzeScript dr file
+         PrintLog           -> return ()
 
-process :: DomainReasoner -> Maybe String -> String -> IO (Request, String, String)
-process dr cgiBin input = do
+process :: DomainReasoner -> Log.LogRef -> Maybe String -> String -> IO (Request, String, String)
+process dr logRef cgiBin input = do
    format <- discoverDataFormat input
-   run format (Just 5) cgiBin dr input
- `catch` \ioe ->
+   run format (Just 5) cgiBin dr logRef input
+ `catch` \ioe -> do
    let msg = "Error: " ++ ioeGetErrorString ioe
-   in return (emptyRequest, msg, "text/plain")
+   Log.changeLog logRef (\r -> r { Log.errormsg = msg })
+   return (emptyRequest, msg, "text/plain")
  where
    run XML  = processXML
    run JSON = processJSON

@@ -1,7 +1,7 @@ -----------------------------------------------------------------------------
--- Copyright 2015, Open Universiteit Nederland. This file is distributed
--- under the terms of the GNU General Public License. For more information,
--- see the file "LICENSE.txt", which is included in the distribution.
+-- Copyright 2015, Ideas project team. This file is distributed under the
+-- terms of the Apache License 2.0. For more information, see the files
+-- "LICENSE.txt" and "NOTICE.txt", which are included in the distribution.
 -----------------------------------------------------------------------------
 -- |
 -- Maintainer  :  bastiaan.heeren@ou.nl
@@ -11,7 +11,7 @@ -- Manages links to information
 --
 -----------------------------------------------------------------------------
---  $Id: Documentation.hs 7524 2015-04-08 07:31:15Z bastiaan $
+--  $Id: Documentation.hs 8740 2015-10-14 19:26:22Z bastiaan $
 
 module Ideas.Main.Documentation (makeDocumentation) where
 

@@ -0,0 +1,188 @@+{-# LANGUAGE CPP #-}
+-----------------------------------------------------------------------------
+-- Copyright 2015, Ideas project team. This file is distributed under the
+-- terms of the Apache License 2.0. For more information, see the files
+-- "LICENSE.txt" and "NOTICE.txt", which are included in the distribution.
+-----------------------------------------------------------------------------
+-- |
+-- Maintainer  :  bastiaan.heeren@ou.nl
+-- Stability   :  provisional
+-- Portability :  portable (depends on ghc)
+--
+-- Facilities to create a log database
+--
+-----------------------------------------------------------------------------
+--  $Id: Logging.hs 8743 2015-10-14 19:48:13Z bastiaan $
+
+module Ideas.Main.Logging
+   ( Record(..), addRequest, addState
+   , LogRef, newLogRef, noLogRef, changeLog
+   , logEnabled, logRecord, printLog
+   ) where
+
+import Data.IORef
+import Data.Maybe
+import Data.Time
+import Ideas.Service.Request (Request, Schema(..))
+import Ideas.Service.State
+import qualified Ideas.Service.Request as R
+
+#ifdef DB
+import Data.List
+import Database.HDBC
+import Database.HDBC.Sqlite3 (connectSqlite3)
+#endif
+
+type Diff = NominalDiffTime
+type Time = UTCTime
+
+-- | The Record datatype is based on the Ideas Request Logging Schema version 2.
+data Record = Record
+   { -- request attributes
+     service      :: String  -- name of feedback service
+   , exerciseid   :: String  -- exercise identifier
+   , source       :: String  -- tool/learning environment that makes request
+   , script       :: String  -- name of feedback script (for textual feedback)
+   , requestinfo  :: String  -- additional information from client (only for logging)
+     -- request format
+   , dataformat   :: String  -- xml, json
+   , encoding     :: String  -- options for encoding (e.g. OpenMath, string)
+   , -- grouping requests
+     userid       :: String  -- user identifier (e.g. student number)
+   , sessionid    :: String  -- session identifier (grouping requests for one task)
+   , taskid       :: String  -- task identifier (default: start term)
+     -- meta-information
+   , time         :: Time    -- date and time of request
+   , responsetime :: Diff    -- time needed for processing request
+   , ipaddress    :: String  -- IP address of client
+   , binary       :: String  -- name of (cgi) binary that is being executed
+   , version      :: String  -- version (and revision) information
+   , errormsg     :: String  -- internal error message (default: empty string)
+     -- service info
+   , serviceinfo  :: String  -- summary of reply (customized for each service)
+   , ruleid       :: String  -- rule identifier (customized for each service)
+     -- raw data
+   , input        :: String  -- raw input (request)
+   , output       :: String  -- raw output (reply)
+   }
+ deriving Show
+
+record :: Record
+record = Record "" "" "" "" "" "" "" "" "" "" t0 0 "" "" "" "" "" "" "" ""
+ where t0 = UTCTime (toEnum 0) 0
+
+makeRecord :: IO Record
+makeRecord = do
+   now <- getCurrentTime
+   return record { time = now }
+
+-- | Add record information from the Request datatype
+addRequest :: Request -> Record -> Record
+addRequest req r = r
+   { service     = maybe (service r) show (R.serviceId req)
+   , exerciseid  = maybe (exerciseid r) show (R.exerciseId req)
+   , source      = fromMaybe (source r) (R.source req)
+   , script      = fromMaybe (script r) (R.feedbackScript req)
+   , requestinfo = fromMaybe (requestinfo r) (R.requestInfo req)
+   , dataformat  = show (R.dataformat req)
+   , encoding    = show (R.encoding req)
+   , binary      = fromMaybe (binary r) (R.cgiBinary req)
+   }
+
+-- | Add record information from the state (userid, sessionid, taskid)
+addState :: State a -> Record -> Record
+addState st r = r
+   { userid    = fromMaybe (userid r)    (stateUser st)
+   , sessionid = fromMaybe (sessionid r) (stateSession st)
+   , taskid    = fromMaybe (taskid r)    (stateStartTerm st)
+   }
+
+---------------------------------------------------------------------
+
+newtype LogRef = L { mref :: Maybe (IORef Record) }
+
+noLogRef :: LogRef
+noLogRef = L Nothing
+
+newLogRef :: IO LogRef
+newLogRef = do
+   r   <- makeRecord
+   ref <- newIORef r
+   return (L (Just ref))
+
+getRecord :: LogRef -> IO Record
+getRecord = maybe (return record) readIORef . mref
+
+changeLog :: LogRef -> (Record -> Record) -> IO ()
+changeLog = maybe (\_ -> return ()) modifyIORef . mref
+
+printLog :: LogRef -> IO ()
+printLog logRef = do
+   putStrLn "-- log information"
+   getRecord logRef >>= print
+
+--------------------------------------------------------------------------------
+
+logEnabled :: Bool
+logRecord  :: Schema -> LogRef -> IO ()
+
+#ifdef DB
+logEnabled = True
+logRecord schema logRef =
+   case schema of
+      V1 -> connectSqlite3 "service.db"  >>= logRecordWith V1 logRef
+      V2 -> connectSqlite3 "requests.db" >>= logRecordWith V2 logRef
+      NoLogging -> return ()
+#else
+-- without logging
+logEnabled    = False
+logRecord _ _ = return ()
+#endif
+
+--------------------------------------------------------------------------------
+
+#ifdef DB
+nameOfTable :: Schema -> String
+nameOfTable V1 = "log"
+nameOfTable _  = "requests"
+
+columnsInTable :: Schema -> Record -> [SqlValue]
+columnsInTable V1 = values_v1
+columnsInTable _  = values_v2
+
+values_v1 :: Record -> [SqlValue]
+values_v1 r =
+   let get f = toSql (f r)
+   in [ get service, get exerciseid, get source, get dataformat, get encoding
+      , get input, get output, get ipaddress, get time, get responsetime
+      ]
+
+values_v2 :: Record -> [SqlValue]
+values_v2 r =
+   let get f = toSql (f r)
+   in [ get service, get exerciseid, get source, get script, get requestinfo
+      , get dataformat, get encoding, get userid, get sessionid, get taskid
+      , get time, get responsetime, get ipaddress, get binary, get version
+      , get errormsg, get serviceinfo, get ruleid, get input, get output
+      ]
+
+logRecordWith :: IConnection c => Schema -> LogRef -> c -> IO ()
+logRecordWith schema logRef conn = do
+   -- calculate duration
+   r   <- getRecord logRef
+   end <- getCurrentTime
+   let diff = diffUTCTime end (time r)
+   -- insert data into database
+   insertRecord schema r {responsetime = diff} conn
+   -- close the connection to the database
+   disconnect conn
+ `catchSql` \err ->
+   putStrLn $ "Error in logging to database: " ++ show err
+
+insertRecord :: IConnection c => Schema -> Record -> c ->  IO ()
+insertRecord schema r conn =
+   let cols = columnsInTable schema r
+       pars = "(" ++ intercalate "," (replicate (length cols) "?") ++ ")"
+       stm  = "INSERT INTO " ++ nameOfTable schema ++ " VALUES " ++ pars
+   in run conn stm cols >> commit conn
+#endif

@@ -1,81 +0,0 @@-{-# LANGUAGE CPP #-}
------------------------------------------------------------------------------
--- Copyright 2015, Open Universiteit Nederland. This file is distributed
--- under the terms of the GNU General Public License. For more information,
--- see the file "LICENSE.txt", which is included in the distribution.
------------------------------------------------------------------------------
--- |
--- Maintainer  :  alex.gerdes@ou.nl
--- Stability   :  provisional
--- Portability :  portable (depends on ghc)
---
--- Facilities to create a log database
---
------------------------------------------------------------------------------
---  $Id: LoggingDatabase.hs 7524 2015-04-08 07:31:15Z bastiaan $
-
-module Ideas.Main.LoggingDatabase (logMessage, logEnabled) where
-
-import Data.Time
-import Ideas.Service.Request
-#ifdef DB
-import Data.Maybe
-import Database.HDBC
-import Database.HDBC.Sqlite3 (connectSqlite3)
-
-logEnabled :: Bool
-logEnabled = True
-
--- | Log a message to the database (a Sqlite database).
-logMessage :: Request -> String -> String -> String -> UTCTime -> IO ()
-logMessage req input output ipaddress begin = do
-     -- make a connection with the database
-     conn <- connectSqlite3 "service.db"
-
-     -- check if the database exists, if not make one
-     --tables <- getTables conn
-     --if not (elem "log" tables) then run conn createStmt [] else return 0
-
-     -- calculate duration
-     end <- getCurrentTime
-     let diff = diffUTCTime end begin
-
-     -- insert data into database
-     run conn "INSERT INTO log VALUES (?,?,?,?,?,?,?,?,?,?)"
-             [ toSql $ maybe "unknown" show (serviceId req)
-             , toSql $ maybe "unknown" show (exerciseId req)
-             , toSql $ fromMaybe "unknown" (source req)
-             , toSql $ show (dataformat req)
-             , toSql $ show (encoding req)
-             , toSql $ input
-             , toSql $ output
-             , toSql $ ipaddress
-             , toSql $ begin
-             , toSql $ diff
-             ]
-     commit conn
-
-     -- close the connection to the database
-     disconnect conn
-  `catchSql` \err -> do putStrLn $ "Error in logging to database: " ++ show err
-
-{-
--- | Log table schema
-createStmt =  "CREATE TABLE log ( service      VARCHAR(250)"
-           ++                  ", exerciseId   VARCHAR(250)"
-           ++                  ", source       VARCHAR(250)"
-           ++                  ", dataformat   VARCHAR(250)"
-           ++                  ", encoding     VARCHAR(250)"
-           ++                  ", input        VARCHAR(250)"
-           ++                  ", output       VARCHAR(250)"
-           ++                  ", ipaddress    VARCHAR(20)"
-           ++                  ", time         TIME"
-           ++                  ", responsetime TIME)"
--}
-#else
-logMessage :: Request -> String -> String -> String -> UTCTime -> IO ()
-logMessage _ _ _ _ _ = return ()
-
-logEnabled :: Bool
-logEnabled = False
-#endif

@@ -1,8 +1,8 @@-----------------------------------------------------------------------------
--- Copyright 2015, Open Universiteit Nederland. This file is distributed
--- under the terms of the GNU General Public License. For more information,
--- see the file "LICENSE.txt", which is included in the distribution.
 -----------------------------------------------------------------------------
+-- Copyright 2015, Ideas project team. This file is distributed under the
+-- terms of the Apache License 2.0. For more information, see the files
+-- "LICENSE.txt" and "NOTICE.txt", which are included in the distribution.
+-----------------------------------------------------------------------------
 -- |
 -- Maintainer  :  bastiaan.heeren@ou.nl
 -- Stability   :  provisional
@@ -11,7 +11,7 @@ -- Options and command-line flags for services
 --
 -----------------------------------------------------------------------------
---  $Id: Options.hs 7524 2015-04-08 07:31:15Z bastiaan $
+--  $Id: Options.hs 8743 2015-10-14 19:48:13Z bastiaan $
 
 module Ideas.Main.Options
    ( Flag(..), getFlags
@@ -19,15 +19,17 @@    ) where
 
 import Data.Maybe
-import Ideas.Main.LoggingDatabase (logEnabled)
+import Ideas.Main.Logging (logEnabled)
 import Ideas.Main.Revision
 import System.Console.GetOpt
 import System.Environment
 import System.Exit
 
-data Flag = Version | Help | InputFile String
+data Flag = Version | Help | PrintLog
+          | InputFile String
           | MakePages FilePath | Test FilePath
           | MakeScriptFor String | AnalyzeScript FilePath
+
    deriving Eq
 
 header :: String
@@ -55,13 +57,14 @@ 
 options :: [OptDescr Flag]
 options =
-   [ Option []  ["version"]        (NoArg Version) "show version number"
-   , Option "?" ["help"]           (NoArg Help)    "show options"
-   , Option "f" ["file"]           fileArg         "use input FILE as request"
-   , Option ""  ["make-pages"]     pagesArg        "generate pages for exercises and services"
-   , Option ""  ["test"]           testArg         "run tests on directory (default: 'test')"
-   , Option ""  ["make-script"]    makeScrArg      "generate feedback script for exercise"
-   , Option ""  ["analyze-script"] analyzeScrArg   "analyze feedback script and report errors"
+   [ Option []  ["version"]        (NoArg Version)  "show version number"
+   , Option "?" ["help"]           (NoArg Help)     "show options"
+   , Option ""  ["print-log"]      (NoArg PrintLog) "print log information (for debugging)"
+   , Option "f" ["file"]           fileArg          "use input FILE as request"
+   , Option ""  ["make-pages"]     pagesArg         "generate pages for exercises and services"
+   , Option ""  ["test"]           testArg          "run tests on directory (default: 'test')"
+   , Option ""  ["make-script"]    makeScrArg       "generate feedback script for exercise"
+   , Option ""  ["analyze-script"] analyzeScrArg    "analyze feedback script and report errors"
    ]
 
 fileArg, testArg, pagesArg, makeScrArg, analyzeScrArg :: ArgDescr Flag

@@ -2,10 +2,10 @@ module Ideas.Main.Revision where  ideasVersion :: String-ideasVersion = "1.3"+ideasVersion = "1.4"  ideasRevision :: Int-ideasRevision = 7519+ideasRevision = 8775  ideasLastChanged :: String-ideasLastChanged = "wo, 08 apr 2015"+ideasLastChanged = "vr, 23 okt 2015"

@@ -1,7 +1,7 @@ -----------------------------------------------------------------------------
--- Copyright 2015, Open Universiteit Nederland. This file is distributed
--- under the terms of the GNU General Public License. For more information,
--- see the file "LICENSE.txt", which is included in the distribution.
+-- Copyright 2015, Ideas project team. This file is distributed under the
+-- terms of the Apache License 2.0. For more information, see the files
+-- "LICENSE.txt" and "NOTICE.txt", which are included in the distribution.
 -----------------------------------------------------------------------------
 -- |
 -- Maintainer  :  bastiaan.heeren@ou.nl
@@ -9,7 +9,7 @@ -- Portability :  portable (depends on ghc)
 --
 -----------------------------------------------------------------------------
---  $Id: BasicServices.hs 7524 2015-04-08 07:31:15Z bastiaan $
+--  $Id: BasicServices.hs 8740 2015-10-14 19:26:22Z bastiaan $
 
 module Ideas.Service.BasicServices
    ( -- * Basic Services
@@ -30,20 +30,20 @@ import qualified Ideas.Common.Classes as Apply
 import qualified Ideas.Common.Library as Library
 
-generate :: StdGen -> Exercise a -> Maybe Difficulty -> Either String (State a)
-generate rng ex md =
+generate :: StdGen -> Exercise a -> Maybe Difficulty -> Maybe String -> IO (State a)
+generate rng ex md userId =
    case randomTerm rng ex md of
-      Just a  -> return (emptyState ex a)
-      Nothing -> Left "No random term"
+      Just a  -> startState ex userId a
+      Nothing -> fail "No random term"
 
-create :: Exercise a -> String -> Either String (State a)
-create ex input =
-    case parser ex input of
-        Left err -> Left err
-        Right a
-            | evalPredicate (Library.ready ex) a -> Left "Is ready"
-            | evalPredicate (Library.suitable ex) a -> Right (emptyState ex a)
-            | otherwise -> Left "Not suitable"
+create :: Exercise a -> String -> Maybe String -> IO (State a)
+create ex input userId =
+   case parser ex input of
+      Left err -> fail err
+      Right a
+         | evalPredicate (Library.ready ex) a -> fail "Is ready"
+         | evalPredicate (Library.suitable ex) a -> startState ex userId a
+         | otherwise -> fail "Not suitable"
 
 -- TODO: add a location to each step
 solution :: Maybe StrategyCfg -> State a -> Either String (Derivation (Rule (Context a), Environment) (Context a))
@@ -56,8 +56,8 @@       -- restriction should probably be relaxed later on.
       Just cfg | isEmptyPrefix prfx ->
          let newStrategy = configure cfg (strategy ex)
-             newExercise = ex {strategy = newStrategy}
-         in rec timeout d0 (emptyStateContext newExercise (stateContext state))
+             newPrefix   = emptyPrefix newStrategy (stateContext state)
+         in rec timeout d0 state { statePrefix = newPrefix }
       _ -> rec timeout d0 state
  where
    d0   = emptyDerivation state
@@ -86,7 +86,7 @@    | otherwise = Right $
         noDuplicates $ map make $ firsts state
  where
-   make ((s, ctx), st) = ((stepRule s, location ctx, stepEnvironment s), st)
+   make ((s, ctx, env), st) = ((s, location ctx, env), st)
 
    noDuplicates []     = []
    noDuplicates (x:xs) = x : noDuplicates (filter (not . eq x) xs)
@@ -116,7 +116,7 @@    ys = f (top (stateContext state))
 
    f c = g c ++ concatMap f (downs c)
-   g c = [ (r, location new, makeNoState ex new)
+   g c = [ (r, location new, state { statePrefix = noPrefix, stateContext = new })
          | r   <- ruleset ex
          , (r, location c) `notElem` ps
          , new <- applyAll r c
@@ -146,7 +146,7 @@    ca = setLocation loc (stateContext state)
    applyOff  = -- scenario 2: off-strategy
       case transApplyWith env (transformation r) ca of
-         (new, _):_ -> Right (makeNoState (exercise state) new)
+         (new, _):_ -> Right (state {stateContext = new, statePrefix = noPrefix})
          []         -> Left ("Cannot apply " ++ show r)
 
 stepsremaining :: State a -> Either String Int

@@ -1,8 +1,8 @@ {-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
 -----------------------------------------------------------------------------
--- Copyright 2015, Open Universiteit Nederland. This file is distributed
--- under the terms of the GNU General Public License. For more information,
--- see the file "LICENSE.txt", which is included in the distribution.
+-- Copyright 2015, Ideas project team. This file is distributed under the
+-- terms of the Apache License 2.0. For more information, see the files
+-- "LICENSE.txt" and "NOTICE.txt", which are included in the distribution.
 -----------------------------------------------------------------------------
 -- |
 -- Maintainer  :  bastiaan.heeren@ou.nl
@@ -12,15 +12,15 @@ -- Diagnose a term submitted by a student
 --
 -----------------------------------------------------------------------------
---  $Id: Diagnose.hs 7524 2015-04-08 07:31:15Z bastiaan $
+--  $Id: Diagnose.hs 8743 2015-10-14 19:48:13Z bastiaan $
 
 module Ideas.Service.Diagnose
-   ( Diagnosis(..), tDiagnosis, diagnose, restartIfNeeded, newState
+   ( Diagnosis(..), tDiagnosis, diagnose
    , difference, differenceEqual
    ) where
 
 import Data.Function
-import Data.List (sortBy)
+import Data.List (intercalate, sortBy)
 import Data.Maybe
 import Ideas.Common.Library hiding (ready)
 import Ideas.Service.BasicServices hiding (apply)
@@ -32,9 +32,8 @@ -- Result types for diagnose service
 
 data Diagnosis a
-   = Buggy          Environment (Rule (Context a))
---   | Missing
---   | IncorrectPart  [a]
+   = SyntaxError    String
+   | Buggy          Environment (Rule (Context a))
    | NotEquivalent  String
    | Similar        Bool (State a)
    | WrongRule      Bool (State a) (Maybe (Rule (Context a)))
@@ -47,22 +46,20 @@ instance Show (Diagnosis a) where
    show diagnosis =
       case diagnosis of
-         Buggy as r       -> "Buggy rule " ++ show (show r) ++ showArgs as
-         Unknown _ _      -> "Unknown step"
---         Missing          -> "Missing solutions"
---         IncorrectPart xs -> "Incorrect parts (" ++ show (length xs) ++ " items)"
-         NotEquivalent s  -> if null s then "Unknown mistake" else s
-         Similar _ _      -> "Very similar"
-         WrongRule _ _ mr -> "Wrong rule selected"  ++
-                             maybe "" (\r -> ", " ++ showId r ++ "recognized") mr
-         Expected _ _ r   -> "Rule " ++ show (show r) ++ ", expected by strategy"
-         Detour _ _ _ r   -> "Rule " ++ show (show r) ++ ", not following strategy"
-         Correct _ _      -> "Unknown step"
+         SyntaxError s    -> f "SyntaxError" [s]
+         Buggy _ r        -> f "Buggy" [show r]
+         NotEquivalent s  -> f "NotEquivalent" [ s | not (null s) ]
+         Similar _ _      -> "Similar"
+         WrongRule _ _ mr -> f "WrongRule" [ show r | r <- maybeToList mr ]
+         Expected _ _ r   -> f "Expected" [show r]
+         Detour _ _ _ r   -> f "Detour" [show r]
+         Correct _ _      -> "Correct"
+         Unknown _ _      -> "Unknown"
     where
-      showArgs as
-         | noBindings as = ""
-         | otherwise     = " (" ++ show as ++ ")"
-
+      f s xs
+         | null xs   = s
+         | otherwise = s ++ "(" ++ intercalate "," xs ++ ")"
+{-
 newState :: Diagnosis a -> Maybe (State a)
 newState diagnosis =
    case diagnosis of
@@ -74,7 +71,7 @@       Detour   _ s _ _ -> Just s
       Correct  _ s     -> Just s
       Unknown  _ s     -> Just s
-
+-}
 ----------------------------------------------------------------
 -- The diagnose service
 
@@ -118,11 +115,11 @@               Correct (finished restarted) restarted
  where
    ex        = exercise state
-   restarted = restartIfNeeded (makeNoState ex new)
+   restarted = restart state {stateContext = new}
    similar   = similarity ex (stateContext state) new
 
    expected = do
-      let xs = either (const []) id $ allfirsts (restartIfNeeded state)
+      let xs = either (const []) id $ allfirsts state
           p (_, ns) = similarity ex new (stateContext ns) -- use rule recognizer?
       listToMaybe (filter p xs)
 
@@ -143,40 +140,27 @@ ----------------------------------------------------------------
 -- Helpers
 
--- If possible (and if needed), restart the strategy
--- Make sure that the new state has a prefix
--- When resetting the prefix, also make sure that the context is refreshed
-restartIfNeeded :: State a -> State a
-restartIfNeeded state
-   | withoutPrefix state && canBeRestarted ex =
-        emptyState ex (stateTerm state)
-   | otherwise = state
- where
-   ex = exercise state
-
 tDiagnosis :: Type a (Diagnosis a)
 tDiagnosis = Tag "Diagnosis" $ Iso (f <-> g) tp
     where
-      tp = (tPair tEnvironment tRule :|: (tString :|: tTuple3 tBool tState (tMaybe tRule)))
+      tp = (tString :|: tPair tEnvironment tRule :|: (tString :|: tTuple3 tBool tState (tMaybe tRule)))
          :|: tPair tBool tState :|: tTuple3 tBool tState tRule
          :|: tTuple4 tBool tState tEnvironment tRule :|: tPair tBool tState :|: tPair tBool tState
 
-      f (Left (Left (as, r))) = Buggy as r
-   --   f (Left (Right (Left ()))) = Missing
-   --   f (Left (Right (Right (Left xs)))) = IncorrectPart xs
-      f (Left (Right (Left s))) = NotEquivalent s
-      f (Left (Right (Right (b, s, mr)))) = WrongRule b s mr
+      f (Left (Left s)) = SyntaxError s
+      f (Left (Right (Left (as, r)))) = Buggy as r
+      f (Left (Right (Right (Left s)))) = NotEquivalent s
+      f (Left (Right (Right (Right (b, s, mr))))) = WrongRule b s mr
       f (Right (Left (b, s))) = Similar b s
       f (Right (Right (Left (b, s, r)))) = Expected b s r
       f (Right (Right (Right (Left (b, s, as, r))))) = Detour b s as r
       f (Right (Right (Right (Right (Left (b, s)))))) = Correct b s
       f (Right (Right (Right (Right (Right (b, s)))))) = Unknown b s
 
-      g (Buggy as r)       = Left (Left (as, r))
-   --   g Missing            = Left (Right (Left ()))
-   --   g (IncorrectPart xs) = Left (Right (Right (Left xs)))
-      g (NotEquivalent s)  = Left (Right (Left s))
-      g (WrongRule b s mr) = Left (Right (Right (b, s, mr)))
+      g (SyntaxError s)    = Left (Left s)
+      g (Buggy as r)       = Left (Right (Left (as, r)))
+      g (NotEquivalent s)  = Left (Right (Right (Left s)))
+      g (WrongRule b s mr) = Left (Right (Right (Right (b, s, mr))))
       g (Similar b s)      = Right (Left (b, s))
       g (Expected b s r)   = Right (Right (Left (b, s, r)))
       g (Detour b s as r)  = Right (Right (Right (Left (b, s, as, r))))

@@ -1,8 +1,7 @@-{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, UndecidableInstances #-}
 -----------------------------------------------------------------------------
--- Copyright 2015, Open Universiteit Nederland. This file is distributed
--- under the terms of the GNU General Public License. For more information,
--- see the file "LICENSE.txt", which is included in the distribution.
+-- Copyright 2015, Ideas project team. This file is distributed under the
+-- terms of the Apache License 2.0. For more information, see the files
+-- "LICENSE.txt" and "NOTICE.txt", which are included in the distribution.
 -----------------------------------------------------------------------------
 -- |
 -- Maintainer  :  bastiaan.heeren@ou.nl
@@ -10,7 +9,7 @@ -- Portability :  portable (depends on ghc)
 --
 -----------------------------------------------------------------------------
---  $Id: DomainReasoner.hs 7524 2015-04-08 07:31:15Z bastiaan $
+--  $Id: DomainReasoner.hs 8740 2015-10-14 19:26:22Z bastiaan $
 
 module Ideas.Service.DomainReasoner
    ( DomainReasoner(..), tDomainReasoner, newDomainReasoner