ideas 1.7 → 1.8

raw patch · 107 files changed

+2125/−1664 lines, 107 filesdep +mtldep ~QuickCheckPVP ok

version bump matches the API change (PVP)

Dependencies added: mtl

Dependency ranges changed: QuickCheck

API changes (from Hackage documentation)

Files

• CHANGELOG.txt +15/−0
• NOTICE.txt +4/−3
• ideas.cabal +191/−188
• src/Ideas/Common/Classes.hs +1/−1
• src/Ideas/Common/Constraint.hs +2/−1
• src/Ideas/Common/Context.hs +4/−4
• src/Ideas/Common/Derivation.hs +47/−3
• src/Ideas/Common/DerivationTree.hs +1/−1
• src/Ideas/Common/Environment.hs +1/−2
• src/Ideas/Common/Examples.hs +226/−0
• src/Ideas/Common/Exercise.hs +40/−93
• src/Ideas/Common/ExerciseTests.hs +5/−5
• src/Ideas/Common/Id.hs +6/−6
• src/Ideas/Common/Library.hs +1/−1
• src/Ideas/Common/Predicate.hs +1/−1
• src/Ideas/Common/Rewriting.hs +2/−1
• src/Ideas/Common/Rewriting/AC.hs +1/−1
• src/Ideas/Common/Rewriting/AutoTerm.hs +124/−0
• src/Ideas/Common/Rewriting/Confluence.hs +1/−1
• src/Ideas/Common/Rewriting/Difference.hs +1/−1
• src/Ideas/Common/Rewriting/RewriteRule.hs +2/−2
• src/Ideas/Common/Rewriting/Substitution.hs +1/−2
• src/Ideas/Common/Rewriting/Term.hs +6/−1
• src/Ideas/Common/Rewriting/Unification.hs +1/−1
• src/Ideas/Common/Rule.hs +1/−1
• src/Ideas/Common/Rule/Abstract.hs +1/−1
• src/Ideas/Common/Rule/Parameter.hs +1/−1
• src/Ideas/Common/Rule/Recognizer.hs +1/−2
• src/Ideas/Common/Rule/Transformation.hs +1/−2
• src/Ideas/Common/Strategy.hs +1/−1
• src/Ideas/Common/Strategy/Abstract.hs +1/−1
• src/Ideas/Common/Strategy/Choice.hs +1/−1
• src/Ideas/Common/Strategy/Combinators.hs +1/−1
• src/Ideas/Common/Strategy/Configuration.hs +1/−2
• src/Ideas/Common/Strategy/CyclicTree.hs +1/−1
• src/Ideas/Common/Strategy/Derived.hs +1/−1
• src/Ideas/Common/Strategy/Legacy.hs +1/−1
• src/Ideas/Common/Strategy/Location.hs +1/−1
• src/Ideas/Common/Strategy/Prefix.hs +1/−2
• src/Ideas/Common/Strategy/Process.hs +1/−1
• src/Ideas/Common/Strategy/Sequence.hs +1/−1
• src/Ideas/Common/Strategy/StrategyTree.hs +1/−1
• src/Ideas/Common/Strategy/Symbol.hs +1/−1
• src/Ideas/Common/Strategy/Traversal.hs +2/−2
• src/Ideas/Common/Traversal/Iterator.hs +1/−1
• src/Ideas/Common/Traversal/Navigator.hs +1/−2
• src/Ideas/Common/Traversal/Tests.hs +1/−1
• src/Ideas/Common/Traversal/Utils.hs +1/−1
• src/Ideas/Common/View.hs +1/−1
• src/Ideas/Encoding/DecoderJSON.hs +17/−16
• src/Ideas/Encoding/DecoderXML.hs +20/−47
• src/Ideas/Encoding/Encoder.hs +37/−201
• src/Ideas/Encoding/EncoderHTML.hs +206/−187
• src/Ideas/Encoding/EncoderJSON.hs +71/−79
• src/Ideas/Encoding/EncoderXML.hs +115/−106
• src/Ideas/Encoding/Evaluator.hs +12/−11
• src/Ideas/Encoding/LinkManager.hs +4/−3
• src/Ideas/Encoding/Logging.hs +81/−29
• src/Ideas/Encoding/ModeJSON.hs +11/−11
• src/Ideas/Encoding/ModeXML.hs +17/−16
• src/Ideas/Encoding/OpenMathSupport.hs +1/−1
• src/Ideas/Encoding/Options.hs +30/−28
• src/Ideas/Encoding/Request.hs +3/−7
• src/Ideas/Encoding/RulePresenter.hs +5/−4
• src/Ideas/Encoding/RulesInfo.hs +4/−2
• src/Ideas/Encoding/StrategyInfo.hs +12/−12
• src/Ideas/Main/CmdLineOptions.hs +6/−4
• src/Ideas/Main/Default.hs +51/−38
• src/Ideas/Main/Revision.hs +11/−11
• src/Ideas/Service/BasicServices.hs +11/−8
• src/Ideas/Service/Diagnose.hs +1/−1
• src/Ideas/Service/DomainReasoner.hs +3/−5
• src/Ideas/Service/FeedbackScript/Analysis.hs +1/−1
• src/Ideas/Service/FeedbackScript/Parser.hs +1/−2
• src/Ideas/Service/FeedbackScript/Run.hs +1/−1
• src/Ideas/Service/FeedbackScript/Syntax.hs +1/−2
• src/Ideas/Service/FeedbackText.hs +1/−1
• src/Ideas/Service/ProblemDecomposition.hs +1/−1
• src/Ideas/Service/ServiceList.hs +4/−4
• src/Ideas/Service/State.hs +1/−1
• src/Ideas/Service/Submit.hs +1/−1
• src/Ideas/Service/Types.hs +16/−4
• src/Ideas/Text/HTML.hs +99/−25
• src/Ideas/Text/HTML/Templates.hs +5/−3
• src/Ideas/Text/HTML/W3CSS.hs +2/−1
• src/Ideas/Text/JSON.hs +3/−3
• src/Ideas/Text/Latex.hs +2/−3
• src/Ideas/Text/MathML.hs +50/−35
• src/Ideas/Text/OpenMath/FMP.hs +1/−1
• src/Ideas/Text/OpenMath/Object.hs +26/−21
• src/Ideas/Text/OpenMath/Symbol.hs +1/−1
• src/Ideas/Text/OpenMath/Tests.hs +1/−1
• src/Ideas/Text/UTF8.hs +1/−1
• src/Ideas/Text/XML.hs +315/−91
• src/Ideas/Text/XML/Document.hs +19/−113
• src/Ideas/Text/XML/Interface.hs +0/−137
• src/Ideas/Text/XML/Parser.hs +7/−6
• src/Ideas/Text/XML/Unicode.hs +1/−1
• src/Ideas/Utils/BlackBoxTests.hs +1/−1
• src/Ideas/Utils/Decoding.hs +91/−0
• src/Ideas/Utils/Parsing.hs +1/−1
• src/Ideas/Utils/Prelude.hs +21/−3
• src/Ideas/Utils/QuickCheck.hs +3/−4
• src/Ideas/Utils/StringRef.hs +1/−1
• src/Ideas/Utils/TestSuite.hs +5/−14
• src/Ideas/Utils/Typeable.hs +1/−1
• src/Ideas/Utils/Uniplate.hs +1/−1

@@ -1,3 +1,18 @@+Changelog ideas-1.7 => ideas-1.8++* support for automatically generated (generic) IsTerm instances+* introducing Examples data type for exercise records (unifying expr lists/generators)+* redesigning xml interface (with proper character escaping)+* adding literal xml to service types+* introducing ToXML and ToHTML type classes+* new command-line option for rerunning inputs in database+* solution service variant with parameterized max number of steps+* adding instance for IsTerm (a, b, c)+* extending derivation interface (in Ideas.Common.Derivation)+* refactoring logging interface and database name+* new general Decoding module in utils; refactored encoders/decoders+* moving unicode decoding from parseXML/parseJSON to Main.Default+ Changelog ideas-1.6 => ideas.1.7  * replacing network.cgi package by WAI

@@ -1,4 +1,4 @@-Copyright 2018 Ideas project team+Copyright 2019 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.@@ -23,7 +23,7 @@    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/+       http://ideas.cs.uu.nl/         AUTHORS @@ -35,4 +35,5 @@ CREDITS     Harrie Passier, Arthur van Leeuwen, Josje Lodder, Hieke Keuning, -   Marcell van Geest, Jordy van Dortmont, Jorn van Wijk+   Marcell van Geest, Jordy van Dortmont, Jorn van Wijk, Alejandro Serrano Mena,+   Niels Steenbergen, Wink van Zon

@@ -1,188 +1,191 @@-name:                   ideas-version:                1.7-synopsis:               Feedback services for intelligent tutoring systems-homepage:               http://ideas.cs.uu.nl/www/-description:--  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) 2018-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:     NOTICE.txt, CHANGELOG.txt-build-type:             Simple-cabal-version:          >= 1.8.0.2-tested-with:            GHC == 7.10.3, GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.2--source-repository head-  type:     git-  location: https://github.com/ideas-edu/ideas.git--flag logging-  description: enable support for logging interactions to a sqlite3 database-  default: True------------------------------------------------------------------------------------Library-  if flag(logging) {-    cpp-options:     -DDB-    Build-Depends:   HDBC, HDBC-sqlite3-  }--  ghc-options:       -Wall-  hs-source-dirs:    src-  Build-Depends:-     base >= 4.8 && < 5,-     blaze-builder >= 0.4,-     bytestring,-     case-insensitive,-     QuickCheck >= 2.8,-     Diff,-     containers,-     directory,-     filepath,-     http-types,-     network,-     parsec,-     random,-     streaming-commons < 0.2,-     time,-     uniplate, -     wai,-     wl-pprint--  if !impl(ghc >= 8.0)-    Build-Depends: semigroups == 0.18.*--  Exposed-modules:-    Ideas.Common.Classes-    Ideas.Common.Constraint-    Ideas.Common.Context-    Ideas.Common.Derivation-    Ideas.Common.DerivationTree-    Ideas.Common.Environment-    Ideas.Common.Exercise-    Ideas.Common.ExerciseTests-    Ideas.Common.Id-    Ideas.Common.Library-    Ideas.Common.Predicate-    Ideas.Common.Rewriting-    Ideas.Common.Rewriting.AC-    Ideas.Common.Rewriting.Confluence-    Ideas.Common.Rewriting.Difference-    Ideas.Common.Rewriting.RewriteRule-    Ideas.Common.Rewriting.Substitution-    Ideas.Common.Rewriting.Term-    Ideas.Common.Rewriting.Unification-    Ideas.Common.Rule-    Ideas.Common.Rule.Abstract-    Ideas.Common.Rule.Parameter-    Ideas.Common.Rule.Recognizer-    Ideas.Common.Rule.Transformation-    Ideas.Common.Strategy-    Ideas.Common.Strategy.Abstract-    Ideas.Common.Strategy.Choice-    Ideas.Common.Strategy.Combinators-    Ideas.Common.Strategy.Configuration-    Ideas.Common.Strategy.CyclicTree-    Ideas.Common.Strategy.Derived-    Ideas.Common.Strategy.Legacy-    Ideas.Common.Strategy.Location-    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-    Ideas.Common.Traversal.Tests-    Ideas.Common.Traversal.Utils-    Ideas.Common.View-    Ideas.Encoding.DecoderJSON-    Ideas.Encoding.DecoderXML-    Ideas.Encoding.Encoder-    Ideas.Encoding.EncoderHTML-    Ideas.Encoding.EncoderJSON-    Ideas.Encoding.EncoderXML-    Ideas.Encoding.Evaluator-    Ideas.Encoding.LinkManager-    Ideas.Encoding.Logging-    Ideas.Encoding.ModeJSON-    Ideas.Encoding.ModeXML-    Ideas.Encoding.OpenMathSupport-    Ideas.Encoding.Options-    Ideas.Encoding.Request-    Ideas.Encoding.RulePresenter-    Ideas.Encoding.RulesInfo-    Ideas.Encoding.StrategyInfo-    Ideas.Main.CGI-    Ideas.Main.CmdLineOptions-    Ideas.Main.Default-    Ideas.Main.Revision-    Ideas.Service.BasicServices-    Ideas.Service.Diagnose-    Ideas.Service.DomainReasoner-    Ideas.Service.FeedbackScript.Analysis-    Ideas.Service.FeedbackScript.Parser-    Ideas.Service.FeedbackScript.Run-    Ideas.Service.FeedbackScript.Syntax-    Ideas.Service.FeedbackText-    Ideas.Service.ProblemDecomposition-    Ideas.Service.ServiceList-    Ideas.Service.State-    Ideas.Service.Submit-    Ideas.Service.Types-    Ideas.Text.HTML-    Ideas.Text.HTML.Templates-    Ideas.Text.HTML.W3CSS-    Ideas.Text.JSON-    Ideas.Text.Latex-    Ideas.Text.MathML-    Ideas.Text.OpenMath.Dictionary.Arith1-    Ideas.Text.OpenMath.Dictionary.Calculus1-    Ideas.Text.OpenMath.Dictionary.Fns1-    Ideas.Text.OpenMath.Dictionary.Linalg2-    Ideas.Text.OpenMath.Dictionary.List1-    Ideas.Text.OpenMath.Dictionary.Logic1-    Ideas.Text.OpenMath.Dictionary.Nums1-    Ideas.Text.OpenMath.Dictionary.Quant1-    Ideas.Text.OpenMath.Dictionary.Relation1-    Ideas.Text.OpenMath.Dictionary.Transc1-    Ideas.Text.OpenMath.FMP-    Ideas.Text.OpenMath.Object-    Ideas.Text.OpenMath.Symbol-    Ideas.Text.OpenMath.Tests-    Ideas.Text.UTF8-    Ideas.Text.XML-    Ideas.Text.XML.Document-    Ideas.Text.XML.Interface-    Ideas.Text.XML.Parser-    Ideas.Text.XML.Unicode-    Ideas.Utils.BlackBoxTests-    Ideas.Utils.Parsing-    Ideas.Utils.Prelude-    Ideas.Utils.QuickCheck-    Ideas.Utils.StringRef-    Ideas.Utils.TestSuite-    Ideas.Utils.Typeable-    Ideas.Utils.Uniplate----------------------------------------------------------------------------------+name:                   ideas
+version:                1.8
+synopsis:               Feedback services for intelligent tutoring systems
+homepage:               http://ideas.cs.uu.nl/
+description:
+
+  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) 2019
+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:     NOTICE.txt, CHANGELOG.txt
+build-type:             Simple
+cabal-version:          >= 1.8.0.2
+tested-with:            GHC == 7.10.3, GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.2
+
+source-repository head
+  type:     git
+  location: https://github.com/ideas-edu/ideas.git
+
+flag logging
+  description: enable support for logging interactions to a sqlite3 database
+  default: True
+
+--------------------------------------------------------------------------------
+
+Library
+  if flag(logging) {
+    cpp-options:     -DDB
+    Build-Depends:   HDBC, HDBC-sqlite3
+  }
+
+  ghc-options:       -Wall
+  hs-source-dirs:    src
+  Build-Depends:
+     base >= 4.8 && < 5,
+     blaze-builder >= 0.4,
+     bytestring,
+     case-insensitive,
+     QuickCheck >= 2.8 && < 2.12,
+     Diff,
+     containers,
+     directory,
+     filepath,
+     http-types,
+     mtl,
+     network,
+     parsec,
+     random,
+     streaming-commons < 0.2,
+     time,
+     uniplate, 
+     wai,
+     wl-pprint
+
+  if !impl(ghc >= 8.0)
+    Build-Depends: semigroups == 0.18.*
+
+  Exposed-modules:
+    Ideas.Common.Classes
+    Ideas.Common.Constraint
+    Ideas.Common.Context
+    Ideas.Common.Derivation
+    Ideas.Common.DerivationTree
+    Ideas.Common.Environment
+    Ideas.Common.Examples
+    Ideas.Common.Exercise
+    Ideas.Common.ExerciseTests
+    Ideas.Common.Id
+    Ideas.Common.Library
+    Ideas.Common.Predicate
+    Ideas.Common.Rewriting
+    Ideas.Common.Rewriting.AC
+    Ideas.Common.Rewriting.AutoTerm
+    Ideas.Common.Rewriting.Confluence
+    Ideas.Common.Rewriting.Difference
+    Ideas.Common.Rewriting.RewriteRule
+    Ideas.Common.Rewriting.Substitution
+    Ideas.Common.Rewriting.Term
+    Ideas.Common.Rewriting.Unification
+    Ideas.Common.Rule
+    Ideas.Common.Rule.Abstract
+    Ideas.Common.Rule.Parameter
+    Ideas.Common.Rule.Recognizer
+    Ideas.Common.Rule.Transformation
+    Ideas.Common.Strategy
+    Ideas.Common.Strategy.Abstract
+    Ideas.Common.Strategy.Choice
+    Ideas.Common.Strategy.Combinators
+    Ideas.Common.Strategy.Configuration
+    Ideas.Common.Strategy.CyclicTree
+    Ideas.Common.Strategy.Derived
+    Ideas.Common.Strategy.Legacy
+    Ideas.Common.Strategy.Location
+    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
+    Ideas.Common.Traversal.Tests
+    Ideas.Common.Traversal.Utils
+    Ideas.Common.View
+    Ideas.Encoding.DecoderJSON
+    Ideas.Encoding.DecoderXML
+    Ideas.Encoding.Encoder
+    Ideas.Encoding.EncoderHTML
+    Ideas.Encoding.EncoderJSON
+    Ideas.Encoding.EncoderXML
+    Ideas.Encoding.Evaluator
+    Ideas.Encoding.LinkManager
+    Ideas.Encoding.Logging
+    Ideas.Encoding.ModeJSON
+    Ideas.Encoding.ModeXML
+    Ideas.Encoding.OpenMathSupport
+    Ideas.Encoding.Options
+    Ideas.Encoding.Request
+    Ideas.Encoding.RulePresenter
+    Ideas.Encoding.RulesInfo
+    Ideas.Encoding.StrategyInfo
+    Ideas.Main.CGI
+    Ideas.Main.CmdLineOptions
+    Ideas.Main.Default
+    Ideas.Main.Revision
+    Ideas.Service.BasicServices
+    Ideas.Service.Diagnose
+    Ideas.Service.DomainReasoner
+    Ideas.Service.FeedbackScript.Analysis
+    Ideas.Service.FeedbackScript.Parser
+    Ideas.Service.FeedbackScript.Run
+    Ideas.Service.FeedbackScript.Syntax
+    Ideas.Service.FeedbackText
+    Ideas.Service.ProblemDecomposition
+    Ideas.Service.ServiceList
+    Ideas.Service.State
+    Ideas.Service.Submit
+    Ideas.Service.Types
+    Ideas.Text.HTML
+    Ideas.Text.HTML.Templates
+    Ideas.Text.HTML.W3CSS
+    Ideas.Text.JSON
+    Ideas.Text.Latex
+    Ideas.Text.MathML
+    Ideas.Text.OpenMath.Dictionary.Arith1
+    Ideas.Text.OpenMath.Dictionary.Calculus1
+    Ideas.Text.OpenMath.Dictionary.Fns1
+    Ideas.Text.OpenMath.Dictionary.Linalg2
+    Ideas.Text.OpenMath.Dictionary.List1
+    Ideas.Text.OpenMath.Dictionary.Logic1
+    Ideas.Text.OpenMath.Dictionary.Nums1
+    Ideas.Text.OpenMath.Dictionary.Quant1
+    Ideas.Text.OpenMath.Dictionary.Relation1
+    Ideas.Text.OpenMath.Dictionary.Transc1
+    Ideas.Text.OpenMath.FMP
+    Ideas.Text.OpenMath.Object
+    Ideas.Text.OpenMath.Symbol
+    Ideas.Text.OpenMath.Tests
+    Ideas.Text.UTF8
+    Ideas.Text.XML
+    Ideas.Text.XML.Document
+    Ideas.Text.XML.Parser
+    Ideas.Text.XML.Unicode
+    Ideas.Utils.BlackBoxTests
+    Ideas.Utils.Decoding
+    Ideas.Utils.Parsing
+    Ideas.Utils.Prelude
+    Ideas.Utils.QuickCheck
+    Ideas.Utils.StringRef
+    Ideas.Utils.TestSuite
+    Ideas.Utils.Typeable
+    Ideas.Utils.Uniplate
+
+--------------------------------------------------------------------------------

@@ -1,5 +1,5 @@ -----------------------------------------------------------------------------
--- Copyright 2018, Ideas project team. This file is distributed under the
+-- Copyright 2019, 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.
 -----------------------------------------------------------------------------

@@ -1,5 +1,5 @@ -----------------------------------------------------------------------------
--- Copyright 2018, Ideas project team. This file is distributed under the
+-- Copyright 2019, 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.
 -----------------------------------------------------------------------------
@@ -75,6 +75,7 @@ -- Result
 
 data Result a = Irrelevant | Error String | Ok a
+   deriving Show
 
 instance Functor Result where
    fmap _ Irrelevant  = Irrelevant

@@ -1,6 +1,6 @@ {-# LANGUAGE GADTs, RankNTypes #-}
 -----------------------------------------------------------------------------
--- Copyright 2018, Ideas project team. This file is distributed under the
+-- Copyright 2019, 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.
 -----------------------------------------------------------------------------
@@ -102,8 +102,8 @@ 
 liftCN :: Monad m => (forall b . Navigator b => b -> m b)
                   -> Context a -> m (Context a)
-liftCN f (C env (TermNav a)) = (C env . TermNav) <$> f a
-liftCN f (C env (Simple a))  = (C env . Simple)  <$> f a
+liftCN f (C env (TermNav a)) = C env . TermNav <$> f a
+liftCN f (C env (Simple a))  = C env . Simple  <$> f a
 liftCN _ (C _   (NoNav _))   = fail "noNavigator"
 
 navLocation :: ContextNavigator a -> Location
@@ -159,7 +159,7 @@ useC = liftViewIn (makeView f g)
  where
    f old@(C env a) = castT a >>= \b -> return (C env b, old)
-   g (C env a, old) = fromMaybe old (C env <$> castT a)
+   g (C env a, old) = maybe old (C env) (castT a)
 
 currentTerm :: Context a -> Maybe Term
 currentTerm = currentT . getNavigator

@@ -1,5 +1,5 @@ -----------------------------------------------------------------------------
--- Copyright 2018, Ideas project team. This file is distributed under the
+-- Copyright 2019, 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.
 -----------------------------------------------------------------------------
@@ -18,14 +18,19 @@      Derivation
      -- * Constructing a derivation
    , emptyDerivation, prepend, extend
+   , merge, mergeBy, mergeStep
+     -- * Conversion to/from list
+   , derivationToList, derivationFromList
      -- * Querying a derivation
    , isEmpty, derivationLength, terms, steps, triples
    , firstTerm, lastTerm, lastStep, withoutLast
-   , updateSteps, derivationM
+   , updateSteps, derivationM, splitStep
    ) where
 
 import Data.Maybe
+import Data.Monoid
 import Ideas.Common.Classes
+import Ideas.Common.Rewriting
 import qualified Data.Foldable as F
 import qualified Data.Sequence as S
 
@@ -33,6 +38,7 @@ -- Data type definition and instances
 
 data Derivation s a = D a (S.Seq (s, a))
+   deriving Eq
 
 instance (Show s, Show a) => Show (Derivation s a) where
    show (D a xs) = unlines $
@@ -44,6 +50,11 @@ instance BiFunctor Derivation where
    biMap f g (D a xs) = D (g a) (fmap (biMap f g) xs)
 
+instance (IsTerm s, IsTerm a) => IsTerm (Derivation s a) where
+   toTerm = TList . derivationToList toTerm toTerm
+   fromTerm (TList xs) = derivationFromList fromTerm fromTerm xs
+   fromTerm _ = fail "not a derivation"
+
 -----------------------------------------------------------------------------
 -- Constructing a derivation
 
@@ -56,7 +67,32 @@ extend :: Derivation s a -> (s, a) -> Derivation s a
 extend (D a xs) p = D a (xs S.|> p)
 
+merge :: Eq a => Derivation s a -> Derivation s a -> Maybe (Derivation s a)
+merge = mergeBy (==)
+
+mergeBy :: (a -> a -> Bool) -> Derivation s a -> Derivation s a -> Maybe (Derivation s a)
+mergeBy eq d@(D a xs) (D b ys)
+   | eq (lastTerm d) b = Just $ D a (xs <> ys)
+   | otherwise = Nothing
+
+mergeStep :: Derivation s a -> s -> Derivation s a -> Derivation s a
+mergeStep (D a xs) s (D b ys) = D a (xs <> ((s, b) S.<| ys))
+
 -----------------------------------------------------------------------------
+-- Conversion to/from list
+
+derivationToList :: (s -> b) -> (a -> b) -> Derivation s a -> [b]
+derivationToList f g d =
+   g (firstTerm d) : concat [ [f s, g a] | (_, s, a) <- triples d ]
+
+derivationFromList :: Monad m => (b -> m s) -> (b -> m a) -> [b] -> m (Derivation s a)
+derivationFromList f g = rec
+ where
+   rec []  = fail "derivationFromList"
+   rec [b] = emptyDerivation <$> g b
+   rec (b1:b2:bs) = curry prepend <$> g b1 <*> f b2 <*> rec bs
+
+-----------------------------------------------------------------------------
 -- Querying a derivation
 
 -- | Tests whether the derivation is empty
@@ -103,4 +139,12 @@ 
 -- | Apply a monadic function to each term, and to each step
 derivationM :: Monad m => (s -> m ()) -> (a -> m ()) -> Derivation s a -> m ()
-derivationM f g (D a xs) = g a >> mapM_ (\(s, b) -> f s >> g b) (F.toList xs)+derivationM f g (D a xs) = g a >> mapM_ (\(s, b) -> f s >> g b) (F.toList xs)
+
+splitStep :: (s -> Bool) -> Derivation s a -> Maybe (Derivation s a, s, Derivation s a)
+splitStep p (D a xs) =
+   case S.viewl xs2 of
+      S.EmptyL -> Nothing
+      (s, b) S.:< ys -> Just (D a xs1, s, D b ys)
+ where
+   (xs1, xs2) = S.breakl (p . fst) xs

@@ -1,5 +1,5 @@ -----------------------------------------------------------------------------
--- Copyright 2018, Ideas project team. This file is distributed under the
+-- Copyright 2019, 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.
 -----------------------------------------------------------------------------

