ideas 1.6 → 1.7

raw patch · 105 files changed

+1925/−446 lines, 105 filesdep +blaze-builderdep +bytestringdep +case-insensitivedep −cgidep ~QuickCheckPVP ok

version bump matches the API change (PVP)

Dependencies added: blaze-builder, bytestring, case-insensitive, http-types, network, semigroups, streaming-commons, wai

Dependencies removed: cgi

Dependency ranges changed: QuickCheck

API changes (from Hackage documentation)

Files

• CHANGELOG.txt +19/−0
• NOTICE.txt +2/−2
• ideas.cabal +36/−23
• src/Ideas/Common/Classes.hs +1/−1
• src/Ideas/Common/Constraint.hs +113/−0
• src/Ideas/Common/Context.hs +3/−3
• src/Ideas/Common/Derivation.hs +1/−1
• src/Ideas/Common/DerivationTree.hs +1/−1
• src/Ideas/Common/Environment.hs +8/−3
• src/Ideas/Common/Exercise.hs +15/−2
• src/Ideas/Common/ExerciseTests.hs +1/−1
• src/Ideas/Common/Id.hs +8/−3
• src/Ideas/Common/Library.hs +2/−1
• src/Ideas/Common/Predicate.hs +1/−1
• src/Ideas/Common/Rewriting.hs +1/−1
• src/Ideas/Common/Rewriting/AC.hs +1/−1
• src/Ideas/Common/Rewriting/Confluence.hs +25/−20
• src/Ideas/Common/Rewriting/Difference.hs +27/−56
• src/Ideas/Common/Rewriting/RewriteRule.hs +32/−1
• src/Ideas/Common/Rewriting/Substitution.hs +7/−2
• src/Ideas/Common/Rewriting/Term.hs +3/−3
• 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 +8/−3
• src/Ideas/Common/Rule/Transformation.hs +7/−2
• src/Ideas/Common/Strategy.hs +3/−2
• src/Ideas/Common/Strategy/Abstract.hs +1/−1
• src/Ideas/Common/Strategy/Choice.hs +1/−1
• src/Ideas/Common/Strategy/Combinators.hs +9/−1
• src/Ideas/Common/Strategy/Configuration.hs +7/−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 +8/−3
• 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 +9/−4
• src/Ideas/Common/Traversal/Iterator.hs +1/−1
• src/Ideas/Common/Traversal/Navigator.hs +8/−3
• src/Ideas/Common/Traversal/Tests.hs +2/−1
• src/Ideas/Common/Traversal/Utils.hs +1/−1
• src/Ideas/Common/View.hs +1/−1
• src/Ideas/Encoding/DecoderJSON.hs +1/−1
• src/Ideas/Encoding/DecoderXML.hs +39/−2
• src/Ideas/Encoding/Encoder.hs +7/−3
• src/Ideas/Encoding/EncoderHTML.hs +122/−102
• src/Ideas/Encoding/EncoderJSON.hs +1/−1
• src/Ideas/Encoding/EncoderXML.hs +2/−2
• src/Ideas/Encoding/Evaluator.hs +1/−1
• src/Ideas/Encoding/LinkManager.hs +4/−1
• src/Ideas/Encoding/Logging.hs +11/−8
• src/Ideas/Encoding/ModeJSON.hs +2/−1
• src/Ideas/Encoding/ModeXML.hs +8/−4
• src/Ideas/Encoding/OpenMathSupport.hs +1/−1
• src/Ideas/Encoding/Options.hs +9/−5
• src/Ideas/Encoding/Request.hs +11/−6
• src/Ideas/Encoding/RulePresenter.hs +1/−1
• src/Ideas/Encoding/RulesInfo.hs +4/−2
• src/Ideas/Encoding/StrategyInfo.hs +1/−1
• src/Ideas/Main/CGI.hs +167/−0
• src/Ideas/Main/CmdLineOptions.hs +2/−2
• src/Ideas/Main/Default.hs +64/−35
• src/Ideas/Main/Revision.hs +11/−11
• src/Ideas/Service/BasicServices.hs +1/−1
• src/Ideas/Service/Diagnose.hs +3/−12
• src/Ideas/Service/DomainReasoner.hs +9/−5
• src/Ideas/Service/FeedbackScript/Analysis.hs +1/−1
• src/Ideas/Service/FeedbackScript/Parser.hs +3/−2
• src/Ideas/Service/FeedbackScript/Run.hs +1/−1
• src/Ideas/Service/FeedbackScript/Syntax.hs +12/−4
• src/Ideas/Service/FeedbackText.hs +1/−1
• src/Ideas/Service/ProblemDecomposition.hs +1/−1
• src/Ideas/Service/ServiceList.hs +7/−2
• src/Ideas/Service/State.hs +1/−1
• src/Ideas/Service/Submit.hs +1/−1
• src/Ideas/Service/Types.hs +20/−4
• src/Ideas/Text/HTML.hs +12/−4
• src/Ideas/Text/HTML/Templates.hs +135/−0
• src/Ideas/Text/HTML/W3CSS.hs +633/−0
• src/Ideas/Text/JSON.hs +5/−8
• src/Ideas/Text/Latex.hs +8/−4
• src/Ideas/Text/MathML.hs +136/−0
• src/Ideas/Text/OpenMath/FMP.hs +1/−1
• src/Ideas/Text/OpenMath/Object.hs +1/−1
• 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 +28/−10
• src/Ideas/Text/XML/Document.hs +1/−1
• src/Ideas/Text/XML/Interface.hs +1/−1
• src/Ideas/Text/XML/Parser.hs +1/−1
• src/Ideas/Text/XML/Unicode.hs +1/−1
• src/Ideas/Utils/BlackBoxTests.hs +1/−1
• src/Ideas/Utils/Parsing.hs +1/−1
• src/Ideas/Utils/Prelude.hs +1/−1
• src/Ideas/Utils/QuickCheck.hs +8/−3
• src/Ideas/Utils/StringRef.hs +1/−1
• src/Ideas/Utils/TestSuite.hs +30/−12
• src/Ideas/Utils/Typeable.hs +1/−1
• src/Ideas/Utils/Uniplate.hs +1/−1

@@ -1,3 +1,22 @@+Changelog ideas-1.6 => ideas.1.7++* replacing network.cgi package by WAI+* adding support for MathML+* adding constraints (to exercises) for constraint-based tutoring+* adding support for W3CSS (css classes and templates)+* restyling html output+* set busy timeout on database connection (when logging requests)+* changing name of logging database for v2 schema, and make v2 the default+* logging is now by default enabled: see 'logging' flag in cabal package+* improving performance of rulesinfo service+* merging duplicate attributes in xml/html+* simplifying the computation of the difference between terms+* extending xml-encoder with cases for lists, attributes and content data+* adding missing strategy combinators preference and orelse+* adding instances for type class Different+* improving Show instance for Context+* show logging enabled/disabled in html output+ Changelog ideas-1.5 => ideas.1.6  * dynamic strategy combinator that uses the current object/term

@@ -1,4 +1,4 @@-Copyright 2016 Ideas project team+Copyright 2018 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.@@ -35,4 +35,4 @@ CREDITS     Harrie Passier, Arthur van Leeuwen, Josje Lodder, Hieke Keuning, -   Marcell van Geest, Jordy van Dortmont+   Marcell van Geest, Jordy van Dortmont, Jorn van Wijk

@@ -1,25 +1,25 @@ name:                   ideas-version:                1.6+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 +  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) 2016+copyright:              (c) 2018 license:                Apache-2.0 license-file:           LICENSE.txt author:                 Bastiaan Heeren, Alex Gerdes, Johan Jeuring@@ -28,7 +28,7 @@ extra-source-files:     NOTICE.txt, CHANGELOG.txt build-type:             Simple cabal-version:          >= 1.8.0.2-tested-with:            GHC == 7.10.3+tested-with:            GHC == 7.10.3, GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.2  source-repository head   type:     git@@ -36,7 +36,7 @@  flag logging   description: enable support for logging interactions to a sqlite3 database-  default: False+  default: True  -------------------------------------------------------------------------------- @@ -48,22 +48,32 @@    ghc-options:       -Wall   hs-source-dirs:    src-  Build-Depends:     +  Build-Depends:      base >= 4.8 && < 5,-     cgi >= 3001.3.0.0,+     blaze-builder >= 0.4,+     bytestring,+     case-insensitive,      QuickCheck >= 2.8,      Diff,      containers,-     directory, -     filepath, -     parsec, +     directory,+     filepath,+     http-types,+     network,+     parsec,      random,-     time, +     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@@ -123,6 +133,7 @@     Ideas.Encoding.RulePresenter     Ideas.Encoding.RulesInfo     Ideas.Encoding.StrategyInfo+    Ideas.Main.CGI     Ideas.Main.CmdLineOptions     Ideas.Main.Default     Ideas.Main.Revision@@ -140,8 +151,11 @@     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@@ -172,4 +186,3 @@     Ideas.Utils.Uniplate  ---------------------------------------------------------------------------------

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

@@ -0,0 +1,113 @@+-----------------------------------------------------------------------------
+-- 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)
+--
+-- Constraints for constraint-based tutors
+--
+-----------------------------------------------------------------------------
+
+module Ideas.Common.Constraint
+  ( Constraint, makeConstraint
+  , isRelevant, isSatisfied, isViolated, getResult
+  , Result(..), relevance
+  ) where
+
+import Control.Applicative
+import Control.Monad
+import Ideas.Common.Id
+import Ideas.Common.View
+
+---------------------------------------------------------------------------
+-- Constraint
+
+data Constraint a = C
+  { constraintId :: Id
+  , getResult    :: a -> Result ()
+  }
+
+instance Show (Constraint a) where
+  show = showId
+
+instance Eq (Constraint a) where
+  r1 == r2 = constraintId r1 == constraintId r2
+
+instance Ord (Constraint a) where
+  compare = compareId
+
+instance HasId (Constraint a) where
+  getId        = constraintId
+  changeId f r = r { constraintId = f (constraintId r) }
+
+instance LiftView Constraint where
+   liftViewIn v (C n f) = C n (maybe Irrelevant (f . fst) . match v)
+
+makeConstraint :: IsId n => n -> (a -> Result ()) -> Constraint a
+makeConstraint = C . newId
+
+--  | Relevance condition
+isRelevant :: Constraint a -> a -> Bool
+isRelevant p a =
+   case getResult p a of
+      Irrelevant -> False
+      _          -> True
+
+-- | Satisfaction condition
+isSatisfied :: Constraint a -> a -> Bool
+isSatisfied p a =
+   case getResult p a of
+      Ok _ -> True
+      _    -> False
+
+-- | Satisfaction condition
+isViolated :: Constraint a -> a -> Maybe String
+isViolated p a =
+   case getResult p a of
+      Error s -> Just s
+      _       -> Nothing
+
+---------------------------------------------------------------------------
+-- Result
+
+data Result a = Irrelevant | Error String | Ok a
+
+instance Functor Result where
+   fmap _ Irrelevant  = Irrelevant
+   fmap _ (Error msg) = Error msg
+   fmap f (Ok a)      = Ok (f a)
+
+instance Applicative Result where
+   pure = Ok
+   Irrelevant <*> _          = Irrelevant
+   Error msg  <*> _          = Error msg
+   Ok _       <*> Irrelevant = Irrelevant
+   Ok _       <*> Error msg  = Error msg
+   Ok f       <*> Ok a       = Ok (f a)
+
+instance Alternative Result where
+   empty = Error ""
+   Irrelevant <|> r       = r
+   Error msg  <|> Error _ = Error msg -- left-biased
+   Error _    <|> r       = r
+   Ok a       <|> _       = Ok a
+
+instance Monad Result where
+   return = Ok
+   fail   = Error
+   Irrelevant >>= _ = Irrelevant
+   Error msg  >>= _ = Error msg
+   Ok a       >>= f = f a
+
+instance MonadPlus Result where
+   mzero = empty
+   mplus = (<|>)
+
+-- | Turn errors into irrelevant results
+relevance :: Result a -> Result a
+relevance (Error _) = Irrelevant
+relevance r = r