@@ -1,6 +1,6 @@ {-# LANGUAGE ExistentialQuantification #-}
 -----------------------------------------------------------------------------
--- Copyright 2018, Ideas project team. This file is distributed under the
+-- Copyright 2019, 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.
 -----------------------------------------------------------------------------
@@ -28,7 +28,6 @@ import Control.Monad
 import Data.Function
 import Data.List
-import Data.Monoid hiding ((<>))
 import Data.Semigroup as Sem
 import Ideas.Common.Id
 import Ideas.Common.Rewriting.Term

@@ -0,0 +1,226 @@+-----------------------------------------------------------------------------
+-- Copyright 2019, 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 provides an interface to structure a collection of examples.
+-- Examples can be taken from (lists of) concrete values, or from random
+-- generators. Both types can be marked as test items. Examples can be assigned
+-- a level of difficulty (ranging from very easy to very difficult). Test items
+-- do not have a difficulty level. Examples can be grouped into sub-collections
+-- and assigned an identifier. Use the @Monoid@ operations for combining
+-- examples.
+--
+-----------------------------------------------------------------------------
+
+module Ideas.Common.Examples
+   ( -- * Examples type
+     Examples
+     -- * Constructing examples
+   , example, exampleList, examplesFor, examplesWithDifficulty
+   , random, group, forTesting
+     -- * Assigning difficulty
+   , difficulty, veryEasy, easy, medium, difficult, veryDifficult
+     -- * Transformations and queries
+   , isEmpty, size, flatten, groups
+   , topLevelExamples, topLevelRandoms, topLevelTests, topLevelRandomTests
+   , allExamples, allRandoms, allTests, allRandomTests
+     -- * Difficulty type
+   , Difficulty(..), readDifficulty
+   ) where
+
+import Data.Char
+import Data.Maybe
+import Data.Semigroup
+import Ideas.Common.Id
+import Test.QuickCheck
+
+-----------------------------------------------------------------------------
+-- Examples
+
+data Examples a = Examples
+   { groups :: [(Id, Examples a)] -- ^ Top-level groups
+   , items  :: [Item a]
+   }
+
+instance Semigroup (Examples a) where
+   xs <> ys = Examples (groups xs <> groups ys) (items xs <> items ys)
+
+instance Monoid (Examples a) where
+   mempty  = Examples [] []
+   mappend = (<>)
+
+instance Functor Examples where
+   fmap f (Examples xs ys) = Examples [ (n, fmap f g) | (n, g) <- xs ] (map (fmap f) ys)
+
+data Item a = Example (Maybe Difficulty) a
+            | Random  (Maybe Difficulty) (Gen a)
+            | Test a
+            | RandomTest (Gen a)
+
+instance Functor Item where
+   fmap f (Example d a)  = Example d (f a)
+   fmap f (Test a)       = Test (f a)
+   fmap f (Random d g)   = Random d (fmap f g)
+   fmap f (RandomTest g) = RandomTest (fmap f g)
+
+-- | One example
+example :: a -> Examples a
+example = single . Example Nothing
+
+-- | List of examples
+exampleList :: [a] -> Examples a
+exampleList = Examples [] . map (Example Nothing)
+
+-- | List of examples with the same difficulty
+examplesFor :: Difficulty -> [a] -> Examples a
+examplesFor d = examplesWithDifficulty . zip (repeat d)
+
+-- | List of examples with their own difficulty
+examplesWithDifficulty :: [(Difficulty, a)] -> Examples a
+examplesWithDifficulty = Examples [] . map (uncurry (Example . Just))
+
+-- | Use a random generator (from QuickCheck) as example generator
+random :: Gen a -> Examples a
+random = single . Random Nothing
+
+group :: Id -> Examples a -> Examples a
+group n xs = Examples [(n, xs)] []
+
+-- | Assign difficulty (to all items without a difficulty level)
+difficulty :: Difficulty -> Examples a -> Examples a
+difficulty d = changeItems f
+ where
+   f (Example Nothing a) = Example (Just d) a
+   f (Random Nothing a)  = Random  (Just d) a
+   f x = x
+
+-- | Turn examples (and random generators) into tests (and test generators)
+forTesting :: Examples a -> Examples a
+forTesting = changeItems f
+ where
+   f (Example _ a) = Test a
+   f (Random _ a)  = RandomTest a
+   f x = x
+
+-- Querying
+
+-- | Top-level examples
+topLevelExamples :: Examples a -> [(Maybe Difficulty, a)]
+topLevelExamples = collectItems f
+ where
+   f (Example md a) = Just (md, a)
+   f _ = Nothing
+
+-- | Top-level random generators
+topLevelRandoms :: Examples a -> [(Maybe Difficulty, Gen a)]
+topLevelRandoms = collectItems f
+ where
+   f (Random md g) = Just (md, g)
+   f _ = Nothing
+
+-- | Top-level test cases
+topLevelTests :: Examples a -> [a]
+topLevelTests = collectItems f
+ where
+   f (Test a) = Just a
+   f _ = Nothing
+
+-- | Top-level test generators
+topLevelRandomTests :: Examples a -> [Gen a]
+topLevelRandomTests = collectItems f
+ where
+   f (RandomTest g) = Just g
+   f _ = Nothing
+
+-- | All examples (also in groups)
+allExamples :: Examples a -> [(Maybe Difficulty, a)]
+allExamples = topLevelExamples . flatten
+
+-- | All random generators (also in groups)
+allRandoms :: Examples a -> [(Maybe Difficulty, Gen a)]
+allRandoms = topLevelRandoms . flatten
+
+-- | All test cases (also in groups)
+allTests :: Examples a -> [a]
+allTests = topLevelTests . flatten
+
+-- | All test generators (also in groups)
+allRandomTests :: Examples a -> [Gen a]
+allRandomTests = topLevelRandomTests . flatten
+
+-- | Flatten examples into one collection without subgroups
+flatten :: Examples a -> Examples a
+flatten = Examples [] . getItems
+
+-- | Number of examples, including those in subgroups
+size :: Examples a -> Int
+size = length . getItems
+
+-- | Tests if there ar no examples
+isEmpty :: Examples a -> Bool
+isEmpty = null . getItems
+
+-- local helpers
+single :: Item a -> Examples a
+single x = Examples [] [x]
+
+getItems :: Examples a -> [Item a]
+getItems xs = concatMap (getItems . snd) (groups xs) ++ items xs
+
+changeItems :: (Item a -> Item a) -> Examples a -> Examples a
+changeItems f = rec
+ where
+   rec xs = Examples (map g (groups xs)) (map f (items xs))
+   g (n, ys) = (n, rec ys)
+
+collectItems :: (Item a -> Maybe b) -> Examples a -> [b]
+collectItems f = mapMaybe f . items
+
+-----------------------------------------------------------------------------
+-- Difficulty
+
+data Difficulty = VeryEasy | Easy | Medium | Difficult | VeryDifficult
+   deriving (Eq, Ord, Enum)
+
+instance Show Difficulty where
+   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.
+readDifficulty :: String -> Maybe Difficulty
+readDifficulty s =
+   case filter p [VeryEasy .. VeryDifficult] of
+            [a] -> Just a
+            _   -> Nothing
+ where
+   normal = filter isAlpha . map toLower
+   p = (== normal s) . normal . show
+
+veryEasy, easy, medium, difficult, veryDifficult :: Examples a -> Examples a
+veryEasy      = difficulty VeryEasy
+easy          = difficulty Easy
+medium        = difficulty Medium
+difficult     = difficulty Difficult
+veryDifficult = difficulty VeryDifficult

@@ -1,6 +1,6 @@ {-# LANGUAGE Rank2Types, ExistentialQuantification #-}
 -----------------------------------------------------------------------------
--- Copyright 2018, Ideas project team. This file is distributed under the
+-- Copyright 2019, 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.
 -----------------------------------------------------------------------------
@@ -26,21 +26,19 @@    , Status(..), isPublic, isPrivate
      -- * Examples
    , Examples, Difficulty(..), readDifficulty
-   , level, mapExamples, examplesContext
+   , examplesFor, examplesWithDifficulty, examplesContext, examplesAsList
+   , testGenerator, randomTerm, randomTerms
      -- * Context
    , inContext, withoutContext
      -- * Type casting
    , useTypeable, castFrom, castTo
      -- * Exercise properties
    , setProperty, getProperty, setPropertyF, getPropertyF
-     -- * Random generators
-   , simpleGenerator, useGenerator, randomTerm, randomTerms
      -- * Derivations
    , showDerivation, showDerivations, printDerivation, printDerivations
    , diffEnvironment, defaultDerivation, allDerivations
    ) where
 
-import Data.Char
 import Data.List
 import Data.Maybe
 import Data.Ord
@@ -49,6 +47,7 @@ import Ideas.Common.Context
 import Ideas.Common.Derivation
 import Ideas.Common.Environment
+import Ideas.Common.Examples
 import Ideas.Common.Id
 import Ideas.Common.Predicate
 import Ideas.Common.Rewriting
@@ -120,10 +119,6 @@    , navigation :: a -> ContextNavigator a
      -- | A finite list of examples, each with an assigned difficulty.
    , examples :: Examples a
-     -- | A generator for random exercises of a certain difficulty.
-   , randomExercise :: Maybe (QCGen -> Maybe Difficulty -> a)
-     -- | An exercise generator for testing purposes (including corner cases).
-   , testGenerator  :: Maybe (Gen a)
      -- | Conversion to and from the (generic) 'Term' datatype. Needed for
      -- representing the expression in the OpenMath standard.
    , hasTermView :: Maybe (View Term a)
@@ -173,10 +168,8 @@    , canBeRestarted = True
    , extraRules     = []
    , ruleOrdering   = compareId
-     -- testing and exercise generation
-   , testGenerator  = Nothing
-   , randomExercise = Nothing
-   , examples       = []
+     -- examples
+   , examples       = mempty
    }
 
 -- | In addition to the defaults of 'emptyExercise', this constructor sets
@@ -232,9 +225,9 @@       (Nothing, Nothing) -> compareId r1 r2
 
 -- | Get all constraint violations
-violations :: Exercise a -> Context a -> [(Id, String)]
+violations :: Exercise a -> Context a -> [(Constraint (Context a), String)]
 violations ex ctx =