@@ -1,6 +1,6 @@ {-# LANGUAGE GADTs, RankNTypes #-}
 -----------------------------------------------------------------------------
--- Copyright 2016, Ideas project team. This file is distributed under the
+-- 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.
 -----------------------------------------------------------------------------
@@ -41,7 +41,7 @@ ----------------------------------------------------------
 -- Abstract data type
 
--- | Abstract data type for a context: a context stores an envrionent.
+-- | Abstract data type for a context: a context stores an environment.
 data Context a = C
    { getEnvironment :: Environment
    , getNavigator   :: ContextNavigator a
@@ -64,7 +64,7 @@    show c@(C env a) =
       let rest | noBindings env = ""
                | otherwise      = "  {" ++ show env ++ "}"
-      in maybe "??" show (currentNavigator a) ++
+      in maybe (maybe "??" show (currentT a)) show (currentNavigator a) ++
          " @ " ++ show (location c) ++ rest
 
 instance Navigator (Context a) where

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

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

@@ -1,6 +1,6 @@ {-# LANGUAGE ExistentialQuantification #-}
 -----------------------------------------------------------------------------
--- Copyright 2016, Ideas project team. This file is distributed under the
+-- 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.
 -----------------------------------------------------------------------------
@@ -28,6 +28,8 @@ 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
 import Ideas.Common.View
@@ -127,9 +129,12 @@ instance Show Environment where
    show = intercalate ", " . map show . bindings
 
+instance Sem.Semigroup Environment where
+   a <> b = Env (envMap a `mappend` envMap b) -- left has presedence
+
 instance Monoid Environment where
-   mempty = Env mempty
-   mappend a b = Env (envMap a `mappend` envMap b) -- left has presedence
+   mempty  = Env mempty
+   mappend = (<>)
 
 instance HasRefs Environment where
    allRefs env = [ Some ref | Binding ref _ <- bindings env ]

@@ -1,6 +1,6 @@ {-# LANGUAGE Rank2Types, ExistentialQuantification #-}
 -----------------------------------------------------------------------------
--- Copyright 2016, Ideas project team. This file is distributed under the
+-- 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.
 -----------------------------------------------------------------------------
@@ -21,7 +21,7 @@      Exercise(..), emptyExercise, makeExercise
      -- * Convenience functions
    , prettyPrinterContext, isReady, isSuitable
-   , ruleset, getRule, ruleOrderingWith
+   , ruleset, getRule, ruleOrderingWith, violations
      -- * Status
    , Status(..), isPublic, isPrivate
      -- * Examples
@@ -45,6 +45,7 @@ import Data.Maybe
 import Data.Ord
 import Ideas.Common.Classes
+import Ideas.Common.Constraint
 import Ideas.Common.Context
 import Ideas.Common.Derivation
 import Ideas.Common.Environment
@@ -110,6 +111,9 @@      -- rule can be used (e.g. feedback services onefirst and derivation; other
      -- feedback services return all possible rules).
    , ruleOrdering :: Rule (Context a) -> Rule (Context a) -> Ordering
+     -- | Constraints for constraint-based tutors. A constraint contains a
+     -- relevance condition and a satisfaction condition.
+   , constraints  :: [Constraint (Context a)]
      -- | A navigator is needed for traversing the expression and for using the
      -- traversal strategy combinators. By default, an exercise has no
      -- navigator.
@@ -164,6 +168,7 @@    , properties     = M.empty
      -- strategies and rules
    , strategy       = label "Fail" S.fail
+   , constraints    = []
    , navigation     = noNavigator
    , canBeRestarted = True
    , extraRules     = []
@@ -225,6 +230,14 @@       (Just _,  Nothing) -> LT
       (Nothing, Just _ ) -> GT
       (Nothing, Nothing) -> compareId r1 r2
+
+-- | Get all constraint violations
+violations :: Exercise a -> Context a -> [(Id, String)]
+violations ex ctx =
+   [ (getId c, msg)
+   | c <- constraints ex
+   , msg <- maybeToList (isViolated c ctx)
+   ]
 
 -----------------------------------------------------------------------------
 -- Status

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

@@ -1,5 +1,5 @@ -----------------------------------------------------------------------------
--- Copyright 2016, Ideas project team. This file is distributed under the
+-- 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.
 -----------------------------------------------------------------------------
@@ -40,13 +40,15 @@    , Identify(..)
      -- re-export
    , module Data.Monoid
+   , (<>)
    ) where
 
 import Control.Monad
 import Data.Char
 import Data.List
-import Data.Monoid
+import Data.Monoid hiding ((<>))
 import Data.Ord
+import Data.Semigroup as Sem
 import Ideas.Common.Classes
 import Ideas.Utils.Prelude (splitsWithElem)
 import Ideas.Utils.StringRef
@@ -76,9 +78,12 @@ instance Ord Id where
    compare = comparing idRef
 
+instance Sem.Semigroup Id where
+   (<>) = ( # )
+
 instance Monoid Id where
    mempty  = emptyId
-   mappend = ( # )
+   mappend = (<>)
 
 instance Arbitrary Id where
    arbitrary = frequency

@@ -1,5 +1,5 @@ -----------------------------------------------------------------------------
--- Copyright 2016, Ideas project team. This file is distributed under the
+-- 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.
 -----------------------------------------------------------------------------
@@ -19,6 +19,7 @@    ) where
 
 import Ideas.Common.Classes as Export
+import Ideas.Common.Constraint as Export hiding (Result(..))
 import Ideas.Common.Context as Export
 import Ideas.Common.Derivation as Export
 import Ideas.Common.Environment as Export

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

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

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

@@ -1,5 +1,5 @@ -----------------------------------------------------------------------------
--- Copyright 2016, Ideas project team. This file is distributed under the
+-- 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.
 -----------------------------------------------------------------------------
@@ -16,6 +16,7 @@    , Config, defaultConfig, showTerm, complexity, termEquality
    ) where
 
+import Data.List
 import Data.Maybe
 import Ideas.Common.Id
 import Ideas.Common.Rewriting.RewriteRule
@@ -78,7 +79,7 @@ 
 criticalPairs :: [RewriteRule a] -> [(Term, Pair a, Pair a)]
 criticalPairs rs =
-   [ (a, (r1, b1), (r2, b2))
+   [ (renumber a, (r1, renumber b1), (r2, renumber b2))
    | r1       <- rs
    , r2       <- rs
    , na <- superImpose r1 r2
@@ -86,6 +87,10 @@    , let a = unfocus na
    , b1 <- rewriteTerm r1 a
    , b2 <- map unfocus (changeG (rewriteTerm r2) na)
+   , let is  = nub (concatMap metaVars [a, b1, b2])
+         sub = zip is [0..]
+         renumber (TMeta i) = TMeta (fromMaybe i (lookup i sub))
+         renumber t = descend renumber t
    ]
 
 noDiamondPairs :: Config -> [RewriteRule a] -> [(Term, Triple a, Triple a)]
@@ -133,25 +138,25 @@ 
 ----------------------------------------------------
 -- Example
-{-
-r1, r2, r3, r4, r5 :: RewriteRule SLogic
-r1 = rewriteRule "R1" $ \p q r -> p :||: (q :||: r) :~> (p :||: q) :||: r
-r2 = rewriteRule "R2" $ \p q   -> p :||: q :~> q :||: p
-r3 = rewriteRule "R3" $ \p     -> p :||: p :~> p
-r4 = rewriteRule "R4" $ \p     -> p :||: T :~> T
-r5 = rewriteRule "R5" $ \p     -> p :||: F :~> p
 
-this = [r1, r2, r3, r4, r5, r6]
-go = reportPairs $ noDiamondPairs this
+_go :: IO ()
+_go = checkConfluence [r1, r2, r3]
+ where
+   r1, r2, r3 :: RewriteRule Term
+   r1 = makeRewriteRule "a1" $ \a -> plus (TNum 0) a :~> a
+   r2 = makeRewriteRule "a2" $ \a b c -> plus a (plus b c) :~> plus (plus a b) c
+   r3 = makeRewriteRule "a3" $ \a -> plus a (TNum 0) :~> a
 
-r6 :: RewriteRule SLogic
-r6 = rewriteRule "R6" $ \p -> p :||: T :~> F
+   plus :: Term -> Term -> Term
+   plus x y = TCon (newSymbol "plus") [x, y]
 
-r1, r2, r3 :: RewriteRule Expr
-r1 = rewriteRule "a1" $ \a -> 0+a :~> a
-r2 = rewriteRule "a3" $ \a b c -> a+(b+c) :~> (a+b)+c
-r3 = rewriteRule "a2" $ \a -> a+0 :~> a
+_go2 :: IO ()
+_go2 = checkConfluence [r1,r2,r3]
+ where
+   -- example 7.7 in Baader-Nipkow
+   r1, r2,r3  :: RewriteRule Term
+   r1 = makeRewriteRule "a1" $ \x y z -> f(f(x,y),z) :~> f(x,f(y,z))
+   r2 = makeRewriteRule "a2" $ \x -> f(x,x) :~> x
+   r3 = makeRewriteRule "a3" $ \x y -> f(f(x,y),x) :~> x
 
-go = do -- putStrLn $ unlines $ map show $ criticalPairs [r1,r2]
-        checkConfluence [r1,r2,r3]
--}+   f(x,y) = TCon (newSymbol "f") [x,y]

@@ -1,5 +1,5 @@ -----------------------------------------------------------------------------
--- Copyright 2016, Ideas project team. This file is distributed under the
+-- 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.
 -----------------------------------------------------------------------------
@@ -13,10 +13,7 @@ --
 -----------------------------------------------------------------------------
 
-module Ideas.Common.Rewriting.Difference
-   ( difference, differenceEqual
-   , differenceWith, differenceEqualWith
-   ) where
+module Ideas.Common.Rewriting.Difference (difference, differenceWith) where
 
 import Control.Monad
 import Data.Function
@@ -24,64 +21,38 @@ import Ideas.Common.Rewriting.Term
 import Ideas.Common.View
 
-differenceWith :: View Term a -> a -> a -> Maybe (a, a)
-differenceWith = diff (\_ _ -> True)
-
-differenceEqualWith :: View Term a -> (a -> a -> Bool) -> a -> a -> Maybe (a, a)
-differenceEqualWith v eq p q = guard (eq p q) >> diff eq v p q
-
 difference :: IsTerm a => a -> a -> Maybe (a, a)
-difference = diff (\_ _ -> True) termView
-
--- | This function returns the difference, except that the
--- returned terms should be logically equivalent. Nothing can signal that
--- there is no difference, or that the terms to start with are not equivalent.
-differenceEqual :: IsTerm a => (a -> a -> Bool) -> a -> a -> Maybe (a, a)
-differenceEqual eq p q = do
-   guard (eq p q)
-   diff eq termView p q
-
-collectSym :: Symbol -> Term -> [Term]
-collectSym s a = maybe [a] (uncurry ((++) `on` collectSym s)) (isBinary s a)
+difference = differenceWith termView
 
--- local implementation function
-diff :: (a -> a -> Bool) -> View Term a -> a -> a -> Maybe (a, a)
-diff eq v a b = do
-   let eqT x y = fromMaybe False $ liftM2 eq (match v x) (match v y)
-   (t1, t2) <- diffTerm eqT (build v a) (build v b)
+differenceWith :: View Term a -> a -> a -> Maybe (a, a)
+differenceWith v a b = do
+   (t1, t2) <- diffTerm (build v a) (build v b)
    liftM2 (,) (match v t1) (match v t2)
 
-diffTerm :: (Term -> Term -> Bool) -> Term -> Term -> Maybe (Term, Term)
-diffTerm eq = rec
+-- returns a result if the terms are different
+diffTerm :: Term -> Term -> Maybe (Term, Term)
+diffTerm p q =
+   case (getFunctionA p, getFunctionA q) of
+      (Just (s1, ps), Just (s2, qs))
+         | s1 == s2  -> diffList ps qs
+         | otherwise -> here
+      _  | p == q    -> Nothing
+         | otherwise -> here
  where
-   rec p q =
-      case (getFunction p, getFunction q) of
-         (Just (s1, ps), Just (s2, qs))
-            | s1 /= s2         -> Just (p, q)
-            | isAssociative s1 -> (diffA s1 `on` collectSym s1) p q
-            | otherwise        -> diffList ps qs
-         _  | p == q           -> Nothing
-            | otherwise        -> Just (p, q)
+   here = Just (p, q)
 
    diffList xs ys
-      | length xs /= length ys = Nothing
+      | length xs /= length ys = here
       | otherwise =
-           case catMaybes (zipWith rec xs ys) of
-              [p] -> Just p
-              _   -> Nothing
+           case catMaybes (zipWith diffTerm xs ys) of
+              []    -> Nothing
+              [one] -> Just one
+              _     -> here
 
-   diffA s = curry (make . rev . f . rev . f)
-    where
-      f (p:ps, q:qs) | not (null ps || null qs) &&
-                       isNothing (rec p q) &&
-                       equal ps qs =
-         f (ps, qs)
-      f pair = pair
+getFunctionA :: (Monad m, WithFunctions a) => a -> m (Symbol, [a])
+getFunctionA a = f <$> getFunction a
+ where
+   f (s, xs) = (s, if isAssociative s then collectSym s a else xs)
 
-      equal     = eq `on` builder
-      rev       = reverse *** reverse
-      builder   = foldr1 (binary s)
-      make pair =
-         case pair of
-            ([p], [q]) -> rec p q
-            (ps, qs)   -> Just (builder ps, builder qs)+collectSym :: WithFunctions a => Symbol -> a -> [a]
+collectSym s a = maybe [a] (uncurry ((++) `on` collectSym s)) (isBinary s a)

@@ -1,7 +1,7 @@ {-# LANGUAGE ExistentialQuantification, MultiParamTypeClasses,
        FunctionalDependencies, FlexibleInstances, UndecidableInstances #-}
 -----------------------------------------------------------------------------
--- Copyright 2016, Ideas project team. This file is distributed under the
+-- 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.
 -----------------------------------------------------------------------------
@@ -72,11 +72,42 @@ instance Different a => Different [a] where
    different = ([], [fst different])
 
+instance Different Int where
+   different = (0, 1)
+
+instance Different Integer where
+   different = (0, 1)
+
+instance Different Double where
+   different = (0, 1)
+
+instance Different Float where
+   different = (0, 1)
+
+instance Different Rational where
+   different = (0, 1)
+
+instance Different Bool where
+   different = (True, False)
+
 instance Different Char where
    different = ('a', 'b')
 
 instance Different Term where
    different = (TNum 0, TNum 1)
+
+instance (Different a, Different b) => Different (a, b) where
+   different =
+      let (a1, a2) = different
+          (b1, b2) = different
+      in ((a1, b1), (a2, b2))
+
+instance (Different a, Different b, Different c) => Different (a, b, c) where
+   different =
+      let (a1, a2) = different
+          (b1, b2) = different
+          (c1, c2) = different
+      in ((a1, b1, c1), (a2, b2, c2))
 
 class (IsTerm a, Show a) => RuleBuilder t a | t -> a where
    buildRuleSpec  :: Int -> t -> RuleSpec Term

@@ -1,5 +1,5 @@ -----------------------------------------------------------------------------
--- Copyright 2016, Ideas project team. This file is distributed under the
+-- 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.
 -----------------------------------------------------------------------------
@@ -21,6 +21,8 @@ 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
 import Ideas.Utils.Uniplate
@@ -35,9 +37,12 @@ newtype Substitution = S { unS :: IM.IntMap Term }
    deriving Eq
 
+instance Sem.Semigroup Substitution where
+   (<>) = (@@)
+
 instance Monoid Substitution where
    mempty  = emptySubst
-   mappend = (@@)
+   mappend = (<>)
 
 infixr 5 |->
 infixr 6 @@

@@ -1,6 +1,6 @@ {-# OPTIONS -fno-warn-orphans #-}
 -----------------------------------------------------------------------------
--- Copyright 2016, Ideas project team. This file is distributed under the
+-- 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.
 -----------------------------------------------------------------------------
@@ -39,7 +39,7 @@ import Ideas.Common.Id
 import Ideas.Common.View
 import Ideas.Utils.Prelude (ShowString(..))
-import Ideas.Utils.QuickCheck
+import Ideas.Utils.QuickCheck hiding (function)
 import Ideas.Utils.Uniplate
 import qualified Data.IntSet as IS
 import qualified Data.Map as M
@@ -211,7 +211,7 @@    getFunction _           = fail "Ideas.Common.Rewriting.getFunction"
 
 isSymbol :: WithFunctions a => Symbol -> a -> Bool
-isSymbol s = maybe False (==s) . getSymbol
+isSymbol s = (== Just s) . getSymbol
 
 isFunction :: (WithFunctions a, Monad m) => Symbol -> a -> m [a]
 isFunction s a =

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

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

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

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

@@ -1,5 +1,5 @@ -----------------------------------------------------------------------------
--- Copyright 2016, Ideas project team. This file is distributed under the
+-- 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.
 -----------------------------------------------------------------------------
@@ -18,6 +18,8 @@    ) where
 
 import Data.Maybe
+import Data.Monoid hiding ((<>))
+import Data.Semigroup as Sem
 import Ideas.Common.Environment
 import Ideas.Common.Rule.Transformation
 import Ideas.Common.View
@@ -42,9 +44,12 @@       let f = fmap fst . match v
       in R $ makeTrans f *** makeTrans f >>> unR r
 
+instance Sem.Semigroup (Recognizer a) where
+   f <> g = R $ unR f `mappend` unR g
+
 instance Monoid (Recognizer a) where
-   mempty      = R mempty
-   mappend f g = R $ unR f `mappend` unR g
+   mempty  = R mempty
+   mappend = (<>)
 
 instance Recognizable Recognizer where
    recognizer = id

@@ -1,6 +1,6 @@ {-# LANGUAGE GADTs, Rank2Types #-}
 -----------------------------------------------------------------------------
--- Copyright 2016, Ideas project team. This file is distributed under the
+-- 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.
 -----------------------------------------------------------------------------
@@ -35,6 +35,8 @@ 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
 import Ideas.Common.Environment
@@ -82,9 +84,12 @@    left f  = f :++: identity
    right f = identity :++: f
 
+instance Sem.Semigroup (Trans a b) where
+   (<>) = (<+>)
+
 instance Monoid (Trans a b) where
    mempty  = zeroArrow
-   mappend = (<+>)
+   mappend = (<>)
 
 instance Functor (Trans a) where
    fmap f t = t >>^ f

@@ -1,5 +1,5 @@ -----------------------------------------------------------------------------
--- Copyright 2016, Ideas project team. This file is distributed under the
+-- 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.
 -----------------------------------------------------------------------------
@@ -26,7 +26,8 @@      -- ** Basic combinators
    , (.*.), (.|.), (.%.), (.@.), (!~>)
    , succeed, fail, atomic, label, inits
-   , sequence, choice, alternatives, interleave, permute
+   , sequence, choice, preference, orelse
+   , alternatives, interleave, permute
      -- ** EBNF combinators
    , many, many1, replicate, option
      -- ** Negation and greedy combinators

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

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

@@ -1,5 +1,5 @@ -----------------------------------------------------------------------------
--- Copyright 2016, Ideas project team. This file is distributed under the
+-- 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.
 -----------------------------------------------------------------------------
@@ -85,6 +85,14 @@ -- | Combines a list of alternative strategies
 choice :: IsStrategy f => [f a] -> Strategy a
 choice = Choice.choice . map toStrategy
+
+-- | Combines a list of strategies with left-preference
+preference :: IsStrategy f => [f a] -> Strategy a
+preference = Choice.preference . map toStrategy
+
+-- | Combines a list of strategies with left-biased choice
+orelse :: IsStrategy f => [f a] -> Strategy a
+orelse = Choice.orelse . map toStrategy
 
 -- | Merges a list of strategies (in parallel)
 interleave :: IsStrategy f => [f a] -> Strategy a

@@ -1,6 +1,6 @@ {-# LANGUAGE TypeFamilies #-}
 -----------------------------------------------------------------------------
--- Copyright 2016, Ideas project team. This file is distributed under the
+-- 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.
 -----------------------------------------------------------------------------
@@ -22,6 +22,8 @@    ) where
 
 import Data.Char
+import Data.Monoid hiding ((<>))
+import Data.Semigroup as Sem
 import Ideas.Common.Classes
 import Ideas.Common.Id
 import Ideas.Common.Rule
@@ -43,10 +45,13 @@ instance Show StrategyCfg where
    show (Cfg xs) = show xs
 
+instance Sem.Semigroup StrategyCfg where
+   (Cfg xs) <> (Cfg ys) = Cfg (xs ++ ys)
+
 instance Monoid StrategyCfg where
    mempty  = Cfg []
    mconcat xs = Cfg [ y | Cfg ys <- xs, y <- ys ]
-   mappend (Cfg xs) (Cfg ys) = Cfg (xs ++ ys)
+   mappend = (<>)
 
 newtype ConfigLocation = ByName Id
 

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

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

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

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

@@ -1,6 +1,6 @@ {-# LANGUAGE TypeFamilies #-}
 -----------------------------------------------------------------------------
--- Copyright 2016, Ideas project team. This file is distributed under the
+-- 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.
 -----------------------------------------------------------------------------
@@ -30,6 +30,8 @@ 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
 import Ideas.Common.Rewriting.Term
@@ -51,9 +53,12 @@ instance Show (Prefix a) where
    show = intercalate ";" . map show . prefixPaths
 
+instance Sem.Semigroup (Prefix a) where
+   (Prefix xs p) <> (Prefix ys q) = Prefix (xs ++ ys) (p .|. q)
+
 instance Monoid (Prefix a) where
-   mempty = noPrefix
-   mappend (Prefix xs p) (Prefix ys q) = Prefix (xs ++ ys) (p .|. q)
+   mempty  = noPrefix
+   mappend = (<>)
 
 instance Firsts (Prefix a) where
    type Elem (Prefix a) = (Rule a, a, Environment)

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

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

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

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

@@ -1,5 +1,5 @@ -----------------------------------------------------------------------------
--- Copyright 2016, Ideas project team. This file is distributed under the
+-- 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.
 -----------------------------------------------------------------------------
@@ -30,7 +30,9 @@    , ruleUp, ruleDown, ruleDownLast, ruleLeft, ruleRight
    ) where
 
-import Data.Monoid
+import Data.Monoid hiding ((<>))
+import qualified Data.Semigroup as Sem
+import Data.Semigroup ((<>))
 import Ideas.Common.Classes
 import Ideas.Common.Rule
 import Ideas.Common.Strategy.Abstract
@@ -106,9 +108,12 @@ 
 newtype Option a = O { unO :: Info a -> Info a }
 
+instance Sem.Semigroup (Option a) where
+   O f <> O g = O (f . g)
+
 instance Monoid (Option a) where
-   mempty            = O id
-   O f `mappend` O g = O (f . g)
+   mempty  = O id
+   mappend = (<>)
 
 fromOptions :: [Option a] -> Info a
 fromOptions xs = unO (mconcat xs) (Info VisitOne Choice [] True False)

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

@@ -1,6 +1,6 @@ {-# LANGUAGE TypeFamilies, GeneralizedNewtypeDeriving #-}
 -----------------------------------------------------------------------------
--- Copyright 2016, Ideas project team. This file is distributed under the
+-- 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.
 -----------------------------------------------------------------------------
@@ -35,6 +35,8 @@ 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
 import Ideas.Utils.Uniplate
@@ -49,9 +51,12 @@ instance Show Location where
    show = show . fromLocation
 
+instance Sem.Semigroup Location where
+   L xs <> L ys = L (xs ++ ys)
+
 instance Monoid Location where
-   mempty = L []
-   L xs `mappend` L ys = L (xs ++ ys)
+   mempty  = L []
+   mappend = (<>)
 
 toLocation :: [Int] -> Location
 toLocation = L

@@ -1,5 +1,5 @@ -----------------------------------------------------------------------------
--- Copyright 2016, Ideas project team. This file is distributed under the
+-- 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.
 -----------------------------------------------------------------------------
@@ -17,6 +17,7 @@ 
 import Control.Monad
 import Data.Maybe
+import Data.Semigroup as Sem
 import Ideas.Common.Traversal.Iterator
 import Ideas.Common.Traversal.Navigator
 import Ideas.Common.Traversal.Utils

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

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

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

@@ -1,6 +1,6 @@ {-# LANGUAGE GADTs #-}
 -----------------------------------------------------------------------------
--- Copyright 2016, Ideas project team. This file is distributed under the
+-- 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.
 -----------------------------------------------------------------------------
@@ -26,6 +26,7 @@ import Ideas.Encoding.Request
 import Ideas.Service.State
 import Ideas.Service.Types
+import Ideas.Text.MathML
 import Ideas.Text.OpenMath.Object
 import Ideas.Text.XML
 
@@ -34,6 +35,10 @@ xmlDecoder :: TypedDecoder a XML
 xmlDecoder tp =
    case tp of
+      Tag s (Const String) ->
+         decodeChild s decodeData
+       `mplus`
+         decodeAttribute s
       Tag s t
          | s == "answer" ->
               decodeChild "answer" (xmlDecoder t)
@@ -44,6 +49,12 @@          | otherwise ->
               decodeChild s (xmlDecoder t)
       Iso p t  -> from p <$> xmlDecoder t
+      List t -> do
+         x  <- xmlDecoder t
+         xs <- xmlDecoder (List t)
+         return (x:xs)
+       `mplus`
+         return []
       Pair t1 t2 -> do
          x <- xmlDecoder t1
          y <- xmlDecoder t2
@@ -67,6 +78,8 @@             Id          -> -- improve!
                            decodeChild "location" $
                               makeDecoder (newId . getData)
+            MathML      -> decodeMathML
+            String      -> decodeData
             _ -> fail $ "No support for argument type in XML: " ++ show tp
       _ -> fail $ "No support for argument type in XML: " ++ show tp
 
@@ -133,6 +146,9 @@       Just a  -> return a
       Nothing -> fail "Invalid OpenMath object for this exercise"
 
+decodeMathML :: XMLDecoder a MathML
+decodeMathML = decodeFirstChild "math" $ decoderFor fromXML
+
 decodeEnvironment :: XMLDecoder a Environment
 decodeEnvironment =
    decodeChild "context" (decoderFor $ foldM add mempty . children)
@@ -187,10 +203,31 @@    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+              _ -> 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

@@ -1,6 +1,6 @@ {-# LANGUAGE RankNTypes #-}
 -----------------------------------------------------------------------------
--- Copyright 2016, Ideas project team. This file is distributed under the
+-- 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.
 -----------------------------------------------------------------------------
@@ -32,13 +32,14 @@    , split, symbol, setInput
      -- re-export
    , module Export
+   , (<>)
    ) where
 
 import Control.Applicative as Export hiding (Const)
 import Control.Arrow as Export
 import Control.Monad
 import Data.Maybe
-import Data.Monoid as Export
+import Data.Semigroup as Sem
 import Ideas.Common.Library hiding (exerciseId, symbol)
 import Ideas.Encoding.Options
 import Ideas.Encoding.Request
@@ -219,9 +220,12 @@    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 = liftA2 mappend
 
 instance BuildXML t => BuildXML (Encoder a s t) where
    n .=. s   = pure (n .=. s)

@@ -1,6 +1,6 @@-{-# LANGUAGE GADTs #-}
+{-# LANGUAGE GADTs, OverloadedStrings #-}
 -----------------------------------------------------------------------------
--- Copyright 2016, Ideas project team. This file is distributed under the
+-- 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.
 -----------------------------------------------------------------------------
@@ -19,10 +19,11 @@ import Data.List
 import Data.Maybe
 import Data.Ord
-import Ideas.Common.Library hiding (alternatives)
+import Ideas.Common.Library hiding (alternatives, left, right, collapse, Medium)
 import Ideas.Common.Strategy.Symbol
-import Ideas.Encoding.Encoder
+import Ideas.Encoding.Encoder hiding (left, right)
 import Ideas.Encoding.LinkManager
+import Ideas.Encoding.Logging
 import Ideas.Encoding.Request
 import Ideas.Encoding.RulePresenter
 import Ideas.Encoding.RulesInfo
@@ -32,12 +33,15 @@ import Ideas.Service.DomainReasoner
 import Ideas.Service.State
 import Ideas.Service.Types
-import Ideas.Text.HTML
+import Ideas.Text.HTML hiding (table, keyValueTable)
+import Ideas.Text.HTML.Templates
+import Ideas.Text.HTML.W3CSS hiding (tag, ul, top, table, content)
 import Ideas.Text.OpenMath.FMP
 import Ideas.Text.OpenMath.Object
-import Ideas.Text.XML
+import Ideas.Text.XML hiding (content)
 import Ideas.Utils.TestSuite
 import System.IO.Unsafe
+import qualified Ideas.Text.HTML.W3CSS as W3
 
 type HTMLEncoder a t = Encoder a t HTMLBuilder
 
@@ -50,34 +54,68 @@    makePage lm dr ex <$> encodeType lm dr
 
 makePage :: LinkManager -> DomainReasoner -> Exercise a -> HTMLBuilder -> HTMLPage
-makePage lm dr ex a =
-   addCSS (urlForCSS lm "ideas.css") $
+makePage lm dr ex body =
    (if hasLatexEncoding ex then addScript mathJaxUrl else id) $
-   htmlPage "Ideas: documentation pages" $ mconcat
-      [ divClass "page-header" $ mconcat
-           [ divClass  "ideas-logo" space
-           , divClass  "ounl-logo"  space
-           , spanClass "menuitem"   $ linkToIndex lm $ string "Index"
-           , spanClass "menuitem"   $ linkToExercises lm $ string "Exercises"
-           , spanClass "menuitem"   $ linkToServices lm  $ string "Services"
-           ]
-      , divClass "page-content" a
-      , divClass "page-footer" $
-           string (fullVersion dr)
-      ]
+   -- addCSS "http://ideas.cs.uu.nl/css/2007-chili-pepper.css" $
+   addCSS (urlForCSS lm "2007-chili-pepper.css") $
+   webpage myWebPage
  where
    mathJaxUrl =
       "https://cdn.mathjax.org/mathjax/latest/MathJax.js?config=TeX-MML-AM_CHTML"
 
+   myWebPage = WebPage
+      { title       = "Ideas: documentation pages"
+      , menuButtons =
+           [ Button "http://ideas.cs.uu.nl/ " (theme L1) (fontAwesome "lightbulb-o" <> tag "span" (fontSize Large " I") <> tag "span" (fontSize Medium "DEAS"))
+           , Button (urlForIndex lm)     (hover White) "Index"
+           , Button (urlForExercises lm) (hover White) $ "Exercises " <> nrBadge (length (exercises dr))
+           , Button (urlForServices lm)  (hover White) $ "Services " <> nrBadge (length (services dr))
+           ]
+      , menuStyle   = theme_ . fontSize Large
+      , iconBarsStyle = hover White . fontSize Large . theme L1
+      , sideWidth = 150
+      , sideHeader  = tag "h4" $ barItem $ bold $ textTheme "Exercise"
+      , sideButtons =
+           let mk f = Button (f lm ex) (hover Black)
+           in if getId ex == mempty then [] else
+              [ mk urlForExercise    "Information"
+              , mk urlForStrategy    "Strategy"
+              , mk urlForRules       "Rules"
+              , mk urlForConstraints "Constraints"
+              , mk urlForExamples    "Examples"
+              , mk urlForDerivations "Derivations"
+              , mk urlForTestReport  "Test report"
+              ]
+      , sideStyle = theme L3 . fontSize Medium
+      , iconCloseStyle = fontSize XL . hover Black
+      , content = body
+      , footer = italic $ string $ fullVersion dr
+      , footerStyle = theme L1
+      }
+
+nrBadge :: BuildXML a => Int -> a
+nrBadge = badge . theme L1 . fontSize Small . text
+
+table :: BuildXML a => Bool -> [[a]] -> a
+table hasHeader = tableAll . mconcat . zipWith f (hasHeader : repeat False)
+ where
+   f header = tag "tr" . mconcat . map makeCell
+    where
+      makeCell | header    = tag "th"
+               | otherwise = tag "td"
+
+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 =
    (encodeIndex, tDomainReasoner) <?>
-   (exerciseHeader lm <> htmlDiagnosis lm dr, tDiagnosis) <?>
-   (exerciseHeader lm <> encodeExampleList lm, tList (tPair tDifficulty tContext)) <?>
-   (exerciseHeader lm <> htmlFirsts lm, tList (tPair tStepInfo tState)) <?>
-   (exerciseHeader lm <> htmlAllApplications lm, tList (tTuple3 tRule tLocation tState)) <?>
-   (exerciseHeader lm <> encodeDerivation lm, tDerivation (tPair tRule tEnvironment) tContext) <?>
-   (exerciseHeader lm <> encodeDerivationList lm, tList (tDerivation (tPair tRule tEnvironment) tContext)) <?>
+   (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) ->
         case tp of
            Iso iso t  -> encodeType lm dr // (to iso val ::: t)
@@ -89,7 +127,7 @@                             Right x -> encodeType lm dr // (x ::: t2)
            List (Const Service) -> encodeServiceList lm // val
            List (Const SomeExercise) -> encodeExerciseList lm // val
-           List (Const Rule) -> exerciseHeader lm <> encodeRuleList 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)
@@ -98,16 +136,16 @@ encodeConst lm dr = encoderFor $ \tv@(val ::: tp) ->
    case tp of
       Service     -> encodeService // val
-      Exercise    -> exerciseHeader lm <> encodeExercise lm // val
-      Strategy    -> exerciseHeader lm <> encodeStrategy // val
+      Exercise    -> exerciseHeader (encodeExercise lm // val)
+      Strategy    -> exerciseHeader (encodeStrategy // val)
       Rule        -> encodeRule // val
-      State       -> exerciseHeader lm <> (encodeState lm dr // val)
+      State       -> exerciseHeader (encodeState lm dr // val)
       Location    -> text val
       Environment -> text val
       Term        -> text val
       Context     -> encodeContext // val
       String      -> string val
-      Result      -> exerciseHeader lm <> encodeResult lm val
+      Result      -> exerciseHeader (encodeResult lm val)
       _           -> text tv
 
 encodeContext :: HTMLEncoder a (Context a)
@@ -116,13 +154,8 @@ 
 encodeIndex :: HTMLEncoder a DomainReasoner
 encodeIndex = makeEncoder $ \dr -> mconcat
-   [ h1 $ "Domain reasoner " ++ showId dr
-   , htmlDescription dr
-   , keyValueTable
-        [ ("version", string $ fullVersion dr)
-        , ("exercises", text $ length $ exercises dr)
-        , ("services", text $ length $ services dr)
-        ]
+   [ htmlDescription "Domain reasoner" dr
+   , panel $ right $ string "Logging: " <> bool logEnabled
    , munless (null $ aliases dr) $
         h2 "Exercise aliases" <>
         table True (
@@ -185,10 +218,9 @@ 
 encodeService :: HTMLEncoder a Service
 encodeService = makeEncoder $ \srv -> mconcat
-   [ h1 $ "Service " ++ showId srv
+   [ htmlDescription "Service" srv
    , mwhen (serviceDeprecated srv) $
         para $ spanClass "warning" $ string "Warning: this service is deprecated"
-   , htmlDescription srv
    , case serviceFunction srv of
         _ ::: tp ->
            let (xs, ys) = inputOutputTypes tp
@@ -238,11 +270,12 @@           [ para $ submitStateInfo lm ex ]
    ]
  where
-   generalInfo ex = keyValueTable
-      [ ("Code",   ttText (showId ex))
+   generalInfo ex = container $ panel $ left $ keyValueTable
+      [ ("Code",   string $ showId ex)
       , ("Status", text $ status ex)
       , ("Strategy", linkToStrategy lm ex $ string (showId $ strategy ex))
       , ("Rules", text nrOfSoundRules)
+      , ("Constraints", text (length (constraints ex)))
       , ("Buggy rules", text nrOfBuggyRules)
       , ("OpenMath support", bool $ isJust $ hasTermView ex)
       , ("Restartable strategy", bool $ canBeRestarted ex)
@@ -253,27 +286,12 @@       (nrOfBuggyRules, nrOfSoundRules) =
          mapBoth length (partition isBuggy (ruleset ex))
 
-exerciseHeader :: LinkManager -> HTMLEncoder a b
-exerciseHeader lm = withExercise $ \ex -> mconcat
-   [ exerciseMenu lm
-   , h1 $ "Exercise " ++ showId ex
-   , pure $ htmlDescription ex
+exerciseHeader :: HTMLEncoder a b -> HTMLEncoder a b
+exerciseHeader body = withExercise $ \ex -> tag "div" $ mconcat
+   [ pure (htmlDescription "Exercise" ex)
+   , body
    ]
 
-exerciseMenu :: LinkManager -> HTMLEncoder a b
-exerciseMenu lm = divClass "menubox" $
-   bold (string "Exercise") <>
-   ul [ with linkToExercise    "information"
-      , with linkToStrategy "   strategy"
-      , with linkToRules       "rules"
-      , with linkToExamples    "examples"
-      , with linkToDerivations "derivations"
-      , with linkToTestReport  "test report"
-      ]
- where
-   with f s = withExercise $ \ex ->
-      pure $ f lm ex (string s)
-
 encodeStrategy :: HTMLEncoder a (Strategy (Context a))
 encodeStrategy = exerciseEncoder $ \ex s -> mconcat
    [ h2 "Strategy"
@@ -369,7 +387,7 @@                 , string "Used", string "Siblings", string "Rewrite rule"
                 ]
        used = rulesInStrategy (strategy ex)
-       f r  = [ linkToRule lm ex r $ ttText (showId r)
+       f r  = [ linkToRule lm ex r $ string $ showId r
               , text $ length $ getRefs r
               , bool $ r `elem` used
               , string $ intercalate ", " $ map show $ ruleSiblings r
@@ -386,8 +404,7 @@ 
 encodeRule :: HTMLEncoder a (Rule (Context a))
 encodeRule = exerciseEncoder $ \ex r -> mconcat
-   [ h1 $ "Rule " ++ showId r
-   , htmlDescription r
+   [ htmlDescription "Rule" r
    , let commas  = string . intercalate ", "
          idList  = commas . map showId
          refList = commas . map show . getRefIds
@@ -414,19 +431,15 @@ encodeExampleList :: LinkManager -> HTMLEncoder a [(Difficulty, Context a)]
 encodeExampleList lm = exerciseEncoder $ \ex pairs -> mconcat $
    h2 "Examples" :
-   [ h3 (s ++ " (" ++ show (length xs) ++ ")")
-       <> mconcat (map (make ex) xs)
+   [  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
    ]
  where
-   make ex (_, x) = para $
-      ( let st = emptyStateContext ex x
-        in spanClass "statelink" $ linkToState lm st $ external lm)
-      <> htmlContext False ex x
-
-external :: BuildXML a => LinkManager -> a
-external lm = element "img"
-   ["src" .=. urlForImage lm "external.png", "width" .=. "15"]
+   make 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 =
@@ -448,8 +461,8 @@                 Just True -> mempty
                 _ -> spanClass "error" (string "Final term is not finished")
        forStep ((r, env1), env2) =
-          let showEnv e = munless (noBindings e) $ string $ ", " ++ show e in
-          spanClass "derivation-step" $ mconcat
+          let showEnv e = munless (noBindings e) $ string $ "," ++ show e in
+          container $ marginPos CenterLeft $ mconcat
              [ unescaped "&#8658; "
              , linkToRule lm ex r $ string $ showId r
              , showEnv env1 -- local environment
@@ -460,7 +473,7 @@ 
 htmlState :: LinkManager -> HTMLEncoder a (State a)
 htmlState lm = makeEncoder $ \state ->
-   para $ divClass "state" $
+   para $ container $ background LightGray $ para $
       stateLink lm state
       <> htmlContext True (exercise state) (stateContext state)
       <> string "ready: " <> bool (finished state)
@@ -471,14 +484,15 @@    textLines = mconcat . intersperse br . map string . lines
    f = if useDiv then divClass else spanClass
 
-   inline s = "\\(" ++ s ++ "\\)"
+   inline s = "\\(" ++ s ++ "\\)" :: String
    printer
       | hasLatexEncoding ex = inline . show . latexPrinterContext ex
       | otherwise = prettyPrinterContext ex
 
 stateLink :: LinkManager -> State a -> HTMLBuilder
 stateLink lm st =
-   spanClass "derivation-statelink" $ linkToState lm st $ external lm
+   container $ right $ linkToState lm st $
+   tag "span" $ textTheme $ fontAwesome "external-link"
 
 encodeState :: LinkManager -> DomainReasoner -> HTMLEncoder a (State a)
 encodeState lm dr =
@@ -489,18 +503,20 @@       in mconcat
          [ h2 "Feedback"
          , submitDiagnose lm state
-         , ul [ case xs of
-                   Right (hd:_) -> linkToState lm (snd hd) $ string "onefirst"
+         , tag "p" $ padding Small  $ mconcat [ case xs of
+                   Right (hd:_) -> linkToState lm (snd hd) $ serviceButton $ string "onefirst"
                    _ -> string "(no onefirst)"
-              , linkToFirsts lm state $ string $ "allfirsts (" ++ show n ++ ")"
-              , linkToApplications lm state $ string "allapplications"
-              , linkToDerivation lm state $ string "derivation"
-              , linkToMicrosteps lm state $ string "microsteps"
-              ]
+              , linkToFirsts lm state $ serviceButton $ string $ "allfirsts (" ++ show n ++ ")"
+              , linkToApplications lm state $ serviceButton $ string "allapplications"
+              , linkToDerivation lm state $ serviceButton $ string "derivation"
+              , linkToMicrosteps lm state $ serviceButton $ string "microsteps"
+           ]
          , munless (noBindings state) $
               h2 "Environment" <> text (environment state)
          , encodePrefix state (statePrefix state)
          ])
+     where
+       serviceButton = theme L1  . W3.w3class "w3-button"
 
 -- use allfirsts service of domain reasoner, instead of calling the service
 -- directly. Note that the service can be redefined (e.g. for the Ask-Elle tutor)
@@ -509,7 +525,7 @@ 
 useAllFirstsIO :: DomainReasoner -> State a -> IO (Either String [(StepInfo a, State a)])
 useAllFirstsIO dr st = do
-   srv <- findService dr (newId "allfirsts")
+   srv <- findService dr (newId ("allfirsts" :: String))
    case serviceFunction srv of
       f ::: tp -> do
          conv <- equalM tp (tState .-> tError (tList (tPair tStepInfo tState)))
@@ -547,7 +563,7 @@ 
 htmlDerivationWith :: HTMLBuilder -> (s -> HTMLBuilder) -> (t -> HTMLBuilder) -> Derivation s t -> HTMLBuilder
 htmlDerivationWith before forStep forTerm d =
-   divClass "derivation" $ mconcat $
+   container $ background LightGray $ para $ mconcat $
       before : forTerm (firstTerm d) :
          [ forStep s <> forTerm a | (_, s, a) <- triples d ]
 
@@ -599,21 +615,25 @@       Unknown _ s ->
          h2 "Unknown" <> encodeState lm dr // s
 
-htmlDescription :: HasId a => a -> HTMLBuilder
-htmlDescription a = munless (null (description a)) $
-   para $
-      bold (string "Description") <> br
-      <> spanClass "description" (string (description a))
+htmlDescription :: HasId a => String -> a -> HTMLBuilder
+htmlDescription tp a = munless (null (description a)) $
+   para $ panel $ barPos CenterLeft $ borderTheme $ background LightGray $ para $ mconcat
+      [ bold $ string $ tp ++ " " ++ showId a
+      , br
+      , italic $ string $ description a
+      ]
 
 submitForm :: HTMLBuilder -> HTMLBuilder
-submitForm this = element "form"
-   [ "name"     .=. "myform"
-   , "onsubmit" .=. "return submitTerm()"
-   , "method"   .=. "post"
-   , this
-   , element "input" ["type" .=. "text", "name" .=. "myterm"]
-   , element "input" ["type"  .=. "submit", "value" .=. "Submit"]
-   ]
+submitForm this = form . padding Tiny $ mconcat
+  [ para $ mconcat [termLabel, termInput mempty]
+  , this
+  , para $ submitBtn mempty
+  ]
+ where
+   form      = tag "form"  . ("name" .=. "myform" <>) . ("method" .=. "post" <>) . ("onsubmit" .=. "return submitTerm()" <>) . w3class "w3-container"
+   termLabel = tag "label" $ tag "b" "Input:"
+   termInput = tag "input" . ("name" .=. "myterm" <>) . ("type" .=. "text" <>) . border . W3.input
+   submitBtn = tag "input" . ("value" .=. "Submit" <>) . ("type" .=. "submit" <>) . theme L1 . W3.w3class "w3-button"
 
 -- stateinfo service
 submitStateInfo :: LinkManager -> Exercise a -> HTMLBuilder
@@ -624,7 +644,7 @@    request = "<request service='stateinfo' exerciseid='" ++ showId ex
           ++ "' encoding='html'><state><expr>\" + getTerm() + \"</expr></state></request>"
 
--- diagnose service
+-- diagnose service *here*
 submitDiagnose :: LinkManager -> State a -> HTMLBuilder
 submitDiagnose lm st = submitForm mempty <> submitRequest lm request
  where

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

@@ -1,6 +1,6 @@ {-# LANGUAGE GADTs #-}
 -----------------------------------------------------------------------------
--- Copyright 2016, Ideas project team. This file is distributed under the
+-- 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.
 -----------------------------------------------------------------------------
@@ -20,7 +20,7 @@ 
 import Data.Char
 import Data.Maybe
-import Data.Monoid
+import Data.Monoid hiding ((<>))
 import Ideas.Common.Library hiding (exerciseId, alternatives)
 import Ideas.Encoding.Encoder
 import Ideas.Encoding.OpenMathSupport

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

@@ -1,6 +1,6 @@ {-# LANGUAGE RankNTypes #-}
 -----------------------------------------------------------------------------
--- Copyright 2016, Ideas project team. This file is distributed under the
+-- 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.
 -----------------------------------------------------------------------------
@@ -25,6 +25,7 @@      -- links to state information (dynamic)
    , linkToState, linkToFirsts, linkToApplications, linkToDerivation
    , linkToMicrosteps
+   , escapeInURL
    ) where
 
 import Data.Maybe
@@ -50,6 +51,7 @@    , urlForExercise      :: forall a . Exercise a -> String
    , urlForStrategy      :: forall a . Exercise a -> String
    , urlForRules         :: forall a . Exercise a -> String
+   , urlForConstraints   :: forall a . Exercise a -> String
    , urlForExamples      :: forall a . Exercise a -> String
    , urlForDerivations   :: forall a . Exercise a -> String
    , urlForRule          :: forall a . Exercise a -> Rule (Context a) -> String
@@ -143,6 +145,7 @@    , urlForExercise    = url . exerciseRequest "exerciseinfo"
    , urlForStrategy    = url . exerciseRequest "strategyinfo"
    , urlForRules       = url . exerciseRequest "rulelist"
+   , urlForConstraints = url . exerciseRequest "constraintlist"
    , urlForTestReport  = url . exerciseRequest "testreport"
    , urlForExamples    = url . exerciseRequest "examples"
    , urlForDerivations = url . exerciseRequest "examplederivations"

@@ -1,6 +1,6 @@ {-# LANGUAGE CPP, FlexibleContexts #-}
 -----------------------------------------------------------------------------
--- Copyright 2016, Ideas project team. This file is distributed under the
+-- 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.
 -----------------------------------------------------------------------------
@@ -29,7 +29,7 @@ #ifdef DB
 import Data.List
 import Database.HDBC
-import Database.HDBC.Sqlite3 (connectSqlite3)
+import Database.HDBC.Sqlite3 (connectSqlite3, setBusyTimeout)
 #endif
 
 type Diff = NominalDiffTime
@@ -129,8 +129,8 @@ logEnabled = True
 logRecord schema logRef =
    case schema of
-      V1 -> connectSqlite3 "service.db"  >>= logRecordWith V1 logRef
-      V2 -> connectSqlite3 "requests.db" >>= logRecordWith V2 logRef
+      V1 -> logRecordWith "service.db"  V1 logRef
+      V2 -> logRecordWith "requests.db" V2 logRef
       NoLogging -> return ()
 #else
 -- without logging
@@ -165,8 +165,11 @@       , get errormsg, get serviceinfo, get ruleid, get input, get output
       ]
 
-logRecordWith :: IConnection c => Schema -> LogRef -> c -> IO ()
-logRecordWith schema logRef conn = do
+logRecordWith :: FilePath -> Schema -> LogRef -> IO ()
+logRecordWith file schema logRef = do
+   -- connect to database
+   conn <- connectSqlite3 file
+   setBusyTimeout conn 200 -- milliseconds
    -- calculate duration
    r   <- getRecord logRef
    end <- getCurrentTime
@@ -175,8 +178,8 @@    insertRecord schema r {responsetime = diff} conn
    -- close the connection to the database
    disconnect conn
- `catchSql` \err ->
-   putStrLn $ "Error in logging to database: " ++ show err
+ `catchSql` \_ ->
+   return ()
 
 insertRecord :: IConnection c => Schema -> Record -> c ->  IO ()
 insertRecord schema r conn =

@@ -1,5 +1,5 @@ -----------------------------------------------------------------------------
--- Copyright 2016, Ideas project team. This file is distributed under the
+-- 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.
 -----------------------------------------------------------------------------
@@ -17,6 +17,7 @@ import Control.Monad
 import Data.Char
 import Data.Maybe
+import Data.Semigroup ((<>))
 import Ideas.Common.Library hiding (exerciseId)
 import Ideas.Encoding.DecoderJSON
 import Ideas.Encoding.EncoderJSON

@@ -1,5 +1,5 @@ -----------------------------------------------------------------------------
--- Copyright 2016, Ideas project team. This file is distributed under the
+-- 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.
 -----------------------------------------------------------------------------
@@ -38,13 +38,17 @@     `catch` handler
    let showXML | compactOutput req = compactXML
                | otherwise = show
+       showHtmlDoc doc = "<!DOCTYPE html>" ++ compactXML doc
    if htmlOutput req
-      then return (req, showXML resp, "text/html")
+      then return (req, showHtmlDoc resp, "text/html")
       else let out = addVersion (version dr) resp
            in return (req, showXML out, "application/xml")
  where
-   handler :: IOException -> IO XML
-   handler = resultError logRef . ioeGetErrorString
+   handler :: SomeException -> IO XML
+   handler e = resultError logRef $
+      case fromException e of
+         Just ioe -> ioeGetErrorString ioe
+         Nothing  -> show e
 
 addVersion :: String -> XML -> XML
 addVersion s xml =

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

@@ -1,5 +1,5 @@ -----------------------------------------------------------------------------
--- Copyright 2016, Ideas project team. This file is distributed under the
+-- 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.
 -----------------------------------------------------------------------------
@@ -17,7 +17,8 @@    ) where
 
 import Control.Applicative
-import Data.Monoid
+import Data.Monoid hiding ((<>))
+import Data.Semigroup as Sem
 import Ideas.Common.Library (Exercise, getId)
 import Ideas.Encoding.Request
 import Ideas.Service.DomainReasoner
@@ -41,9 +42,8 @@    , maxTime  :: Maybe Int    -- timeout for services, in seconds
    }
 
-instance Monoid Options where
-   mempty = Options mempty Nothing mempty Nothing Nothing
-   mappend x y = Options
+instance Sem.Semigroup Options where
+   x <> y = Options
       { request  = request x <> request y
       , qcGen    = make qcGen
       , script   = script x <> script y
@@ -52,6 +52,10 @@       }
     where
       make f = f x <|> f y
+
+instance Monoid Options where
+   mempty  = Options mempty Nothing mempty Nothing Nothing
+   mappend = (<>)
 
 optionHtml :: Options
 optionHtml = mempty

@@ -1,5 +1,5 @@ -----------------------------------------------------------------------------
--- Copyright 2016, Ideas project team. This file is distributed under the
+-- 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.
 -----------------------------------------------------------------------------
@@ -16,6 +16,8 @@ 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
 
@@ -32,10 +34,8 @@    , encoding       :: [Encoding]
    }
 
-instance Monoid Request where
-   mempty = Request Nothing Nothing Nothing Nothing
-                    Nothing Nothing Nothing Nothing Nothing []
-   mappend x y = Request
+instance Sem.Semigroup Request where
+   x <> y = Request
       { serviceId      = make serviceId
       , exerciseId     = make exerciseId
       , source         = make source
@@ -50,10 +50,15 @@     where
       make f = f x <|> f y
 
+instance Monoid Request where
+   mempty = Request Nothing Nothing Nothing Nothing
+                    Nothing Nothing Nothing Nothing Nothing []
+   mappend = (<>)
+
 data Schema = V1 | V2 | NoLogging deriving (Show, Eq)
 
 getSchema :: Request -> Schema
-getSchema = fromMaybe V1 . logSchema -- log schema V1 is the default
+getSchema = fromMaybe V2 . logSchema -- log schema V2 is the default
 
 readSchema :: Monad m => String -> m Schema
 readSchema s0

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

@@ -1,5 +1,5 @@ -----------------------------------------------------------------------------
--- Copyright 2016, Ideas project team. This file is distributed under the
+-- 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.
 -----------------------------------------------------------------------------
@@ -25,6 +25,8 @@ rulesInfoXML :: Exercise a -> (a -> XMLBuilder) -> XMLBuilder
 rulesInfoXML ex enc = mconcat (map ruleInfoXML (ruleset ex))
  where
+   exampleMap = collectExamples ex
+
    ruleInfoXML r = element "rule"
       [ "name"        .=. showId r
       , "buggy"       .=. f (isBuggy r)
@@ -48,7 +50,7 @@                 ]
       -- Examples
       , mconcat [ element "example" [enc a, enc b]
-                | let pairs = M.findWithDefault [] (getId r) (collectExamples ex)
+                | let pairs = M.findWithDefault [] (getId r) exampleMap
                 , (a, b) <- take 3 pairs
                 ]
       ]

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

@@ -0,0 +1,167 @@+{-# LANGUAGE OverloadedStrings #-}
+-- Original source: https://hackage.haskell.org/package/wai-extra-3.0.20.0/docs/Network-Wai-Handler-CGI.html
+module Ideas.Main.CGI (run) where
+
+import Blaze.ByteString.Builder (fromByteString, toLazyByteString, flush)
+import Blaze.ByteString.Builder.Char8 (fromChar, fromString)
+import Control.Arrow ((***))
+import Control.Monad (unless, void)
+import Data.ByteString.Lazy.Internal (defaultChunkSize)
+import Data.Char (toLower)
+import Data.Function (fix)
+import Data.IORef
+import Data.Maybe (fromMaybe)
+import Network.HTTP.Types (Status (..), hRange, hContentType, hContentLength)
+import Network.Socket (getAddrInfo, addrAddress)
+import Network.Wai
+import Network.Wai.Internal
+import System.Environment (getEnvironment)
+import System.IO (Handle)
+import qualified Data.ByteString.Char8 as B
+import qualified Data.ByteString.Lazy as L
+import qualified Data.CaseInsensitive as CI
+import qualified Data.Streaming.ByteString.Builder as Blaze
+import qualified Data.String as String
+import qualified Network.HTTP.Types as H
+import qualified System.IO
+
+safeRead :: Read a => a -> String -> a
+safeRead d s =
+  case reads s of
+    ((x, _):_) -> x
+    [] -> d
+
+lookup' :: String -> [(String, String)] -> String
+lookup' key pairs = fromMaybe "" $ lookup key pairs
+
+-- | Run an application using CGI.
+run :: Application -> IO ()
+run app = do
+    vars <- getEnvironment
+    let input = requestBodyHandle System.IO.stdin
+        output = B.hPut System.IO.stdout
+    runGeneric vars input output Nothing app
+
+-- | A generic CGI helper, which allows other backends (FastCGI and SCGI) to
+-- use the same code as CGI. Most users will not need this function, and can
+-- stick with 'run' or 'runSendfile'.
+runGeneric
+     :: [(String, String)] -- ^ all variables
+     -> (Int -> IO (IO B.ByteString)) -- ^ responseBody of input
+     -> (B.ByteString -> IO ()) -- ^ destination for output
+     -> Maybe B.ByteString -- ^ does the server support the X-Sendfile header?
+     -> Application
+     -> IO ()
+runGeneric vars inputH outputH xsendfile app = do
+    let rmethod = B.pack $ lookup' "REQUEST_METHOD" vars
+        pinfo = lookup' "PATH_INFO" vars
+        qstring = lookup' "QUERY_STRING" vars
+        contentLength = safeRead 0 $ lookup' "CONTENT_LENGTH" vars
+        remoteHost' =
+            let s = fromMaybe "" (lookup "REMOTE_HOST" vars)
+            in fromMaybe s (lookup "REMOTE_ADDR" vars)
+
+        isSecure' =
+            case map toLower $ lookup' "SERVER_PROTOCOL" vars of
+                "https" -> True
+                _ -> False
+    addrs <- getAddrInfo Nothing (Just remoteHost') Nothing
+    requestBody' <- inputH contentLength
+    let addr =
+            case addrs of
+                a:_ -> addrAddress a
+                [] -> error $ "Invalid REMOTE_ADDR or REMOTE_HOST: " ++ remoteHost'
+        reqHeaders = map (cleanupVarName *** B.pack) vars
+        env = Request
+            { requestMethod = rmethod
+            , rawPathInfo = B.pack pinfo
+            , pathInfo = H.decodePathSegments $ B.pack pinfo
+            , rawQueryString = B.pack qstring
+            , queryString = H.parseQuery $ B.pack qstring
+            , requestHeaders = reqHeaders
+            , isSecure = isSecure'
+            , remoteHost = addr
+            , httpVersion = H.http11 -- FIXME
+            , requestBody = requestBody'
+            , vault = mempty
+            , requestBodyLength = KnownLength $ fromIntegral contentLength
+            , requestHeaderHost = lookup "host" reqHeaders
+            , requestHeaderRange = lookup hRange reqHeaders
+            , requestHeaderReferer = lookup "referer" reqHeaders
+            , requestHeaderUserAgent = lookup "user-agent" reqHeaders
+            }
+    void $ app env $ \res ->
+        case (xsendfile, res) of
+            (Just sf, ResponseFile s hs fp Nothing) -> do
+                mapM_ outputH $ L.toChunks $ toLazyByteString $ sfBuilder s hs sf fp
+                return ResponseReceived
+            _ -> do
+                let (s, hs, wb) = responseToStream res
+                (blazeRecv, blazeFinish) <- Blaze.newByteStringBuilderRecv Blaze.defaultStrategy
+                wb $ \b -> do
+                    let sendBuilder builder = do
+                            popper <- blazeRecv builder
+                            fix $ \loop -> do
+                                bs <- popper
+                                unless (B.null bs) $ do
+                                    outputH bs
+                                    loop
+                    sendBuilder $ headers s hs `mappend` fromChar '\n'
+                    b sendBuilder (sendBuilder flush)
+                blazeFinish >>= maybe (return ()) outputH
+                return ResponseReceived
+  where
+    headers s hs = mconcat (map header $ status s : map header' (fixHeaders hs))
+    status (Status i m) = (fromByteString "Status", mconcat
+        [ fromString $ show i
+        , fromChar ' '
+        , fromByteString m
+        ])
+    header' (x, y) = (fromByteString $ CI.original x, fromByteString y)
+    header (x, y) = mconcat
+        [ x
+        , fromByteString ": "
+        , y
+        , fromChar '\n'
+        ]
+    sfBuilder s hs sf fp = mconcat
+        [ headers s hs
+        , header (fromByteString sf, fromString fp)
+        , fromChar '\n'
+        , fromByteString sf
+        , fromByteString " not supported"
+        ]
+    fixHeaders h =
+        case lookup hContentType h of
+            Nothing -> (hContentType, "text/html; charset=utf-8") : h
+            Just _ -> h
+
+cleanupVarName :: String -> CI.CI B.ByteString
+cleanupVarName "CONTENT_TYPE" = hContentType
+cleanupVarName "CONTENT_LENGTH" = hContentLength
+cleanupVarName "SCRIPT_NAME" = "CGI-Script-Name"
+cleanupVarName s =
+    case s of
+        'H':'T':'T':'P':'_':a:as -> String.fromString $ a : helper' as
+        _ -> String.fromString s -- FIXME remove?
+  where
+    helper' ('_':x:rest) = '-' : x : helper' rest
+    helper' (x:rest) = toLower x : helper' rest
+    helper' [] = []
+
+requestBodyHandle :: Handle -> Int -> IO (IO B.ByteString)
+requestBodyHandle h = requestBodyFunc $ \i -> do
+    bs <- B.hGet h i
+    return $ if B.null bs then Nothing else Just bs
+
+requestBodyFunc :: (Int -> IO (Maybe B.ByteString)) -> Int -> IO (IO B.ByteString)
+requestBodyFunc get count0 = do
+    ref <- newIORef count0
+    return $ do
+        count <- readIORef ref
+        if count <= 0
+            then return B.empty
+            else do
+                mbs <- get $ min count defaultChunkSize
+                writeIORef ref $ count - maybe 0 B.length mbs
+                return $ fromMaybe B.empty mbs

@@ -1,5 +1,5 @@ -----------------------------------------------------------------------------
--- Copyright 2016, Ideas project team. This file is distributed under the
+-- 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.
 -----------------------------------------------------------------------------
@@ -33,7 +33,7 @@ header :: String
 header =
    "IDEAS: Intelligent Domain-specific Exercise Assistants\n" ++
-   "Copyright 2016, Open Universiteit Nederland\n" ++
+   "Copyright 2018, Open Universiteit Nederland\n" ++
    versionText ++
    "\n\nUsage: ideas [OPTION]     (by default, CGI protocol)\n" ++
    "\nOptions:"

@@ -1,5 +1,5 @@ -----------------------------------------------------------------------------
--- Copyright 2016, Ideas project team. This file is distributed under the
+-- 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.
 -----------------------------------------------------------------------------
@@ -21,7 +21,11 @@ 
 import Control.Exception
 import Control.Monad
+import Data.ByteString (ByteString, unpack)
+import Data.Char
 import Data.Maybe
+import Data.Semigroup ((<>))
+import Data.String
 import Ideas.Encoding.ModeJSON (processJSON)
 import Ideas.Encoding.ModeXML (processXML)
 import Ideas.Encoding.Options (Options, maxTime, optionCgiBin)
@@ -32,12 +36,15 @@ import Ideas.Service.ServiceList
 import Ideas.Service.Types (Service)
 import Ideas.Utils.BlackBoxTests
+import Ideas.Utils.Prelude
 import Ideas.Utils.TestSuite
-import Network.CGI
+import Network.HTTP.Types
+import Network.Wai hiding (Request)
 import System.IO
-import System.IO.Error (ioeGetErrorString)
 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
 
 defaultMain :: DomainReasoner -> IO ()
 defaultMain = defaultMainWith mempty
@@ -51,53 +58,51 @@ 
 -- Invoked as a cgi binary
 defaultCGI :: Options -> DomainReasoner -> IO ()
-defaultCGI options dr = runCGI $ handleErrors $ do
+defaultCGI options dr = CGI.run $ \req respond -> do
    -- create a record for logging
-   logRef  <- liftIO Log.newLogRef
+   logRef  <- Log.newLogRef
    -- query environment
-   addr    <- remoteAddr       -- the IP address of the remote host
-   cgiBin  <- scriptName       -- get name of binary
-   input   <- inputOrDefault
+   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
    -- process request
-   (req, txt, ctp) <- liftIO $
-      process (options <> optionCgiBin cgiBin) dr logRef input
+   (preq, txt, ctp) <-
+      process (options <> optionCgiBin script) dr logRef input
    -- log request to database
-   when (useLogging req) $ liftIO $ do
-      Log.changeLog logRef $ \r -> Log.addRequest req r
+   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 req) logRef
+      Log.logRecord (getSchema preq) logRef
 
    -- write header and output
-   setHeader "Content-type" ctp
-   -- Cross-Origin Resource Sharing (CORS) prevents browser warnings
-   -- about cross-site scripting
-   setHeader "Access-Control-Allow-Origin" "*"
-   output txt
+   respond $ responseLBS
+      status200
+      [ (fromString "Content-Type", fromString ctp)
+        -- Cross-Origin Resource Sharing (CORS) prevents browser warnings
+        -- about cross-site scripting
+      , (fromString "Access-Control-Allow-Origin", fromString "*")
+      ]
+      (fromString txt)
 
-inputOrDefault :: CGI String
-inputOrDefault = do
-   inHtml <- acceptsHTML
-   ms     <- getInput "input" -- read variable 'input'
-   case ms of
+inputOrDefault :: CGI.Request -> IO String
+inputOrDefault req = do
+   maybeInput <- inputFromRequest req
+   case maybeInput of
       Just s -> return s
       Nothing
-         | inHtml    -> return defaultBrowser
-         | otherwise -> fail "environment variable 'input' is empty"
+         | acceptsHTML -> return defaultBrowser
+         | otherwise   -> fail "environment variable 'input' is empty"
  where
    -- Invoked from browser
    defaultBrowser :: String
    defaultBrowser = "<request service='index' encoding='html'/>"
 
-   acceptsHTML :: CGI Bool
-   acceptsHTML = do
-      maybeAcceptCT <- requestAccept
-      let htmlCT = ContentType "text" "html" []
-          xs = negotiate [htmlCT] maybeAcceptCT
-      return (isJust maybeAcceptCT && not (null xs))
+   acceptsHTML :: Bool
+   acceptsHTML = "text/html" `elem` accepts req
 
 -- Invoked from command-line with flags
 defaultCommandLine :: Options -> DomainReasoner -> [CmdLineOption] -> IO ()
@@ -113,7 +118,7 @@          -- process input file
          InputFile file ->
             withBinaryFile file ReadMode $ \h -> do
-               logRef <- liftIO Log.newLogRef
+               logRef <- Log.newLogRef
                input  <- hGetContents h
                (req, txt, _) <- process options dr logRef input
                putStrLn txt
@@ -139,8 +144,8 @@ process options dr logRef input = do
    format <- discoverDataFormat input
    run format options {maxTime = Just 5} (addVersion dr) logRef input
- `catch` \ioe -> do
-   let msg = "Error: " ++ ioeGetErrorString ioe
+ `catch` \e -> do
+   let msg = "Error: " ++ show (e :: SomeException)
    Log.changeLog logRef (\r -> r { Log.errormsg = msg })
    return (mempty, msg, "text/plain")
  where
@@ -158,4 +163,28 @@    , fullVersion = update fullVersion Options.fullVersion
    }
  where
-   update f s = if null (f dr) then s else f dr+   update f s = if null (f dr) then s else f dr
+
+-- local helper functions
+
+findHeader :: String -> CGI.Request -> Maybe String
+findHeader s = fmap fromByteString . lookup (fromString s) . requestHeaders
+
+inputFromRequest :: CGI.Request -> IO (Maybe String)
+inputFromRequest req =
+   -- first try query string (for GET requests) ...
+   case inputFromQuery (queryString req) of
+      Just s  -> return (Just s)
+      Nothing -> do
+         -- ... then try request body (for POST requests)
+         body <- requestBody req
+         return (inputFromQuery (parseQuery body))
+
+inputFromQuery :: Query -> Maybe String
+inputFromQuery = fmap fromByteString . join . lookup (fromString "input")
+
+accepts :: CGI.Request -> [String]
+accepts = maybe [] (splitsWithElem ',') . findHeader "Accept"
+
+fromByteString :: ByteString -> String
+fromByteString = map (chr . fromEnum) . unpack

@@ -1,11 +1,11 @@--- Automatically generated by Makefile.  Do not change.-module Ideas.Main.Revision where--ideasVersion :: String-ideasVersion = "1.6"--ideasRevision :: String-ideasRevision = "893c5ef99623f5741cb221bd14b52c17d133cc69"--ideasLastChanged :: String-ideasLastChanged = "Wed Dec 14 14:07:10 2016 +0100"+-- 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"

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

@@ -1,6 +1,6 @@ {-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
 -----------------------------------------------------------------------------
--- Copyright 2016, Ideas project team. This file is distributed under the
+-- 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.
 -----------------------------------------------------------------------------
@@ -16,10 +16,9 @@ module Ideas.Service.Diagnose
    ( Diagnosis(..), tDiagnosis, diagnose
    , getState, getStateAndReady
-   , difference, differenceEqual
+   , difference
    ) where
 
-import Data.Function
 import Data.List (intercalate, sortBy)
 import Data.Maybe
 import Ideas.Common.Library hiding (ready)
@@ -135,10 +134,9 @@       , (_, env) <- recognizeRule ex r sub1 sub2
       ]
     where
-      diff = if searchForBuggy then difference else differenceEqual
       (sub1, sub2) = fromMaybe (stateContext state, new) $ do
          newTerm <- fromContext new
-         (a, b)  <- diff ex (stateTerm state) newTerm
+         (a, b)  <- difference ex (stateTerm state) newTerm
          return (inContext ex a, inContext ex b)
 
 ----------------------------------------------------------------
@@ -175,13 +173,6 @@ difference ex a b = do
    v <- hasTermView ex
    Diff.differenceWith v a b
-
--- Used by the FP tutor
-differenceEqual :: Exercise a -> a -> a -> Maybe (a, a)
-differenceEqual ex a b = do
-   v <- hasTermView ex
-   let simpleEq = equivalence ex `on` inContext ex
-   Diff.differenceEqualWith v simpleEq a b
 
 ----------------------------------------------------------------
 -- Compare answer sets (and search for missing parts/incorrect parts)

@@ -1,5 +1,5 @@ -----------------------------------------------------------------------------
--- Copyright 2016, Ideas project team. This file is distributed under the
+-- 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.
 -----------------------------------------------------------------------------
@@ -19,7 +19,8 @@ 
 import Data.List
 import Data.Maybe
-import Data.Monoid
+import Data.Monoid hiding ((<>))
+import Data.Semigroup as Sem
 import Data.Ord
 import Ideas.Common.Library
 import Ideas.Service.FeedbackScript.Parser
@@ -41,9 +42,8 @@    , fullVersion :: String
    }
 
-instance Monoid DomainReasoner where
-   mempty = DR mempty mempty mempty mempty mempty mempty mempty mempty mempty
-   mappend c1 c2 = DR
+instance Sem.Semigroup DomainReasoner where
+   c1 <> c2 = DR
       { reasonerId  = reasonerId c1  <> reasonerId c2
       , exercises   = exercises c1   <> exercises c2
       , services    = services c1    <> services c2
@@ -54,6 +54,10 @@       , version     = version c1     <> version c2
       , fullVersion = fullVersion c1 <> fullVersion c2
       }
+
+instance Monoid DomainReasoner where
+   mempty  = DR mempty mempty mempty mempty mempty mempty mempty mempty mempty
+   mappend = (<>)
 
 instance HasId DomainReasoner where
    getId = reasonerId

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

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

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

@@ -1,5 +1,5 @@ -----------------------------------------------------------------------------
--- Copyright 2016, Ideas project team. This file is distributed under the
+-- 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.
 -----------------------------------------------------------------------------
@@ -21,6 +21,8 @@ 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
 
@@ -102,13 +104,19 @@    showList xs ys =
       foldr (combine . show) ys (concatMap textItems xs)
 
+instance Sem.Semigroup Script where
+   s <> t = makeScript (scriptDecls s ++ scriptDecls t)
+
 instance Monoid Script where
-   mempty = makeScript []
-   mappend s t = makeScript (scriptDecls s ++ scriptDecls t)
+   mempty  = makeScript []
+   mappend = (<>)
 
+instance Sem.Semigroup Text where
+   (<>) = (:<>:)
+
 instance Monoid Text where
    mempty  = TextEmpty
-   mappend = (:<>:)
+   mappend = (<>)
 
 instance Uniplate Condition where
    uniplate (CondNot a) = plate CondNot |* a

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

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

@@ -1,5 +1,5 @@ -----------------------------------------------------------------------------
--- Copyright 2016, Ideas project team. This file is distributed under the
+-- 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.
 -----------------------------------------------------------------------------
@@ -46,7 +46,7 @@ metaServiceList dr =
    [ indexS dr, servicelistS dr, serviceinfoS dr, exerciselistS dr
    , rulelistS, ruleinfoS, rulesinfoS, strategyinfoS, exerciseinfoS
-   , stateinfoS, examplederivationsS, testreportS, logS
+   , constraintlistS, stateinfoS, examplederivationsS, testreportS, logS
    ]
 
 ------------------------------------------------------
@@ -305,6 +305,11 @@ exerciseinfoS = makeService "meta.exerciseinfo"
    "Exercise information" $
    id ::: tExercise .-> tExercise
+
+constraintlistS :: Service
+constraintlistS = makeService "meta.constraintlist"
+   "Returns list of constraints" $
+   constraints ::: tExercise .-> tList tConstraint
 
 stateinfoS :: Service
 stateinfoS = makeService "meta.stateinfo"

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

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

@@ -1,6 +1,6 @@ {-# LANGUAGE GADTs, RankNTypes, FlexibleInstances, FlexibleContexts #-}
 -----------------------------------------------------------------------------
--- Copyright 2016, Ideas project team. This file is distributed under the
+-- 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.
 -----------------------------------------------------------------------------
@@ -19,11 +19,12 @@    , TypeRep(..), Const(..), Type, TypedValue(..)
    , Equal(..), ShowF(..), equalM
      -- * Constructing types
-   , tEnvironment, tLocation, tRule, tUnit, tTuple3, tTuple4, tTuple5, tPair
+   , tEnvironment, tLocation, tRule, tConstraint
+   , tUnit, tTuple3, tTuple4, tTuple5, tPair
    , tTerm, tStrategy, tTree, tState, tBool, tMaybe, tString, tList
    , tId, tService, tSomeExercise, tText, tDifficulty, tUserId ,tContext
    , tDerivation, tError, (.->), tIO, tExercise, tTestSuiteResult, tQCGen
-   , tScript, tExamples, tStrategyCfg, tInt
+   , tScript, tExamples, tStrategyCfg, tMathML, tInt
      -- * Searching a typed value
    , findValuesOfType
    ) where
@@ -36,6 +37,7 @@ import Ideas.Common.Library
 import Ideas.Service.FeedbackScript.Syntax
 import Ideas.Service.State
+import Ideas.Text.MathML
 import Test.QuickCheck.Random (QCGen)
 import qualified Ideas.Utils.TestSuite as TestSuite
 
@@ -85,11 +87,13 @@    equal Int         Int         = Just id
    equal Bool        Bool        = Just id
    equal String      String      = Just id
+   equal MathML      MathML      = Just id
    equal Service     Service     = Just id
    equal Exercise    Exercise    = Just id
    equal Strategy    Strategy    = Just id
    equal State       State       = Just id
-   equal Rule         Rule       = Just id
+   equal Rule        Rule        = Just id
+   equal Constraint  Constraint  = Just id
    equal Context     Context     = Just id
    equal Id          Id          = Just id
    equal Location    Location    = Just id
@@ -140,6 +144,7 @@    Strategy     :: Const a (Strategy (Context a))
    State        :: Const a (State a)
    Rule         :: Const a (Rule (Context a))
+   Constraint   :: Const a (Constraint (Context a))
    Context      :: Const a (Context a)
    -- other types
    Id           :: Const a Id
@@ -152,6 +157,7 @@    QCGen        :: Const a QCGen
    Result       :: Const a TestSuite.Result
    SomeExercise :: Const a (Some Exercise)
+   MathML       :: Const a MathML
    -- basic types
    Bool         :: Const a Bool
    Int          :: Const a Int
@@ -198,6 +204,7 @@          Exercise         -> showId val
          Strategy         -> show val
          Rule             -> showId val
+         Constraint       -> showId val
          Id               -> showId val
          SomeExercise     -> case val of Some ex -> showId ex
          State            -> show val
@@ -210,6 +217,7 @@          Text             -> show val
          QCGen            -> show val
          Result           -> show val
+         MathML           -> show val
          Bool             -> map toLower (show val)
          Int              -> show val
          String           -> val
@@ -223,6 +231,7 @@    showF Strategy     = "Strategy"
    showF State        = "State"
    showF Rule         = "Rule"
+   showF Constraint   = "Constraint"
    showF Context      = "Context"
    showF Id           = "Id"
    showF Location     = "Location"
@@ -234,6 +243,7 @@    showF QCGen        = "QCGen"
    showF Result       = "TestSuiteResult"
    showF SomeExercise = "Exercise"
+   showF MathML       = "MathML"
    showF Bool         = "Bool"
    showF Int          = "Int"
    showF String       = "String"
@@ -299,6 +309,9 @@ tContext :: Type a (Context a)
 tContext = Const Context
 
+tMathML :: Type a MathML
+tMathML = Const MathML
+
 tBool :: Type a Bool
 tBool = Const Bool
 
@@ -307,6 +320,9 @@ 
 tRule :: Type a (Rule (Context a))
 tRule = Const Rule
+
+tConstraint :: Type a (Constraint (Context a))
+tConstraint = Const Constraint
 
 tLocation :: Type a Location
 tLocation = Const Location

@@ -1,5 +1,5 @@ -----------------------------------------------------------------------------
--- Copyright 2016, Ideas project team. This file is distributed under the
+-- 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.
 -----------------------------------------------------------------------------
@@ -15,7 +15,7 @@ 
 module Ideas.Text.HTML
    ( HTMLPage, HTMLBuilder
-   , addCSS, addScript, showHTML
+   , addCSS, addScript, addStyle, showHTML
    , string, text
    , htmlPage, link
    , h1, h2, h3, h4, h5, h6
@@ -32,7 +32,7 @@ 
 import Data.Char
 import Data.List
-import Data.Monoid
+import Data.Monoid hiding ((<>))
 import Ideas.Text.XML
 import Prelude hiding (div)
 import qualified Ideas.Text.XML as XML
@@ -43,6 +43,7 @@    { title       :: String
    , styleSheets :: [FilePath]
    , scripts     :: [FilePath]
+   , styleTxts   :: [String]
    , htmlContent :: HTMLBuilder
    }
 
@@ -59,6 +60,10 @@               | css <- styleSheets page
               ]
          , mconcat
+              [ tag "style" (unescaped txt)
+              | txt <- styleTxts page
+              ]
+         , mconcat
               [ element "script" ["src" .=. js, "type" .=. "text/javascript", string " "]
               | js <- scripts page
               ]
@@ -75,9 +80,12 @@ addScript :: FilePath -> HTMLPage -> HTMLPage
 addScript js page = page { scripts = js : scripts page }
 
+addStyle :: String -> HTMLPage -> HTMLPage
+addStyle txt page = page { styleTxts = txt : styleTxts page }
+
 -- html helper functions
 htmlPage :: String -> HTMLBuilder -> HTMLPage
-htmlPage s = HTMLPage s [] []
+htmlPage s = HTMLPage s [] [] []
 
 link :: BuildXML a => String -> a -> a
 link url body = tag "a" $

@@ -0,0 +1,135 @@+{-# LANGUAGE OverloadedStrings #-}
+-----------------------------------------------------------------------------
+-- 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)
+--
+-- W3CSS templates for html pages
+--
+-----------------------------------------------------------------------------
+
+module Ideas.Text.HTML.Templates
+   ( webpage, WebPage(..), Button(..), Style
+   , fontAwesome
+   ) where
+
+import Ideas.Text.HTML
+import Ideas.Text.HTML.W3CSS hiding (tag, ul, top, table, content)
+import Ideas.Text.XML hiding (content)
+import qualified Ideas.Text.HTML.W3CSS as W3
+
+data WebPage = WebPage
+   { title          :: String
+   , menuButtons    :: [Button]
+   , menuStyle      :: Style
+   , iconBarsStyle  :: Style
+   , sideWidth      :: Int
+   , sideHeader     :: HTMLBuilder
+   , sideButtons    :: [Button]
+   , sideStyle      :: Style
+   , iconCloseStyle :: Style
+   , content        :: HTMLBuilder
+   , footer         :: HTMLBuilder
+   , footerStyle    :: Style
+   }
+
+type Style = HTMLBuilder -> HTMLBuilder
+
+data Button = Button
+   { buttonUrl   :: String
+   , buttonStyle :: HTMLBuilder -> HTMLBuilder
+   , buttonText  :: HTMLBuilder
+   }
+
+fromButtons :: [Button] -> HTMLBuilder
+fromButtons = mconcat . map fromButton
+
+fromButton :: Button -> HTMLBuilder
+fromButton b = button (buttonUrl b) $ barItem $ buttonStyle b $ buttonText b
+
+fontAwesome :: BuildXML a => String -> a
+fontAwesome s = italic $ ("class" .=. ("fa fa-" ++ s)) <> string " "
+
+-- https://www.w3schools.com/w3css/tryw3css_templates_webpage.htm
+webpage :: WebPage -> HTMLPage
+webpage wp = w3css $
+   addCSS "https://fonts.googleapis.com/css?family=Roboto" $
+   addCSS "https://cdnjs.cloudflare.com/ajax/libs/font-awesome/4.7.0/css/font-awesome.min.css" $
+   addStyle styleText $
+   htmlPage (title wp) $
+      navBar <> sideBar <> overlayEffect <> mainContent <> script
+ where
+   navBar = tag "div" $ W3.top $
+      tag "div" $ bar $ W3.top $ leftAlign $ menuStyle wp $ mconcat
+         [ if null (sideButtons wp) then mempty else
+           button "javascript:void(0)" $ barItem $ right $ hideLarge $ iconBarsStyle wp $
+              ("onclick" .=. "w3_open()") <> fontAwesome "bars"
+         , fromButtons (menuButtons wp)
+         ]
+
+   sideBar = if null (sideButtons wp) then mempty else
+      tag "nav" $ sidebar $ barBlock $ collapse $ sideStyle wp $ mconcat
+         [ "id" .=. "mySidebar"
+         , link "javascript:void(0)" $ right $ padding Large $ iconCloseStyle wp $ hideLarge $ mconcat
+              [ "onclick" .=. "w3_close()"
+              , "title"   .=. "Close Menu"
+              , fontAwesome "remove"
+              ]
+         , sideHeader wp
+         , fromButtons (sideButtons wp)
+         ]
+
+   overlayEffect = tag "div" $ overlay $ hideLarge $ mconcat
+      [ "onclick" .=. "w3_close()"
+      , "style"   .=. "cursor:pointer"
+      , "title"   .=. "close side menu"
+      , "id"      .=. "myOverlay"
+      , " "
+      ]
+
+   script = tag "script" (unescaped scriptText)
+
+   width | null (sideButtons wp) = "0px"
+         | otherwise             = show (sideWidth wp) ++ "px"
+
+   mainContent = tag "div" $ mainPage $ mconcat
+      [ "style" .=. ("margin-left:" ++ width)
+      , container $ vpadding XXXL $ content wp
+      , tag "footer" $ mconcat
+           [ "id" .=. "myFooter"
+           , container $ footerStyle wp $ para $ footer wp
+           ]
+      ]
+
+   styleText =
+      "html,body,h1,h2,h3,h4,h5,h6 {font-family: \"Roboto\", sans-serif;}\
+      \.w3-sidebar {\
+      \  z-index: 3;\
+      \  width: " ++ width ++ ";\
+      \  top: 43px;\
+      \  bottom: 0;\
+      \  height: inherit;\
+      \}"
+
+scriptText :: String
+scriptText =
+   "var mySidebar = document.getElementById(\"mySidebar\");\
+   \var overlayBg = document.getElementById(\"myOverlay\");\
+   \function w3_open() {\
+   \    if (mySidebar.style.display === 'block') {\
+   \        mySidebar.style.display = 'none';\
+   \        overlayBg.style.display = 'none';\
+   \    } else {\
+   \        mySidebar.style.display = 'block';\
+   \        overlayBg.style.display = 'block';\
+   \    }\
+   \}\
+   \function w3_close() {\
+   \    mySidebar.style.display = 'none';\
+   \    overlayBg.style.display = 'none';\
+   \}"

@@ -0,0 +1,633 @@+-----------------------------------------------------------------------------
+-- 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)
+--
+-- A minimal interface for using W3.CSS, a modern CSS framework with built-in
+-- responsiveness.
+-- See https://www.w3schools.com/w3css/
+--
+-----------------------------------------------------------------------------
+module Ideas.Text.HTML.W3CSS where
+
+import Data.Char
+import Ideas.Text.HTML
+import Ideas.Text.XML
+import qualified Ideas.Text.XML as XML
+
+w3css :: HTMLPage -> HTMLPage
+w3css = addCSS "https://www.w3schools.com/w3css/4/w3.css"
+
+w3class :: BuildXML a => String -> a -> a
+w3class s a = ("class" .=. s) <> a
+
+w3classIf :: BuildXML a => Bool -> String -> a -> a
+w3classIf b s = if b then w3class s else id
+
+data Color
+   = Red | Pink | Purple | DeepPurple | Indigo | Blue | LightBlue
+   | Cyan | Aqua | Teal | Green | LightGreen | Lime | Sand | Khaki
+   | Yellow | Amber | Orange | DeepOrange | BlueGray | Brown | LightGray
+   | Gray | DarkGray | Black | PaleRed | PaleYellow | PaleGreen | PaleBlue | White
+ deriving Show
+
+data Size = Tiny | Small | Medium | Large | XL | XXL | XXXL | Jumbo
+ deriving (Eq, Ord)
+
+data Position = TopLeft    | Top    | TopRight
+              | CenterLeft | Center | CenterRight
+              | BottomLeft | Bottom | BottomRight
+ deriving (Show, Eq)
+
+onTop, onLeft, onRight, onBottom :: Position -> Bool
+onTop    = (`elem` [TopLeft, Top, TopRight])
+onLeft   = (`elem` [TopLeft, CenterLeft, BottomLeft])
+onRight  = (`elem` [TopRight, CenterRight, BottomRight])
+onBottom = (`elem` [BottomLeft, Bottom, BottomRight])
+
+instance Show Size where
+   show Tiny   = "tiny"
+   show Small  = "small"
+   show Medium = "medium"
+   show Large  = "large"
+   show XL     = "xlarge"
+   show XXL    = "xxlarge"
+   show XXXL   = "xxxlarge"
+   show Jumbo  = "jumbo"
+
+uncamel :: String -> String
+uncamel = concatMap f
+ where
+   f c = if isUpper c then ['-', toLower c] else [c]
+
+--------------------------------------------------------------------------------
+-- * Container Classes
+
+-- | HTML container with 16px left and right padding
+container :: BuildXML a => a -> a
+container = XML.tag "div" . w3class "w3-container"
+
+-- | HTML container with 16px left and right padding and 16px top and bottom margin
+panel :: BuildXML a => a -> a
+panel = XML.tag "div" . w3class "w3-panel"
+
+-- | Circular badge
+badge :: BuildXML a => a -> a
+badge = XML.tag "span" . w3class "w3-badge"
+
+-- | Rectangular tag
+tag :: BuildXML a => a -> a
+tag = XML.tag "span" . w3class "w3-tag"
+
+-- | Unordered list
+ul :: BuildXML a => [a] -> a
+ul = ulWith id
+
+-- | Unordered list
+ulWith :: BuildXML a => (a -> a) -> [a] -> a
+ulWith f = XML.tag "ul" . w3class "w3-ul" . f . mconcat . map (XML.tag "li")
+
+-- | Code container
+code :: BuildXML a => a -> a
+code = XML.tag "div" . w3class "w3-code"
+
+-- | Inline code container (for code snippets)
+codespan :: BuildXML a => a -> a
+codespan = XML.tag "code" . w3class "w3-codespan"
+
+--------------------------------------------------------------------------------
+-- * Table Classes
+
+-- | Container for an HTML table
+table :: BuildXML a => a -> a
+table = XML.tag "table" .  w3class "w3-table"
+
+-- | All properties set
+tableAll :: BuildXML a => a -> a
+tableAll = XML.tag "table" . w3class "w3-table-all"
+
+-- | Striped table
+striped :: BuildXML a => a -> a
+striped = w3class "w3-striped"
+
+-- | Bordered lines
+bordered :: BuildXML a => a -> a
+bordered = w3class "w3-bordered"
+
+-- | Centered table
+centered :: BuildXML a => a -> a
+centered = w3class "w3-centered"
+
+-- | Hoverable table
+hoverable :: BuildXML a => a -> a
+hoverable = w3class "w3-hoverable"
+
+-- | Creates a responsive table
+responsive :: BuildXML a => a -> a
+responsive = w3class "w3-responsive"
+
+--------------------------------------------------------------------------------
+-- * Card Classes
+
+-- | Same as w3-card-2
+card :: BuildXML a => a -> a
+card = w3class "w3-card"
+
+-- | Container for any HTML content (2px bordered shadow)
+card2 :: BuildXML a => a -> a
+card2 = w3class "w3-card-2"
+
+-- | Container for any HTML content (4px bordered shadow)
+card4 :: BuildXML a => a -> a
+card4 = w3class "w3-card-4"
+
+--------------------------------------------------------------------------------
+-- * Responsive Classes
+
+-- | Container for one row of fluid responsive content
+row :: BuildXML a => a -> a
+row = w3class "w3-row"
+
+-- | Row where all columns have a default padding
+rowPadding :: BuildXML a => a -> a
+rowPadding = w3class "w3-row-padding"
+
+-- | Container for fixed size centered content
+content :: BuildXML a => a -> a
+content = w3class "w3-content"
+
+-- | Half (1/2) screen column container
+half :: BuildXML a => a -> a
+half = w3class "w3-half"
+
+-- | Third (1/3) screen column container
+third :: BuildXML a => a -> a
+third = w3class "w3-third"
+
+-- | Two third (2/3) screen column container
+twothird :: BuildXML a => a -> a
+twothird = w3class "w3-twothird"
+
+-- | Quarter (1/4) screen column container
+quarter :: BuildXML a => a -> a
+quarter = w3class "w3-quarter"
+
+-- | Three quarters (3/4) screen column container
+threequarter :: BuildXML a => a -> a
+threequarter = w3class "w3-threequarter"
+
+-- | Column container for any HTML content
+col :: BuildXML a => a -> a
+col = w3class "w3-col"
+
+-- | Occupies the rest of the column width
+rest :: BuildXML a => a -> a
+rest = w3class "w3-rest"
+
+-- | Hide content on small screens (less than 601px)
+hideSmall :: BuildXML a => a -> a
+hideSmall = w3class "w3-hide-small"
+
+-- | Hide content on medium screens
+hideMedium :: BuildXML a => a -> a
+hideMedium = w3class "w3-hide-medium"
+
+-- | Hide content on large screens (larger than 992px)
+hideLarge :: BuildXML a => a -> a
+hideLarge = w3class "w3-hide-large"
+
+-- | Responsive image
+image :: BuildXML a => a -> a
+image = w3class "w3-image"
+
+-- | Adds mobile-first responsiveness to any element. Displays elements as block elements on mobile devices.
+mobile :: BuildXML a => a -> a
+mobile = w3class "w3-mobile"
+
+-- l1 - l12 Responsive sizes for large screens
+-- m1 - m12 Responsive sizes for medium screens
+-- s1 - s12 Responsive sizes for small screens
+
+--------------------------------------------------------------------------------
+-- * Layout Classes
+
+-- | Container for layout columns (cells).
+cellRow :: BuildXML a => a -> a
+cellRow = w3class "w3-cell-row"
+
+-- | Layout column (cell).
+cell :: BuildXML a => a -> a
+cell = w3class "w3-cell"
+
+-- | Aligns content at the top of a column (cell).
+cellTop :: BuildXML a => a -> a
+cellTop = w3class "w3-cell-top"
+
+-- | Aligns content at the vertical middle of a column (cell).
+cellMiddle :: BuildXML a => a -> a
+cellMiddle = w3class "w3-cell-middle"
+
+-- | Aligns content at the bottom of a column (cell).
+cellBottom :: BuildXML a => a -> a
+cellBottom = w3class "w3-cell-bottom"
+
+--------------------------------------------------------------------------------
+-- * Bar Classes - Navigation
+
+-- | Horizontal bar
+bar :: BuildXML a => a -> a
+bar = w3class "w3-bar"
+
+-- | Vertical bar
+barBlock :: BuildXML a => a -> a
+barBlock = w3class "w3-bar-block"
+
+-- | Provides common style for bar items
+barItem :: BuildXML a => a -> a
+barItem = w3class "w3-bar-item"
+
+-- | Side bar
+sidebar :: BuildXML a => a -> a
+sidebar = w3class "w3-sidebar"
+
+-- | Used together with w3-sidebar to create a fully automatic responsive side navigation. For this class to work, the page content must be within a "w3-main" class
+collapse :: BuildXML a => a -> a
+collapse = w3class "w3-collapse"
+
+-- | Container for page content when using the w3-collapse class for responsive side navigations
+mainPage :: BuildXML a => a -> a
+mainPage = w3class "w3-main"
+
+--------------------------------------------------------------------------------
+-- * Dropdown Classes
+
+-- | Clickable dropdown element
+dropdownClick :: BuildXML a => a -> a
+dropdownClick = w3class "w3-dropdown-click"
+
+-- | Hoverable dropdown element
+dropdownHover :: BuildXML a => a -> a
+dropdownHover = w3class "w3-dropdown-hover"
+
+--------------------------------------------------------------------------------
+-- * Button Classes
+
+-- | Rectangular button with grey background color on hover
+button :: BuildXML a => String -> a -> a
+button url = link url . w3class "w3-button"
+
+-- | Rectangular button with shadows on hover
+btn :: BuildXML a => String -> a -> a
+btn url = link url . w3class "w3-btn"
+
+-- | Rectangular button with ripple effect
+ripple :: BuildXML a => String -> a -> a
+ripple url = link url . w3class "w3-ripple"
+
+--------------------------------------------------------------------------------
+-- * Input Classes
+
+-- | Input elements
+input :: BuildXML a => a -> a
+input = w3class "w3-input"
+
+-- | Checkbox input type
+check :: BuildXML a => a -> a
+check = w3class "w3-check"
+
+-- | Radio input type
+radio :: BuildXML a => a -> a
+radio = w3class "w3-radio"
+
+-- | Input select element
+select :: BuildXML a => a -> a
+select = w3class "w3-select"
+
+--------------------------------------------------------------------------------
+-- * Modal Classes
+
+-- | Modal container
+modal :: BuildXML a => a -> a
+modal = w3class "w3-modal"
+
+-- | Modal pop-up element
+modalContent :: BuildXML a => a -> a
+modalContent = w3class "w3-modal-content"
+
+-- | Tooltip element
+tooltip :: BuildXML a => a -> a
+tooltip = w3class "w3-tooltip"
+
+-- | Tooltip text
+tooltipText :: BuildXML a => a -> a
+tooltipText = w3class "w3-text"
+
+--------------------------------------------------------------------------------
+-- * Animation Classes
+
+-- | Animates an element from -300px to 0px
+animate :: BuildXML a => Position -> a -> a
+animate p = w3classIf (onTop p)    "w3-animate-top"
+          . w3classIf (onLeft p)   "w3-animate-left"
+          . w3classIf (onBottom p) "w3-animate-bottom"
+          . w3classIf (onRight p)  "w3-animate-right"
+
+-- | Animates an element's opacity from 0 to 1
+animateOpacity :: BuildXML a => a -> a
+animateOpacity = w3class "w3-animate-opacity"
+
+-- | Animates an element from 0 to 100% in size
+animateZoom :: BuildXML a => a -> a
+animateZoom = w3class "w3-animate-zoom"
+
+-- | Animates an element's opacity from 0 to 1 and 1 to 0 (fades in AND out)
+animateFading :: BuildXML a => a -> a
+animateFading = w3class "w3-animate-fading"
+
+-- | Spin an icon 360 degrees
+spin :: BuildXML a => a -> a
+spin = w3class "w3-spin"
+
+-- | Animates the width of an input field to 100%
+animateInput :: BuildXML a => a -> a
+animateInput = w3class "w3-animate-input"
+
+--------------------------------------------------------------------------------
+-- * Font and Text Classes
+
+-- | Specifies a font size: tiny 10px, small 12px, large 18px, xlarge 24px, xxlarge 32px, xxxlarge 48px, jumbo 64px
+fontSize :: BuildXML a => Size -> a -> a
+fontSize = w3class . ("w3-" ++) . show
+
+-- | Specifies a wider text
+wide :: BuildXML a => a -> a
+wide = w3class "w3-wide"
+
+-- | Changes the font to serif
+serif :: BuildXML a => a -> a
+serif = w3class "w3-serif"
+
+--------------------------------------------------------------------------------
+-- * Display Classes
+
+-- | Centered content
+center :: BuildXML a => a -> a
+center = w3class "w3-center"
+
+-- | Floats an element to the left (float: left)
+left :: BuildXML a => a -> a
+left = w3class "w3-left"
+
+-- | Floats an element to the right (float: right)
+right :: BuildXML a => a -> a
+right = w3class "w3-right"
+
+-- | Left aligned text
+leftAlign :: BuildXML a => a -> a
+leftAlign = w3class "w3-left-align"
+
+-- | Right aligned text
+rightAlign :: BuildXML a => a -> a
+rightAlign = w3class "w3-right-align"
+
+-- | Right and left aligned text
+justify :: BuildXML a => a -> a
+justify = w3class "w3-justify"
+
+-- | Circled content
+circle :: BuildXML a => a -> a
+circle = w3class "w3-circle"
+
+-- | Hidden content (display:none)
+hide :: BuildXML a => a -> a
+hide = w3class "w3-hide"
+
+-- | Alias of w3-show (display:block)
+showBlock :: BuildXML a => a -> a
+showBlock = w3class "w3-show-block"
+
+-- | Show content as inline-block (display:inline-block)
+showInlineBlock :: BuildXML a => a -> a
+showInlineBlock = w3class "w3-show-inline-block"
+
+-- | Fixed content at the top of a page
+top :: BuildXML a => a -> a
+top = w3class "w3-top"
+
+-- | Fixed content at the bottom of a page
+bottom :: BuildXML a => a -> a
+bottom = w3class "w3-bottom"
+
+-- | Container for w3-display-classes (position: relative)
+display :: BuildXML a => Position -> a -> a
+display p = w3class "w3-display-container" . w3class (f p)
+ where
+   f TopLeft     = "w3-display-topleft"
+   f Top         = "w3-display-topmiddle"
+   f TopRight    = "w3-display-topright"
+   f CenterLeft  = "w3-display-left"
+   f Center      = "w3-display-middle"
+   f CenterRight = "w3-display-right"
+   f BottomLeft  = "w3-display-bottomleft"
+   f Bottom      = "w3-display-bottommiddle"
+   f BottomRight = "w3-display-bottomright"
+
+-- | Displays content on hover inside the w3-display-container
+displayHover :: BuildXML a => a -> a
+displayHover = w3class "w3-display-hover"
+
+--------------------------------------------------------------------------------
+-- * Effect Classes
+
+-- | Adds opacity/transparency to an element (opacity: 0.6)
+opacity :: BuildXML a => a -> a
+opacity = w3class "w3-opacity"
+
+-- | Turns off opacity/transparency (opacity: 1)
+opacityOff :: BuildXML a => a -> a
+opacityOff = w3class "w3-opacity-off"
+
+-- | Adds opacity/transparency to an element (opacity: 0.75)
+opacityMin :: BuildXML a => a -> a
+opacityMin = w3class "w3-opacity-min"
+
+-- | Adds opacity/transparency to an element (opacity: 0.25)
+opacityMax :: BuildXML a => a -> a
+opacityMax = w3class "w3-opacity-max"
+
+-- | Adds a grayscale effect to an element (grayscale: 50%)
+grayscaleMin :: BuildXML a => a -> a
+grayscaleMin = w3class "w3-grayscale-min"
+
+-- | Adds a grayscale effect to an element (grayscale: 75%)
+grayscale :: BuildXML a => a -> a
+grayscale = w3class "w3-grayscale"
+
+-- | Adds a grayscale effect to an element (grayscale: 100%)
+grayscaleMax :: BuildXML a => a -> a
+grayscaleMax = w3class "w3-grayscale-max"
+
+-- | Adds a sepia effect to an element (sepia: 50%)
+sepiaMin :: BuildXML a => a -> a
+sepiaMin = w3class "w3-sepia-min"
+
+-- | Adds a sepia effect to an element (sepia: 75%)
+sepia :: BuildXML a => a -> a
+sepia = w3class "w3-sepia"
+
+-- | Adds a sepia effect to an element (sepia: 100%)
+sepiaMax :: BuildXML a => a -> a
+sepiaMax = w3class "w3-sepia-max"
+
+-- | Creates an overlay effect
+overlay :: BuildXML a => a -> a
+overlay = w3class "w3-overlay"
+
+--------------------------------------------------------------------------------
+-- * Background Color Classes
+
+-- | Background color
+background :: BuildXML a => Color -> a -> a
+background = w3class . ("w3" ++) .  uncamel . show
+
+-- | Transparent background-color
+transparent :: BuildXML a => a -> a
+transparent = w3class "w3-transparent"
+
+--------------------------------------------------------------------------------
+--  * Color Classes
+
+-- | Hover color
+hover :: BuildXML a => Color -> a -> a
+hover = w3class . ("w3-hover" ++) .  uncamel . show
+
+--------------------------------------------------------------------------------
+-- * Text Color Classes
+
+-- | Text color
+textColor :: BuildXML a => Color -> a -> a
+textColor = w3class . ("w3-text" ++) .  uncamel . show
+
+--------------------------------------------------------------------------------
+-- * Hover Classes
+
+-- | Hover text color
+hoverColor :: BuildXML a => Color -> a -> a
+hoverColor = w3class . ("w3-hover-text" ++) .  uncamel . show
+
+-- | Adds transparency to an element on hover (opacity: 0.6)
+hoverOpacity :: BuildXML a => a -> a
+hoverOpacity = w3class "w3-hover-opacity"
+
+-- | Removes transparency from an element on hover (100% opacity)
+hoverOpacityOff :: BuildXML a => a -> a
+hoverOpacityOff = w3class "w3-hover-opacity-off"
+
+-- | Adds shadow to an element on hover
+hoverShadow :: BuildXML a => a -> a
+hoverShadow = w3class "w3-hover-shadow"
+
+-- | Adds a black and white (100% grayscale) effect to an element
+hoverGrayscale :: BuildXML a => a -> a
+hoverGrayscale = w3class "w3-hover-grayscale"
+
+-- | Adds a sepia effect to an element on hover
+hoverSepia :: BuildXML a => a -> a
+hoverSepia = w3class "w3-hover-sepia"
+
+-- | Removes hover effects from an element
+hoverNone :: BuildXML a => a -> a
+hoverNone = w3class "w3-hover-none"
+
+--------------------------------------------------------------------------------
+-- * Round Classes
+
+-- | Element rounded (border-radius): small 2px, medium 4px, large 8px, xlarge 16px, xxlarge 32px
+rounded :: BuildXML a => Size -> a -> a
+rounded s = w3class "w3-round" . w3class ("w3-round-" ++ show s)
+
+--------------------------------------------------------------------------------
+-- * Padding Classes
+
+-- | Small: Padding 4px top and bottom, and 8px left and right, Medium: Padding 8px top and bottom, and 16px left and right, Large: Padding 12px top and bottom, and 24px left and right.
+padding :: BuildXML a => Size -> a -> a
+padding s
+   | s < Medium = w3class "w3-padding-small"
+   | s > Medium = w3class "w3-padding-large"
+   | otherwise  = w3class "w3-padding-small"
+
+-- | Padding top and bottom: medium 16px, large 24px, xlarge 32px, xxlarge 48px, xxxlarge 64px
+vpadding :: BuildXML a => Size -> a -> a
+vpadding s
+   | s <= Medium = w3class "w3-padding-16"
+   | s == Large  = w3class "w3-padding-24"
+   | s == XL     = w3class "w3-padding-32"
+   | s == XXL    = w3class "w3-padding-48"
+   | otherwise   = w3class "w3-padding-64"
+
+--------------------------------------------------------------------------------
+-- * Margin Classes
+
+-- | Adds an 16px margin to an element
+margin :: BuildXML a => a -> a
+margin = w3class "w3-margin"
+
+marginPos :: BuildXML a => Position -> a -> a
+marginPos p = w3classIf (onTop p)    "w3-margin-top"
+            . w3classIf (onLeft p)   "w3-margin-left"
+            . w3classIf (onBottom p) "w3-margin-bottom"
+            . w3classIf (onRight p)  "w3-margin-right"
+
+-- | Adds an 16px top and bottom margin to an element
+section :: BuildXML a => a -> a
+section = w3class "w3-section"
+
+--------------------------------------------------------------------------------
+-- * Border Classes
+
+-- | Borders (top, right, bottom, left)
+border :: BuildXML a => a -> a
+border = w3class "w3-border"
+
+borderPos :: BuildXML a => Position -> a -> a
+borderPos p = w3classIf (onTop p)    "w3-border-top"
+            . w3classIf (onLeft p)   "w3-border-left"
+            . w3classIf (onBottom p) "w3-border-bottom"
+            . w3classIf (onRight p)  "w3-border-right"
+
+-- | Removes all borders
+noBorder :: BuildXML a => a -> a
+noBorder = w3class "w3-border-0"
+
+-- | Border color
+borderColor :: BuildXML a => Color -> a -> a
+borderColor = w3class . ("w3-border" ++) .  uncamel . show
+
+-- | Adds a thick border (bar) to an element
+barPos :: BuildXML a => Position -> a -> a
+barPos p = w3classIf (onTop p)    "w3-topbar"
+         . w3classIf (onLeft p)   "w3-leftbar"
+         . w3classIf (onBottom p) "w3-bottombar"
+         . w3classIf (onRight p)  "w3-rightbar"
+
+--------------------------------------------------------------------------------
+-- * Color themes
+
+data ColorTheme
+   = L1 | L2 | L3 | L4 | L5 -- light
+   | D1 | D2 | D3 | D4 | D5 -- dark
+ deriving Show
+
+-- standard color theme
+theme_, textTheme, borderTheme :: BuildXML a => a -> a
+theme_      = w3class "w3-theme"
+textTheme   = w3class "w3-text-theme"
+borderTheme = w3class "w3-border-theme"
+
+theme :: BuildXML a => ColorTheme -> a -> a
+theme = w3class . ("w3-theme-" ++) . map toLower . show

@@ -1,5 +1,5 @@ -----------------------------------------------------------------------------
--- Copyright 2016, Ideas project team. This file is distributed under the
+-- 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.
 -----------------------------------------------------------------------------
@@ -151,11 +151,6 @@    fromJSON (Array [a, b, c, d]) = (,,,) <$> fromJSON a <*> fromJSON b <*> fromJSON c <*> fromJSON d
    fromJSON _                    = fail "expecting an array with 4 elements"
 
-instance InJSON IOException where
-   toJSON     = toJSON . ioeGetErrorString
-   fromJSON (String s) = return (userError s)
-   fromJSON _ = fail "excepting a string"
-
 --------------------------------------------------------
 -- Parser
 
@@ -260,8 +255,10 @@          return (okResponse json (requestId req))
        `catch` handler req
  where
-   handler :: RPCRequest -> IOException -> IO RPCResponse
-   handler req e = return (errorResponse (toJSON e) (requestId req))
+   handler :: RPCRequest -> SomeException -> IO RPCResponse
+   handler req e =
+      let msg = maybe (show e) ioeGetErrorString (fromException e)
+      in return $ errorResponse (toJSON msg) (requestId req)
 
 --------------------------------------------------------
 -- Testing parser/pretty-printer

@@ -1,6 +1,6 @@ {-# LANGUAGE OverloadedStrings #-}
 -----------------------------------------------------------------------------
--- Copyright 2016, Ideas project team. This file is distributed under the
+-- 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.
 -----------------------------------------------------------------------------
@@ -20,7 +20,8 @@    ) where
 
 import Data.List
-import Data.Monoid
+import Data.Monoid hiding ((<>))
+import Data.Semigroup as Sem
 import Data.String
 
 newtype Latex = L { showLatex :: String }
@@ -31,9 +32,12 @@ instance IsString Latex where
    fromString = L
 
+instance Sem.Semigroup Latex where
+   L xs <> L ys = L (xs <> ys)
+
 instance Monoid Latex where
-   mempty = L []
-   L xs `mappend` L ys = L (mappend xs ys)
+   mempty  = L []
+   mappend = (<>)
 
 class ToLatex a where
    toLatex     :: a -> Latex

@@ -0,0 +1,136 @@+-----------------------------------------------------------------------------
+-- 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)
+--
+-----------------------------------------------------------------------------
+
+module Ideas.Text.MathML
+   ( MathML(..), xml2mathml, mathml2xml
+   ) where
+
+import Data.Either
+import Data.Maybe
+import Ideas.Text.XML
+import Ideas.Utils.Uniplate hiding (children)
+
+data MathML = MRow [MathML]
+            | MId String
+            | MNumber String
+            | MOperator String
+            | MString String
+            | MText String
+            | MSqrt MathML
+            | MRoot MathML MathML
+            | MSup MathML MathML -- base, superscript
+            | MSub MathML MathML -- base, subscript
+            | MSubSup MathML MathML MathML -- base, subscript, superscript
+            | MFrac MathML MathML -- numerator, denominator
+            | MFenced String String MathML -- left, right, content
+            | MSpace
+            | MStyle
+            | MPadded
+            | MPhantom
+            | MError
+            | MEnclose
+            | MUnder
+            | MOver
+            | MUnderOver
+            | MTable
+            | MTableRow
+            | MLabeledTableRow
+            | MTableData
+   deriving (Show, Eq)
+{-
+from: https://www.w3.org/TR/MathML2/chapter3.html#presm.mn @ 3.2.1
+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 InXML MathML where
+   toXML   = mathml2xml
+   fromXML = either fail return . xml2mathml
+
+instance Uniplate MathML where
+   uniplate math =
+      case math of
+         MRow xs       -> plate MRow ||* xs
+         _             -> plate math
+
+----------------------------------------------------------
+-- conversion functions: XML <-> MathML
+
+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
+       -- 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
+       _ -> fail ("unsupported MathML: " ++ show xml)
+   impliedMRow :: [Either String Element] -> Either String MathML
+   impliedMRow [Right r] = rec r
+   impliedMRow xs = MRow <$> mapM rec (rights xs)
+
+mathml2xml :: MathML -> XML
+mathml2xml = makeXML "math" . rec
+ where
+   rec :: MathML -> XMLBuilder
+   rec math =
+      case math of
+         MRow ms           -> element "mrow" (map rec ms)
+         MId s             -> element "mi" [string s]
+         MNumber s         -> element "mn" [string s]
+         MOperator s       -> element "mo" [string s]
+         MString s         -> element "ms" [string s]
+         MText s           -> element "mtext" [string s]
+         MSqrt m           -> element "msqrt" [rec m]
+         MRoot m1 m2       -> element "mroot" [rec m1, rec m2]
+         MSup m1 m2        -> element "msup" [rec m1, rec m2]
+         MSub m1 m2        -> element "msub" [rec m1, rec m2]
+         MSubSup m1 m2 m3  -> element "msubsup" [rec m1, rec m2, rec m3]
+         MFrac m1 m2       -> element "mfrac" [rec m1, rec m2]
+         MFenced s1 s2 m   -> element "mfenced" ["open" .=. s1, "close" .=. s2, rec m]
+         MSpace            -> element "mspace" []
+         MStyle            -> element "mstyle" []
+         MPadded           -> element "mpadded" []
+         MPhantom          -> element "mphantom" []
+         MError            -> element "merror" []
+         MEnclose          -> element "menclose" []
+         MUnder            -> element "munder" []
+         MOver             -> element "mover" []
+         MUnderOver        -> element "munderover" []
+         MTable            -> element "mtable" []
+         MTableRow         -> element "mtr" []
+         MLabeledTableRow  -> element "mlabeledtr" []
+         MTableData        -> element "mtd" []

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

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

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

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

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

@@ -1,5 +1,5 @@ -----------------------------------------------------------------------------
--- Copyright 2016, Ideas project team. This file is distributed under the
+-- 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.
 -----------------------------------------------------------------------------
@@ -19,15 +19,21 @@    , parseXML, parseXMLFile, compactXML, findAttribute
    , children, Attribute(..), fromBuilder, findChild, findChildren, getData
    , BuildXML(..)
-   , module Data.Monoid, munless, mwhen
+   , module Data.Monoid
+   , (<>)
+   , munless, mwhen
    ) where
 
 import Control.Monad
 import Data.Char
 import Data.Foldable (toList)
-import Data.Monoid
+import Data.List
+import Data.Monoid hiding ((<>))
+import Data.Semigroup as Sem
+import Data.String
 import Ideas.Text.XML.Interface hiding (parseXML)
 import System.IO
+import qualified Data.Map as M
 import qualified Data.Sequence as Seq
 import qualified Ideas.Text.XML.Interface as I
 
@@ -72,9 +78,9 @@ ----------------------------------------------------------------
 -- XML builders
 
-infix 3 .=.
+infix 7 .=.
 
-class Monoid a => BuildXML a where
+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
@@ -92,20 +98,32 @@ 
 data XMLBuilder = BS (Seq.Seq Attr) (Seq.Seq (Either String Element))
 
--- local helper
+-- local helper: merge attributes, but preserve order
 fromBS :: XMLBuilder -> (AttrList, Content)
-fromBS (BS as elts) = (toList as, toList elts)
+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
 
-instance Monoid XMLBuilder where
-   mempty = BS mempty mempty
-   mappend (BS as1 elts1) (BS as2 elts2) =
+instance Sem.Semigroup XMLBuilder where
+  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
+
+instance IsString XMLBuilder where
+   fromString = string
 
 makeXML :: String -> XMLBuilder -> XML
 makeXML s = uncurry (Element s) . fromBS

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

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

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

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

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

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

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

@@ -1,5 +1,5 @@ -----------------------------------------------------------------------------
--- Copyright 2016, Ideas project team. This file is distributed under the
+-- 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.
 -----------------------------------------------------------------------------
@@ -25,6 +25,8 @@ 
 import Control.Arrow
 import Control.Monad
+import Data.Monoid hiding ((<>))
+import Data.Semigroup as Sem
 import Data.Ratio
 import Test.QuickCheck
 
@@ -33,9 +35,12 @@ 
 newtype ArbGen a = AG [(Rational, (Int, Gen ([a] -> a)))]
 
+instance Sem.Semigroup (ArbGen a) where
+   AG xs <> AG ys = AG (xs <> ys)
+
 instance Monoid (ArbGen a) where
-   mempty = AG mempty
-   AG xs `mappend` AG ys = AG (xs `mappend` ys)
+   mempty  = AG mempty
+   mappend = (<>)
 
 generator :: ArbGen a -> Gen a
 generator (AG pairs) = sized rec

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

@@ -1,5 +1,5 @@ -----------------------------------------------------------------------------
--- Copyright 2016, Ideas project team. This file is distributed under the
+-- 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.
 -----------------------------------------------------------------------------
@@ -17,7 +17,9 @@ 
 module Ideas.Utils.TestSuite
    ( -- * TestSuite
-     TestSuite, module Data.Monoid
+     TestSuite
+   , module Data.Monoid
+   , (<>)
    , suite, useProperty, usePropertyWith
    , assertTrue, assertNull, assertEquals, assertIO
    , assertMessage, assertMessageIO
@@ -44,7 +46,8 @@ import Data.IORef
 import Data.List
 import Data.Maybe
-import Data.Monoid
+import Data.Monoid hiding ((<>))
+import Data.Semigroup as Sem
 import Data.Time
 import System.IO
 import Test.QuickCheck hiding (Result)
@@ -58,9 +61,12 @@ data Test = Case  String (IO Message)
           | Suite String TestSuite
 
+instance Sem.Semigroup TestSuite where
+   TS xs <> TS ys = TS (xs <> ys)
+
 instance Monoid TestSuite where
-   mempty = TS mempty
-   TS xs `mappend` TS ys = TS (xs <> ys)
+   mempty  = TS mempty
+   mappend = (<>)
 
 tests :: TestSuite -> [Test]
 tests (TS xs) = toList xs
@@ -243,9 +249,8 @@       ", warnings: " ++ show (nrOfWarnings result) ++
       ", "           ++ show (diffTime result)     ++ ")"
 
-instance Monoid Result where
-   mempty = Result mempty mempty 0 0 0 0 mempty
-   x `mappend` y = Result
+instance Sem.Semigroup Result where
+   x <> y = Result
       { suites       = suites x <> suites y
       , cases        = cases x  <> cases y
       , diffTime     = diffTime x     + diffTime y
@@ -255,6 +260,10 @@       , resultRating = resultRating x <> resultRating y
       }
 
+instance Monoid Result where
+   mempty  = Result mempty mempty 0 0 0 0 mempty
+   mappend = (<>)
+
 instance HasStatus Result where
    getStatus r | nrOfErrors r   > 0 = Error
                | nrOfWarnings r > 0 = Warning
@@ -352,9 +361,12 @@          | null (messageLines a) = "ok"
          | otherwise             = ""
 
+instance Sem.Semigroup Message where
+   M s r xs <> M t q ys = M (s <> t) (r <> q) (xs <> ys)
+
 instance Monoid Message where
-   mempty = M mempty mempty mempty
-   M s r xs `mappend` M t q ys = M (s <> t) (r <> q) (xs <> ys)
+   mempty  = M mempty mempty mempty
+   mappend = (<>)
 
 instance HasStatus Message where
    getStatus = messageStatus
@@ -375,9 +387,12 @@ data Status = Ok | Warning | Error
    deriving (Eq, Ord)
 
+instance Sem.Semigroup Status where
+   (<>) = max
+
 instance Monoid Status where
    mempty  = Ok
-   mappend = max
+   mappend = (<>)
 
 class HasStatus a where
    getStatus :: a -> Status
@@ -393,9 +408,12 @@ data Rating = Rating !Int | MaxRating
    deriving (Eq, Ord)
 
+instance Sem.Semigroup Rating where
+   (<>) = min
+
 instance Monoid Rating where
    mempty  = MaxRating
-   mappend = min
+   mappend = (<>)
 
 class HasRating a where
    rating :: a -> Maybe Int

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

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