-   [ (getId c, msg)
+   [ (c, msg)
    | c <- constraints ex
    , msg <- maybeToList (isViolated c ctx)
    ]
@@ -261,51 +254,44 @@ -----------------------------------------------------------------------------
 -- Examples
 
-type Examples a = [(Difficulty, a)]
-
-data Difficulty = VeryEasy | Easy | Medium | Difficult | VeryDifficult
-   deriving (Eq, Ord, Enum)
-
-instance Show Difficulty where
-   show = (xs !!) . fromEnum
-    where
-      xs = ["very_easy", "easy", "medium", "difficult", "very_difficult"]
+-- | Returns the examples of an exercise class lifted to a context.
+examplesContext :: Exercise a -> Examples (Context a)
+examplesContext ex = fmap (inContext ex) (examples ex)
 
-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` "_-"]
+examplesAsList :: Exercise a -> [a]
+examplesAsList = map snd . allExamples . examples
 
--- | Parser for difficulty levels, which ignores non-alpha charactes (including
--- spaces) and upper/lower case distinction.
-readDifficulty :: String -> Maybe Difficulty
-readDifficulty s =
-   case filter p [VeryEasy .. VeryDifficult] of
-            [a] -> Just a
-            _   -> Nothing
+fromGen :: QCGen -> Gen a -> a
+fromGen rng (MkGen f) = a
  where
-   normal = filter isAlpha . map toLower
-   p = (== normal s) . normal . show
+   (sz, r) = randomR (0, 100) rng
+   a       = f r sz
 
--- | Assigns a difficulty level to a list of expressions.
-level :: Difficulty -> [a] -> Examples a
-level = zip . repeat
+-- | Returns a random exercise of a certain difficulty with some random
+-- number generator. The field 'randomExercise' is used; if this is not
+-- defined (i.e., Nothing), one of the examples is used instead.
+randomTerm :: QCGen -> Exercise a -> Maybe Difficulty -> Maybe a
+randomTerm rng ex mdif =
+   case filter ((== mdif) . fst) (allRandoms (examples ex)) of
+      (_, g):_ -> Just (fromGen rng g)
+      []
+         | null xs   -> Nothing
+         | otherwise -> Just (snd (xs !! i))
+       where
+         xs = filter p (allExamples (examples ex)) -- improve
+         p (Just d, _) = maybe True (==d) mdif
+         p _ = False
+         i = fst (randomR (0, length xs - 1) rng)
 
-mapExamples :: (a -> b) -> Examples a -> Examples b
-mapExamples f = map (second f)
+-- | Returns a list of randomly generated terms of a certain difficulty.
+randomTerms :: QCGen -> Exercise a -> Maybe Difficulty -> [a]
+randomTerms rng ex mdif = rec rng
+ where
+   rec a = maybe id (:) (randomTerm a ex mdif) (rec (snd (next a)))
 
--- | Returns the examples of an exercise class lifted to a context.
-examplesContext :: Exercise a -> Examples (Context a)
-examplesContext ex = mapExamples (inContext ex) (examples ex)
+-- | An exercise generator for testing purposes (including corner cases); first generator only.
+testGenerator :: Exercise a -> Maybe (Gen a)
+testGenerator = listToMaybe . allRandomTests . examples
 
 -----------------------------------------------------------------------------
 -- Context
@@ -371,45 +357,6 @@ castF = fmap fromIdentity . gcast1 . Identity
 
 newtype Identity a = Identity { fromIdentity :: a}
-
----------------------------------------------------------------
--- Random generators
-
--- | Makes a random exercise generator from a QuickCheck generator; the exercise
--- generator ignores the difficulty level. See the 'randomExercise' field.
-simpleGenerator :: Gen a -> Maybe (QCGen -> Maybe Difficulty -> a)
-simpleGenerator = useGenerator . const
-
--- | Makes a random exercise generator based on a QuickCheck generator for a
--- particular difficulty level. See the 'randomExercise' field.
-useGenerator :: (Maybe Difficulty -> Gen a) -> Maybe (QCGen -> Maybe Difficulty -> a)
-useGenerator makeGen = Just (\rng -> rec rng . makeGen)
- where
-   rec rng (MkGen f) = a
-    where
-      (size, r) = randomR (0, 100) rng
-      a         = f r size
-
--- | Returns a random exercise of a certain difficulty with some random
--- number generator. The field 'randomExercise' is used; if this is not
--- defined (i.e., Nothing), one of the examples is used instead.
-randomTerm :: QCGen -> Exercise a -> Maybe Difficulty -> Maybe a
-randomTerm rng ex mdif =
-   case randomExercise ex of
-      Just f  -> return (f rng mdif)
-      Nothing
-         | null xs   -> Nothing
-         | otherwise -> Just (snd (xs !! i))
-       where
-         xs = filter p (examples ex)
-         p (d, _) = maybe True (==d) mdif
-         i = fst (randomR (0, length xs - 1) rng)
-
--- | Returns a list of randomly generated terms of a certain difficulty.
-randomTerms :: QCGen -> Exercise a -> Maybe Difficulty -> [a]
-randomTerms rng ex mdif = rec rng
- where
-   rec a = maybe id (:) (randomTerm a ex mdif) (rec (snd (next a)))
 
 ---------------------------------------------------------------
 -- Derivations

@@ -1,5 +1,5 @@ -----------------------------------------------------------------------------
--- Copyright 2018, Ideas project team. This file is distributed under the
+-- Copyright 2019, 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.
 -----------------------------------------------------------------------------
@@ -71,9 +71,9 @@        where
          showAsGen = showAs (prettyPrinter ex) gen
  where
-   xs | isJust (randomExercise ex) =
-           take 10 (randomTerms qcgen ex Nothing)
-      | otherwise = map snd (examples ex)
+   rs = randomTerms qcgen ex Nothing
+   xs | null rs   = examplesAsList ex
+      | otherwise = take 10 rs
 
 data ShowAs a = S {showS :: a -> String, fromS :: a}
 
@@ -108,7 +108,7 @@    | otherwise = suite "Examples" $
         concatMap (checksForTerm True qcgen ex) xs
  where
-   xs = map snd (examples ex)
+   xs = examplesAsList ex
 
 checksForTerm :: Bool -> QCGen -> Exercise a -> a -> [TestSuite]
 checksForTerm leftMost _ ex a =

@@ -1,5 +1,5 @@ -----------------------------------------------------------------------------
--- Copyright 2018, Ideas project team. This file is distributed under the
+-- Copyright 2019, 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.
 -----------------------------------------------------------------------------
@@ -26,7 +26,7 @@ -- of this type class typically allow labels to appear at multiple locations
 -- within their structure.
 --
--- The 'Id' datatype implements and re-exports the Monoid interface.
+-- The 'Id' datatype implements the Monoid interface.
 --
 -----------------------------------------------------------------------------
 
@@ -38,18 +38,15 @@    , describe, description, showId, compareId
      -- * Labeling with identifiers
    , Identify(..)
-     -- re-export
-   , module Data.Monoid
-   , (<>)
    ) where
 
 import Control.Monad
 import Data.Char
 import Data.List
-import Data.Monoid hiding ((<>))
 import Data.Ord
 import Data.Semigroup as Sem
 import Ideas.Common.Classes
+import Ideas.Text.HTML
 import Ideas.Utils.Prelude (splitsWithElem)
 import Ideas.Utils.StringRef
 import Test.QuickCheck
@@ -92,6 +89,9 @@                return $ newId xs)
       , (1, liftM2 mappend arbitrary arbitrary)
       ]
+
+instance ToHTML Id where
+   toHTML = text
 
 -- | Type class 'IsId' for constructing identifiers. Examples are
 -- @newId \"algebra.equation\"@, @newId (\"a\", \"b\", \"c\")@, and @newId ()@

@@ -1,5 +1,5 @@ -----------------------------------------------------------------------------
--- Copyright 2018, Ideas project team. This file is distributed under the
+-- Copyright 2019, 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.
 -----------------------------------------------------------------------------

@@ -1,6 +1,6 @@ {-# LANGUAGE ExistentialQuantification #-}
 -----------------------------------------------------------------------------
--- Copyright 2018, Ideas project team. This file is distributed under the
+-- Copyright 2019, 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.
 -----------------------------------------------------------------------------

@@ -1,5 +1,5 @@ -----------------------------------------------------------------------------
--- Copyright 2018, Ideas project team. This file is distributed under the
+-- Copyright 2019, 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.
 -----------------------------------------------------------------------------
@@ -12,5 +12,6 @@ 
 module Ideas.Common.Rewriting (module Export) where
 
+import Ideas.Common.Rewriting.AutoTerm as Export (toTermG, fromTermG)
 import Ideas.Common.Rewriting.RewriteRule as Export
 import Ideas.Common.Rewriting.Term as Export

@@ -1,5 +1,5 @@ -----------------------------------------------------------------------------
--- Copyright 2018, Ideas project team. This file is distributed under the
+-- Copyright 2019, 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.
 -----------------------------------------------------------------------------

@@ -0,0 +1,124 @@+-----------------------------------------------------------------------------
+-- Copyright 2019, 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)
+--
+-----------------------------------------------------------------------------
+
+module Ideas.Common.Rewriting.AutoTerm (toTermG, fromTermG, testTermFor) where
+
+import Control.Monad.State
+import Data.Data
+import Ideas.Common.Rewriting.Term
+import Ideas.Utils.Prelude (headM)
+
+toTermG :: Data a => a -> Term
+toTermG a =
+   case constrRep constr of
+      IntConstr n   -> TNum n                  -- for Int and Integer
+      FloatConstr r -> TFloat (fromRational r) -- for Double and Float
+      CharConstr c  -> TVar [c]
+      AlgConstr _   ->
+         case cast a of
+            Just s  -> TVar s -- for String
+            Nothing -> makeTerm constr (gfoldl op e a)
+ where
+   op (M xs) x = M (xs ++ [toTermG x])
+   e _    = M []
+   constr = toConstr a
+
+newtype M a = M [Term]
+
+-- test for list constructors
+makeTerm :: Constr -> M a -> Term
+makeTerm c (M xs) =
+   case xs of
+      [y, TList ys] | isCons  -> TList (y:ys)
+      []            | isNil   -> TList []
+      _ -> TCon (constrSymbol c) xs
+ where
+   txt = showConstr c
+   isNil   = txt == "[]"
+   isCons  = txt == "(:)"
+
+isTuple :: String -> Bool
+isTuple ('(':xs) = rec xs
+ where
+   rec ")"      = True
+   rec (',':ys) = rec ys
+   rec _        = False
+isTuple _       = False
+
+------------------------------------------------------------------------
+
+constrSymbol :: Constr -> Symbol
+constrSymbol c
+   | txt == "[]"  = nilSymbol
+   | txt == "(:)" = consSymbol
+   | isTuple txt  = tupleSymbol
+   | otherwise    = newSymbol (dataTypeName (constrType c) `mappend` show c)
+ where
+   txt = showConstr c
+
+nilSymbol, consSymbol, tupleSymbol :: Symbol
+nilSymbol   = newSymbol "list.nil"
+consSymbol  = newSymbol "list.cons"
+tupleSymbol = newSymbol "tuple"
+
+constructors :: Data a => Proxy a -> [Constr]
+constructors = dataTypeConstrs . dataTypeOf . fromProxy
+ where
+   fromProxy :: Proxy a -> a
+   fromProxy = error "fromProxy"
+
+findConstr :: (Monad m, Data a) => Proxy a -> Symbol -> m Constr
+findConstr p s =
+   headM [ c | c <- constructors p, s == constrSymbol c ]
+
+fromTermG :: (MonadPlus m, Data a) => Term -> m a
+fromTermG term =
+   case term of
+      TCon s xs -> fromTermTConG Proxy s xs
+      TVar [c]  -> castM c `mplus` castM [c]
+      TVar s    -> castM s
+      TList xs  -> fromTermG (foldr cons nil xs)
+      TNum n    -> castM n `mplus` castM (fromInteger n :: Int)
+      TFloat d  -> castM d `mplus` castM (doubleToFloat d)
+      TMeta _   -> fail "fromTermG: found TMeta"
+ where
+   cons = binary consSymbol
+   nil  = symbol nilSymbol
+
+castM :: (Monad m, Typeable a, Typeable b) => a -> m b
+castM = maybe (fail "fromTermG") return . cast
+
+doubleToFloat :: Double -> Float
+doubleToFloat = fromRational . toRational
+
+fromTermTConG :: (MonadPlus m, Data a) => Proxy a -> Symbol -> [Term] -> m a
+fromTermTConG p s xs = do
+   c <- findConstr p s
+   evalStateT (gunfold op return c) xs
+ where
+   op m = do
+      f <- m
+      t <- pop
+      a <- lift (fromTermG t)
+      return (f a)
+
+pop :: Monad m => StateT [a] m a
+pop = do
+   ts <- get
+   case ts of
+      []    -> fail "pop"
+      hd:tl -> put tl >> return hd
+
+--------------
+
+testTermFor :: (Data a, Eq a) => a -> Bool
+testTermFor x = fromTermG (toTermG x) == Just x

@@ -1,5 +1,5 @@ -----------------------------------------------------------------------------
--- Copyright 2018, Ideas project team. This file is distributed under the
+-- Copyright 2019, 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.
 -----------------------------------------------------------------------------

@@ -1,5 +1,5 @@ -----------------------------------------------------------------------------
--- Copyright 2018, Ideas project team. This file is distributed under the
+-- Copyright 2019, 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.
 -----------------------------------------------------------------------------

@@ -1,7 +1,7 @@-{-# LANGUAGE ExistentialQuantification, MultiParamTypeClasses,
+{-# LANGUAGE ExistentialQuantification,
        FunctionalDependencies, FlexibleInstances, UndecidableInstances #-}
 -----------------------------------------------------------------------------
--- Copyright 2018, Ideas project team. This file is distributed under the
+-- Copyright 2019, 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.
 -----------------------------------------------------------------------------

@@ -1,5 +1,5 @@ -----------------------------------------------------------------------------
--- Copyright 2018, Ideas project team. This file is distributed under the
+-- Copyright 2019, 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.
 -----------------------------------------------------------------------------
@@ -21,7 +21,6 @@ import Control.Monad
 import Data.List
 import Data.Maybe
-import Data.Monoid hiding ((<>))
 import Data.Semigroup as Sem
 import Ideas.Common.Rewriting.Term
 import Ideas.Utils.TestSuite

@@ -1,6 +1,6 @@ {-# OPTIONS -fno-warn-orphans #-}
 -----------------------------------------------------------------------------
--- Copyright 2018, Ideas project team. This file is distributed under the
+-- Copyright 2019, 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.
 -----------------------------------------------------------------------------
@@ -120,6 +120,11 @@    toTerm (a, b) = TList [toTerm a, toTerm b]
    fromTerm (TList [a, b]) =  (,) <$> fromTerm a <*> fromTerm b
    fromTerm _              = fail "fromTerm"
+
+instance (IsTerm a, IsTerm b, IsTerm c) => IsTerm (a, b, c) where
+   toTerm (a, b, c) = TList [toTerm a, toTerm b, toTerm c]
+   fromTerm (TList [a, b, c]) = (,,) <$> fromTerm a <*> fromTerm b <*> fromTerm c
+   fromTerm _                 = fail "fromTerm"
 
 instance (IsTerm a, IsTerm b) => IsTerm (Either a b) where
    toTerm = either toTerm toTerm

@@ -1,5 +1,5 @@ -----------------------------------------------------------------------------
--- Copyright 2018, Ideas project team. This file is distributed under the
+-- Copyright 2019, 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.
 -----------------------------------------------------------------------------

@@ -1,5 +1,5 @@ -----------------------------------------------------------------------------
--- Copyright 2018, Ideas project team. This file is distributed under the
+-- Copyright 2019, 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.
 -----------------------------------------------------------------------------

@@ -1,6 +1,6 @@ {-# LANGUAGE MultiParamTypeClasses #-}
 -----------------------------------------------------------------------------
--- Copyright 2018, Ideas project team. This file is distributed under the
+-- Copyright 2019, 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.
 -----------------------------------------------------------------------------

@@ -1,5 +1,5 @@ -----------------------------------------------------------------------------
--- Copyright 2018, Ideas project team. This file is distributed under the
+-- Copyright 2019, 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.
 -----------------------------------------------------------------------------

@@ -1,5 +1,5 @@ -----------------------------------------------------------------------------
--- Copyright 2018, Ideas project team. This file is distributed under the
+-- Copyright 2019, 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.
 -----------------------------------------------------------------------------
@@ -18,7 +18,6 @@    ) where
 
 import Data.Maybe
-import Data.Monoid hiding ((<>))
 import Data.Semigroup as Sem
 import Ideas.Common.Environment
 import Ideas.Common.Rule.Transformation

@@ -1,6 +1,6 @@ {-# LANGUAGE GADTs, Rank2Types #-}
 -----------------------------------------------------------------------------
--- Copyright 2018, Ideas project team. This file is distributed under the
+-- Copyright 2019, 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.
 -----------------------------------------------------------------------------
@@ -35,7 +35,6 @@ import Control.Applicative
 import Control.Arrow
 import Data.Maybe
-import Data.Monoid hiding ((<>))
 import Data.Semigroup as Sem
 import Ideas.Common.Classes
 import Ideas.Common.Context

@@ -1,5 +1,5 @@ -----------------------------------------------------------------------------
--- Copyright 2018, Ideas project team. This file is distributed under the
+-- Copyright 2019, 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.
 -----------------------------------------------------------------------------

@@ -1,6 +1,6 @@ {-# LANGUAGE TypeFamilies, RankNTypes #-}
 -----------------------------------------------------------------------------
--- Copyright 2018, Ideas project team. This file is distributed under the
+-- Copyright 2019, 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.
 -----------------------------------------------------------------------------

@@ -1,5 +1,5 @@ -----------------------------------------------------------------------------
--- Copyright 2018, Ideas project team. This file is distributed under the
+-- Copyright 2019, 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.
 -----------------------------------------------------------------------------

@@ -1,5 +1,5 @@ -----------------------------------------------------------------------------
--- Copyright 2018, Ideas project team. This file is distributed under the
+-- Copyright 2019, 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.
 -----------------------------------------------------------------------------

@@ -1,6 +1,6 @@ {-# LANGUAGE TypeFamilies #-}
 -----------------------------------------------------------------------------
--- Copyright 2018, Ideas project team. This file is distributed under the
+-- Copyright 2019, 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.
 -----------------------------------------------------------------------------
@@ -22,7 +22,6 @@    ) where
 
 import Data.Char
-import Data.Monoid hiding ((<>))
 import Data.Semigroup as Sem
 import Ideas.Common.Classes
 import Ideas.Common.Id

@@ -1,5 +1,5 @@ -----------------------------------------------------------------------------
--- Copyright 2018, Ideas project team. This file is distributed under the
+-- Copyright 2019, 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.
 -----------------------------------------------------------------------------

@@ -1,6 +1,6 @@ {-# LANGUAGE FlexibleContexts #-}
 -----------------------------------------------------------------------------
--- Copyright 2018, Ideas project team. This file is distributed under the
+-- Copyright 2019, 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.
 -----------------------------------------------------------------------------

@@ -1,5 +1,5 @@ -----------------------------------------------------------------------------
--- Copyright 2018, Ideas project team. This file is distributed under the
+-- Copyright 2019, 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.
 -----------------------------------------------------------------------------

@@ -1,5 +1,5 @@ -----------------------------------------------------------------------------
--- Copyright 2018, Ideas project team. This file is distributed under the
+-- Copyright 2019, 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.
 -----------------------------------------------------------------------------

@@ -1,6 +1,6 @@ {-# LANGUAGE TypeFamilies #-}
 -----------------------------------------------------------------------------
--- Copyright 2018, Ideas project team. This file is distributed under the
+-- Copyright 2019, 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.
 -----------------------------------------------------------------------------
@@ -30,7 +30,6 @@ import Data.Char
 import Data.List (intercalate)
 import Data.Maybe
-import Data.Monoid hiding ((<>))
 import Data.Semigroup as Sem
 import Ideas.Common.Classes
 import Ideas.Common.Environment

@@ -1,6 +1,6 @@ {-# LANGUAGE TypeFamilies #-}
 -----------------------------------------------------------------------------
--- Copyright 2018, Ideas project team. This file is distributed under the
+-- Copyright 2019, 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.
 -----------------------------------------------------------------------------

@@ -1,6 +1,6 @@ {-# LANGUAGE TypeFamilies #-}
 -----------------------------------------------------------------------------
--- Copyright 2018, Ideas project team. This file is distributed under the
+-- Copyright 2019, 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.
 -----------------------------------------------------------------------------

@@ -1,6 +1,6 @@ {-# LANGUAGE RankNTypes, ExistentialQuantification #-}
 -----------------------------------------------------------------------------
--- Copyright 2018, Ideas project team. This file is distributed under the
+-- Copyright 2019, 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.
 -----------------------------------------------------------------------------

@@ -1,5 +1,5 @@ -----------------------------------------------------------------------------
--- Copyright 2018, Ideas project team. This file is distributed under the
+-- Copyright 2019, 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.
 -----------------------------------------------------------------------------

@@ -1,5 +1,5 @@ -----------------------------------------------------------------------------
--- Copyright 2018, Ideas project team. This file is distributed under the
+-- Copyright 2019, 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.
 -----------------------------------------------------------------------------
@@ -31,7 +31,6 @@    ) where
 
 import Data.Monoid hiding ((<>))
-import qualified Data.Semigroup as Sem
 import Data.Semigroup ((<>))
 import Ideas.Common.Classes
 import Ideas.Common.Rule
@@ -39,6 +38,7 @@ import Ideas.Common.Strategy.Combinators
 import Ideas.Common.Traversal.Navigator
 import Prelude hiding (repeat, not, traverse)
+import qualified Data.Semigroup as Sem
 import qualified Prelude
 
 ----------------------------------------------------------------------

@@ -1,6 +1,6 @@ {-# LANGUAGE TypeFamilies #-}
 -----------------------------------------------------------------------------
--- Copyright 2018, Ideas project team. This file is distributed under the
+-- Copyright 2019, 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.
 -----------------------------------------------------------------------------

@@ -1,6 +1,6 @@ {-# LANGUAGE TypeFamilies, GeneralizedNewtypeDeriving #-}
 -----------------------------------------------------------------------------
--- Copyright 2018, Ideas project team. This file is distributed under the
+-- Copyright 2019, 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.
 -----------------------------------------------------------------------------
@@ -35,7 +35,6 @@ import Data.Function
 import Data.Generics.Str
 import Data.Maybe
-import Data.Monoid hiding ((<>))
 import Data.Semigroup as Sem
 import Ideas.Common.Traversal.Iterator
 import Ideas.Common.Traversal.Utils

@@ -1,5 +1,5 @@ -----------------------------------------------------------------------------
--- Copyright 2018, Ideas project team. This file is distributed under the
+-- Copyright 2019, 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.
 -----------------------------------------------------------------------------

@@ -1,6 +1,6 @@ {-# LANGUAGE TypeFamilies #-}
 -----------------------------------------------------------------------------
--- Copyright 2018, Ideas project team. This file is distributed under the
+-- Copyright 2019, 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.
 -----------------------------------------------------------------------------

@@ -1,6 +1,6 @@ {-# LANGUAGE GADTs, GeneralizedNewtypeDeriving #-}
 -----------------------------------------------------------------------------
--- Copyright 2018, Ideas project team. This file is distributed under the
+-- Copyright 2019, 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.
 -----------------------------------------------------------------------------

@@ -1,6 +1,6 @@ {-# LANGUAGE GADTs #-}
 -----------------------------------------------------------------------------
--- Copyright 2018, Ideas project team. This file is distributed under the
+-- Copyright 2019, 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.
 -----------------------------------------------------------------------------
@@ -17,7 +17,7 @@    ( JSONDecoder, jsonDecoder
    ) where
 
-import Control.Monad
+import Control.Monad.State (mplus, foldM, get, gets, put)
 import Data.Char
 import Data.Maybe
 import Ideas.Common.Library hiding (exerciseId, symbol)
@@ -26,17 +26,18 @@ import Ideas.Service.State
 import Ideas.Service.Types hiding (String)
 import Ideas.Text.JSON
+import Ideas.Utils.Decoding (symbol)
 import qualified Ideas.Service.Types as Tp
 
-type JSONDecoder a = Decoder a JSON
+type JSONDecoder a t = DecoderX a JSON t
 
 jsonDecoder :: TypedDecoder a JSON
-jsonDecoder tp = decoderFor $ \json ->
+jsonDecoder tp = get >>= \json ->
    case json of
       Array xs -> decodeType tp // xs
       _ -> fail "expecting an array"
 
-decodeType :: Type a t -> Decoder a [JSON] t
+decodeType :: Type a t -> DecoderX a [JSON] t
 decodeType tp =
    case tp of
       Tag _ t -> decodeType t
@@ -62,9 +63,9 @@       Exercise    -> getExercise
       Environment -> decodeEnvironment
       Location    -> decodeLocation
-      Term        -> decoderFor (return . jsonToTerm)
-      Int         -> decoderFor fromJSON
-      Tp.String   -> decoderFor fromJSON
+      Term        -> gets jsonToTerm
+      Int         -> get >>= fromJSON
+      Tp.String   -> get >>= fromJSON
       Id          -> decodeId
       Rule        -> decodeRule
       _           -> fail $ "No support for argument type: " ++ show tp
@@ -72,19 +73,19 @@ decodeRule :: JSONDecoder a (Rule (Context a))
 decodeRule = do
    ex <- getExercise
-   decoderFor $ \json ->
+   get >>= \json ->
       case json of
          String s -> getRule ex (newId s)
          _        -> fail "expecting a string for rule"
 
 decodeId :: JSONDecoder a Id
-decodeId = decoderFor $ \json ->
+decodeId = get >>= \json ->
    case json of
       String s -> return (newId s)
       _        -> fail "expecting a string for id"
 
 decodeLocation :: JSONDecoder a Location
-decodeLocation = decoderFor $ \json ->
+decodeLocation = get >>= \json ->
    case json of
       String s -> toLocation <$> readM s
       _        -> fail "expecting a string for a location"
@@ -92,9 +93,9 @@ decodeState :: JSONDecoder a (State a)
 decodeState = do
    ex <- getExercise
-   decoderFor $ \json ->
+   get >>= \json ->
       case json of
-         Array [a] -> setInput a >> decodeState
+         Array [a] -> put a >> decodeState
          Array (String _code : pref : term : jsonContext : rest) -> do
             pts  <- decodePaths       // pref
             a    <- decodeExpression  // term
@@ -122,7 +123,7 @@ 
 decodePaths :: JSONDecoder a (LabeledStrategy (Context a) -> Context a -> Prefix (Context a))
 decodePaths =
-   decoderFor $ \json ->
+   get >>= \json ->
       case json of
          String p
             | p ~= "noprefix" -> return (\_ _ -> noPrefix)
@@ -132,7 +133,7 @@    x ~= y = filter isAlphaNum (map toLower x) == y
 
 decodeEnvironment :: JSONDecoder a Environment
-decodeEnvironment = decoderFor $ \json ->
+decodeEnvironment = get >>= \json ->
    case json of
       String "" -> return mempty
       Object xs -> foldM (flip add) mempty xs
@@ -148,7 +149,7 @@    inContext ex <$> decodeExpression
 
 decodeExpression :: JSONDecoder a a
-decodeExpression = withJSONTerm $ \b -> getExercise >>= decoderFor . f b
+decodeExpression = withJSONTerm $ \b -> getExercise >>= \ex -> get >>= f b ex
  where
    f True ex json =
       case hasJSONView ex of

@@ -1,6 +1,6 @@ {-# LANGUAGE GADTs #-}
 -----------------------------------------------------------------------------
--- Copyright 2018, Ideas project team. This file is distributed under the
+-- Copyright 2019, 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.
 -----------------------------------------------------------------------------
@@ -17,20 +17,21 @@    ( XMLDecoder, xmlDecoder
    ) where
 
-import Control.Monad
+import Control.Applicative hiding (Const)
+import Control.Monad.State hiding (State)
 import Data.Char
 import Ideas.Common.Library
 import Ideas.Common.Traversal.Navigator
 import Ideas.Encoding.Encoder
 import Ideas.Encoding.OpenMathSupport
-import Ideas.Encoding.Request
+import Ideas.Encoding.Request hiding (XML)
 import Ideas.Service.State
 import Ideas.Service.Types
 import Ideas.Text.MathML
 import Ideas.Text.OpenMath.Object
 import Ideas.Text.XML
 
-type XMLDecoder a = Decoder a XML
+type XMLDecoder a t = DecoderX a XML t
 
 xmlDecoder :: TypedDecoder a XML
 xmlDecoder tp =
@@ -44,7 +45,7 @@               decodeChild "answer" (xmlDecoder t)
          | s == "Difficulty" -> do
               g <- equalM tDifficulty tp
-              a <- decoderFor (findAttribute "difficulty")
+              a <- decodeAttribute "difficulty"
               maybe (fail "unknown difficulty level") (return . g) (readDifficulty a)
          | otherwise ->
               decodeChild s (xmlDecoder t)
@@ -69,7 +70,7 @@             Context     -> decodeContext
             Rule        -> decodeRule
             Environment -> decodeArgEnvironment
-            Term        -> decoderFor (fromXML >=> fromOMOBJ)
+            Term        -> get >>= (fromXML >=> fromOMOBJ)
             Location    -> decodeLocation
             StratCfg    -> decodeConfiguration
             QCGen       -> getQCGen
@@ -77,9 +78,10 @@             Exercise    -> getExercise
             Id          -> -- improve!
                            decodeChild "location" $
-                              makeDecoder (newId . getData)
+                              gets (newId . getData)
             MathML      -> decodeMathML
             String      -> decodeData
+            XML         -> get
             _ -> fail $ "No support for argument type in XML: " ++ show tp
       _ -> fail $ "No support for argument type in XML: " ++ show tp
 
@@ -87,12 +89,12 @@ decodeRule :: XMLDecoder a (Rule (Context a))
 decodeRule = decodeChild "ruleid" $ do
    ex <- getExercise
-   decoderFor (getRule ex . newId . getData)
+   get >>= getRule ex . newId . getData
 
 -- <location>
 decodeLocation :: XMLDecoder a Location
 decodeLocation = decodeChild "location" $
-   makeDecoder (toLocation . read . getData)
+   gets (toLocation . read . getData)
 
 -- <state>
 decodeState :: XMLDecoder a (State a)
@@ -106,7 +108,7 @@ -- <prefix>
 decodePaths :: XMLDecoder a [Path]
 decodePaths = do
-   prefixText <- makeDecoder (maybe "" getData . findChild "prefix")
+   prefixText <- gets (maybe "" getData . findChild "prefix")
    if all isSpace prefixText
       then return [emptyPath]
       else if prefixText ~= "no prefix"
@@ -136,10 +138,10 @@    f True  = decodeOMOBJ
    f False = decodeChild "expr" $ do
       ex <- getExercise
-      decoderFor $ either fail return . parser ex . getData
+      get >>= either fail return . parser ex . getData
 
 decodeOMOBJ :: XMLDecoder a a
-decodeOMOBJ = decodeChild "OMOBJ" $ decoderFor $ \xml -> do
+decodeOMOBJ = decodeChild "OMOBJ" $ get >>= \xml -> do
    ex    <- getExercise
    omobj <- fromXML xml
    case fromOpenMath ex omobj of
@@ -147,11 +149,11 @@       Nothing -> fail "Invalid OpenMath object for this exercise"
 
 decodeMathML :: XMLDecoder a MathML
-decodeMathML = decodeFirstChild "math" $ decoderFor fromXML
+decodeMathML = decodeFirstChild "math" $ get >>= fromXML
 
 decodeEnvironment :: XMLDecoder a Environment
 decodeEnvironment =
-   decodeChild "context" (decoderFor $ foldM add mempty . children)
+   decodeChild "context" (get >>= foldM add mempty . children)
    <|> return mempty
  where
    add env item = do
@@ -174,7 +176,7 @@ -- <configuration>
 decodeConfiguration :: XMLDecoder a StrategyCfg
 decodeConfiguration = decodeChild "configuration" $
-   decoderFor $ \xml ->
+   get >>= \xml ->
       mconcat <$> mapM decodeAction (children xml)
  where
    decodeAction item = do
@@ -184,11 +186,11 @@       return (action `byName` newId cfgloc)
 
 decodeArgEnvironment :: XMLDecoder a Environment
-decodeArgEnvironment = decoderFor $
+decodeArgEnvironment = get >>=
    fmap makeEnvironment . mapM (decodeBinding //) . findChildren "argument"
 
 decodeBinding :: XMLDecoder a Binding
-decodeBinding = decoderFor $ \xml -> do
+decodeBinding = get >>= \xml -> do
    a   <- findAttribute "description" xml
    req <- getRequest
    case findChild "OMOBJ" xml of
@@ -201,33 +203,4 @@       _ -> return (makeBinding (makeRef a) (getData xml))
  where
    termBinding :: String -> Term -> Binding
-   termBinding = makeBinding . makeRef
-
-decodeData :: XMLDecoder a String
-decodeData = split $ \xml ->
-   case content xml of
-      Left s:rest -> Right (s, xml {content = rest})
-      _           -> Left "Could not find data"
-
-decodeChild :: String -> XMLDecoder a b -> XMLDecoder a b
-decodeChild s m = split f >>= (m //)
- where
-   p     = either (const False) ((==s) . name)
-   f xml = case break p (content xml) of
-              (xs, Right y:ys) -> Right (y, xml { content = xs ++ ys })
-              _ -> Left $ "Could not find child " ++ s
-
-decodeFirstChild :: String -> XMLDecoder a b -> XMLDecoder a b
-decodeFirstChild s m = split f >>= (m //)
- where
-   f xml = case content xml of
-              Right y:ys | name y == s -> Right (y, xml { content = ys })
-              _ -> Left $ "Could not find first child " ++ s
-
-decodeAttribute :: String -> XMLDecoder a String
-decodeAttribute s = split $ \xml ->
-   case break p (attributes xml) of
-      (xs, (_ := val):ys) -> Right (val, xml {attributes = xs ++ ys })
-      _ -> Left $ "Could not find attribute " ++ s
- where
-   p (n := _) = n == s+   termBinding = makeBinding . makeRef

@@ -1,6 +1,6 @@ {-# LANGUAGE RankNTypes #-}
 -----------------------------------------------------------------------------
--- Copyright 2018, Ideas project team. This file is distributed under the
+-- Copyright 2019, 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.
 -----------------------------------------------------------------------------
@@ -13,9 +13,9 @@ 
 module Ideas.Encoding.Encoder
    ( -- * Converter type class
-     Converter(..)
-   , getExercise, getBaseUrl, getQCGen, getScript, getRequest
-   , withExercise, withOpenMath, withJSONTerm, (//)
+     getExercise, getOptions, getRequest
+   , withExercise, getBaseUrl, getQCGen, getScript
+   , (//), withJSONTerm, withOpenMath
      -- * JSON support
    , hasJSONView, addJSONView, jsonEncoding
    , termToJSON, jsonToTerm
@@ -23,73 +23,60 @@    , hasLatexEncoding, latexPrinter, latexPrinterContext
    , latexEncoding, latexEncodingWith
      -- * Encoder datatype
-   , Encoder, TypedEncoder
-   , makeEncoder, encoderFor, exerciseEncoder
+   , EncoderX, TypedEncoder
    , (<?>), encodeTyped
      -- * Decoder datatype
-   , Decoder, TypedDecoder
-   , makeDecoder, decoderFor
-   , split, symbol, setInput
-     -- re-export
-   , module Export
-   , (<>)
+   , DecoderX, TypedDecoder
    ) where
 
-import Control.Applicative as Export hiding (Const)
-import Control.Arrow as Export
-import Control.Monad
+import Control.Monad.Reader
 import Data.Maybe
-import Data.Semigroup as Sem
-import Ideas.Common.Library hiding (exerciseId, symbol)
+import Ideas.Common.Library
 import Ideas.Encoding.Options
 import Ideas.Encoding.Request
 import Ideas.Service.FeedbackScript.Parser (Script)
 import Ideas.Service.Types
 import Ideas.Text.JSON hiding (String)
 import Ideas.Text.Latex
-import Ideas.Text.XML
+import Ideas.Utils.Decoding
 import Test.QuickCheck.Random
-import qualified Control.Category as C
 import qualified Ideas.Common.Rewriting.Term as Term
 import qualified Ideas.Text.JSON as JSON
 
 -------------------------------------------------------------------
 -- Converter type class
 
-class Converter f where
-   fromExercise :: (Exercise a -> t) -> f a s t
-   fromOptions  :: (Options -> t) -> f a s t
-   run :: Monad m => f a s t -> Exercise a -> Options -> s -> m t
+getExercise :: DecoderX a s (Exercise a)
+getExercise = reader fst
 
-getExercise :: Converter f => f a s (Exercise a)
-getExercise = fromExercise id
+getOptions :: DecoderX a s Options
+getOptions = reader snd
 
-getBaseUrl :: Converter f => f a s String
-getBaseUrl = fromOptions (fromMaybe "http://ideas.cs.uu.nl/" . baseUrl)
+getRequest :: DecoderX a s Request
+getRequest = request <$> getOptions
 
-getQCGen :: Converter f => f a s QCGen
-getQCGen = fromOptions (fromMaybe (mkQCGen 0) . qcGen)
+withExercise :: (Exercise a -> DecoderX a s t) -> DecoderX a s t
+withExercise = (getExercise >>=)
 
-getScript :: Converter f => f a s Script
-getScript = fromOptions script
+getBaseUrl :: DecoderX a s String
+getBaseUrl = fromMaybe "http://ideas.cs.uu.nl/" . baseUrl <$> getOptions
 
-getRequest :: Converter f => f a s Request
-getRequest = fromOptions request
+getQCGen :: DecoderX a s QCGen
+getQCGen = fromMaybe (mkQCGen 0) . qcGen <$> getOptions
 
-withExercise :: (Converter f, Monad (f a s)) => (Exercise a -> f a s t) -> f a s t
-withExercise = (getExercise >>=)
+getScript :: DecoderX a s Script
+getScript = script <$> getOptions
 
-withOpenMath :: (Converter f, Monad (f a s)) => (Bool -> f a s t) -> f a s t
+withOpenMath :: (Bool -> DecoderX a s t) -> DecoderX a s t
 withOpenMath = (fmap useOpenMath getRequest >>=)
 
-withJSONTerm :: (Converter f, Monad (f a s)) => (Bool -> f a s t) -> f a s t
+withJSONTerm :: (Bool -> DecoderX a s t) -> DecoderX a s t
 withJSONTerm = (fmap useJSONTerm getRequest >>=)
 
-(//) :: (Converter f, Monad (f a s2)) => f a s t -> s -> f a s2 t
+(//) :: Decoder env s a -> s -> Decoder env s2 a
 p // a = do
-   opts <- fromOptions id
-   ex   <- getExercise
-   run p ex opts a
+   env  <- ask
+   runDecoder p env a
 
 -------------------------------------------------------------------
 -- JSON terms
@@ -178,175 +165,24 @@ -------------------------------------------------------------------
 -- Encoder datatype
 
-newtype Encoder a s t = Enc { runEnc :: (Exercise a, Options) -> s -> Error t }
-
-type TypedEncoder a = Encoder a (TypedValue (Type a))
-
-instance C.Category (Encoder a) where
-   id    = arr id
-   f . g = Enc $ \xs -> runEnc g xs >=> runEnc f xs
-
-instance Arrow (Encoder a) where
-   arr   f = Enc $ \_ -> return . f
-   first f = Enc $ \xs (a, b) -> runEnc f xs a >>= \c -> return (c, b)
-
-instance Functor (Encoder a s) where
-   fmap f p = Enc $ \xs s -> f <$> runEnc p xs s
-
-instance Applicative (Encoder a s) where
-   pure a  = Enc $ \_ _ -> return a
-   p <*> q = Enc $ \xs s -> do
-      f <- runEnc p xs s
-      f <$> runEnc q xs s
-
-instance Alternative (Encoder a s) where
-   empty = fail "Encoder: emptu"
-   p <|> q = Enc $ \xs s ->
-      runEnc p xs s <|> runEnc q xs s
-
-instance Monad (Encoder a s) where
-   return   = pure
-   fail s   = Enc $ \_ _ -> fail s
-   p >>= f  = Enc $ \xs s -> do
-      a <- runEnc p xs s
-      runEnc (f a) xs s
-
-instance MonadPlus (Encoder a s) where
-   mzero = fail "Encoder: mzero"
-   mplus = (<|>)
-
-instance Converter Encoder where
-   fromExercise f = Enc $ \(ex, _) _ -> return (f ex)
-   fromOptions  f = Enc $ \(_, opts) _ -> return (f opts)
-   run f ex opts  = runErrorM . runEnc f (ex, opts)
-
-instance Sem.Semigroup t => Sem.Semigroup (Encoder a s t) where
-   (<>) = liftA2 (<>)
-
-instance Monoid t => Monoid (Encoder a s t) where
-   mempty  = pure mempty
-   mappend = liftA2 mappend
-
-instance BuildXML t => BuildXML (Encoder a s t) where
-   n .=. s   = pure (n .=. s)
-   unescaped = pure . unescaped
-   builder   = pure . builder
-   tag       = fmap . tag
-
-makeEncoder :: (s -> t) -> Encoder a s t
-makeEncoder = arr
-
-encoderFor :: (s -> Encoder a s t) -> Encoder a s t
-encoderFor f = C.id >>= f
+type EncoderX a = Encoder (Exercise a, Options)
 
-exerciseEncoder :: (Exercise a -> s -> t) -> Encoder a s t
-exerciseEncoder f = withExercise $ makeEncoder . f
+type TypedEncoder a b = TypedValue (Type a) -> EncoderX a b
 
 infixr 5 <?>
 
-(<?>) :: (Encoder a t b, Type a1 t) -> Encoder a (TypedValue (Type a1)) b
-                                    -> Encoder a (TypedValue (Type a1)) b
-(p, t) <?> q = do
-   val ::: tp <- makeEncoder id
+(<?>) :: (t -> EncoderX a b, Type a t) -> TypedEncoder a b -> TypedEncoder a b
+((p, t) <?> q) tv@(val ::: tp) =
    case equal tp t of
-      Just f -> p // f val
-      Nothing -> q
+      Just f  -> p (f val)
+      Nothing -> q tv
 
-encodeTyped :: Encoder st t b -> Type a t -> Encoder st (TypedValue (Type a)) b
+encodeTyped :: (t -> EncoderX a b) -> Type a t -> TypedEncoder a b
 encodeTyped p t = (p, t) <?> fail "Types do not match"
 
 -------------------------------------------------------------------
 -- Decoder datatype
 
-newtype Decoder a s t = Dec { runDec :: (Exercise a, Options) -> s -> Error (t, s) }
-
-type TypedDecoder a s = forall t . Type a t -> Decoder a s t
-
-instance Functor (Decoder a s) where
-   fmap f p = Dec $ \xs s -> mapFirst f <$> runDec p xs s
-
-instance Applicative (Decoder a s) where
-   pure a  = Dec $ \_ s -> return (a, s)
-   p <*> q = Dec $ \xs s1 -> do
-      (f, s2) <- runDec p xs s1
-      mapFirst f <$> runDec q xs s2
-
-instance Alternative (Decoder a s) where
-   empty   = fail "Decoder: empty"
-   p <|> q = Dec $ \xs s -> runDec p xs s <|> runDec q xs s
-
-instance Monad (Decoder a s) where
-   return   = pure
-   fail s   = Dec $ \_ _ -> fail s
-   p >>= f  = Dec $ \xs s1 -> do
-      (a, s2) <- runDec p xs s1
-      runDec (f a) xs s2
-
-instance MonadPlus (Decoder a s) where
-   mzero = fail "Decoder: mzero"
-   mplus = (<|>)
-
-get :: Decoder a s s
-get = Dec $ \_ s -> return (s, s)
-
-put :: s -> Decoder a s ()
-put s = Dec $ \_ _ -> return ((), s)
-
-instance Converter Decoder where
-   fromExercise f = Dec $ \(ex, _) s -> return (f ex, s)
-   fromOptions  f = Dec $ \(_, opts) s -> return (f opts, s)
-   run f ex opts  = fmap fst . runErrorM . runDec f (ex, opts)
-
-split :: (s -> Either String (t, s)) -> Decoder a s t
-split f = get >>= either fail (\(a, s2) -> put s2 >> return a) . f
-
-symbol :: Decoder a [s] s
-symbol = split f
- where
-   f []     = Left "Empty input"
-   f (x:xs) = Right (x, xs)
-
-setInput :: s -> Decoder a s ()
-setInput inp = split (\_ -> Right ((), inp))
-
-makeDecoder:: (s -> t) -> Decoder a s t
-makeDecoder f = fmap f get
-
-decoderFor :: (s -> Decoder a s t) -> Decoder a s t
-decoderFor f = get >>= f
-
--------------------------------------------------------------------
--- Error monad (helper)
-
-newtype Error a = Error { runError :: Either String a }
-
-instance Functor Error where
-   fmap f = Error . fmap f . runError
-
-instance Applicative Error where
-   pure    = Error . Right
-   p <*> q = Error $
-      case (runError p, runError q) of
-         (Left s, _)  -> Left s
-         (_, Left s)  -> Left s
-         (Right f, Right x) -> Right (f x)
-
-instance Alternative Error where
-   empty   = Error (Left "empty")
-   p <|> q = Error $
-      case (runError p, runError q) of
-         (Right a, _) -> Right a
-         (_, Right a) -> Right a
-         (Left s, _)  -> Left s
-
-instance Monad Error where
-   fail    = Error . Left
-   return  = pure
-   m >>= f = Error $ either Left (runError . f) (runError m)
-
-instance MonadPlus Error where
-   mzero = fail "mzero"
-   mplus = (<|>)
+type DecoderX a = Decoder (Exercise a, Options)
 
-runErrorM :: Monad m => Error a -> m a
-runErrorM = either fail return . runError+type TypedDecoder a s = forall t . Type a t -> Decoder (Exercise a, Options) s t

@@ -1,6 +1,6 @@ {-# LANGUAGE GADTs, OverloadedStrings #-}
 -----------------------------------------------------------------------------
--- Copyright 2018, Ideas project team. This file is distributed under the
+-- Copyright 2019, 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.
 -----------------------------------------------------------------------------
@@ -13,15 +13,16 @@ --
 -----------------------------------------------------------------------------
 
-module Ideas.Encoding.EncoderHTML (htmlEncoder) where
+module Ideas.Encoding.EncoderHTML (HTMLEncoder, htmlEncoder) where
 
 import Data.Char
 import Data.List
 import Data.Maybe
-import Data.Ord
-import Ideas.Common.Library hiding (alternatives, left, right, collapse, Medium)
+import Data.Monoid
+import Ideas.Common.Examples (isEmpty, size, allRandoms)
+import Ideas.Common.Library hiding (alternatives, isEmpty, left, right, collapse, Medium)
 import Ideas.Common.Strategy.Symbol
-import Ideas.Encoding.Encoder hiding (left, right)
+import Ideas.Encoding.Encoder
 import Ideas.Encoding.LinkManager
 import Ideas.Encoding.Logging
 import Ideas.Encoding.Request
@@ -39,19 +40,24 @@ import Ideas.Text.OpenMath.FMP
 import Ideas.Text.OpenMath.Object
 import Ideas.Text.XML hiding (content)
+import Ideas.Utils.Prelude (munless, mwhen)
 import Ideas.Utils.TestSuite
 import System.IO.Unsafe
 import qualified Ideas.Text.HTML.W3CSS as W3
 
-type HTMLEncoder a t = Encoder a t HTMLBuilder
+type HTMLEncoder a = EncoderX a HTMLBuilder
 
 htmlEncoder :: DomainReasoner -> TypedEncoder a HTMLPage
-htmlEncoder dr = do
+htmlEncoder dr tv = do
+   lm <- getLinkManager
+   ex <- getExercise
+   makePage lm dr ex <$> encodeType dr tv
+
+getLinkManager :: EncoderX a LinkManager
+getLinkManager = do
    req  <- getRequest
    base <- getBaseUrl
-   let lm = makeLinkManager base (fromMaybe "" (cgiBinary req))
-   ex <- getExercise
-   makePage lm dr ex <$> encodeType lm dr
+   return $ makeLinkManager base (fromMaybe "" (cgiBinary req))
 
 makePage :: LinkManager -> DomainReasoner -> Exercise a -> HTMLBuilder -> HTMLPage
 makePage lm dr ex body =
@@ -107,53 +113,52 @@ keyValueTable :: BuildXML a => [(String, a)] -> a
 keyValueTable = table False . map (\(s, a) -> [string s, a])
 
-encodeType :: LinkManager -> DomainReasoner -> HTMLEncoder a (TypedValue (Type a))
-encodeType lm dr =
+encodeType :: DomainReasoner -> TypedValue (Type a) -> HTMLEncoder a
+encodeType dr =
    (encodeIndex, tDomainReasoner) <?>
-   (exerciseHeader (htmlDiagnosis lm dr), tDiagnosis) <?>
-   (exerciseHeader (encodeExampleList lm), tList (tPair tDifficulty tContext)) <?>
-   (exerciseHeader (htmlFirsts lm), tList (tPair tStepInfo tState)) <?>
-   (exerciseHeader (htmlAllApplications lm), tList (tTuple3 tRule tLocation tState)) <?>
-   (exerciseHeader (encodeDerivation lm), tDerivation (tPair tRule tEnvironment) tContext) <?>
-   (exerciseHeader (encodeDerivationList lm), tList (tDerivation (tPair tRule tEnvironment) tContext)) <?>
-   encoderFor (\(val ::: tp) ->
+   (exerciseHeader . htmlDiagnosis dr, tDiagnosis) <?>
+   (exerciseHeader . encodeExampleList, tList (tPair tDifficulty tContext)) <?>
+   (exerciseHeader . htmlFirsts, tList (tPair tStepInfo tState)) <?>
+   (exerciseHeader . htmlAllApplications, tList (tTuple3 tRule tLocation tState)) <?>
+   (exerciseHeader . encodeDerivation, tDerivation (tPair tRule tEnvironment) tContext) <?>
+   (exerciseHeader . encodeDerivationList, tList (tDerivation (tPair tRule tEnvironment) tContext)) <?>
+   \(val ::: tp) ->
         case tp of
-           Iso iso t  -> encodeType lm dr // (to iso val ::: t)
-           Tag _ t    -> encodeType lm dr // (val ::: t)
-           Pair t1 t2 -> encodeType lm dr // (fst val ::: t1) <>
-                         encodeType lm dr // (snd val ::: t2)
+           Iso iso t  -> encodeType dr (to iso val ::: t)
+           Tag _ t    -> encodeType dr (val ::: t)
+           Pair t1 t2 -> encodeType dr (fst val ::: t1) <>
+                         encodeType dr (snd val ::: t2)
            t1 :|: t2  -> case val of
-                            Left x  -> encodeType lm dr // (x ::: t1)
-                            Right x -> encodeType lm dr // (x ::: t2)
-           List (Const Service) -> encodeServiceList lm // val
-           List (Const SomeExercise) -> encodeExerciseList lm // val
-           List (Const Rule) -> exerciseHeader (encodeRuleList lm // val)
-           List t -> ul [ encodeType lm dr // (x ::: t) | x <- val ]
-           Const t -> encodeConst lm dr // (val ::: t)
-           _ -> string $ "unknown: " ++ show tp)
+                            Left x  -> encodeType dr (x ::: t1)
+                            Right x -> encodeType dr (x ::: t2)
+           List (Const Service) -> encodeServiceList val
+           List (Const SomeExercise) -> encodeExerciseList val
+           List (Const Rule) -> exerciseHeader (encodeRuleList val)
+           List t -> ul [ encodeType dr (x ::: t) | x <- val ]
+           Const t -> encodeConst dr (val ::: t)
+           _ -> string $ "unknown: " ++ show tp
 
-encodeConst :: LinkManager -> DomainReasoner -> HTMLEncoder a (TypedValue (Const a))
-encodeConst lm dr = encoderFor $ \tv@(val ::: tp) ->
+encodeConst :: DomainReasoner -> TypedValue (Const a) -> HTMLEncoder a
+encodeConst dr tv@(val ::: tp) =
    case tp of
-      Service     -> encodeService // val
-      Exercise    -> exerciseHeader (encodeExercise lm // val)
-      Strategy    -> exerciseHeader (encodeStrategy // val)
-      Rule        -> encodeRule // val
-      State       -> exerciseHeader (encodeState lm dr // val)
+      Service     -> encodeService val
+      Exercise    -> exerciseHeader (encodeExercise val)
+      Strategy    -> exerciseHeader (encodeStrategy val)
+      Rule        -> encodeRule val
+      State       -> exerciseHeader (encodeState dr val)
       Location    -> text val
       Environment -> text val
       Term        -> text val
-      Context     -> encodeContext // val
+      Context     -> encodeContext val
       String      -> string val
-      Result      -> exerciseHeader (encodeResult lm val)
+      Result      -> exerciseHeader (encodeResult val)
       _           -> text tv
 
-encodeContext :: HTMLEncoder a (Context a)
-encodeContext = exerciseEncoder $ \ex ->
-   string . prettyPrinterContext ex
+encodeContext :: Context a -> HTMLEncoder a
+encodeContext ctx = (\ex -> string (prettyPrinterContext ex ctx)) <$> getExercise
 
-encodeIndex :: HTMLEncoder a DomainReasoner
-encodeIndex = makeEncoder $ \dr -> mconcat
+encodeIndex :: DomainReasoner -> HTMLEncoder a
+encodeIndex dr = return $ mconcat
    [ htmlDescription "Domain reasoner" dr
    , panel $ right $ string "Logging: " <> bool logEnabled
    , munless (null $ aliases dr) $
@@ -172,32 +177,36 @@            ])
    ]
 
-encodeServiceList :: LinkManager -> HTMLEncoder a [Service]
-encodeServiceList lm = makeEncoder $ \srvs ->
-   h1 "Services" <>
-   mconcat
-      [ h2 (show i ++ ". " ++ s) <> table False (map make xs)
-      | (i, s, xs) <- groupById srvs
-      ]
+encodeServiceList :: [Service] -> HTMLEncoder a
+encodeServiceList srvs = do
+   lm <- getLinkManager
+   return $
+      h1 "Services" <>
+      mconcat
+         [ h2 (show i ++ ". " ++ s) <> table False (map (make lm) xs)
+         | (i, s, xs) <- groupById srvs
+         ]
  where
-   make s = [ linkToService lm s (string (showId s)) <>
-              mwhen (serviceDeprecated s) (italic (string " (deprecated)"))
-            , string (description s)
-            ]
+   make lm s = [ linkToService lm s (string (showId s)) <>
+                 mwhen (serviceDeprecated s) (italic (string " (deprecated)"))
+               , string (description s)
+               ]
 
-encodeExerciseList :: LinkManager -> HTMLEncoder a [Some Exercise]
-encodeExerciseList lm = makeEncoder $ \exs ->
-   h1 "Exercises" <>
-   mconcat
-      [ h2 (show i ++ ". " ++ dom) <> table False (map make xs)
-      | (i, dom, xs) <- groupsWith f exs
-      ]
+encodeExerciseList :: [Some Exercise] -> HTMLEncoder a
+encodeExerciseList exs = do
+   lm <- getLinkManager
+   return $
+      h1 "Exercises" <>
+      mconcat
+         [ h2 (show i ++ ". " ++ dom) <> table False (map (make lm) xs)
+         | (i, dom, xs) <- groupsWith f exs
+         ]
  where
    f :: Some Exercise -> String
    f (Some ex) = fromMaybe "" (listToMaybe (qualifiers (getId ex)))
 
-   make :: Some Exercise -> [HTMLBuilder]
-   make (Some ex) =
+   make :: LinkManager -> Some Exercise -> [HTMLBuilder]
+   make lm (Some ex) =
       [ linkToExercise lm ex $ string $ showId ex
       , string $ map toLower $ show $ status ex
       , string $ description ex
@@ -211,13 +220,13 @@ 
 orderedGroupsWith :: Ord b => (b -> String) -> (a -> b) -> [a] -> [(Int, String, [a])]
 orderedGroupsWith showf get =
-   zipWith f [1..] . groupBy eq . sortBy (comparing get)
+   zipWith f [1..] . groupBy eq . sortOn get
  where
    eq x y = get x == get y
    f i xs = (i, showf (get (head xs)), xs)
 
-encodeService :: HTMLEncoder a Service
-encodeService = makeEncoder $ \srv -> mconcat
+encodeService :: Service -> HTMLEncoder a
+encodeService srv = return $ mconcat
    [ htmlDescription "Service" srv
    , mwhen (serviceDeprecated srv) $
         para $ spanClass "warning" $ string "Warning: this service is deprecated"
@@ -252,25 +261,27 @@       Unit       -> []
       _          -> [Some tp]
 
-encodeExercise :: LinkManager -> HTMLEncoder a (Exercise a)
-encodeExercise lm = makeEncoder $ \ex -> mconcat
-   [ generalInfo ex
-   , h2 "Example exercises"
-   , ul $ [ para $ linkToExamples lm ex $ string "list of examples"
-          | not (null (examples ex))
-          ] ++
-          [ para $ mconcat $
-               string "generate exercise: " :
-               intersperse (string ", ")
-                  [ linkToRandomExample lm ex d $ text d
-                  | d <- [VeryEasy .. VeryDifficult]
-                  ]
-          | isJust (randomExercise ex)
-          ] ++
-          [ para $ submitStateInfo lm ex ]
-   ]
+encodeExercise :: Exercise a -> HTMLEncoder a
+encodeExercise ex = do
+   lm <- getLinkManager
+   return $ mconcat
+      [ generalInfo lm
+      , h2 "Example exercises"
+      , ul $ [ para $ linkToExamples lm ex $ string "list of examples"
+             | isEmpty (examples ex)
+             ] ++
+             [ para $ mconcat $
+                  string "generate exercise: " :
+                  intersperse (string ", ")
+                     [ linkToRandomExample lm ex d $ text d
+                     | d <- [VeryEasy .. VeryDifficult]
+                     ]
+             | not $ null $ allRandoms $ examples ex
+             ] ++
+             [ para $ submitStateInfo lm ex ]
+      ]
  where
-   generalInfo ex = container $ panel $ left $ keyValueTable
+   generalInfo lm = container $ panel $ left $ keyValueTable
       [ ("Code",   string $ showId ex)
       , ("Status", text $ status ex)
       , ("Strategy", linkToStrategy lm ex $ string (showId $ strategy ex))
@@ -279,38 +290,40 @@       , ("Buggy rules", text nrOfBuggyRules)
       , ("OpenMath support", bool $ isJust $ hasTermView ex)
       , ("Restartable strategy", bool $ canBeRestarted ex)
-      , ("Exercise generator", bool $ isJust $ randomExercise ex)
-      , ("Examples", text $ length $ examples ex)
+      , ("Exercise generator", bool $ not $ null $ allRandoms $ examples ex)
+      , ("Examples", text $ size $ examples ex)
       ]
     where
       (nrOfBuggyRules, nrOfSoundRules) =
          mapBoth length (partition isBuggy (ruleset ex))
 
-exerciseHeader :: HTMLEncoder a b -> HTMLEncoder a b
-exerciseHeader body = withExercise $ \ex -> tag "div" $ mconcat
-   [ pure (htmlDescription "Exercise" ex)
-   , body
-   ]
+exerciseHeader :: HTMLEncoder a -> HTMLEncoder a
+exerciseHeader body = withExercise $ \ex ->
+   tag "div" $ mconcat
+      [ return (htmlDescription "Exercise" ex)
+      , body
+      ]
 
-encodeStrategy :: HTMLEncoder a (Strategy (Context a))
-encodeStrategy = exerciseEncoder $ \ex s -> mconcat
-   [ h2 "Strategy"
-   , highlightXML True (strategyToXML s)
-   , h2 "Locations"
-   , let f :: HasId a => ([Int], a) -> [HTMLBuilder]
-         f (loc, a) = [text loc, indent (length loc) <> string (showId a)]
-         indent n = string (replicate (3*n) '.')
-     in table True
-           ( [string "Location", string "Label"]
-           : map f (strategyLocations (strategy ex))
-           )
-   ]
+encodeStrategy :: Strategy (Context a) -> HTMLEncoder a
+encodeStrategy s = withExercise $ \ex ->
+   return $ mconcat
+      [ h2 "Strategy"
+      , highlightXML True (strategyToXML s)
+      , h2 "Locations"
+      , let f :: HasId a => ([Int], a) -> [HTMLBuilder]
+            f (loc, a) = [text loc, indent (length loc) <> string (showId a)]
+            indent n = string (replicate (3*n) '.')
+        in table True
+              ( [string "Location", string "Label"]
+              : map f (strategyLocations (strategy ex))
+              )
+      ]
 
 bool :: Bool -> HTMLBuilder
 bool b = string (if b then "yes" else "no")
 
-encodeResult :: BuildXML b => LinkManager -> Result -> b
-encodeResult lm tests = mconcat
+encodeResult :: Result -> HTMLEncoder a
+encodeResult tests = getLinkManager >>= \lm -> mconcat
    [ h2 "Test report"
    , divClass "test-summary" $ mconcat
         [ divClass "test-status" (statusImg lm tests 32)
@@ -327,26 +340,26 @@              ]
         ]
    , mwhen (isError tests) $
-        mconcat (h2 "Errors" : map makeItem errors)
+        mconcat (h2 "Errors" : map (makeItem lm) errors)
    , mwhen (isWarning tests) $
-        mconcat (h2 "Warnings" : map makeItem warnings)
+        mconcat (h2 "Warnings" : map (makeItem lm) warnings)
    , h2 "Tests"
-   , make tests
+   , make lm tests
    ]
  where
    msgs     = allMessages tests
    errors   = filter (isError . snd) msgs
    warnings = filter (isWarning . snd) msgs
 
-   make t = mconcat $
-      map makeGroup (subResults t) ++
-      map makeItem (topMessages t)
+   make lm t = mconcat $
+      map (makeGroup lm) (subResults t) ++
+      map (makeItem lm) (topMessages t)
 
-   makeGroup (s, t) = divClass "test-group" $
+   makeGroup lm (s, t) = divClass "test-group" $
       divClass "test-title" (string (s ++ " " ++ show t))
-      <> make t
+      <> make lm t
 
-   makeItem (s, m) = divClass "test-item" $
+   makeItem lm (s, m) = divClass "test-item" $
       statusImg lm m 16 <> spaces 3 <> string s <> msg
     where
       msg | isOk m      = mempty
@@ -379,8 +392,9 @@           | a == 1    = "star_2.png"
           | otherwise = "star_3.png"
 
-encodeRuleList :: LinkManager -> HTMLEncoder a [Rule (Context a)]
-encodeRuleList lm = exerciseEncoder $ \ex rs ->
+encodeRuleList :: [Rule (Context a)] -> HTMLEncoder a
+encodeRuleList rs = withExercise $ \ex -> do
+   lm <- getLinkManager
    let (rs1, rs2) = partition isBuggy rs
 
        header = [ string "Rule name", string "Args"
@@ -395,66 +409,70 @@                    ruleToHTML (Some ex) r
               ]
 
-   in mconcat
+   return $ mconcat
          [ h2 $ "Rules for " ++ showId ex
          , table True (header:map f rs2)
          , h2 $ "Buggy rules for " ++ showId ex
          , table True (header:map f rs1)
          ]
 
-encodeRule :: HTMLEncoder a (Rule (Context a))
-encodeRule = exerciseEncoder $ \ex r -> mconcat
-   [ htmlDescription "Rule" r
-   , let commas  = string . intercalate ", "
-         idList  = commas . map showId
-         refList = commas . map show . getRefIds
-     in para $ keyValueTable
-           [ ("Parameters", refList r)
-           , ("Buggy", bool (isBuggy r))
-           , ("Rewrite rule", bool (isRewriteRule r))
-           , ("Siblings", idList $ ruleSiblings r)
-           ]
-   , mwhen (isRewriteRule r) $
-        h2 "Rewrite rule" <> ruleToHTML (Some ex) r
-   -- FMPS
-   , let xs = getRewriteRules (transformation r)
-     in munless (null xs) $ mconcat $
-           h2 "Formal Mathematical Properties" :
-           [ para $
-              let fmp = rewriteRuleToFMP (not $ isBuggy r) rr
-              in highlightXML False $ makeXML "FMP" $
-                    builder $ omobj2xml $ toObject fmp
-           | Some rr <- xs
-           ]
-   ]
+encodeRule :: Rule (Context a) -> HTMLEncoder a
+encodeRule r = withExercise $ \ex ->
+   return $ mconcat
+      [ htmlDescription "Rule" r
+      , let commas  = string . intercalate ", "
+            idList  = commas . map showId
+            refList = commas . map show . getRefIds
+        in para $ keyValueTable
+              [ ("Parameters", refList r)
+              , ("Buggy", bool (isBuggy r))
+              , ("Rewrite rule", bool (isRewriteRule r))
+              , ("Siblings", idList $ ruleSiblings r)
+              ]
+      , mwhen (isRewriteRule r) $
+           h2 "Rewrite rule" <> ruleToHTML (Some ex) r
+      -- FMPS
+      , let xs = getRewriteRules (transformation r)
+        in munless (null xs) $ mconcat $
+              h2 "Formal Mathematical Properties" :
+              [ para $
+                 let fmp = rewriteRuleToFMP (not $ isBuggy r) rr
+                 in highlightXML False $ makeXML "FMP" $
+                       builder $ omobj2xml $ toObject fmp
+              | Some rr <- xs
+              ]
+      ]
 
-encodeExampleList :: LinkManager -> HTMLEncoder a [(Difficulty, Context a)]
-encodeExampleList lm = exerciseEncoder $ \ex pairs -> mconcat $
-   h2 "Examples" :
-   [  container . third $
-       h3 (s ++ " (" ++ show (length xs) ++ ")")
-       <> W3.ulWith hoverable (map ((fontAwesome "hand-o-right" <>) . padding Small . make ex) xs)
-   | (_, s, xs) <- orderedGroupsWith show fst pairs
-   ]
+encodeExampleList :: [(Difficulty, Context a)] -> HTMLEncoder a
+encodeExampleList pairs = withExercise $ \ex -> do
+   lm <- getLinkManager
+   return $ mconcat $
+      h2 "Examples" :
+      [  container . third $
+          h3 (s ++ " (" ++ show (length xs) ++ ")")
+          <> W3.ulWith hoverable (map ((fontAwesome "hand-o-right" <>) . padding Small . make lm ex) xs)
+      | (_, s, xs) <- orderedGroupsWith show fst pairs
+      ]
  where
-   make ex (_, x) =
+   make lm ex (_, x) =
       let st = emptyStateContext ex x
       in button (escapeInURL (urlForState lm st)) (htmlContext False ex x)
 
-encodeDerivation :: LinkManager -> HTMLEncoder a (Derivation (Rule (Context a), Environment) (Context a))
-encodeDerivation lm =
-   h2 "Derivation" <> htmlDerivation lm
+encodeDerivation :: Derivation (Rule (Context a), Environment) (Context a) -> HTMLEncoder a
+encodeDerivation d =
+   h2 "Derivation" <> htmlDerivation d
 
-encodeDerivationList :: LinkManager -> HTMLEncoder a [Derivation (Rule (Context a), Environment) (Context a)]
-encodeDerivationList lm = encoderFor $ \ds ->
+encodeDerivationList :: [Derivation (Rule (Context a), Environment) (Context a)] -> HTMLEncoder a
+encodeDerivationList ds =
    h2 "Derivations"
    <> mconcat
-      [ h3 (show i ++ ".") <> htmlDerivation lm // d
+      [ h3 (show i ++ ".") <> htmlDerivation d
       | (i, d) <- zip [1::Int ..] ds
       ]
 
-htmlDerivation :: LinkManager -> HTMLEncoder a (Derivation (Rule (Context a), Environment) (Context a))
-htmlDerivation lm = exerciseEncoder $ \ex d ->
+htmlDerivation :: Derivation (Rule (Context a), Environment) (Context a) -> HTMLEncoder a
+htmlDerivation d = withExercise $ \ex -> do
+   lm <- getLinkManager
    let before =
           stateLink lm (emptyStateContext ex (firstTerm d))
           <> case fmap (isReady ex) (fromContext (lastTerm d)) of
@@ -463,17 +481,18 @@        forStep ((r, env1), env2) =
           let showEnv e = munless (noBindings e) $ string $ "," ++ show e in
           container $ marginPos CenterLeft $ mconcat
-             [ unescaped "&#8658; "
+             [ string [chr 8658, ' ']
              , linkToRule lm ex r $ string $ showId r
              , showEnv env1 -- local environment
              , showEnv env2 -- global environment (diff)
              ]
        forTerm = htmlContext True ex
-   in htmlDerivationWith before forStep forTerm (diffEnvironment d)
+   return $ htmlDerivationWith before forStep forTerm (diffEnvironment d)
 
-htmlState :: LinkManager -> HTMLEncoder a (State a)
-htmlState lm = makeEncoder $ \state ->
-   para $ container $ background LightGray $ para $
+htmlState :: State a -> HTMLEncoder a
+htmlState state = do
+   lm <- getLinkManager
+   return $ para $ container $ background LightGray $ para $
       stateLink lm state
       <> htmlContext True (exercise state) (stateContext state)
       <> string "ready: " <> bool (finished state)
@@ -494,13 +513,13 @@    container $ right $ linkToState lm st $
    tag "span" $ textTheme $ fontAwesome "external-link"
 
-encodeState :: LinkManager -> DomainReasoner -> HTMLEncoder a (State a)
-encodeState lm dr =
-   htmlState lm <>
-   makeEncoder (\state ->
+encodeState :: DomainReasoner -> State a -> HTMLEncoder a
+encodeState dr state = do
+   lm <- getLinkManager
+   htmlState state <>
       let xs = useAllFirsts dr state
           n  = either (const 0) length xs
-      in mconcat
+      in return (mconcat
          [ h2 "Feedback"
          , submitDiagnose lm state
          , tag "p" $ padding Small  $ mconcat [ case xs of
@@ -567,8 +586,8 @@       before : forTerm (firstTerm d) :
          [ forStep s <> forTerm a | (_, s, a) <- triples d ]
 
-htmlFirsts :: LinkManager -> HTMLEncoder a [(StepInfo a, State a)]
-htmlFirsts lm = encoderFor $ \xs ->
+htmlFirsts :: [(StepInfo a, State a)] -> HTMLEncoder a
+htmlFirsts xs =
    h2 "Firsts" <>
    ul [ keyValueTable
            [ ("Rule", string $ showId r)
@@ -576,22 +595,22 @@            , ("Term", text $ show $ currentTerm (top $ stateContext s) )
            , ("Focus", text $ show $ currentTerm (stateContext s) )
            , ("Environment", text env)
-           ] <> htmlState lm // s
+           ] <> htmlState s
       | ((r, loc, env), s) <- xs
       ]
 
-htmlAllApplications :: LinkManager -> HTMLEncoder a [(Rule (Context a), Location, State a)]
-htmlAllApplications lm = encoderFor $ \xs ->
+htmlAllApplications :: [(Rule (Context a), Location, State a)] -> HTMLEncoder a
+htmlAllApplications xs =
    h2 "All applications" <>
    ul [ keyValueTable
            [ ("Rule", string $ showId r)
            , ("Location", text loc)
-           ] <> (if isBuggy r then mempty else htmlState lm // s)
+           ] <> (if isBuggy r then mempty else htmlState s)
       | (r, loc, s) <- xs
       ]
 
-htmlDiagnosis :: LinkManager -> DomainReasoner -> HTMLEncoder a (Diagnosis a)
-htmlDiagnosis lm dr = encoderFor $ \diagnosis ->
+htmlDiagnosis :: DomainReasoner -> Diagnosis a -> HTMLEncoder a
+htmlDiagnosis dr diagnosis =
    case diagnosis of
       SyntaxError s ->
          spanClass "error" $ string s
@@ -600,20 +619,20 @@       NotEquivalent s ->
          spanClass "error" $ string $ if null s then "Not equivalent" else s
       Similar _ s ->
-         h2 "Similar term" <> encodeState lm dr // s
+         h2 "Similar term" <> encodeState dr s
       WrongRule _ s mr ->
          h2 ("WrongRule " ++ maybe "" showId mr)
-         <> encodeState lm dr // s
+         <> encodeState dr s
       Expected _ s r ->
          h2 ("Expected (" ++ show r ++ ")")
-         <> encodeState lm dr // s
+         <> encodeState dr s
       Detour _ s _ r ->
          h2 ("Detour (" ++ show r ++ ")")
-         <> encodeState lm dr // s
+         <> encodeState dr s
       Correct _ s ->
-         h2 "Correct" <> encodeState lm dr // s
+         h2 "Correct" <> encodeState dr s
       Unknown _ s ->
-         h2 "Unknown" <> encodeState lm dr // s
+         h2 "Unknown" <> encodeState dr s
 
 htmlDescription :: HasId a => String -> a -> HTMLBuilder
 htmlDescription tp a = munless (null (description a)) $
@@ -670,7 +689,7 @@ submitURL :: String -> HTMLBuilder
 submitURL url = tag "script" $
    ("type" .=. "text/javascript")
-   <> unescaped (
+   <> string ( -- script is not to be escaped
       "function getTerm() {\
       \   var s = document.myform.myterm.value;\
       \   var result = '';\

@@ -1,6 +1,6 @@ {-# LANGUAGE GADTs #-}
 -----------------------------------------------------------------------------
--- Copyright 2018, Ideas project team. This file is distributed under the
+-- Copyright 2019, Ideas project team. This file is distributed `r 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.
 -----------------------------------------------------------------------------
@@ -15,9 +15,11 @@ 
 module Ideas.Encoding.EncoderJSON (jsonEncoder) where
 
+import Control.Applicative hiding (Const)
 import Data.Maybe
 import Ideas.Common.Library hiding (exerciseId)
-import Ideas.Encoding.Encoder hiding (symbol)
+import Ideas.Encoding.Encoder
+import Ideas.Encoding.Request
 import Ideas.Service.State
 import Ideas.Service.Types hiding (String)
 import Ideas.Text.JSON
@@ -26,33 +28,33 @@ import qualified Ideas.Service.Submit as Submit
 import qualified Ideas.Service.Types as Tp
 
-type JSONEncoder a t = Encoder a t JSON
+type JSONEncoder a = EncoderX a JSON
 
 jsonEncoder :: TypedEncoder a JSON
-jsonEncoder = encoderFor $ \tv@(val ::: tp) ->
+jsonEncoder tv@(val ::: tp) =
    case tp of
       _ | length (tupleList tv) > 1 ->
-         jsonTuple <$> sequence [ jsonEncoder // x | x <- tupleList tv ]
-      Iso p t   -> jsonEncoder // (to p val ::: t)
+         jsonTuple <$> sequence [ jsonEncoder x | x <- tupleList tv ]
+      Iso p t   -> jsonEncoder (to p val ::: t)
       t1 :|: t2 -> case val of
-         Left  x -> jsonEncoder // (x ::: t1)
-         Right y -> jsonEncoder // (y ::: t2)
+         Left  x -> jsonEncoder (x ::: t1)
+         Right y -> jsonEncoder (y ::: t2)
       Pair t1 t2 ->
          let f x y = jsonTuple [x, y]
-         in liftA2 f (jsonEncoder // (fst val ::: t1))
-                     (jsonEncoder // (snd val ::: t2))
+         in liftA2 f (jsonEncoder (fst val ::: t1))
+                     (jsonEncoder (snd val ::: t2))
       List (Const Rule) ->
-         pure $ Array $ map ruleShortInfo val
+         return $ Array $ map ruleShortInfo val
       Tp.Tag s t
-         | s == "Result"     -> encodeTyped encodeResult Submit.tResult
-         | s == "Diagnosis"  -> encodeTyped encodeDiagnosis Diagnose.tDiagnosis
-         | s == "Derivation" -> (encodeDerivation, tDerivation (tPair tRule tEnvironment) tContext) <?>
-                                encodeTyped encodeDerivationText (tDerivation tString tContext)
-         | s == "elem"       -> jsonEncoder // (val ::: t)
-         | otherwise -> (\b -> Object [(s, b)]) <$> jsonEncoder // (val ::: t)
-      Tp.Unit   -> pure Null
-      Tp.List t -> Array <$> sequence [ jsonEncoder // (x ::: t) | x <- val ]
-      Const ctp -> jsonEncodeConst // (val ::: ctp)
+         | s == "Result"     -> encodeTyped encodeResult Submit.tResult tv
+         | s == "Diagnosis"  -> encodeTyped encodeDiagnosis Diagnose.tDiagnosis tv
+         | s == "Derivation" -> ((encodeDerivation, tDerivation (tPair tRule tEnvironment) tContext) <?>
+                                encodeTyped encodeDerivationText (tDerivation tString tContext)) tv
+         | s == "elem"       -> jsonEncoder (val ::: t)
+         | otherwise -> (\b -> Object [(s, b)]) <$> jsonEncoder (val ::: t)
+      Tp.Unit   -> return Null
+      Tp.List t -> Array <$> sequence [ jsonEncoder (x ::: t) | x <- val ]
+      Const ctp -> jsonEncodeConst (val ::: ctp)
       _ -> fail $ "Cannot encode type: " ++ show tp
  where
    tupleList :: TypedValue (TypeRep f) -> [TypedValue (TypeRep f)]
@@ -64,41 +66,42 @@    tupleList (ev ::: (t1 :|: t2)) =
       either (\x -> tupleList (x ::: t1))
              (\x -> tupleList (x ::: t2)) ev
-   tupleList tv = [tv]
+   tupleList a = [a]
 
-jsonEncodeConst :: JSONEncoder a (TypedValue (Const a))
-jsonEncodeConst = encoderFor $ \(val ::: tp) ->
+jsonEncodeConst :: TypedValue (Const a) -> JSONEncoder a
+jsonEncodeConst (val ::: tp) =
    case tp of
       SomeExercise -> case val of
-                         Some ex -> pure (exerciseInfo ex)
-      State        -> encodeState // val
-      Rule         -> pure (toJSON (showId val))
-      Context      -> encodeContext // val
-      Location     -> pure (toJSON (show val))
-      Environment  -> encodeEnvironment // val
-      Term         -> pure (termToJSON val)
-      Text         -> pure (toJSON (show val))
-      Int          -> pure (toJSON val)
-      Bool         -> pure (toJSON val)
-      Tp.String    -> pure (toJSON val)
+                         Some ex -> return (exerciseInfo ex)
+      State        -> encodeState val
+      Rule         -> return (toJSON (showId val))
+      Context      -> encodeContext val
+      Location     -> return (toJSON (show val))
+      Constraint   -> return (toJSON (show val))
+      Environment  -> encodeEnvironment val
+      Term         -> return (termToJSON val)
+      Text         -> return (toJSON (show val))
+      Int          -> return (toJSON val)
+      Bool         -> return (toJSON val)
+      Tp.String    -> return (toJSON val)
       _ -> fail $ "Type " ++ show tp ++ " not supported in JSON"
 
 --------------------------
 
 -- legacy representation
-encodeEnvironment :: JSONEncoder a Environment
-encodeEnvironment = makeEncoder $ \env ->
+encodeEnvironment :: Environment -> JSONEncoder a
+encodeEnvironment env = return $
    let f a = Object [(showId a, String (showValue a))]
    in Array [ f a | a <- bindings env ]
 
-encodeContext :: JSONEncoder a (Context a)
-encodeContext = withJSONTerm (exerciseEncoder . f)
+encodeContext :: Context a -> JSONEncoder a
+encodeContext ctx = f . useJSONTerm <$> getRequest <*> getExercise
  where
-   f True  ex = fromMaybe Null . liftA2 build (hasJSONView ex) . fromContext
-   f False ex = String . prettyPrinterContext ex
+   f True  ex = fromMaybe Null $ liftA2 build (hasJSONView ex) $ fromContext ctx
+   f False ex = String $ prettyPrinterContext ex ctx
 
-encodeState :: JSONEncoder a (State a)
-encodeState = encoderFor $ \st ->
+encodeState :: State a -> JSONEncoder a
+encodeState st =
    let ctx   = stateContext st
        get f = String (fromMaybe "" (f st))
        make pp env = Array $
@@ -110,33 +113,33 @@           , env
           ] ++ if isNothing (stateUser st) then [] else
           [ Array [get stateUser, get stateSession, get stateStartTerm] ]
-   in make <$> (encodeContext // ctx) <*> (encodeStateEnvironment // ctx)
+   in make <$> encodeContext ctx <*> encodeStateEnvironment ctx
 
-encodeStateEnvironment :: JSONEncoder a (Context a)
-encodeStateEnvironment = makeEncoder $ \ctx ->
+encodeStateEnvironment :: Context a -> JSONEncoder a
+encodeStateEnvironment ctx = return $
    let loc = fromLocation (location ctx)
        env = (if null loc then id else insertRef (makeRef "location") loc)
            $ environment ctx
    in Object [ (showId a, String $ showValue a) | a <- bindings env ]
 
-encodeDerivation :: JSONEncoder a (Derivation (Rule (Context a), Environment) (Context a))
-encodeDerivation = encoderFor $ \d ->
+encodeDerivation :: Derivation (Rule (Context a), Environment) (Context a) -> JSONEncoder a
+encodeDerivation d =
    let xs = [ (s, a) | (_, s, a) <- triples d ]
-   in jsonEncoder // (xs ::: tList (tPair (tPair tRule tEnvironment) tContext))
+   in jsonEncoder (xs ::: tList (tPair (tPair tRule tEnvironment) tContext))
 
-encodeDerivationText :: JSONEncoder a (Derivation String (Context a))
-encodeDerivationText = encoderFor $ \d ->
+encodeDerivationText :: Derivation String (Context a) -> JSONEncoder a
+encodeDerivationText d =
    let xs = [ (s, a) | (_, s, a) <- triples d ]
-   in jsonEncoder // (xs ::: tList (tPair tString tContext))
+   in jsonEncoder (xs ::: tList (tPair tString tContext))
 
-encodeResult :: JSONEncoder a (Submit.Result a)
-encodeResult = encoderFor $ \result -> Object <$>
+encodeResult :: Submit.Result a -> JSONEncoder a
+encodeResult result = Object <$>
    case result of
-      Submit.Buggy rs -> pure
+      Submit.Buggy rs -> return
          [ ("result", String "Buggy")
          , ("rules", Array $ map (String . showId) rs)
          ]
-      Submit.NotEquivalent s -> pure $
+      Submit.NotEquivalent s -> return $
          ("result", String "NotEquivalent") :
          [ ("reason", String s) | not (null s)]
       Submit.Ok rs st ->
@@ -145,28 +148,28 @@                 , ("rules", Array $ map (String . showId) rs)
                 , ("state", x)
                 ]
-         in f <$> jsonEncoder // (st ::: tState)
+         in f <$> jsonEncoder (st ::: tState)
       Submit.Detour rs st ->
          let f x =
                 [ ("result", String "Detour")
                 , ("rules", Array $ map (String . showId) rs)
                 , ("state", x)
                 ]
-         in f <$> jsonEncoder // (st ::: tState)
+         in f <$> jsonEncoder (st ::: tState)
       Submit.Unknown st ->
          let f x =
                 [ ("result", String "Unknown")
                 , ("state", x)
                 ]
-         in f <$> jsonEncoder // (st ::: tState)
+         in f <$> jsonEncoder (st ::: tState)
 
-encodeDiagnosis :: JSONEncoder a (Diagnose.Diagnosis a)
-encodeDiagnosis = encoderFor $ \diagnosis ->
+encodeDiagnosis :: Diagnose.Diagnosis a -> JSONEncoder a
+encodeDiagnosis diagnosis =
    case diagnosis of
       Diagnose.SyntaxError s ->
-         pure $ Object [("syntaxerror", String s)]
+         return $ Object [("syntaxerror", String s)]
       Diagnose.NotEquivalent s ->
-         if null s then pure (Object [("notequiv", Null)])
+         if null s then return (Object [("notequiv", Null)])
                    else make "notequiv" [fromReason s]
       Diagnose.Buggy env r ->
          make "buggy" [fromEnv env, fromRule r]
@@ -184,23 +187,12 @@          make "unknown" [fromReady b, fromState st]
  where
    make s = fmap (\xs -> Object [(s, Array xs)]) . sequence
-   fromEnv env      = jsonEncoder // (env ::: tEnvironment)
-   fromRule r       = pure (toJSON (showId r))
-   fromMaybeRule mr = pure (maybe Null (toJSON . showId) mr)
-   fromReady b      = pure (Object [("ready", toJSON b)])
-   fromState st     = jsonEncoder // (st ::: tState)
-   fromReason s     = pure (Object [("reason", toJSON s)])
-
-{-
-encodeTree :: Tree JSON -> JSON
-encodeTree (Node r ts) =
-  case r of
-    Array [x, t] -> Object
-       [ ("rootLabel", x)
-       , ("type", t)
-       , ("subForest", Array $ map encodeTree ts)
-       ]
-    _ -> error "ModeJSON: malformed tree!" -}
+   fromEnv env      = jsonEncoder (env ::: tEnvironment)
+   fromRule r       = return (toJSON (showId r))
+   fromMaybeRule mr = return (maybe Null (toJSON . showId) mr)
+   fromReady b      = return (Object [("ready", toJSON b)])
+   fromState st     = jsonEncoder (st ::: tState)
+   fromReason s     = return (Object [("reason", toJSON s)])
 
 jsonTuple :: [JSON] -> JSON
 jsonTuple xs =

@@ -1,6 +1,6 @@ {-# LANGUAGE GADTs #-}
 -----------------------------------------------------------------------------
--- Copyright 2018, Ideas project team. This file is distributed under the
+-- Copyright 2019, 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.
 -----------------------------------------------------------------------------
@@ -19,11 +19,13 @@    ) where
 
 import Data.Char
+import Data.List
 import Data.Maybe
-import Data.Monoid hiding ((<>))
-import Ideas.Common.Library hiding (exerciseId, alternatives)
+import Data.Monoid
+import Ideas.Common.Library hiding (exerciseId)
 import Ideas.Encoding.Encoder
 import Ideas.Encoding.OpenMathSupport
+import Ideas.Encoding.Request hiding (XML)
 import Ideas.Encoding.RulesInfo (rulesInfoXML)
 import Ideas.Encoding.StrategyInfo
 import Ideas.Service.Diagnose
@@ -32,12 +34,13 @@ import Ideas.Service.Types
 import Ideas.Text.OpenMath.Object
 import Ideas.Text.XML
+import Ideas.Utils.Prelude (munless)
 import qualified Ideas.Service.FeedbackText as FeedbackText
 import qualified Ideas.Service.ProblemDecomposition as PD
 
 -----------------
 
-type XMLEncoder a t = Encoder a t XMLBuilder
+type XMLEncoder a = EncoderX a XMLBuilder
 
 xmlEncoder :: TypedEncoder a XMLBuilder
 xmlEncoder =
@@ -47,96 +50,100 @@    (encodeDerivationText, tDerivation tString tContext) <?>
    (encodeDifficulty, tDifficulty) <?>
    (encodeMessage, FeedbackText.tMessage) <?>
-   encoderFor (\(val ::: tp) ->
-        case tp of
-           -- meta-information
-           Tag "RuleShortInfo" t ->
-              case equal t (Const Rule) of
-                 Just f  -> ruleShortInfo // f val
-                 Nothing -> fail "rule short info"
-           Tag "RulesInfo" _ ->
-              withExercise $ \ex ->
-              withOpenMath $ \useOM ->
-                 pure (rulesInfoXML ex (buildExpression useOM ex))
-           Tag "elem" t ->
-              tag "elem" (xmlEncoder // (val ::: t))
-           -- special cases for lists
-           List (Const Rule) ->
-              encodeAsList [ ruleShortInfo // r | r <- val ]
-           List t ->
-              encodeAsList [ xmlEncoder // (a ::: t) | a <- val ]
-           -- standard
-           Tag _ t    -> xmlEncoder // (val ::: t)
-           Iso iso t  -> xmlEncoder // (to iso val ::: t)
-           Pair t1 t2 -> xmlEncoder // (fst val ::: t1) <>
-                         xmlEncoder // (snd val ::: t2)
-           t1 :|: t2  -> case val of
-                            Left  a -> xmlEncoder // (a ::: t1)
-                            Right b -> xmlEncoder // (b ::: t2)
-           Unit       -> mempty
-           Const t    -> xmlEncoderConst // (val ::: t)
-           _ -> fail $ show tp)
+   \(val ::: tp) ->
+   case tp of
+      -- meta-information
+      Tag "RuleShortInfo" t ->
+         case equal t (Const Rule) of
+            Just f  -> ruleShortInfo (f val)
+            Nothing -> fail "rule short info"
+      Tag "RulesInfo" _ -> do
+         ex    <- getExercise
+         useOM <- useOpenMath <$> getRequest
+         return (rulesInfoXML ex (buildExpression useOM ex))
+      Tag "elem" t ->
+         tag "elem" (xmlEncoder (val ::: t))
+      -- special cases for lists
+      List (Const Rule) ->
+         encodeAsList [ ruleShortInfo r | r <- val ]
+      List t ->
+         encodeAsList [ xmlEncoder (a ::: t) | a <- val ]
+      -- standard
+      Tag _ t    -> xmlEncoder (val ::: t)
+      Iso iso t  -> xmlEncoder (to iso val ::: t)
+      Pair t1 t2 -> xmlEncoder (fst val ::: t1) <>
+                    xmlEncoder (snd val ::: t2)
+      t1 :|: t2  -> case val of
+                       Left  a -> xmlEncoder (a ::: t1)
+                       Right b -> xmlEncoder (b ::: t2)
+      Unit       -> mempty
+      Const t    -> xmlEncoderConst (val ::: t)
+      _ -> fail $ show tp
 
-xmlEncoderConst :: XMLEncoder a (TypedValue (Const a))
-xmlEncoderConst = encoderFor $ \tv@(val ::: tp) ->
+xmlEncoderConst :: TypedValue (Const a) -> XMLEncoder a
+xmlEncoderConst tv@(val ::: tp) =
    case tp of
       SomeExercise -> case val of
-                         Some a -> exerciseInfo // a
+                         Some a -> exerciseInfo a
       Strategy     -> builder (strategyToXML val)
       Rule         -> "ruleid" .=. show val
-      State        -> encodeState // val
-      Context      -> encodeContext // val
-      Location     -> encodeLocation // val
-      Environment  -> encodeEnvironment // val
-      Term         -> builder (toXML (toOMOBJ val))
-      Text         -> encodeText // val
+      Constraint   -> "constraint" .=. show val
+      State        -> encodeState val
+      Context      -> encodeContext val
+      Location     -> encodeLocation val
+      Environment  -> encodeEnvironment val
+      Term         -> builderXML (toOMOBJ val)
+      Text         -> encodeText val
       Bool         -> string (showBool val)
+      XML          -> builder val
       _            -> text tv
 
-encodeState :: XMLEncoder a (State a)
-encodeState = encoderFor $ \st -> element "state"
+encodeState :: State a -> XMLEncoder a
+encodeState st = element "state"
    [ if withoutPrefix st
      then mempty
      else element "prefix" [string (show (statePrefix st))]
-   , encodeContext // stateContext st
+   , encodeContext (stateContext st)
    ]
 
-encodeContext :: XMLEncoder a (Context a)
-encodeContext = withOpenMath $ \useOM -> exerciseEncoder $ \ex ctx ->
+encodeContext :: Context a -> XMLEncoder a
+encodeContext ctx = do
+   ex    <- getExercise
+   useOM <- useOpenMath <$> getRequest
    maybe (error "encodeContext") (buildExpression useOM ex) (fromContext ctx)
-   <>
-   let values = bindings (withLoc ctx)
-       loc    = fromLocation (location ctx)
-       withLoc
-          | null loc  = id
-          | otherwise = insertRef (makeRef "location") loc
-   in munless (null values) $ element "context"
-         [  element "item"
-               [ "name"  .=. showId tb
-               , case getTermValue tb of
-                    term | useOM ->
-                       builder (omobj2xml (toOMOBJ term))
-                    _ -> "value" .=. showValue tb
-               ]
-         | tb <- values
-         ]
+      <>
+      let values = bindings (withLoc ctx)
+          loc    = fromLocation (location ctx)
+          withLoc
+             | null loc  = id
+             | otherwise = insertRef (makeRef "location") loc
+      in munless (null values) $ element "context"
+            [  element "item"
+                  [ "name"  .=. showId tb
+                  , case getTermValue tb of
+                       term | useOM ->
+                          builder (omobj2xml (toOMOBJ term))
+                       _ -> "value" .=. showValue tb
+                  ]
+            | tb <- values
+            ]
 
 buildExpression :: BuildXML b => Bool -> Exercise a -> a -> b
 buildExpression useOM ex
-   | useOM     = either msg (builder . toXML) . toOpenMath ex
+   | useOM     = either msg builderXML . toOpenMath ex
    | otherwise = tag "expr" . string . prettyPrinter ex
  where
    msg s = error ("Error encoding term in OpenMath: " ++ s)
 
-encodeLocation :: XMLEncoder a Location
-encodeLocation = encoderFor $ \loc -> "location" .=. show loc
+encodeLocation :: Location -> XMLEncoder a
+encodeLocation loc = "location" .=. show loc
 
-encodeEnvironment :: HasEnvironment env => XMLEncoder a env
-encodeEnvironment = encoderFor $ \env ->
-   mconcat [ encodeTypedBinding // b | b <- bindings env ]
+encodeEnvironment :: HasEnvironment env => env -> XMLEncoder a
+encodeEnvironment env = mconcat [ encodeTypedBinding b | b <- bindings env ]
 
-encodeTypedBinding :: XMLEncoder a Binding
-encodeTypedBinding = withOpenMath $ \useOM -> makeEncoder $ \tb ->
+encodeTypedBinding :: Binding -> XMLEncoder a
+encodeTypedBinding tb = do
+   useOM <- useOpenMath <$> getRequest
    tag "argument" $
       ("description" .=. showId tb) <>
       case getTermValue tb of
@@ -144,34 +151,36 @@             omobj2xml $ toOMOBJ term
          _ -> string (showValue tb)
 
-encodeDerivation :: XMLEncoder a (Derivation (Rule (Context a), Environment) (Context a))
-encodeDerivation = encoderFor $ \d ->
+encodeDerivation :: Derivation (Rule (Context a), Environment) (Context a) -> XMLEncoder a
+encodeDerivation d =
    let xs = [ (s, a) | (_, s, a) <- triples d ]
-   in xmlEncoder // (xs ::: tList (tPair (tPair tRule tEnvironment) tContext))
+   in xmlEncoder (xs ::: tList (tPair (tPair tRule tEnvironment) tContext))
 
-encodeDerivationText :: XMLEncoder a (Derivation String (Context a))
-encodeDerivationText = encoderFor $ \d -> encodeAsList
-   [ ("ruletext" .=. s) <> encodeContext // a
+encodeDerivationText :: Derivation String (Context a) -> XMLEncoder a
+encodeDerivationText d = encodeAsList
+   [ ("ruletext" .=. s) <> encodeContext a
    | (_, s, a) <- triples d
    ]
 
-ruleShortInfo :: XMLEncoder a (Rule (Context a))
-ruleShortInfo = makeEncoder $ \r -> mconcat
+ruleShortInfo :: Rule (Context a) -> XMLEncoder a
+ruleShortInfo r = mconcat
    [ "name"        .=. showId r
    , "buggy"       .=. showBool (isBuggy r)
    , "arguments"   .=. show (length (getRefs r))
    , "rewriterule" .=. showBool (isRewriteRule r)
    ]
 
-encodeDifficulty :: XMLEncoder a Difficulty
-encodeDifficulty = makeEncoder $ \d ->
+encodeDifficulty :: Difficulty -> XMLEncoder a
+encodeDifficulty d =
    "difficulty" .=. show d
 
-encodeText :: XMLEncoder a Text
-encodeText = encoderFor $ \txt ->
-   mconcat [ encodeItem // item | item <- textItems txt ]
+encodeText :: Text -> XMLEncoder a
+encodeText txt = do
+   ex    <- getExercise
+   useOM <- useOpenMath <$> getRequest
+   mconcat (intersperse (string " ") [ encodeItem ex useOM item | item <- textItems txt ])
  where
-   encodeItem = withOpenMath $ \useOM -> exerciseEncoder $ \ex item ->
+   encodeItem ex useOM item =
       case item of
          TextTerm a -> fromMaybe (text item) $ do
             v <- hasTermView ex
@@ -179,57 +188,57 @@             return (buildExpression useOM ex b)
          _ -> text item
 
-encodeMessage :: XMLEncoder a FeedbackText.Message
-encodeMessage = encoderFor $ \msg ->
+encodeMessage :: FeedbackText.Message -> XMLEncoder a
+encodeMessage msg =
    element "message"
       [ case FeedbackText.accept msg of
            Just b  -> "accept" .=. showBool b
            Nothing -> mempty
-      , encodeText // FeedbackText.text msg
+      , encodeText (FeedbackText.text msg)
       ]
 
-encodeDiagnosis :: XMLEncoder a (Diagnosis a)
-encodeDiagnosis = encoderFor $ \diagnosis ->
+encodeDiagnosis :: Diagnosis a -> XMLEncoder a
+encodeDiagnosis diagnosis =
    case diagnosis of
       SyntaxError s -> element "syntaxerror" [string s]
       Buggy env r -> element "buggy"
-         [encodeEnvironment // env, "ruleid" .=. showId r]
+         [encodeEnvironment env, "ruleid" .=. showId r]
       NotEquivalent s ->
           if null s then emptyTag "notequiv"
                     else element "notequiv" [ "reason" .=.  s ]
       Similar b st -> element "similar"
-         ["ready" .=. showBool b, encodeState // st]
+         ["ready" .=. showBool b, encodeState st]
       WrongRule b st mr -> element "wrongrule" $
-         [ "ready" .=. showBool b, encodeState // st ] ++
+         [ "ready" .=. showBool b, encodeState st ] ++
          maybe [] (\r -> ["ruleid" .=. showId r]) mr
       Expected b st r -> element "expected"
-         ["ready" .=. showBool b, encodeState // st, "ruleid" .=. showId r]
+         ["ready" .=. showBool b, encodeState st, "ruleid" .=. showId r]
       Detour b st env r -> element "detour"
-         [ "ready" .=. showBool b, encodeState // st
-         , encodeEnvironment // env, "ruleid" .=. showId r
+         [ "ready" .=. showBool b, encodeState st
+         , encodeEnvironment env, "ruleid" .=. showId r
          ]
       Correct b st -> element "correct"
-         ["ready" .=. showBool b, encodeState // st]
+         ["ready" .=. showBool b, encodeState st]
       Unknown b st -> element "unknown"
-         ["ready" .=. showBool b, encodeState // st]
+         ["ready" .=. showBool b, encodeState st]
 
-encodeDecompositionReply :: XMLEncoder a (PD.Reply a)
-encodeDecompositionReply = encoderFor $ \reply ->
+encodeDecompositionReply :: PD.Reply a -> XMLEncoder a
+encodeDecompositionReply reply =
    case reply of
       PD.Ok loc st ->
-         element "correct" [encLoc loc, encodeState // st]
+         element "correct" [encLoc loc, encodeState st]
       PD.Incorrect eq loc st env ->
          element "incorrect"
             [ "equivalent" .=. showBool eq
             , encLoc loc
-            , encodeState // st
-            , encodeEnvironment // env
+            , encodeState st
+            , encodeEnvironment env
             ]
  where
     encLoc = tag "location" . text
 
-exerciseInfo :: XMLEncoder a (Exercise b)
-exerciseInfo = encoderFor $ \ex -> mconcat
+exerciseInfo :: Exercise b -> XMLEncoder a
+exerciseInfo ex = mconcat
    [ "exerciseid"  .=. showId ex
    , "description" .=. description ex
    , "status"      .=. show (status ex)
@@ -238,7 +247,7 @@ ------------------------------------------------
 -- helpers
 
-encodeAsList :: [XMLEncoder a t] -> XMLEncoder a t
+encodeAsList :: [XMLEncoder a] -> XMLEncoder a
 encodeAsList = element "list" . map (tag "elem")
 
 showBool :: Bool -> String

@@ -1,6 +1,6 @@ {-# LANGUAGE GADTs, RankNTypes #-}
 -----------------------------------------------------------------------------
--- Copyright 2018, Ideas project team. This file is distributed under the
+-- Copyright 2019, 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.
 -----------------------------------------------------------------------------
@@ -19,6 +19,7 @@ import Ideas.Encoding.Options
 import Ideas.Service.Diagnose
 import Ideas.Service.Types
+import Ideas.Utils.Decoding
 
 data Evaluator a b c = Evaluator (TypedDecoder a b) (TypedEncoder a c)
 
@@ -31,18 +32,18 @@ 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 =
+logType :: Options -> EvalResult a c -> Type a b -> (b -> Record -> Record) -> IO ()
+logType opts res tp f =
    case concatMap (findValuesOfType tp) (values res) of
       []   -> return ()
-      hd:_ -> changeLog logRef (f hd)
+      hd:_ -> changeLog (logRef opts) (f hd)
 
-evalService :: LogRef -> Exercise a -> Options -> Evaluator a b c -> Service -> b -> IO c
-evalService logRef ex opts f srv b = do
+evalService :: Exercise a -> Options -> Evaluator a b c -> Service -> b -> IO c
+evalService ex opts f srv b = do
    res <- eval ex 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}
+   logType opts res tState addState
+   logType opts res tRule $ \rl r -> r {ruleid = showId rl}
+   logType opts res tDiagnosis $ \d r -> r {serviceinfo = show d}
    return (evalResult res)
 
 eval :: Exercise a -> Options -> Evaluator a b c -> b -> TypedValue (Type a) -> IO (EvalResult a c)
@@ -57,7 +58,7 @@          t1 :-> t2 :-> t3 ->
             rec (uncurry val ::: Pair t1 t2 :-> t3)
          t1 :-> t2 -> do
-            a   <- run (dec t1) ex opts b
+            a   <- runDecoder (dec t1) (ex, opts) b
             res <- rec (val a ::: t2)
             return res { inputValues = (a ::: t1) : inputValues res }
          -- perform IO
@@ -65,5 +66,5 @@             a <- val
             rec (a ::: t)
          _ -> do
-            c <- run enc ex opts tv
+            c <- runEncoder (enc tv) (ex, opts)
             return $ EvalResult [] tv c

@@ -1,6 +1,6 @@ {-# LANGUAGE RankNTypes #-}
 -----------------------------------------------------------------------------
--- Copyright 2018, Ideas project team. This file is distributed under the
+-- Copyright 2019, 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.
 -----------------------------------------------------------------------------
@@ -29,14 +29,15 @@    ) where
 
 import Data.Maybe
+import Data.Monoid
 import Ideas.Common.Library
-import Ideas.Encoding.Encoder
 import Ideas.Encoding.EncoderXML
 import Ideas.Encoding.Options
 import Ideas.Service.State
 import Ideas.Service.Types
 import Ideas.Text.HTML
 import Ideas.Text.XML
+import Ideas.Utils.Decoding
 
 data LinkManager = LinkManager
    { urlForCSS           :: String -> String
@@ -188,7 +189,7 @@ -- assume nothing goest wrong
 stateToXML :: State a -> XMLBuilder
 stateToXML st = fromMaybe (error "LinkManager: Invalid state") $
-   run encodeState (exercise st) optionHtml st
+   runEncoder (encodeState st) (exercise st, optionHtml mempty)
 
 linkWith :: (a -> String) -> a -> HTMLBuilder -> HTMLBuilder
 linkWith f = link . escapeInURL . f

@@ -1,6 +1,6 @@ {-# LANGUAGE CPP, FlexibleContexts #-}
 -----------------------------------------------------------------------------
--- Copyright 2018, Ideas project team. This file is distributed under the
+-- Copyright 2019, 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.
 -----------------------------------------------------------------------------
@@ -15,12 +15,18 @@ 
 module Ideas.Encoding.Logging
    ( Record(..), addRequest, addState
-   , LogRef, newLogRef, noLogRef, changeLog
-   , logEnabled, logRecord, printLog
+   , LogRef, makeLogRef, defaultLogRef, enableLogging, disableLogging
+   , changeLog, logEnabled, logRecord, logRecordWith, printLog
+   , selectFrom
+   , getRecord
+   , getFilePath
    ) where
 
+import Control.Monad
+import Data.Char
 import Data.IORef
 import Data.Maybe
+import Data.Semigroup (Semigroup(..))
 import Data.Time
 import Ideas.Encoding.Request (Request, Schema(..))
 import Ideas.Service.State
@@ -37,8 +43,9 @@ 
 -- | The Record datatype is based on the Ideas Request Logging Schema version 2.
 data Record = Record
-   { -- request attributes
-     service      :: String  -- name of feedback service
+   { useLogging   :: Bool
+     -- 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)
@@ -67,7 +74,7 @@  deriving Show
 
 record :: Record
-record = Record "" "" "" "" "" "" "" "" "" "" t0 0 "" "" "" "" "" "" "" ""
+record = Record True "" "" "" "" "" "" "" "" "" "" t0 0 "" "" "" "" "" "" "" ""
  where t0 = UTCTime (toEnum 0) 0
 
 makeRecord :: IO Record
@@ -98,22 +105,47 @@ 
 ---------------------------------------------------------------------
 
-newtype LogRef = L { mref :: Maybe (IORef Record) }
+data LogRef = NoRef | LogRef FilePath Schema (IORef Record)
 
-noLogRef :: LogRef
-noLogRef = L Nothing
+instance Semigroup LogRef where
+   NoRef <> r = r
+   r <> _     = r
 
-newLogRef :: IO LogRef
-newLogRef = do
+instance Monoid LogRef where
+   mempty  = NoRef
+   mappend = (<>)
+
+defaultLogRef :: IO LogRef
+defaultLogRef = makeLogRef "requests.db" V2
+
+makeLogRef :: FilePath -> Schema -> IO LogRef
+makeLogRef file schema = do
    r   <- makeRecord
    ref <- newIORef r
-   return (L (Just ref))
+   return (LogRef file schema ref)
 
+enableLogging :: LogRef -> IO ()
+enableLogging = flip changeLog (\r -> r {useLogging = True})
+
+disableLogging :: LogRef -> IO ()
+disableLogging = flip changeLog (\r -> r {useLogging = False})
+
+whenLogging :: LogRef -> IO () -> IO ()
+whenLogging logRef m = do
+   r <- getRecord logRef
+   when (useLogging r) m
+
 getRecord :: LogRef -> IO Record
-getRecord = maybe (return record) readIORef . mref
+getRecord NoRef          = return record
+getRecord (LogRef _ _ r) = readIORef r
 
+getFilePath :: LogRef -> Maybe FilePath
+getFilePath NoRef = Nothing
+getFilePath (LogRef fp _ _) = Just fp
+
 changeLog :: LogRef -> (Record -> Record) -> IO ()
-changeLog = maybe (\_ -> return ()) modifyIORef . mref
+changeLog NoRef          _ = return ()
+changeLog (LogRef _ _ r) f = modifyIORef r f
 
 printLog :: LogRef -> IO ()
 printLog logRef = do
@@ -123,19 +155,19 @@ --------------------------------------------------------------------------------
 
 logEnabled :: Bool
-logRecord  :: Schema -> LogRef -> IO ()
+logRecord  :: LogRef -> IO ()
+selectFrom :: FilePath -> String -> [String] -> ([String] -> IO a) -> IO [a]
 
 #ifdef DB
 logEnabled = True
-logRecord schema logRef =
-   case schema of
-      V1 -> logRecordWith "service.db"  V1 logRef
-      V2 -> logRecordWith "requests.db" V2 logRef
-      NoLogging -> return ()
 #else
 -- without logging
-logEnabled    = False
-logRecord _ _ = return ()
+logEnabled         = False
+logRecord _        = return ()
+selectFrom _ _ _ _ = return []
+
+logRecordWith :: LogRef -> c -> IO ()
+logRecordWith _ _ = return ()
 #endif
 
 --------------------------------------------------------------------------------
@@ -165,19 +197,27 @@       , get errormsg, get serviceinfo, get ruleid, get input, get output
       ]
 
-logRecordWith :: FilePath -> Schema -> LogRef -> IO ()
-logRecordWith file schema logRef = do
-   -- connect to database
-   conn <- connectSqlite3 file
-   setBusyTimeout conn 200 -- milliseconds
+logRecord NoRef  = return ()
+logRecord logRef@(LogRef file _ _) =
+   (whenLogging logRef) $ do
+      -- connect to database
+      conn <- connectSqlite3 file
+      setBusyTimeout conn 200 -- milliseconds
+      logRecordWith logRef conn
+      -- close the connection to the database
+      disconnect conn
+    `catchSql` \_ ->
+      return ()
+
+logRecordWith :: IConnection c => LogRef -> c -> IO ()
+logRecordWith NoRef _  = return ()
+logRecordWith logRef@(LogRef _ schema _) 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` \_ ->
    return ()
 
@@ -187,4 +227,16 @@        pars = "(" ++ intercalate "," (replicate (length cols) "?") ++ ")"
        stm  = "INSERT INTO " ++ nameOfTable schema ++ " VALUES " ++ pars
    in run conn stm cols >> commit conn
+
+selectFrom database table columns f = do
+   let sql    = "SELECT " ++ commas (map safe columns) ++ " from " ++ safe table
+       commas = intercalate ","
+       safe   = filter isAlphaNum
+   con  <- connectSqlite3 database
+   stat <- prepare con sql
+   _    <- execute stat []
+   rows <- fetchAllRows stat
+   xs   <- mapM (f . map fromSql) rows
+   disconnect con
+   return xs
 #endif

@@ -1,5 +1,5 @@ -----------------------------------------------------------------------------
--- Copyright 2018, Ideas project team. This file is distributed under the
+-- Copyright 2019, 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.
 -----------------------------------------------------------------------------
@@ -22,21 +22,21 @@ import Ideas.Encoding.DecoderJSON
 import Ideas.Encoding.EncoderJSON
 import Ideas.Encoding.Evaluator
-import Ideas.Encoding.Logging (LogRef, changeLog, errormsg)
-import Ideas.Encoding.Options (Options, makeOptions, maxTime, cgiBin)
+import Ideas.Encoding.Logging (changeLog, errormsg)
+import Ideas.Encoding.Options (Options, makeOptions, maxTime, cgiBin, logRef)
 import Ideas.Encoding.Request
 import Ideas.Service.DomainReasoner
 import Ideas.Text.JSON
 import Ideas.Utils.Prelude (timedSeconds)
 
-processJSON :: Options -> DomainReasoner -> LogRef -> String -> IO (Request, String, String)
-processJSON options dr logRef txt = do
+processJSON :: Options -> DomainReasoner -> String -> IO (Request, String, String)
+processJSON options dr txt = do
    json <- either fail return (parseJSON txt)
    req  <- jsonRequest options json
    resp <- jsonRPC json $ \fun arg ->
-              maybe id timedSeconds (maxTime options) (myHandler options dr logRef req fun arg)
+              maybe id timedSeconds (maxTime options) (myHandler options dr req fun arg)
    unless (responseError resp == Null) $
-      changeLog logRef (\r -> r {errormsg = show (responseError resp)})
+      changeLog (logRef options) (\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")
@@ -99,15 +99,15 @@       Just _  -> fail $ "Invalid value for " ++ attr ++ " (expecting string)"
       Nothing -> return a
 
-myHandler :: Options -> DomainReasoner -> LogRef -> Request -> RPCHandler
-myHandler opt1 dr logRef request fun json = do
+myHandler :: Options -> DomainReasoner -> Request -> RPCHandler
+myHandler opt1 dr request fun json = do
    srv <- findService dr (newId fun)
    Some ex <- case exerciseId request of
                  Just a  -> findExercise dr a
                  Nothing -> return (Some emptyExercise)
-   opt2 <- makeOptions dr ex request
+   opt2 <- makeOptions dr request
    let options = opt1 <> opt2
-   evalService logRef ex options jsonEvaluator srv json
+   evalService ex options jsonEvaluator srv json
 
 jsonEvaluator :: Evaluator a JSON JSON
 jsonEvaluator = Evaluator jsonDecoder jsonEncoder

@@ -1,5 +1,5 @@ -----------------------------------------------------------------------------
--- Copyright 2018, Ideas project team. This file is distributed under the
+-- Copyright 2019, 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.
 -----------------------------------------------------------------------------
@@ -16,13 +16,14 @@ 
 import Control.Exception
 import Control.Monad
+import Data.Monoid
 import Ideas.Common.Library hiding (exerciseId)
 import Ideas.Encoding.DecoderXML
 import Ideas.Encoding.EncoderHTML
 import Ideas.Encoding.EncoderXML
 import Ideas.Encoding.Evaluator
-import Ideas.Encoding.Logging (LogRef, changeLog, errormsg)
-import Ideas.Encoding.Options (Options, makeOptions, maxTime, cgiBin)
+import Ideas.Encoding.Logging (changeLog, errormsg)
+import Ideas.Encoding.Options (Options, makeOptions, maxTime, cgiBin, logRef)
 import Ideas.Encoding.Request
 import Ideas.Service.DomainReasoner
 import Ideas.Text.HTML
@@ -30,14 +31,14 @@ import Ideas.Utils.Prelude (timedSeconds)
 import System.IO.Error
 
-processXML :: Options -> DomainReasoner -> LogRef -> String -> IO (Request, String, String)
-processXML options dr logRef txt = do
+processXML :: Options -> DomainReasoner -> String -> IO (Request, String, String)
+processXML options dr txt = do
    xml  <- either fail return (parseXML txt)
    req  <- xmlRequest (cgiBin options) xml
-   resp <- maybe id timedSeconds (maxTime options) (xmlReply options dr logRef req xml)
+   resp <- maybe id timedSeconds (maxTime options) (xmlReply options dr req xml)
     `catch` handler
    let showXML | compactOutput req = compactXML
-               | otherwise = show
+               | otherwise = prettyXML
        showHtmlDoc doc = "<!DOCTYPE html>" ++ compactXML doc
    if htmlOutput req
       then return (req, showHtmlDoc resp, "text/html")
@@ -45,7 +46,7 @@            in return (req, showXML out, "application/xml")
  where
    handler :: SomeException -> IO XML
-   handler e = resultError logRef $
+   handler e = resultError options $
       case fromException e of
          Just ioe -> ioeGetErrorString ioe
          Nothing  -> show e
@@ -81,8 +82,8 @@ defaultSeed Nothing Nothing = Just 2805 -- magic number
 defaultSeed _ m = m
 
-xmlReply :: Options -> DomainReasoner -> LogRef -> Request -> XML -> IO XML
-xmlReply opt1 dr logRef request xml = do
+xmlReply :: Options -> DomainReasoner -> Request -> XML -> IO XML
+xmlReply opt1 dr request xml = do
    srv <- case serviceId request of
              Just a  -> findService dr a
              Nothing -> fail "No service"
@@ -91,14 +92,14 @@                  Just a  -> findExercise dr a
                  Nothing -> return (Some emptyExercise)
 
-   opt2 <- makeOptions dr ex request
+   opt2 <- makeOptions dr request
    let options = opt1 <> opt2
 
    if htmlOutput request
       -- HTML evaluator
-      then toXML <$> evalService logRef ex options (htmlEvaluator dr) srv xml
+      then toXML <$> evalService ex options (htmlEvaluator dr) srv xml
       -- xml evaluator
-      else resultOk <$> evalService logRef ex options xmlEvaluator srv xml
+      else resultOk <$> evalService ex options xmlEvaluator srv xml
 
 extractExerciseId :: Monad m => XML -> m Id
 extractExerciseId = fmap newId . findAttribute "exerciseid"
@@ -108,9 +109,9 @@    ("result" .=. "ok")
    <> body
 
-resultError :: LogRef -> String -> IO XML
-resultError logRef msg = do
-   changeLog logRef (\r -> r {errormsg = msg})
+resultError :: Options -> String -> IO XML
+resultError options msg = do
+   changeLog (logRef options) (\r -> r {errormsg = msg})
    return $ makeXML "reply" $
       ("result" .=. "error")
       <> tag "message" (string msg)

@@ -1,6 +1,6 @@ {-# LANGUAGE Rank2Types #-}
 -----------------------------------------------------------------------------
--- Copyright 2018, Ideas project team. This file is distributed under the
+-- Copyright 2019, 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.
 -----------------------------------------------------------------------------

@@ -1,5 +1,5 @@ -----------------------------------------------------------------------------
--- Copyright 2018, Ideas project team. This file is distributed under the
+-- Copyright 2019, 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.
 -----------------------------------------------------------------------------
@@ -12,14 +12,14 @@ 
 module Ideas.Encoding.Options
    ( Options, makeOptions, optionBaseUrl
-   , script, request, qcGen, baseUrl, maxTime
+   , script, request, qcGen, baseUrl, maxTime, logRef
    , cgiBin, optionCgiBin, optionHtml
    ) where
 
 import Control.Applicative
-import Data.Monoid hiding ((<>))
+import Data.Maybe
 import Data.Semigroup as Sem
-import Ideas.Common.Library (Exercise, getId)
+import Ideas.Encoding.Logging (LogRef)
 import Ideas.Encoding.Request
 import Ideas.Service.DomainReasoner
 import Ideas.Service.FeedbackScript.Parser (parseScriptSafe, Script)
@@ -31,47 +31,49 @@ cgiBin :: Options -> Maybe String
 cgiBin = cgiBinary . request
 
-optionCgiBin :: String -> Options
-optionCgiBin s = mempty {request = mempty {cgiBinary = Just s}}
+optionCgiBin :: String -> Options -> Options
+optionCgiBin s options = options {request = (request options) {cgiBinary = Just s}}
 
 data Options = Options
-   { request  :: Request      -- meta-information about the request
-   , qcGen    :: Maybe QCGen  -- random number generator
-   , script   :: Script       -- feedback script
-   , baseUrl  :: Maybe String -- for html-encoder's css and image files
-   , maxTime  :: Maybe Int    -- timeout for services, in seconds
+   { request   :: Request      -- meta-information about the request
+   , qcGen     :: Maybe QCGen  -- random number generator
+   , script    :: Script       -- feedback script
+   , baseUrl   :: Maybe String -- for html-encoder's css and image files
+   , maxTime   :: Maybe Int    -- timeout for services, in seconds
+   , logRef    :: LogRef       -- reference for logging to database
    }
 
 instance Sem.Semigroup Options where
    x <> y = Options
-      { request  = request x <> request y
-      , qcGen    = make qcGen
-      , script   = script x <> script y
-      , baseUrl  = make baseUrl
-      , maxTime  = make maxTime
+      { request   = request x <> request y
+      , qcGen     = make qcGen
+      , script    = script x <> script y
+      , baseUrl   = make baseUrl
+      , maxTime   = make maxTime
+      , logRef    = logRef x <> logRef y
       }
     where
       make f = f x <|> f y
 
 instance Monoid Options where
-   mempty  = Options mempty Nothing mempty Nothing Nothing
+   mempty  = Options mempty Nothing mempty Nothing Nothing mempty
    mappend = (<>)
 
-optionHtml :: Options
-optionHtml = mempty
-   { request = mempty {encoding = [EncHTML]} }
+optionHtml :: Options -> Options
+optionHtml options = options
+   { request = (request options) {encoding = [EncHTML]} }
 
-optionBaseUrl :: String -> Options
-optionBaseUrl base = mempty {baseUrl = Just base}
+optionBaseUrl :: String -> Options -> Options
+optionBaseUrl base options = options {baseUrl = Just base}
 
-makeOptions :: DomainReasoner -> Exercise a -> Request -> IO Options
-makeOptions dr ex req = do
+makeOptions :: DomainReasoner -> Request -> IO Options
+makeOptions dr req = do
    gen <- maybe newQCGen (return . mkQCGen) (randomSeed req)
    scr <- case feedbackScript req of
              Just s  -> parseScriptSafe s
-             Nothing -> defaultScript dr (getId ex)
+             Nothing -> defaultScript dr (fromMaybe mempty (exerciseId req))
    return $ mempty
-      { request  = req
-      , qcGen    = Just gen
-      , script   = scr
+      { request = req
+      , qcGen   = Just gen
+      , script  = scr
       }

@@ -1,5 +1,5 @@ -----------------------------------------------------------------------------
--- Copyright 2018, Ideas project team. This file is distributed under the
+-- Copyright 2019, 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.
 -----------------------------------------------------------------------------
@@ -16,7 +16,6 @@ import Data.Char
 import Data.List
 import Data.Maybe
-import Data.Monoid hiding ((<>))
 import Data.Semigroup as Sem
 import Ideas.Common.Library hiding (exerciseId)
 import Ideas.Utils.Prelude
@@ -28,7 +27,7 @@    , feedbackScript :: Maybe String
    , requestInfo    :: Maybe String
    , cgiBinary      :: Maybe String
-   , logSchema      :: Maybe Schema
+   , logSchema      :: Maybe Schema     -- should be yes (default)/no
    , randomSeed     :: Maybe Int
    , dataformat     :: Maybe DataFormat -- default: XML
    , encoding       :: [Encoding]
@@ -57,9 +56,6 @@ 
 data Schema = V1 | V2 | NoLogging deriving (Show, Eq)
 
-getSchema :: Request -> Schema
-getSchema = fromMaybe V2 . logSchema -- log schema V2 is the default
-
 readSchema :: Monad m => String -> m Schema
 readSchema s0
    | s == "v1" = return V1
@@ -114,7 +110,7 @@       _ -> False
 
 useLogging :: Request -> Bool
-useLogging = (EncHTML `notElem`) . encoding
+useLogging r = EncHTML `notElem` encoding r && logSchema r /= Just NoLogging
 
 discoverDataFormat :: Monad m => String -> m DataFormat
 discoverDataFormat xs =

@@ -1,5 +1,5 @@ -----------------------------------------------------------------------------
--- Copyright 2018, Ideas project team. This file is distributed under the
+-- Copyright 2019, 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.
 -----------------------------------------------------------------------------
@@ -14,6 +14,7 @@ 
 import Data.List
 import Data.Maybe
+import Data.Monoid
 import Ideas.Common.Library
 import Ideas.Text.HTML
 
@@ -44,12 +45,12 @@          TFloat a  -> show a
          TMeta n   -> showMeta ex n
          TCon s xs -> concatMap (either id recp) $
-                      let txt = spaced (Left (show s) : map Right xs)
+                      let txt = withSpaces (Left (show s) : map Right xs)
                       in fromMaybe txt (specialSymbol s xs)
          TList xs  -> "[" ++ intercalate ", " (map rec xs) ++ "]"
 
-   recp term = parIf (isCon term) (rec term)
-   spaced    = intersperse (Left " ")
+   recp term  = parIf (isCon term) (rec term)
+   withSpaces = intersperse (Left " ")
 
    isCon (TCon _ xs) = not (null xs)
    isCon _           = False

@@ -1,5 +1,5 @@ -----------------------------------------------------------------------------
--- Copyright 2018, Ideas project team. This file is distributed under the
+-- Copyright 2019, 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.
 -----------------------------------------------------------------------------
@@ -15,11 +15,13 @@    ) where
 
 import Data.Char
+import Data.Monoid
 import Ideas.Common.Library
 import Ideas.Encoding.OpenMathSupport (toOMOBJ)
 import Ideas.Text.OpenMath.FMP
 import Ideas.Text.OpenMath.Object
 import Ideas.Text.XML hiding (name)
+import Ideas.Utils.Prelude (munless)
 import qualified Data.Map as M
 
 rulesInfoXML :: Exercise a -> (a -> XMLBuilder) -> XMLBuilder
@@ -66,7 +68,7 @@ type ExampleMap a = M.Map Id [(a, a)]
 
 collectExamples :: Exercise a -> ExampleMap a
-collectExamples ex = foldr (add . snd) M.empty (examples ex)
+collectExamples ex = foldr add M.empty (examplesAsList ex)
  where
    add a m = let f = foldr g m . maybe [] triples
                  g (x, (r, _), y) =

@@ -1,5 +1,5 @@ -----------------------------------------------------------------------------
--- Copyright 2018, Ideas project team. This file is distributed under the
+-- Copyright 2019, 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.
 -----------------------------------------------------------------------------
@@ -14,6 +14,7 @@ 
 module Ideas.Encoding.StrategyInfo (strategyToXML) where
 
+import Data.Monoid
 import Ideas.Common.Id
 import Ideas.Common.Strategy.Abstract
 import Ideas.Common.Strategy.Configuration
@@ -37,28 +38,27 @@       _ -> strategyTreeBuilder tree
 
 strategyTreeBuilder :: StrategyTree a -> XMLBuilder
-strategyTreeBuilder = fold emptyAlg
+strategyTreeBuilder = builder . fold emptyAlg
    { fNode = \def xs ->
         case xs of
            [x] | isConfigId def
              -> addProperty (show def) x
-           _ -> tag (show def) (mconcat xs)
+           _ -> makeXML (show def) (mconcat (map builder xs))
    , fLeaf = \r ->
-        tag "rule" ("name" .=. show r)
+        makeXML "rule" ("name" .=. show r)
    , fLabel = \l a ->
-        tag "label" (nameAttr l <> a)
+        makeXML "label" (nameAttr l <> builder a)
    , fRec = \n a ->
-        tag "rec" (("var" .=. show n) <> a)
+        makeXML "rec" (("var" .=. show n) <> builder a)
    , fVar = \n ->
-        tag "var" ("var" .=. show n)
+        makeXML "var" ("var" .=. show n)
    }
 
-addProperty :: String -> XMLBuilder -> XMLBuilder
+addProperty :: String -> XML -> XML
 addProperty s a =
-   case fromBuilder a of
-      Just e | name e `elem` ["label", "rule"] ->
-         builder e { attributes = attributes e ++ [s := "true"] }
-      _      -> tag s a
+   if name a `elem` ["label", "rule"]
+   then a { attributes = attributes a ++ [s := "true"] }
+   else a
 
 -----------------------------------------------------------------------
 -- XML to strategy

@@ -1,5 +1,5 @@ -----------------------------------------------------------------------------
--- Copyright 2018, Ideas project team. This file is distributed under the
+-- Copyright 2019, 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.
 -----------------------------------------------------------------------------
@@ -26,14 +26,14 @@ 
 data CmdLineOption
    = Version | Help | PrintLog
-   | InputFile String | Test FilePath
+   | InputFile String | Rerun String | Test FilePath
    | MakeScriptFor String | AnalyzeScript FilePath
  deriving Eq
 
 header :: String
 header =
    "IDEAS: Intelligent Domain-specific Exercise Assistants\n" ++
-   "Copyright 2018, Open Universiteit Nederland\n" ++
+   "Copyright 2019, Open Universiteit Nederland\n" ++
    versionText ++
    "\n\nUsage: ideas [OPTION]     (by default, CGI protocol)\n" ++
    "\nOptions:"
@@ -59,13 +59,15 @@    , 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 ""  ["rerun"]          rerunArg         "rerun inputs from database"
    , 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, makeScrArg, analyzeScrArg :: ArgDescr CmdLineOption
+fileArg, rerunArg, testArg, makeScrArg, analyzeScrArg :: ArgDescr CmdLineOption
 fileArg       = ReqArg InputFile "FILE"
+rerunArg      = ReqArg Rerun "DATABASE"
 testArg       = OptArg (Test . fromMaybe "test") "DIR"
 makeScrArg    = ReqArg MakeScriptFor "ID"
 analyzeScrArg = ReqArg AnalyzeScript "FILE"

@@ -1,5 +1,5 @@ -----------------------------------------------------------------------------
--- Copyright 2018, Ideas project team. This file is distributed under the
+-- Copyright 2019, 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.
 -----------------------------------------------------------------------------
@@ -24,62 +24,64 @@ import Data.ByteString (ByteString, unpack)
 import Data.Char
 import Data.Maybe
-import Data.Semigroup ((<>))
+import Data.Monoid
 import Data.String
 import Ideas.Encoding.ModeJSON (processJSON)
 import Ideas.Encoding.ModeXML (processXML)
-import Ideas.Encoding.Options (Options, maxTime, optionCgiBin)
+import Ideas.Encoding.Options (Options, maxTime, optionCgiBin, logRef)
 import Ideas.Encoding.Request
 import Ideas.Main.CmdLineOptions hiding (fullVersion)
 import Ideas.Service.DomainReasoner
 import Ideas.Service.FeedbackScript.Analysis
 import Ideas.Service.ServiceList
 import Ideas.Service.Types (Service)
+import Ideas.Text.XML.Unicode (decoding)
 import Ideas.Utils.BlackBoxTests
 import Ideas.Utils.Prelude
 import Ideas.Utils.TestSuite
 import Network.HTTP.Types
-import Network.Wai hiding (Request)
 import System.IO
 import qualified Ideas.Encoding.Logging as Log
 import qualified Ideas.Main.CGI as CGI
 import qualified Ideas.Main.CmdLineOptions as Options
-import qualified Network.Wai as CGI
+import qualified Network.Wai as WAI
 
 defaultMain :: DomainReasoner -> IO ()
 defaultMain = defaultMainWith mempty
 
 defaultMainWith :: Options -> DomainReasoner -> IO ()
 defaultMainWith options dr = do
+   -- create a record for logging (use only if not already provided)
+   ref <- Log.defaultLogRef
+   let newOptions = options {logRef = logRef options <> ref}
+   -- inspect command-line options
    cmdLineOptions <- getCmdLineOptions
    if null cmdLineOptions
-      then defaultCGI options dr
-      else defaultCommandLine options (addVersion dr) cmdLineOptions
+      then defaultCGI newOptions dr
+      else defaultCommandLine newOptions (addVersion dr) cmdLineOptions
 
 -- Invoked as a cgi binary
 defaultCGI :: Options -> DomainReasoner -> IO ()
 defaultCGI options dr = CGI.run $ \req respond -> do
-   -- create a record for logging
-   logRef  <- Log.newLogRef
    -- query environment
    let script = fromMaybe "" (findHeader "CGI-Script-Name" req) -- get name of binary
        addr   = fromMaybe "" (findHeader "REMOTE_ADDR" req)     -- the IP address of the remote host
-   input   <- inputOrDefault req
+   input   <- inputOrDefault req >>= decoding
    -- process request
    (preq, txt, ctp) <-
-      process (options <> optionCgiBin script) dr logRef input
+      process (optionCgiBin script options) dr input
+   -- store request in log reference
+   Log.changeLog (logRef options) $ \r -> Log.addRequest preq r
+      { Log.ipaddress = addr
+      , Log.version   = shortVersion
+      , Log.input     = input
+      , Log.output    = txt
+      }
    -- log request to database
-   when (useLogging preq) $ do
-      Log.changeLog logRef $ \r -> Log.addRequest preq r
-         { Log.ipaddress = addr
-         , Log.version   = shortVersion
-         , Log.input     = input
-         , Log.output    = txt
-         }
-      Log.logRecord (getSchema preq) logRef
-
+   when (useLogging preq) $
+      Log.logRecord (logRef options)
    -- write header and output
-   respond $ responseLBS
+   respond $ WAI.responseLBS
       status200
       [ (fromString "Content-Type", fromString ctp)
         -- Cross-Origin Resource Sharing (CORS) prevents browser warnings
@@ -88,7 +90,7 @@       ]
       (fromString txt)
 
-inputOrDefault :: CGI.Request -> IO String
+inputOrDefault :: WAI.Request -> IO String
 inputOrDefault req = do
    maybeInput <- inputFromRequest req
    case maybeInput of
@@ -116,20 +118,21 @@          Version -> putStrLn ("IDEAS, " ++ versionText)
          Help    -> putStrLn helpText
          -- process input file
+         Rerun database ->
+            processDatabase dr database
          InputFile file ->
             withBinaryFile file ReadMode $ \h -> do
-               logRef <- Log.newLogRef
-               input  <- hGetContents h
-               (req, txt, _) <- process options dr logRef input
+               input  <- hGetContents h >>= decoding
+               (req, txt, _) <- process options dr input
                putStrLn txt
                when (PrintLog `elem` cmdLineOptions) $ do
-                  Log.changeLog logRef $ \r -> Log.addRequest req r
+                  Log.changeLog (logRef options) $ \r -> Log.addRequest req r
                      { Log.ipaddress = "command-line"
                      , Log.version   = shortVersion
                      , Log.input     = input
                      , Log.output    = txt
                      }
-                  Log.printLog logRef
+                  Log.printLog (logRef options)
          -- blackbox tests
          Test dir -> do
             tests  <- blackBoxTests (makeTestRunner dr) ["xml", "json"] dir
@@ -140,13 +143,23 @@          AnalyzeScript file -> parseAndAnalyzeScript dr file
          PrintLog           -> return ()
 
-process :: Options -> DomainReasoner -> Log.LogRef -> String -> IO (Request, String, String)
-process options dr logRef input = do
+processDatabase :: DomainReasoner -> FilePath -> IO ()
+processDatabase dr database = do
+   (n, time) <- getDiffTime $ do
+      rows <- Log.selectFrom database "requests" ["input"] $ \row -> do
+         txt <- headM row
+         (_, out, _) <- process mempty dr txt
+         putStrLn out
+      return (length rows)
+   putStrLn $ "processed " ++ show n ++ " requests in " ++ show time
+
+process :: Options -> DomainReasoner -> String -> IO (Request, String, String)
+process options dr input = do
    format <- discoverDataFormat input
-   run format options {maxTime = Just 5} (addVersion dr) logRef input
+   run format options {maxTime = Just 5} (addVersion dr) input
  `catch` \e -> do
    let msg = "Error: " ++ show (e :: SomeException)
-   Log.changeLog logRef (\r -> r { Log.errormsg = msg })
+   Log.changeLog (logRef options) (\r -> r { Log.errormsg = msg })
    return (mempty, msg, "text/plain")
  where
    run XML  = processXML
@@ -154,7 +167,7 @@ 
 makeTestRunner :: DomainReasoner -> String -> IO String
 makeTestRunner dr input = do
-   (_, out, _) <- process mempty dr Log.noLogRef input
+   (_, out, _) <- decoding input >>= process mempty dr
    return out
 
 addVersion :: DomainReasoner -> DomainReasoner
@@ -167,23 +180,23 @@ 
 -- local helper functions
 
-findHeader :: String -> CGI.Request -> Maybe String
-findHeader s = fmap fromByteString . lookup (fromString s) . requestHeaders
+findHeader :: String -> WAI.Request -> Maybe String
+findHeader s = fmap fromByteString . lookup (fromString s) . WAI.requestHeaders
 
-inputFromRequest :: CGI.Request -> IO (Maybe String)
+inputFromRequest :: WAI.Request -> IO (Maybe String)
 inputFromRequest req =
    -- first try query string (for GET requests) ...
-   case inputFromQuery (queryString req) of
+   case inputFromQuery (WAI.queryString req) of
       Just s  -> return (Just s)
       Nothing -> do
          -- ... then try request body (for POST requests)
-         body <- requestBody req
+         body <- WAI.requestBody req
          return (inputFromQuery (parseQuery body))
 
 inputFromQuery :: Query -> Maybe String
 inputFromQuery = fmap fromByteString . join . lookup (fromString "input")
 
-accepts :: CGI.Request -> [String]
+accepts :: WAI.Request -> [String]
 accepts = maybe [] (splitsWithElem ',') . findHeader "Accept"
 
 fromByteString :: ByteString -> String

@@ -1,11 +1,11 @@--- Automatically generated by Makefile.  Do not change.
-module Ideas.Main.Revision where
-
-ideasVersion :: String
-ideasVersion = "1.6.1"
-
-ideasRevision :: String
-ideasRevision = "40c006abd80b9dc73dd0f33bc4b6692d9a5b338e"
-
-ideasLastChanged :: String
-ideasLastChanged = "Fri May 18 15:48:19 2018 +0200"+-- Automatically generated by Makefile.  Do not change.+module Ideas.Main.Revision where++ideasVersion :: String+ideasVersion = "1.8"++ideasRevision :: String+ideasRevision = "26fe80bf0f02342b55587676d6d34fd4bbcd3cad"++ideasLastChanged :: String+ideasLastChanged = "Mon Sep 9 12:42:00 2019 +0200"

@@ -1,5 +1,5 @@ -----------------------------------------------------------------------------
--- Copyright 2018, Ideas project team. This file is distributed under the
+-- Copyright 2019, 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.
 -----------------------------------------------------------------------------
@@ -12,7 +12,7 @@ 
 module Ideas.Service.BasicServices
    ( -- * Basic Services
-     stepsremaining, findbuggyrules, allfirsts, solution
+     stepsremaining, findbuggyrules, allfirsts, solution, solutionMaxSteps
    , onefirst, onefinal, applicable, allapplications, apply, generate, create
    , StepInfo, tStepInfo, exampleDerivations, recognizeRule
    ) where
@@ -20,6 +20,7 @@ import Control.Monad
 import Data.List
 import Data.Maybe
+import Ideas.Common.Examples
 import Ideas.Common.Library hiding (applicable, apply, ready)
 import Ideas.Common.Traversal.Navigator (downs, navigateTo)
 import Ideas.Service.State
@@ -47,7 +48,10 @@ 
 -- TODO: add a location to each step
 solution :: Maybe StrategyCfg -> State a -> Either String (Derivation (Rule (Context a), Environment) (Context a))
-solution mcfg state =
+solution = solutionMaxSteps 50
+
+solutionMaxSteps :: Int -> Maybe StrategyCfg -> State a -> Either String (Derivation (Rule (Context a), Environment) (Context a))
+solutionMaxSteps maxSteps mcfg state =
    mapSecond (biMap (\(r, _, as) -> (r, as)) stateContext) $
    case mcfg of
       _ | withoutPrefix state -> Left "Prefix is required"
@@ -57,13 +61,12 @@       Just cfg | isEmptyPrefix prfx ->
          let newStrategy = configure cfg (strategy ex)
              newPrefix   = emptyPrefix newStrategy (stateContext state)
-         in rec timeout d0 state { statePrefix = newPrefix }
-      _ -> rec timeout d0 state
+         in rec maxSteps d0 state { statePrefix = newPrefix }
+      _ -> rec maxSteps d0 state
  where
    d0   = emptyDerivation state
    ex   = exercise state
    prfx = statePrefix state
-   timeout = 50 :: Int
 
    rec i acc st =
       case onefirst st of
@@ -72,7 +75,7 @@             | i <= 0    -> Left msg
             | otherwise -> rec (i-1) (acc `extend` ((r, l, as), newState)) newState
     where
-      msg = "Time out after " ++ show timeout ++ " steps. " ++
+      msg = "Time out after " ++ show maxSteps ++ " steps. " ++
             show (biMap fst3 (prettyPrinterContext ex . stateContext) acc)
 
 type StepInfo a = (Rule (Context a), Location, Environment) -- find a good place
@@ -204,4 +207,4 @@       concatMap rec (downs x)
 
 exampleDerivations :: Exercise a -> Either String [Derivation (Rule (Context a), Environment) (Context a)]
-exampleDerivations ex = mapM (solution Nothing . emptyState ex . snd) (examples ex)+exampleDerivations ex = mapM (solution Nothing . emptyState ex) (examplesAsList ex)

@@ -1,6 +1,6 @@ {-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
 -----------------------------------------------------------------------------
--- Copyright 2018, Ideas project team. This file is distributed under the
+-- Copyright 2019, 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.
 -----------------------------------------------------------------------------

@@ -1,5 +1,5 @@ -----------------------------------------------------------------------------
--- Copyright 2018, Ideas project team. This file is distributed under the
+-- Copyright 2019, 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.
 -----------------------------------------------------------------------------
@@ -19,9 +19,7 @@ 
 import Data.List
 import Data.Maybe
-import Data.Monoid hiding ((<>))
 import Data.Semigroup as Sem
-import Data.Ord
 import Ideas.Common.Library
 import Ideas.Service.FeedbackScript.Parser
 import Ideas.Service.Types
@@ -83,13 +81,13 @@ -- Domain Reasoner functions
 
 exercisesSorted :: DomainReasoner -> [Some Exercise]
-exercisesSorted = sortBy (comparing f) . exercises
+exercisesSorted = sortOn f . exercises
  where
    f :: Some Exercise -> String
    f (Some ex) = showId ex
 
 servicesSorted :: DomainReasoner -> [Service]
-servicesSorted = sortBy (comparing showId) . services
+servicesSorted = sortOn showId . services
 
 findExercise :: Monad m => DomainReasoner -> Id -> m (Some Exercise)
 findExercise dr i =

@@ -1,5 +1,5 @@ -----------------------------------------------------------------------------
--- Copyright 2018, Ideas project team. This file is distributed under the
+-- Copyright 2019, 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.
 -----------------------------------------------------------------------------

@@ -1,5 +1,5 @@ -----------------------------------------------------------------------------
--- Copyright 2018, Ideas project team. This file is distributed under the
+-- Copyright 2019, 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.
 -----------------------------------------------------------------------------
@@ -20,7 +20,6 @@ import Control.Monad
 import Data.Char
 import Data.List
-import Data.Monoid hiding ((<>))
 import Data.Semigroup
 import Ideas.Common.Id
 import Ideas.Service.FeedbackScript.Syntax

@@ -1,5 +1,5 @@ -----------------------------------------------------------------------------
--- Copyright 2018, Ideas project team. This file is distributed under the
+-- Copyright 2019, 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.
 -----------------------------------------------------------------------------

@@ -1,5 +1,5 @@ -----------------------------------------------------------------------------
--- Copyright 2018, Ideas project team. This file is distributed under the
+-- Copyright 2019, 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.
 -----------------------------------------------------------------------------
@@ -21,7 +21,6 @@ import Data.Char
 import Data.List
 import Data.Maybe
-import Data.Monoid hiding ((<>))
 import Data.Semigroup as Sem
 import Ideas.Common.Library
 import Ideas.Utils.Uniplate

@@ -1,6 +1,6 @@ {-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, UndecidableInstances #-}
 -----------------------------------------------------------------------------
--- Copyright 2018, Ideas project team. This file is distributed under the
+-- Copyright 2019, 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.
 -----------------------------------------------------------------------------

@@ -1,6 +1,6 @@ {-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeFamilies #-}
 -----------------------------------------------------------------------------
--- Copyright 2018, Ideas project team. This file is distributed under the
+-- Copyright 2019, 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.
 -----------------------------------------------------------------------------

@@ -1,5 +1,5 @@ -----------------------------------------------------------------------------
--- Copyright 2018, Ideas project team. This file is distributed under the
+-- Copyright 2019, 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.
 -----------------------------------------------------------------------------
@@ -169,9 +169,9 @@    f ::: tQCGen .-> tExercise .-> tInt .-> tMaybe tUserId .-> tError tState
  where
    f rng ex nr userId =
-      case drop nr (examples ex) of
-         []      -> Left "No such example"
-         (_,a):_ -> Right $ startState rng ex userId a
+      case drop nr (examplesAsList ex) of
+         []  -> Left "No such example"
+         a:_ -> Right $ startState rng ex userId a
 
 findbuggyrulesS :: Service
 findbuggyrulesS = makeService "basic.findbuggyrules"

@@ -1,6 +1,6 @@ {-# LANGUAGE TypeFamilies #-}
 -----------------------------------------------------------------------------
--- Copyright 2018, Ideas project team. This file is distributed under the
+-- Copyright 2019, 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.
 -----------------------------------------------------------------------------

@@ -1,6 +1,6 @@ {-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
 -----------------------------------------------------------------------------
--- Copyright 2018, Ideas project team. This file is distributed under the
+-- Copyright 2019, 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.
 -----------------------------------------------------------------------------

@@ -1,6 +1,6 @@ {-# LANGUAGE GADTs, RankNTypes, FlexibleInstances, FlexibleContexts #-}
 -----------------------------------------------------------------------------
--- Copyright 2018, Ideas project team. This file is distributed under the
+-- Copyright 2019, 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.
 -----------------------------------------------------------------------------
@@ -24,7 +24,7 @@    , tTerm, tStrategy, tTree, tState, tBool, tMaybe, tString, tList
    , tId, tService, tSomeExercise, tText, tDifficulty, tUserId ,tContext
    , tDerivation, tError, (.->), tIO, tExercise, tTestSuiteResult, tQCGen
-   , tScript, tExamples, tStrategyCfg, tMathML, tInt
+   , tScript, tExamples, tStrategyCfg, tMathML, tInt, tXML
      -- * Searching a typed value
    , findValuesOfType
    ) where
@@ -33,11 +33,13 @@ import Data.Char
 import Data.List
 import Data.Maybe
-import Data.Tree
+import Data.Tree hiding (flatten)
+import Ideas.Common.Examples
 import Ideas.Common.Library
 import Ideas.Service.FeedbackScript.Syntax
 import Ideas.Service.State
 import Ideas.Text.MathML
+import Ideas.Text.XML (XML)
 import Test.QuickCheck.Random (QCGen)
 import qualified Ideas.Utils.TestSuite as TestSuite
 
@@ -105,6 +107,7 @@    equal Text        Text        = Just id
    equal QCGen       QCGen       = Just id
    equal Result      Result      = Just id
+   equal XML         XML         = Just id
    equal _           _           = Nothing
 
 infixr 5 :|:
@@ -158,6 +161,7 @@    Result       :: Const a TestSuite.Result
    SomeExercise :: Const a (Some Exercise)
    MathML       :: Const a MathML
+   XML          :: Const a XML
    -- basic types
    Bool         :: Const a Bool
    Int          :: Const a Int
@@ -218,6 +222,7 @@          QCGen            -> show val
          Result           -> show val
          MathML           -> show val
+         XML              -> show val
          Bool             -> map toLower (show val)
          Int              -> show val
          String           -> val
@@ -244,6 +249,7 @@    showF Result       = "TestSuiteResult"
    showF SomeExercise = "Exercise"
    showF MathML       = "MathML"
+   showF XML          = "XML"
    showF Bool         = "Bool"
    showF Int          = "Int"
    showF String       = "String"
@@ -363,7 +369,10 @@ tQCGen = Const QCGen
 
 tExamples :: Type a (Examples (Context a))
-tExamples = tList (tPair tDifficulty tContext)
+tExamples = Iso (f <-> g) (tList (tPair tDifficulty tContext))
+ where
+   f = examplesWithDifficulty
+   g = map (first (fromMaybe Medium)) . allExamples -- use default difficulty
 
 tId :: Type a Id
 tId = Const Id
@@ -388,6 +397,9 @@ 
 tTestSuiteResult :: Type a TestSuite.Result
 tTestSuiteResult = Const Result
+
+tXML :: Type a XML
+tXML = Const XML
 
 -------------------------------------
 

@@ -1,5 +1,5 @@ -----------------------------------------------------------------------------
--- Copyright 2018, Ideas project team. This file is distributed under the
+-- Copyright 2019, 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.
 -----------------------------------------------------------------------------
@@ -14,31 +14,71 @@ -----------------------------------------------------------------------------
 
 module Ideas.Text.HTML
-   ( HTMLPage, HTMLBuilder
+   ( ToHTML(..), HTMLPage, HTMLBuilder
    , addCSS, addScript, addStyle, showHTML
    , string, text
    , htmlPage, link
    , h1, h2, h3, h4, h5, h6
    , preText, ul, table, keyValueTable
-   , image, space, spaces, highlightXML
+   , image, space, spaces, (<#>), spaced
+   , highlightXML
    , para, ttText, hr, br, pre, bullet
    , divClass, spanClass
      -- HTML generic attributes
    , idA, classA, styleA, titleA
      -- Font style elements
    , tt, italic, bold, big, small
-   , module Data.Monoid
    ) where
 
 import Data.Char
 import Data.List
-import Data.Monoid hiding ((<>))
+import Data.Monoid
 import Ideas.Text.XML
 import Prelude hiding (div)
+import qualified Data.Map as M
 import qualified Ideas.Text.XML as XML
 
 type HTMLBuilder = XMLBuilder
 
+class ToHTML a where
+   toHTML     :: a -> HTMLBuilder
+   listToHTML :: [a] -> HTMLBuilder
+   -- default definitions
+   listToHTML = ul . map toHTML
+
+instance ToHTML a => ToHTML [a] where
+   toHTML = listToHTML
+
+instance (ToHTML a, ToHTML b) => ToHTML (Either a b) where
+   toHTML = either toHTML toHTML
+
+instance (ToHTML a) => ToHTML (Maybe a) where
+   toHTML = maybe mempty toHTML
+
+instance ToHTML () where
+   toHTML _ = mempty
+
+instance (ToHTML a, ToHTML b) => ToHTML (a, b) where
+   toHTML (a, b) = toHTML a <#> toHTML b
+
+instance (ToHTML a, ToHTML b, ToHTML c) => ToHTML (a, b, c) where
+   toHTML (a, b, c) = toHTML a <#> toHTML b <#> toHTML c
+
+instance (ToHTML a, ToHTML b) => ToHTML (M.Map a b) where
+   toHTML = Ideas.Text.HTML.table False . map f . M.toList
+    where
+      f (a, b) = [toHTML a, toHTML b]
+
+instance ToHTML Int where
+   toHTML = text
+
+instance ToHTML Bool where
+   toHTML = text
+
+instance ToHTML Char where
+   toHTML     = string . return
+   listToHTML = string
+
 data HTMLPage = HTMLPage
    { title       :: String
    , styleSheets :: [FilePath]
@@ -47,7 +87,7 @@    , htmlContent :: HTMLBuilder
    }
 
-instance InXML HTMLPage where
+instance ToXML HTMLPage where
    toXML page = makeXML "html" $
       element "head"
          [ tag "title" (string (title page))
@@ -60,7 +100,7 @@               | css <- styleSheets page
               ]
          , mconcat
-              [ tag "style" (unescaped txt)
+              [ tag "style" (string txt)
               | txt <- styleTxts page
               ]
          , mconcat
@@ -69,7 +109,6 @@               ]
          ]
       <> tag "body" (htmlContent page)
-   fromXML _ = fail "HTMLPage.fromXML"
 
 showHTML :: HTMLPage -> String
 showHTML = compactXML . toXML
@@ -118,17 +157,21 @@ ttText = tt . string
 
 ul :: BuildXML a => [a] -> a
-ul = element "ul" . map (tag "li")
+ul xs
+   | null xs   = mempty
+   | otherwise = element "ul" (map (tag "li") xs)
 
 -- | First argument indicates whether the table has a header or not
 table :: BuildXML a => Bool -> [[a]] -> a
-table b rows = element "table" $
-   ("border" .=. "1") :
-   [ element "tr" $
-        ("class" .=. getClass i) :
-        [ tag "td" c | c <- row ]
-   | (i, row) <- zip [0::Int ..] rows
-   ]
+table b rows
+   | null rows = mempty
+   | otherwise = element "table" $
+        ("border" .=. "1") :
+        [ element "tr" $
+             ("class" .=. getClass i) :
+             [ tag "td" c | c <- row ]
+        | (i, row) <- zip [0::Int ..] rows
+        ]
  where
    getClass i
       | i == 0 && b = "top-row"
@@ -144,9 +187,15 @@ spaces n = mconcat (replicate n space)
 
 space, bullet :: BuildXML a => a
-space  = XML.unescaped "&nbsp;"
-bullet = XML.unescaped "&#8226;"
+space  = XML.string [chr 160]  -- &nbsp;
+bullet = XML.string [chr 8226]
 
+(<#>) :: BuildXML a => a -> a -> a
+x <#> y = x <> space <> y
+
+spaced :: BuildXML a => [a] -> a
+spaced = mconcat . intersperse space
+
 image :: BuildXML a => String -> a
 image n = tag "img" ("src" .=. n)
 
@@ -159,14 +208,39 @@ -- A simple XML highlighter
 highlightXML :: Bool -> XML -> HTMLBuilder
 highlightXML nice
-   | nice      = builder . highlight . makeXML "pre" . string . show
-   | otherwise = builder . highlight . makeXML "tt"  . string . compactXML
+   | nice      = tag "pre" . f . prettyXML
+   | otherwise = tag "tt"  . f . compactXML
  where
-   highlight :: XML -> XML
-   highlight html = html {content = map (either (Left . f) Right) (content html)}
-
    -- find <
-   f :: String -> String
+   f :: String -> HTMLBuilder
+   f []           = mempty
+   f ('<':'/':xs) = g "</" [] xs
+   f ('<':xs)     = g "<"  [] xs
+   f (x:xs)       = string [x] <> f xs
+
+   -- find >
+   g start acc []           = string (start ++ reverse acc)
+   g start acc ('/':'>':xs) = pp (start, reverse acc, "/>") <> f xs
+   g start acc ('>':xs)     = pp (start, reverse acc, ">")  <> f xs
+   g start acc (x:xs)       = g start (x:acc) xs
+
+   pp (start, info, end) = blue (string (start ++ as)) <> rec bs <> blue (string end)
+    where
+      (as, bs) = span isAlphaNum info
+
+      rec []       = mempty
+      rec ('=':xs) = orange (string "=") <> rec xs
+      rec ('"':xs) = case break (== '"') xs of
+                        (xs1, _:xs2) -> green (string ('"' : xs1 ++ ['"'])) <> rec xs2
+                        _ -> string ('"':xs)
+      rec (x:xs)   = string [x] <> rec xs
+
+   blue a   = tag "font" ("color" .=. "blue" <> a)
+   orange a = tag "font" ("color" .=. "orange" <> a)
+   green a  = tag "font" ("color" .=. "green" <> a)
+
+      {-
+
    f [] = []
    f list@(x:xs)
       | "&lt;/" `isPrefixOf` list = -- close tag
@@ -184,7 +258,7 @@       | "&gt;" `isPrefixOf` list =
            "</font>&gt;</font>" ++ f (drop 4 list)
       | x=='=' = "<font color='orange'>=</font>" ++ g xs
-      | otherwise = x : g xs
+      | otherwise = x : g xs -}
 
 -----------------------------------------------------------
 -- * HTML generic attributes

@@ -1,6 +1,6 @@ {-# LANGUAGE OverloadedStrings #-}
 -----------------------------------------------------------------------------
--- Copyright 2018, Ideas project team. This file is distributed under the
+-- Copyright 2019, 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.
 -----------------------------------------------------------------------------
@@ -18,6 +18,7 @@    , fontAwesome
    ) where
 
+import Data.Monoid
 import Ideas.Text.HTML
 import Ideas.Text.HTML.W3CSS hiding (tag, ul, top, table, content)
 import Ideas.Text.XML hiding (content)
@@ -92,7 +93,8 @@       , " "
       ]
 
-   script = tag "script" (unescaped scriptText)
+   -- the javascript is not to be escaped
+   script = tag "script" (string scriptText)
 
    width | null (sideButtons wp) = "0px"
          | otherwise             = show (sideWidth wp) ++ "px"
@@ -107,7 +109,7 @@       ]
 
    styleText =
-      "html,body,h1,h2,h3,h4,h5,h6 {font-family: \"Roboto\", sans-serif;}\
+      "html,body,h1,h2,h3,h4,h5,h6 {font-family: Roboto, sans-serif;}\
       \.w3-sidebar {\
       \  z-index: 3;\
       \  width: " ++ width ++ ";\

@@ -1,5 +1,5 @@ -----------------------------------------------------------------------------
--- Copyright 2018, Ideas project team. This file is distributed under the
+-- Copyright 2019, 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.
 -----------------------------------------------------------------------------
@@ -16,6 +16,7 @@ module Ideas.Text.HTML.W3CSS where
 
 import Data.Char
+import Data.Monoid
 import Ideas.Text.HTML
 import Ideas.Text.XML
 import qualified Ideas.Text.XML as XML

@@ -1,5 +1,5 @@ -----------------------------------------------------------------------------
--- Copyright 2018, Ideas project team. This file is distributed under the
+-- Copyright 2019, 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.
 -----------------------------------------------------------------------------
@@ -163,7 +163,7 @@       , Boolean True  <$ P.reserved lexer "true"
       , Boolean False <$ P.reserved lexer "false"
       , Number . either I D <$> naturalOrFloat -- redefined in Ideas.Text.Parsing
-      , String . fromMaybe [] . UTF8.decodeM <$> P.stringLiteral lexer
+      , String <$> P.stringLiteral lexer
       , Array  <$> P.brackets lexer (sepBy json (P.comma lexer))
       , Object <$> P.braces lexer (sepBy keyValue (P.comma lexer))
       ]
@@ -267,7 +267,7 @@    arbitrary = sized arbJSON
 
 instance Arbitrary Number where
-   arbitrary = oneof [I <$> arbitrary, (D . fromInteger) <$> arbitrary]
+   arbitrary = oneof [ I <$> arbitrary, D . fromInteger <$> arbitrary ]
 
 arbJSON :: Int -> Gen JSON
 arbJSON n

@@ -1,6 +1,6 @@ {-# LANGUAGE OverloadedStrings #-}
 -----------------------------------------------------------------------------
--- Copyright 2018, Ideas project team. This file is distributed under the
+-- Copyright 2019, 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.
 -----------------------------------------------------------------------------
@@ -14,13 +14,12 @@ -----------------------------------------------------------------------------
 
 module Ideas.Text.Latex
-   ( Latex, ToLatex(..), (<>)
+   ( Latex, ToLatex(..)
    , array, commas, brackets, parens
    , command
    ) where
 
 import Data.List
-import Data.Monoid hiding ((<>))
 import Data.Semigroup as Sem
 import Data.String
 

@@ -1,5 +1,5 @@ -----------------------------------------------------------------------------
--- Copyright 2018, Ideas project team. This file is distributed under the
+-- Copyright 2019, 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.
 -----------------------------------------------------------------------------
@@ -14,7 +14,6 @@    ( MathML(..), xml2mathml, mathml2xml
    ) where
 
-import Data.Either
 import Data.Maybe
 import Ideas.Text.XML
 import Ideas.Utils.Uniplate hiding (children)
@@ -51,8 +50,10 @@ Conversely, since mn is a presentation element, there are a few situations where it may desirable to include arbitrary text in the content of an mn that should merely render as a numeric literal
 -}
 
+instance ToXML MathML where
+   toXML = mathml2xml
+
 instance InXML MathML where
-   toXML   = mathml2xml
    fromXML = either fail return . xml2mathml
 
 instance Uniplate MathML where
@@ -67,40 +68,54 @@ xml2mathml :: XML -> Either String MathML
 xml2mathml = rec
  where
-   rec xml = case xml of
-       Element "mrow" _ _ -> MRow <$> mapM rec (children xml)
-       Element "mi" _ [Left s] -> return (MId s)
-       Element "mn" _ [Left s] -> return (MNumber s)
-       Element "mo" _ [Left s] -> return (MOperator s)
-       Element "ms" _ [Left s] -> return (MString s)
-       Element "mtext" _ [] -> return (MText "")
-       Element "mtext" _ [Left s] -> return (MText s)
-       Element "mroot" _ [Right c, Right d] -> MRoot <$> rec c <*> rec d
-       Element "msup" _ [Right c, Right d] -> MSup <$> rec c <*> rec d
-       Element "msub" _ [Right c, Right d] -> MSub <$> rec c <*> rec d
-       Element "msubsup" _ [Right c, Right d, Right e] -> MSubSup <$> rec c <*> rec d <*> rec e
-       Element "mfrac" _ [Right c, Right d] -> MFrac <$> rec c <*> rec d
-       Element "mfenced" _ [Right c] -> MFenced (fromMaybe "(" (findAttribute "open" xml)) (fromMaybe ")" (findAttribute "close" xml)) <$> rec c
-       Element "mspace" _ _ -> return MSpace
-       Element "mtable" _ _ -> return MTable
-       Element "mtr" _ _ -> return MTableRow
-       Element "mlabeledtr" _ _ -> return MLabeledTableRow
-       Element "munder" _ _ -> return MUnder
-       Element "mover" _ _ -> return MOver
-       Element "munderover" _ _ -> return MUnderOver
+   rec xml = case name xml of
+       "mrow"       -> MRow <$> mapM rec (children xml)
+       "mi"         -> return (MId (getData xml))
+       "mn"         -> return (MNumber (getData xml))
+       "mo"         -> return (MOperator (getData xml))
+       "ms"         -> return (MString (getData xml))
+       "mtext"      -> return (MText (getData xml))
+       "mroot"      -> case children xml of
+                          [c, d] -> MRoot <$> rec c <*> rec d
+                          _ -> fail "invalid mroot"
+       "msup"       -> case children xml of
+                          [c, d] -> MSup <$> rec c <*> rec d
+                          _ -> fail "invalid msup"
+       "msub"       -> case children xml of
+                          [c, d] -> MSub <$> rec c <*> rec d
+                          _ -> fail "invalid msub"
+       "msubsup"    -> case children xml of
+                          [c, d, e] -> MSubSup <$> rec c <*> rec d <*> rec e
+                          _ -> fail "invalid msubsup"
+       "mfrac"      -> case children xml of
+                          [c, d] -> MFrac <$> rec c <*> rec d
+                          _ -> fail "invalid mfrac"
+       "mfenced"    -> case children xml of
+                          [c] -> MFenced (fromMaybe "(" (findAttribute "open" xml)) (fromMaybe ")" (findAttribute "close" xml)) <$> rec c
+                          _ -> fail "invalid mfenced"
+       "mspace"     -> return MSpace
+       "mtable"     -> return MTable
+       "mtr"        -> return MTableRow
+       "mlabeledtr" -> return MLabeledTableRow
+       "munder"     -> return MUnder
+       "mover"      -> return MOver
+       "munderover" -> return MUnderOver
        -- below are cases that have 1* arguments, when none-one an mrow is implied.
-       Element "math" _ xs -> impliedMRow xs
-       Element "msqrt" _ xs -> MSqrt <$> impliedMRow xs
-       Element "mphantom" _ _ -> return MPhantom
-       Element "mpadded" _ _ -> return MPadded
-       Element "mstyle" _ _ -> return MStyle
-       Element "merror" _ _ -> return MError
-       Element "mtd" _ _ -> return MTableData
-       Element "menclose" _ _ -> return MEnclose
+       "math"       -> impliedMRow xml
+       "msqrt"      -> MSqrt <$> impliedMRow xml
+       "mphantom"   -> return MPhantom
+       "mpadded"    -> return MPadded
+       "mstyle"     -> return MStyle
+       "merror"     -> return MError
+       "mtd"        -> return MTableData
+       "menclose"   -> return MEnclose
        _ -> fail ("unsupported MathML: " ++ show xml)
-   impliedMRow :: [Either String Element] -> Either String MathML
-   impliedMRow [Right r] = rec r
-   impliedMRow xs = MRow <$> mapM rec (rights xs)
+
+   impliedMRow :: XML -> Either String MathML
+   impliedMRow xml =
+      case children xml of
+         [x] -> rec x
+         xs  -> MRow <$> mapM rec xs
 
 mathml2xml :: MathML -> XML
 mathml2xml = makeXML "math" . rec

@@ -1,5 +1,5 @@ -----------------------------------------------------------------------------
--- Copyright 2018, Ideas project team. This file is distributed under the
+-- Copyright 2019, 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.
 -----------------------------------------------------------------------------

@@ -1,5 +1,5 @@ -----------------------------------------------------------------------------
--- Copyright 2018, Ideas project team. This file is distributed under the
+-- Copyright 2019, 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.
 -----------------------------------------------------------------------------
@@ -30,8 +30,10 @@            | OMBIND OMOBJ [String] OMOBJ
    deriving (Show, Eq)
 
+instance ToXML OMOBJ where
+   toXML = omobj2xml
+
 instance InXML OMOBJ where
-   toXML   = omobj2xml
    fromXML = either fail return . xml2omobj
 
 instance Uniplate OMOBJ where
@@ -48,47 +50,50 @@ -- conversion functions: XML <-> OMOBJ
 
 xml2omobj :: XML -> Either String OMOBJ
-xml2omobj xmlTop =
-   case xmlTop of
-      Element "OMOBJ" _ [Right e] -> rec e
-      _ -> fail $ "expected an OMOBJ tag" ++ show xmlTop
+xml2omobj xmlTop
+   | name xmlTop == "OMOBJ" =
+        case children xmlTop of
+           [x] -> rec x
+           _   -> fail "invalid omobj"
+   | otherwise = fail "expected an OMOBJ tag"
  where
    rec xml =
-      case content xml of
-
-         _ | name xml == "OMA" -> do
+      case name xml of
+         "OMA" -> do
             ys <- mapM rec (children xml)
             return (OMA ys)
 
-         [] | name xml == "OMS" -> do
+         "OMS" | emptyContent xml -> do
             let mcd = case findAttribute "cd" xml of
                          Just "unknown" -> Nothing
                          this -> this
             n <- findAttribute "name" xml
             return (OMS (mcd, n))
 
-         [Left s] | name xml == "OMI" ->
-            case readInt s of
+         "OMI" | name xml == "OMI" ->
+            case readInt (getData xml) of
                Just i -> return (OMI (toInteger i))
                _      -> fail "invalid integer in OMI"
 
-         [] | name xml == "OMF" -> do
+         "OMF" | emptyContent xml -> do
             s <- findAttribute "dec" xml
             case readDouble s of
                Just nr -> return (OMF nr)
                _       -> fail "invalid floating-point in OMF"
 
-         [] | name xml == "OMV" -> do
+         "OMV" | emptyContent xml -> do
             s <- findAttribute "name" xml
             return (OMV s)
 
-         [Right x1, Right x2, Right x3] | name xml == "OMBIND" -> do
-            y1 <- rec x1
-            y2 <- recOMBVAR x2
-            y3 <- rec x3
-            return (OMBIND y1 y2 y3)
-
-         _ -> fail ("invalid tag " ++ show (name xml))
+         "OMBIND" ->
+            case children xml of
+               [x1, x2, x3] -> do
+                  y1 <- rec x1
+                  y2 <- recOMBVAR x2
+                  y3 <- rec x3
+                  return (OMBIND y1 y2 y3)
+               _ -> fail "invalid ombind"
+         _ -> fail ("invalid tag " ++ name xml)
 
    recOMBVAR xml
       | name xml == "OMBVAR" =

@@ -1,5 +1,5 @@ -----------------------------------------------------------------------------
--- Copyright 2018, Ideas project team. This file is distributed under the
+-- Copyright 2019, 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.
 -----------------------------------------------------------------------------

@@ -1,5 +1,5 @@ -----------------------------------------------------------------------------
--- Copyright 2018, Ideas project team. This file is distributed under the
+-- Copyright 2019, 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.
 -----------------------------------------------------------------------------

@@ -1,5 +1,5 @@ -----------------------------------------------------------------------------
--- Copyright 2018, Ideas project team. This file is distributed under the
+-- Copyright 2019, 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.
 -----------------------------------------------------------------------------

@@ -1,5 +1,5 @@ -----------------------------------------------------------------------------
--- Copyright 2018, Ideas project team. This file is distributed under the
+-- Copyright 2019, 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.
 -----------------------------------------------------------------------------
@@ -8,157 +8,381 @@ -- Stability   :  provisional
 -- Portability :  portable (depends on ghc)
 --
--- A datatype, parser, and pretty printer for XML documents. Re-exports
--- functions defined elsewhere.
+-- Collection of common operation on XML documents
 --
 -----------------------------------------------------------------------------
 
 module Ideas.Text.XML
-   ( XML, Attr, AttrList, Element(..), InXML(..)
-   , XMLBuilder, makeXML
-   , parseXML, parseXMLFile, compactXML, findAttribute
-   , children, Attribute(..), fromBuilder, findChild, findChildren, getData
-   , BuildXML(..)
-   , module Data.Monoid
-   , (<>)
-   , munless, mwhen
+   ( -- * XML types
+     XML, Name, Attributes, Attribute(..)
+     -- * Parsing XML
+   , parseXML, parseXMLFile
+     -- * Building/constructing XML
+   , BuildXML(..), XMLBuilder, makeXML
+     -- * Pretty-printing XML
+   , prettyXML, compactXML
+     -- * Simple decoding queries
+   , name, attributes, findAttribute, children, findChildren, findChild
+   , getData, expecting
+     -- * Decoding XML
+   , decodeData, decodeAttribute, decodeChild, decodeFirstChild
+     -- * Type classes for converting to/from XML
+   , ToXML(..), builderXML, InXML(..)
+     -- * Processing XML
+   , foldXML, trimXML
+     -- * Deprecated functions
+   , content, emptyContent, fromBuilder
    ) where
 
-import Control.Monad
-import Data.Char
+import Control.Monad.State
+import Data.Char (chr, ord, isSpace)
 import Data.Foldable (toList)
 import Data.List
-import Data.Monoid hiding ((<>))
+import Data.Maybe
 import Data.Semigroup as Sem
 import Data.String
-import Ideas.Text.XML.Interface hiding (parseXML)
+import Ideas.Text.XML.Document (escape, Name, prettyElement)
+import Ideas.Text.XML.Parser (document)
+import Ideas.Text.XML.Unicode
+import Ideas.Utils.Decoding
+import Ideas.Utils.Parsing (parseSimple)
 import System.IO
 import qualified Data.Map as M
 import qualified Data.Sequence as Seq
-import qualified Ideas.Text.XML.Interface as I
+import qualified Ideas.Text.XML.Document as D
 
-----------------------------------------------------------------
--- Datatype definitions
+-------------------------------------------------------------------------------
+-- XML types
 
--- two helper types for attributes
-type XML      = Element
-type Attr     = Attribute  -- (String, String)
-type AttrList = Attributes -- [Attr]
+-- invariants content: no two adjacent Lefts, no Left with empty string,
+-- valid tag/attribute names
+data XML = Tag
+   { name       :: Name
+   , attributes :: Attributes
+   , content    :: [Either String XML]
+   }
+ deriving Eq
 
-class InXML a where
-   toXML       :: a -> XML
-   listToXML   :: [a] -> XML
-   fromXML     :: Monad m => XML -> m a
-   listFromXML :: Monad m => XML -> m [a]
-   -- default definitions
-   listToXML = Element "list" [] . map (Right . toXML)
-   listFromXML xml
-      | name xml == "list" && null (attributes xml) =
-           mapM fromXML (children xml)
-      | otherwise = fail "expecting a list tag"
+instance Show XML where
+   show = compactXML
 
-----------------------------------------------------------------
--- XML parser (a scanner and a XML tree constructor)
+type Attributes = [Attribute]
 
+data Attribute = Name := String
+ deriving Eq
+
+-------------------------------------------------------------------------------
+-- Parsing XML
+
+parseXML :: String -> Either String XML
+parseXML input = do
+   doc   <- parseSimple document input
+   return (fromXMLDoc doc)
+
 parseXMLFile :: FilePath -> IO XML
 parseXMLFile file =
    withBinaryFile file ReadMode $
       hGetContents >=> either fail return . parseXML
 
-parseXML :: String -> Either String XML
-parseXML input = do
-   xml <- I.parseXML input
-   return (ignoreLayout xml)
+fromXMLDoc :: D.XMLDoc -> XML
+fromXMLDoc doc = fromElement (D.root doc)
+ where
+   fromElement (D.Element n as c) =
+      makeXML n (fromAttributes as <> fromContent c)
 
-ignoreLayout :: XML -> XML
-ignoreLayout (Element n as xs) =
-   let f = either (Left . trim) (Right . ignoreLayout)
-   in Element n as (map f xs)
+   fromAttributes = mconcat . map fromAttribute
 
-----------------------------------------------------------------
--- XML builders
+   fromAttribute (n D.:= v) =
+      n .=. concatMap (either return refToString) v
 
+   fromContent :: D.Content -> XMLBuilder
+   fromContent = mconcat . map f
+    where
+      f :: D.XML -> XMLBuilder
+      f (D.Tagged e)    = builder (fromElement e)
+      f (D.CharData s)  = string s
+      f (D.CDATA s)     = string s
+      f (D.Reference r) = fromReference r
+
+   refToString :: D.Reference -> String
+   refToString (D.CharRef i)   = [chr i]
+   refToString (D.EntityRef s) = maybe "" return (lookup s general)
+
+   fromReference :: D.Reference -> XMLBuilder
+   fromReference (D.CharRef i)   = char (chr i)
+   fromReference (D.EntityRef s) = fromMaybe mempty (lookup s entities)
+
+   entities :: [(String, XMLBuilder)]
+   entities =
+      [ (n, fromContent (snd ext)) | (n, ext) <- D.externals doc ] ++
+      -- predefined entities
+      [ (n, char c) | (n, c) <- general ]
+
+   general :: [(String, Char)]
+   general = [("lt",'<'), ("gt",'>'), ("amp",'&'), ("apos",'\''), ("quot",'"')]
+
+-------------------------------------------------------------------------------
+-- Building/constructing XML
+
 infix 7 .=.
 
 class (Sem.Semigroup a, Monoid a) => BuildXML a where
-   (.=.)     :: String -> String -> a   -- attribute
-   unescaped :: String -> a             -- parsed character data (unescaped!)
-   builder   :: Element -> a            -- (named) xml element
-   tag       :: String -> a -> a        -- tag (with content)
+   (.=.)    :: String -> String -> a   -- attribute
+   string   :: String -> a             -- (escaped) text
+   builder  :: XML -> a                -- (named) xml element
+   tag      :: String -> a -> a        -- tag (with content)
    -- functions with a default
-   string   :: String -> a -- escaped text
+   char     :: Char -> a
    text     :: Show s => s -> a -- escaped text with Show class
    element  :: String -> [a] -> a
    emptyTag :: String -> a
    -- implementations
-   string     = unescaped . escape
+   char c     = string [c]
    text       = string . show
    element s  = tag s . mconcat
    emptyTag s = tag s mempty
 
-data XMLBuilder = BS (Seq.Seq Attr) (Seq.Seq (Either String Element))
+instance BuildXML a => BuildXML (Decoder env s a) where
+   n .=. s = pure (n .=. s)
+   string  = pure . string
+   builder = pure . builder
+   tag     = fmap . tag
 
--- local helper: merge attributes, but preserve order
-fromBS :: XMLBuilder -> (AttrList, Content)
-fromBS (BS as elts) = (attrList, toList elts)
- where
-   attrMap = foldr add M.empty as
-   add (k := v) = M.insertWith (\x y -> x ++ " " ++ y) k v
-   attrList = nubBy eqKey (map make (toList as))
-   make (k := _) = k := M.findWithDefault "" k attrMap
-   eqKey (k1 := _) (k2 := _) = k1 == k2
+data XMLBuilder = BS (Seq.Seq Attribute) (Seq.Seq (Either String XML))
 
 instance Sem.Semigroup XMLBuilder where
-  BS as1 elts1 <> BS as2 elts2 =
-      BS (as1 <> as2) (elts1 <> elts2)
+  BS as1 elts1 <> BS as2 elts2 = BS (as1 <> as2) (elts1 <> elts2)
 
 instance Monoid XMLBuilder where
    mempty  = BS mempty mempty
    mappend = (<>)
 
 instance BuildXML XMLBuilder where
-   n .=. s   = BS (Seq.singleton (n := escapeAttr s)) mempty
-   unescaped = BS mempty . Seq.singleton . Left
-   builder   = BS mempty . Seq.singleton . Right
-   tag s     = builder . uncurry (Element s) . fromBS
+   n .=. s  = nameCheck n $ BS (Seq.singleton (n := s)) mempty
+   string s = BS mempty (if null s then mempty else Seq.singleton (Left s))
+   builder  = BS mempty . Seq.singleton . Right
+   tag n    = builder . uncurry (Tag n) . fromBS . nameCheck n
 
 instance IsString XMLBuilder where
    fromString = string
 
 makeXML :: String -> XMLBuilder -> XML
-makeXML s = uncurry (Element s) . fromBS
+makeXML s = uncurry (Tag s) . fromBS . nameCheck s
 
-mwhen :: Monoid a => Bool -> a -> a
-mwhen True  a = a
-mwhen False _ = mempty
+nameCheck :: String -> a -> a
+nameCheck s = if isName s then id else fail $ "Invalid name " ++ s
 
-munless :: Monoid a => Bool -> a -> a
-munless = mwhen . not
+isName :: String -> Bool
+isName []     = False
+isName (x:xs) = (isLetter x || x `elem` "_:") && all isNameChar xs
 
-escapeAttr :: String -> String
-escapeAttr = concatMap f
+isNameChar :: Char -> Bool
+isNameChar c = any ($ c) [isLetter, isDigit, isCombiningChar, isExtender, (`elem` ".-_:")]
+
+-- local helper: merge attributes, but preserve order
+fromBS :: XMLBuilder -> (Attributes, [Either String XML])
+fromBS (BS as elts) = (attrList, merge (toList elts))
  where
-   f '<' = "&lt;"
-   f '&' = "&amp;"
-   f '"' = "&quot;"
-   f c   = [c]
+   attrMap = foldr add M.empty as
+   add (k := v) = M.insertWith (\x y -> x ++ " " ++ y) k v
+   attrList = nubBy eqKey (map make (toList as))
+   make (k := _) = k := M.findWithDefault "" k attrMap
+   eqKey (k1 := _) (k2 := _) = k1 == k2
 
-fromBuilder :: XMLBuilder -> Maybe Element
+   merge [] = []
+   merge (Left x:Left y:rest)  = merge (Left (x++y):rest)
+   merge (Left x:rest)  = Left x : merge rest
+   merge (Right y:rest) = Right y : merge rest
+
+-------------------------------------------------------------------------------
+-- Pretty-printing XML
+
+prettyXML :: XML -> String
+prettyXML = show . prettyElement False . toElement
+
+compactXML :: XML -> String
+compactXML = show . prettyElement True . toElement
+
+toElement :: XML -> D.Element
+toElement = foldXML make mkAttribute mkString
+ where
+   make n as = D.Element n as . concatMap (either id (return . D.Tagged))
+
+   mkAttribute :: Attribute -> D.Attribute
+   mkAttribute (m := s) = (D.:=) m (map Left s)
+
+   mkString :: String -> [D.XML]
+   mkString [] = []
+   mkString xs@(hd:tl)
+      | null xs1  = D.Reference (D.CharRef (ord hd)) : mkString tl
+      | otherwise = D.CharData xs1 : mkString xs2
+    where
+      (xs1, xs2) = break ((> 127) . ord) xs
+
+-------------------------------------------------------------------------------
+-- Simple decoding queries
+
+findAttribute :: Monad m => String -> XML -> m String
+findAttribute s (Tag _ as _) =
+   case [ t | n := t <- as, s==n ] of
+      [hd] -> return hd
+      _    -> fail $ "Invalid attribute: " ++ show s
+
+children :: XML -> [XML]
+children e = [ c | Right c <- content e ]
+
+findChildren :: String -> XML -> [XML]
+findChildren s = filter ((==s) . name) . children
+
+findChild :: Monad m => String -> XML -> m XML
+findChild s e =
+   case findChildren s e of
+      []  -> fail $ "Child not found: " ++ show s
+      [a] -> return a
+      _   -> fail $ "Multiple children found: " ++ show s
+
+getData :: XML -> String
+getData e = concat [ s | Left s <- content e ]
+
+expecting :: Monad m => String -> XML -> m ()
+expecting s xml =
+   unless (name xml == s) $ fail $ "Expecting element " ++ s ++ ", but found " ++ name xml
+
+-------------------------------------------------------------------------------
+-- Decoding XML
+
+decodeData :: Decoder env XML String
+decodeData = get >>= \xml ->
+   case content xml of
+      Left s:rest -> put xml {content = rest} >> return s
+      _           -> fail "Could not find data"
+
+decodeAttribute :: String -> Decoder env XML String
+decodeAttribute s = get >>= \xml ->
+   case break hasName (attributes xml) of
+      (xs, (_ := val):ys) -> put xml {attributes = xs ++ ys } >> return val
+      _ -> fail $ "Could not find attribute " ++ s
+ where
+   hasName (n := _) = n == s
+
+decodeChild :: Name -> Decoder env XML a -> Decoder env XML a
+decodeChild s p = get >>= \xml ->
+   case break hasName (content xml) of
+      (xs, Right y:ys) -> do
+         put y
+         a <- p
+         put xml { content = xs ++ ys }
+         return a
+      _ -> fail $ "Could not find child " ++ s
+ where
+   hasName = either (const False) ((==s) . name)
+
+decodeFirstChild :: Name -> Decoder env XML a -> Decoder env XML a
+decodeFirstChild s p = get >>= \xml ->
+   case content xml of
+      Right y:ys | name y == s -> do
+         put y
+         a <- p
+         put xml { content = ys }
+         return a
+      _ -> fail $ "Could not find first child " ++ s
+
+-------------------------------------------------------------------------------
+-- Type classes for converting to/from XML
+
+class ToXML a where
+   toXML     :: a -> XML
+   listToXML :: [a] -> XML
+   -- default definitions
+   listToXML = makeXML "list" . mconcat . map builderXML
+
+instance ToXML () where
+   toXML _ = makeXML "Unit" mempty
+
+instance ToXML a => ToXML (Maybe a) where
+  toXML = maybe (makeXML "Nothing" mempty) toXML
+
+builderXML :: (ToXML a, BuildXML b) => a -> b
+builderXML = builder . toXML
+
+class ToXML a => InXML a where
+   fromXML     :: Monad m => XML -> m a
+   listFromXML :: Monad m => XML -> m [a]
+   listFromXML xml
+      | name xml == "list" && null (attributes xml) =
+           mapM fromXML (children xml)
+      | otherwise = fail "expecting a list tag"
+
+-------------------------------------------------------------------------------
+-- Processing XML
+
+foldXML :: (Name -> [a] -> [Either s e] -> e) -> (Attribute -> a) -> (String -> s) -> XML -> e
+foldXML fe fa fs = rec
+ where
+   rec (Tag n as cs) = fe n (map fa as) (map (either (Left . fs) (Right . rec)) cs)
+
+trimXML :: XML -> XML
+trimXML = foldXML make fa (string . trim)
+ where
+   fa (n := s) = n .=. trim s
+
+   make :: String -> [XMLBuilder] -> [Either XMLBuilder XML] -> XML
+   make s as = makeXML s . mconcat . (as ++) . map (either id builder)
+
+trim, trimLeft, trimRight :: String -> String
+trim      = trimLeft . trimRight
+trimLeft  = dropWhile isSpace
+trimRight = reverse . trimLeft . reverse
+
+-------------------------------------------------------------------------------
+-- Deprecated functions
+
+emptyContent :: XML -> Bool
+emptyContent = null . content
+
+fromBuilder :: XMLBuilder -> Maybe XML
 fromBuilder m =
    case fromBS m of
       ([], [Right a]) -> Just a
       _               -> Nothing
 
-escape :: String -> String
-escape = concatMap f
+-------------------------------------------------------------------------------
+-- Tests
+
+_runTests :: IO ()
+_runTests = do
+   forM_ [testDataP, testAttrP, testDataB, testAttrB] $ \f ->
+      pp $ map f tests
+   forM_ [mkPD, mkPA, mkBD, mkBA] $ \f ->
+      pp $ map (testXML . f) tests
  where
-   f '<'  = "&lt;"
-   f '>'  = "&gt;"
-   f '&'  = "&amp;"
-   f '"'  = "&quot;"
-   f '\'' = "&apos;"
-   f '\n' = "&#10;"
-   f c   = [c]
+   pp = putStrLn . map (\b -> if b then '.' else 'X')
 
-trim :: String -> String
-trim = dropWhile isSpace . reverse . dropWhile isSpace . reverse+   tests :: [String]
+   tests =
+      [ "input"
+      , "&lt;&gt;&amp;&quot;&apos;"
+      , "<>&'\""
+      , "p & q' => p"
+      , ""
+      , "   "
+      , "eerste \n\n derde regel"
+      ]
+
+   testDataP, testAttrP, testDataB, testAttrB :: String -> Bool
+   testDataP s = let xml = mkPD s in getData xml == s
+   testAttrP s = let xml = mkPA s in findAttribute "a" xml == Just s
+   testDataB s = let xml = mkBD s in getData xml == s
+   testAttrB s = let xml = mkBA s in findAttribute "a" xml == Just s
+
+   testXML :: XML -> Bool
+   testXML xml =
+      case parseXML (compactXML xml) of
+         Left msg -> error msg
+         Right a  -> a == xml
+
+   mkPD, mkPA, mkBD, mkBA :: String -> XML
+   mkPD s = either error id $ parseXML $ "<a>" ++ escape s ++ "</a>"
+   mkPA s = either error id $ parseXML $ "<t a='" ++ escape s ++ "'/>"
+   mkBD s = makeXML "a" (string s)
+   mkBA s = makeXML "t" ("a".=. s)

@@ -1,5 +1,5 @@ -----------------------------------------------------------------------------
--- Copyright 2018, Ideas project team. This file is distributed under the
+-- Copyright 2019, 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.
 -----------------------------------------------------------------------------
@@ -18,7 +18,7 @@    , ContentSpec(..), CP(..), AttType(..), DefaultDecl(..), AttDef
    , EntityDef, AttValue, EntityValue, ExternalID(..), PublicID
    , Conditional(..), TextDecl, External
-   , prettyXML, prettyElement
+   , prettyXML, prettyElement, escape
    ) where
 
 import Prelude hiding ((<$>))
@@ -124,11 +124,14 @@ prettyXML compact xml =
    case xml of
       Tagged e    -> prettyElement compact e
-      CharData s  -> text s
+      CharData s  -> text (escape s)
       CDATA s     -> text "<![CDATA[" <> text s <> text "]]>"
       Reference r -> pretty r
 
 prettyElement :: Bool -> Element -> Doc
+prettyElement _ (Element n@"script" as [CharData s]) =
+   -- quick fix for not escaping javascript code in html
+   openTag n as <> text s <> closeTag n
 prettyElement compact (Element n as c)
    | null c    = openCloseTag n as
    | compact   = make (<>)
@@ -138,95 +141,6 @@                  ibody = (if compact then id else indent 2) body
              in openTag n as `op` ibody `op` closeTag n
 
-{-
-instance Show XMLDoc where
-   show doc = showXMLDecl doc ++ maybe "" show (dtd doc) ++ show (root doc)
-
-instance Show DTD where
-   show (DTD n mid ds) = "<!DOCTYPE " ++ unwords list ++ ">"
-    where
-      list = n : catMaybes [fmap show mid, showDecls ds]
-      showDecls xs
-         | null xs   = Nothing
-         | otherwise = Just $ "[" ++ concatMap show xs ++ "]"
-
-instance Show ExternalID where
-   show extID =
-      case extID of
-         System s   -> "SYSTEM " ++ doubleQuote s
-         Public p s -> unwords ["PUBLIC", doubleQuote p, doubleQuote s]
-
-instance Show DocTypeDecl where
-   show decl =
-      case decl of
-         ElementDecl n c  -> "<!ELEMENT " ++ n ++ " " ++ show c ++ ">"
-         AttListDecl n as -> "<!ATTLIST " ++ unwords (n:map showAttDef as) ++ ">"
-         EntityDecl b n e ->
-            let xs = ["%" | not b] ++ [n, showEntityDef e]
-            in "<!ENTITY " ++ unwords xs ++ ">"
-         NotationDecl n e ->
-            let f s = "PUBLIC " ++ doubleQuote s
-            in "<!NOTATION " ++ n ++ " " ++ either show f e ++ ">"
-         DTDParameter r   -> show r
-         DTDConditional c -> show c
-
-instance Show ContentSpec where
-   show cspec =
-      case cspec of
-         Empty -> "EMPTY"
-         Any   -> "ANY"
-         Mixed b ns ->
-            let txt = intercalate "|" ("#PCDATA":ns)
-            in parenthesize txt ++ (if b then "*" else "")
-         Children cp -> show cp
-
-instance Show CP where
-   show cp =
-      case cp of
-         Choice xs      -> parenthesize (intercalate "|" (map show xs))
-         Sequence xs    -> parenthesize (intercalate "," (map show xs))
-         QuestionMark c -> show c ++ "?"
-         Star c         -> show c ++ "*"
-         Plus c         -> show c ++ "+"
-         CPName n       -> n
-
-instance Show AttType where
-   show attType =
-      case attType of
-         IdType       -> "ID"
-         IdRefType    -> "IDREF"
-         IdRefsType   -> "IDREFS"
-         EntityType   -> "ENTITY"
-         EntitiesType -> "ENTITIES"
-         NmTokenType  -> "NMTOKEN"
-         NmTokensType -> "NMTOKENS"
-         StringType   -> "CDATA"
-         EnumerationType xs -> parenthesize (intercalate "|" xs)
-         NotationType xs    -> "NOTATION " ++ parenthesize (intercalate "|" xs)
-
-instance Show DefaultDecl where
-   show defaultDecl =
-      case defaultDecl of
-         Required -> "#REQUIRED"
-         Implied  -> "#IMPLIED"
-         Value v  -> showAttValue v
-         Fixed v  -> "#FIXED " ++ showAttValue v
-
-instance Show Conditional where
-   show conditional =
-      case conditional of
-         Include xs -> "<![INCLUDE[" ++ concatMap show xs ++ "]]>"
-         Ignore _ -> "" -- ToDO undefined -- [String]
-
-showXMLDecl :: XMLDoc -> String
-showXMLDecl doc
-   | isJust (versionInfo doc) = "<?xml " ++ unwords (catMaybes [s1,s2,s3]) ++ "?>"
-   | otherwise = ""
- where
-   s1 = fmap (\s -> "version=" ++ doubleQuote s) (versionInfo doc)
-   s2 = fmap (\s -> "encoding=" ++ doubleQuote s) (encoding doc)
-   s3 = fmap (\b -> "standalone=" ++ doubleQuote (if b then "yes" else "no")) (standalone doc)
--}
 openTag :: Name -> Attributes -> Doc
 openTag = prettyTag (char '<') (char '>')
 
@@ -239,26 +153,18 @@ prettyTag :: Doc -> Doc -> Name -> Attributes -> Doc
 prettyTag open close n as = open <> hsep (text n:map pretty as) <> close
 
-prettyAttValue :: AttValue -> Doc -- TODO: no double quotes allowed (should be escaped)
-prettyAttValue = dquotes . hcat . map (either f pretty)
- where
-   f '"' = empty
-   f c   = char c
-{-
-showEntityValue :: EntityValue -> String
-showEntityValue = doubleQuote . concatMap (either f (either show show))
- where
-   f '"' = []
-   f c   = [c]
-
-showAttDef :: AttDef -> String
-showAttDef (s, tp, dd) = unwords [s, show tp, show dd]
+prettyAttValue :: AttValue -> Doc
+prettyAttValue = dquotes . hcat . map (either (text . escapeChar) pretty)
 
-showEntityDef :: EntityDef -> String
-showEntityDef entityDef =
-   case entityDef of
-      Left ev -> showEntityValue ev
-      Right (eid, ms) -> show eid ++ maybe "" (" NDATA "++) ms
+escape :: String -> String
+escape = concatMap escapeChar
 
-parenthesize :: String -> String
-parenthesize s = "(" ++ s ++ ")" -}+escapeChar :: Char -> String
+escapeChar c =
+   case c of
+      '<'  -> "&lt;"
+      '>'  -> "&gt;"
+      '&'  -> "&amp;"
+      '"'  -> "&quot;"
+      '\'' -> "&apos;"
+      _    -> [c]

@@ -1,137 +0,0 @@------------------------------------------------------------------------------
--- Copyright 2018, 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)
---
--- Collection of common operation on XML documents
---
------------------------------------------------------------------------------
-
-module Ideas.Text.XML.Interface
-   ( Element(..), Content, Attribute(..), Attributes
-   , normalize, parseXML, compactXML
-   , children, findAttribute, findChildren, findChild, getData
-   ) where
-
-import Control.Arrow
-import Data.Char (chr, ord)
-import Data.Maybe
-import Ideas.Text.XML.Document (Name, prettyElement)
-import Ideas.Text.XML.Parser (document)
-import Ideas.Text.XML.Unicode (decoding)
-import Ideas.Utils.Parsing (parseSimple)
-import qualified Ideas.Text.XML.Document as D
-
-data Element = Element
-   { name       :: Name
-   , attributes :: Attributes
-   , content    :: Content
-   }
-
-instance Show Element where
-   show = show . extend
-
-compactXML :: Element -> String
-compactXML = show . prettyElement True . extend
-
-type Content = [Either String Element]
-
-type Attributes = [Attribute]
-data Attribute = Name := String
-
-normalize :: D.XMLDoc -> Element
-normalize doc = toElement (D.root doc)
- where
-   toElement :: D.Element -> Element
-   toElement (D.Element n as c) =
-      Element n (map toAttribute as) (toContent c)
-
-   toAttribute :: D.Attribute -> Attribute
-   toAttribute (n D.:= v) =
-      n := concatMap (either return refToString) v
-
-   toContent :: D.Content -> Content
-   toContent = merge . concatMap f
-    where
-      f :: D.XML -> Content
-      f (D.Tagged e)    = [Right (toElement e)]
-      f (D.CharData s)  = [Left s]
-      f (D.CDATA s)     = [Left s]
-      f (D.Reference r) = refToContent r
-
-   refToString :: D.Reference -> String
-   refToString (D.CharRef i)   = [chr i]
-   refToString (D.EntityRef s) = maybe "" return (lookup s general)
-
-   refToContent :: D.Reference -> Content
-   refToContent (D.CharRef i)   = [Left [chr i]]
-   refToContent (D.EntityRef s) = fromMaybe [] (lookup s entities)
-
-   entities :: [(String, Content)]
-   entities =
-      [ (n, toContent (snd ext)) | (n, ext) <- D.externals doc ] ++
-      -- predefined entities
-      map (second (return . Left . return)) general
-
-   general :: [(String, Char)]
-   general = [("lt",'<'), ("gt",'>'), ("amp",'&'), ("apos",'\''), ("quot",'"')]
-
-   merge :: Content -> Content
-   merge (Left s:Left t:rest) = merge (Left (s++t) : rest)
-   merge (x:xs) = x:merge xs
-   merge []     = []
-
-extend :: Element -> D.Element
-extend (Element n as c) =
-   D.Element n (map toAttribute as) (concatMap toXML c)
- where
-   toAttribute :: Attribute -> D.Attribute
-   toAttribute (m := s) = (D.:=) m (map Left s)
-
-   toXML :: Either String Element -> [D.XML]
-   toXML = either fromString (return . D.Tagged . extend)
-
-   fromString :: String -> [D.XML]
-   fromString [] = []
-   fromString xs@(hd:tl)
-      | null xs1  = D.Reference (D.CharRef (ord hd)) : fromString tl
-      | otherwise = D.CharData xs1 : fromString xs2
-    where
-      (xs1, xs2) = break ((> 127) . ord) xs
-
------------------------------------------------------
-
-parseXML :: String -> Either String Element
-parseXML xs = do
-   input <- decoding xs
-   doc   <- parseSimple document input
-   return (normalize doc)
-
------------------------------------------------------
-
-findAttribute :: Monad m => String -> Element -> m String
-findAttribute s (Element _ as _) =
-   case [ t | n := t <- as, s==n ] of
-      [hd] -> return hd
-      _    -> fail $ "Invalid attribute: " ++ show s
-
-findChildren :: String -> Element -> [Element]
-findChildren s = filter ((==s) . name) . children
-
-findChild :: Monad m => String -> Element -> m Element
-findChild s e =
-   case findChildren s e of
-      []  -> fail $ "Child not found: " ++ show s
-      [a] -> return a
-      _   -> fail $ "Multiple children found: " ++ show s
-
-children :: Element -> [Element]
-children e = [ c | Right c <- content e ]
-
-getData :: Element -> String
-getData e = concat [ s | Left s <- content e ]

@@ -1,6 +1,5 @@-{-# LANGUAGE FlexibleContexts #-}
 -----------------------------------------------------------------------------
--- Copyright 2018, Ideas project team. This file is distributed under the
+-- Copyright 2019, 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.
 -----------------------------------------------------------------------------
@@ -18,8 +17,8 @@ module Ideas.Text.XML.Parser (document, extParsedEnt, extSubset) where
 
 import Control.Monad
-import Data.Char (toUpper, ord, isSpace)
-import Data.List (foldl') -- '
+import Data.Char (toUpper, ord)
+import Data.List (foldl')
 import Data.Maybe (catMaybes)
 import Ideas.Text.XML.Document hiding (versionInfo, name, content)
 import Ideas.Text.XML.Unicode
@@ -132,7 +131,9 @@ -- [11]   	SystemLiteral	   ::=   	('"' [^"]* '"') | ("'" [^']* "'")
 systemLiteral :: Parser String
 systemLiteral = doubleQuoted (p "\"") <|> singleQuoted (p "'")
- where p s = many (noneOf s)
+ where
+   p :: String -> Parser String
+   p s = many (noneOf s)
 
 -- [12]   	PubidLiteral	   ::=   	'"' PubidChar* '"' | "'" (PubidChar - "'")* "'"
 pubidLiteral :: Parser String
@@ -349,7 +350,7 @@ content = chainr1 (fmap g charData) (fmap f ps)
  where
    f ma l r = l ++ maybe [] return ma ++ r
-   g s = [ CharData s | any (not . isSpace) s ]  -- quick fix, ignores layout
+   g s = [ CharData s | not (null s) ]
    ps  = try (fmap Just (choice (map try [fmap Tagged element, fmap Reference reference, cdSect]))
       <|> ((try pInstr <|> comment) >> return Nothing))
 

@@ -1,5 +1,5 @@ -----------------------------------------------------------------------------
--- Copyright 2018, Ideas project team. This file is distributed under the
+-- Copyright 2019, 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.
 -----------------------------------------------------------------------------

@@ -1,5 +1,5 @@ -----------------------------------------------------------------------------
--- Copyright 2018, Ideas project team. This file is distributed under the
+-- Copyright 2019, 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.
 -----------------------------------------------------------------------------

@@ -0,0 +1,91 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+-----------------------------------------------------------------------------
+-- Copyright 2019, 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)
+--
+-- Extensions to the QuickCheck library
+--
+-----------------------------------------------------------------------------
+
+module Ideas.Utils.Decoding
+   ( Decoder, runDecoder, symbol
+   , Encoder, runEncoder
+   , Error, runError, runErrorM
+   ) where
+
+import Control.Applicative
+import Control.Monad
+import Control.Monad.Reader
+import Control.Monad.State
+import Data.Semigroup as Sem
+
+-------------------------------------------------------------------
+
+newtype Decoder env s a = Dec { runDec :: StateT s (ReaderT env Error) a }
+ deriving (Functor, Applicative, Alternative, Monad, MonadPlus, MonadReader env, MonadState s)
+
+instance Sem.Semigroup a => Sem.Semigroup (Decoder env s a) where
+   (<>) = liftA2 (<>)
+
+instance Monoid a => Monoid (Decoder env s a) where
+   mempty  = pure mempty
+   mappend = liftA2 mappend
+
+symbol :: Decoder env [s] s
+symbol = get >>= \list ->
+   case list of
+      []   -> fail "Empty input"
+      x:xs ->
+         put xs >> return x
+
+runDecoder :: Monad m => Decoder env s a -> env -> s -> m a
+runDecoder p env s = runErrorM (runReaderT (evalStateT (runDec p) s) env)
+
+-------------------------------------------------------------------
+
+type Encoder env = Decoder env ()
+
+runEncoder :: Monad m => Encoder env a -> env -> m a
+runEncoder p env = runDecoder p env ()
+
+-------------------------------------------------------------------
+-- Error monad (helper)
+
+newtype Error a = Error { runError :: Either String a }
+
+instance Functor Error where
+   fmap f = Error . fmap f . runError
+
+instance Applicative Error where
+   pure    = Error . Right
+   p <*> q = Error $
+      case (runError p, runError q) of
+         (Left s, _)  -> Left s
+         (_, Left s)  -> Left s
+         (Right f, Right x) -> Right (f x)
+
+instance Alternative Error where
+   empty   = Error (Left "empty")
+   p <|> q = Error $
+      case (runError p, runError q) of
+         (Right a, _) -> Right a
+         (_, Right a) -> Right a
+         (Left s, _)  -> Left s
+
+instance Monad Error where
+   fail    = Error . Left
+   return  = pure
+   m >>= f = Error $ either Left (runError . f) (runError m)
+
+instance MonadPlus Error where
+   mzero = fail "mzero"
+   mplus = (<|>)
+
+runErrorM :: Monad m => Error a -> m a
+runErrorM = either fail return . runError

@@ -1,5 +1,5 @@ -----------------------------------------------------------------------------
--- Copyright 2018, Ideas project team. This file is distributed under the
+-- Copyright 2019, 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.
 -----------------------------------------------------------------------------

@@ -1,6 +1,6 @@ {-# LANGUAGE ExistentialQuantification #-}
 -----------------------------------------------------------------------------
--- Copyright 2018, Ideas project team. This file is distributed under the
+-- Copyright 2019, 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.
 -----------------------------------------------------------------------------
@@ -19,15 +19,17 @@    , cartesian, distinct, allsame
    , fixpoint
    , splitAtElem, splitsWithElem
-   , timedSeconds
+   , timedSeconds, getDiffTime
    , fst3, snd3, thd3
    , headM, findIndexM
    , elementAt, changeAt, replaceAt
    , list
+   , mwhen, munless
    ) where
 
 import Data.Char
 import Data.List
+import Data.Time
 import System.Timeout
 
 data Some f = forall a . Some (f a)
@@ -94,6 +96,13 @@ timedSeconds n m = timeout (n * 10^(6 :: Int)) m >>=
    maybe (fail ("Timeout after " ++ show n ++ " seconds")) return
 
+getDiffTime :: IO a -> IO (a, NominalDiffTime)
+getDiffTime action = do
+   t0 <- getCurrentTime
+   a  <- action
+   t1 <- getCurrentTime
+   return (a, diffUTCTime t1 t0)
+
 fst3 :: (a, b, c) -> a
 fst3 (x, _, _) = x
 
@@ -124,4 +133,13 @@ replaceAt i = changeAt i . const
 
 list :: b -> ([a] -> b) -> [a] -> b
-list b f xs = if null xs then b else f xs+list b f xs = if null xs then b else f xs
+
+-- Monoids
+
+mwhen :: Monoid a => Bool -> a -> a
+mwhen True  a = a
+mwhen False _ = mempty
+
+munless :: Monoid a => Bool -> a -> a
+munless = mwhen . not

@@ -1,5 +1,5 @@ -----------------------------------------------------------------------------
--- Copyright 2018, Ideas project team. This file is distributed under the
+-- Copyright 2019, 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.
 -----------------------------------------------------------------------------
@@ -25,9 +25,8 @@ 
 import Control.Arrow
 import Control.Monad
-import Data.Monoid hiding ((<>))
-import Data.Semigroup as Sem
 import Data.Ratio
+import Data.Semigroup as Sem
 import Test.QuickCheck
 
 ---------------------------------------------------------
@@ -63,7 +62,7 @@ -- Constructors
 
 arbGen :: Arbitrary b => (b -> a) -> ArbGen a
-arbGen f = newGen 0 ((const . f) <$> arbitrary)
+arbGen f = newGen 0 (const . f <$> arbitrary)
 
 constGen :: a -> ArbGen a
 constGen = pureGen 0 . const

@@ -1,5 +1,5 @@ -----------------------------------------------------------------------------
--- Copyright 2018, Ideas project team. This file is distributed under the
+-- Copyright 2019, 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.
 -----------------------------------------------------------------------------

@@ -1,5 +1,5 @@ -----------------------------------------------------------------------------
--- Copyright 2018, Ideas project team. This file is distributed under the
+-- Copyright 2019, 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.
 -----------------------------------------------------------------------------
@@ -18,8 +18,6 @@ module Ideas.Utils.TestSuite
    ( -- * TestSuite
      TestSuite
-   , module Data.Monoid
-   , (<>)
    , suite, useProperty, usePropertyWith
    , assertTrue, assertNull, assertEquals, assertIO
    , assertMessage, assertMessageIO
@@ -46,9 +44,9 @@ import Data.IORef
 import Data.List
 import Data.Maybe
-import Data.Monoid hiding ((<>))
 import Data.Semigroup as Sem
 import Data.Time
+import Ideas.Utils.Prelude (getDiffTime)
 import System.IO
 import Test.QuickCheck hiding (Result)
 import qualified Data.Sequence as S
@@ -62,7 +60,7 @@           | Suite String TestSuite
 
 instance Sem.Semigroup TestSuite where
-   TS xs <> TS ys = TS (xs <> ys)
+   TS xs <> TS ys = TS (xs S.>< ys)
 
 instance Monoid TestSuite where
    mempty  = TS mempty
@@ -251,8 +249,8 @@ 
 instance Sem.Semigroup Result where
    x <> y = Result
-      { suites       = suites x <> suites y
-      , cases        = cases x  <> cases y
+      { suites       = suites x S.>< suites y
+      , cases        = cases x  S.>< cases y
       , diffTime     = diffTime x     + diffTime y
       , nrOfTests    = nrOfTests x    + nrOfTests y
       , nrOfWarnings = nrOfWarnings x + nrOfWarnings y
@@ -426,13 +424,6 @@ 
 -----------------------------------------------------
 -- Utility function
-
-getDiffTime :: IO a -> IO (a, NominalDiffTime)
-getDiffTime action = do
-   t0 <- getCurrentTime
-   a  <- action
-   t1 <- getCurrentTime
-   return (a, diffUTCTime t1 t0)
 
 returnStrict :: Monad m => a -> m a
 returnStrict a = a `seq` return a

@@ -2,7 +2,7 @@ {-# LANGUAGE TypeOperators #-}
 {-# LANGUAGE TypeFamilies #-}
 -----------------------------------------------------------------------------
--- Copyright 2018, Ideas project team. This file is distributed under the
+-- Copyright 2019, 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.
 -----------------------------------------------------------------------------