-- Apply a pricing procedure = a list of percentual or absolute additions
--   forwards ("compute") 
--   and backwards ("resolve" - which is the point here).
 
-- Each condition is a linear function on any of the formerly computed,
-- intermediate terms, so a condition is a function [a] -> a
 
percent p x = p * x / 100
 
-- Need a data type for conditions, 
-- in order to distinguish absolute from relative conditions
data Condition a  = RelativeCondition { apply :: a }
                  | AbsoluteCondition { apply :: a }
 
-- predicate function for detecting relative types
isRelative :: Condition a -> Bool
isRelative( RelativeCondition _ ) = True
isRelative( _ )                   = False
 
condRel p     = RelativeCondition (\ x ->  percent p ( last x ) )
condRelBase p = RelativeCondition (\ x ->  percent p ( head x ) )
condAbs q     = AbsoluteCondition (\ x -> q )
 
-- How to compute a scheme: 
-- Apply functions successively, starting with base price
compute scheme base = last ( 
   foldl (\ x f -> x ++ [ last x + apply f x ] )
   [ base ] 
   scheme 
   )
 
--- Reduced scheme consists only of the relative conditions
reduced scheme = filter isRelative scheme
 
-- How to resolve a scheme
resolve scheme result = 
   ( result - compute scheme 0 ) 
     / compute (reduced scheme) 1
 
 
-- A sample calculation scheme
scheme = [
 condAbs      10.00,
 condRel      5.00,
 condRelBase  3.25,
 condAbs     20.00,
 condRel      3.00,
 condRelBase  2.00,
 condRel      7.00,
 condAbs     10.00
 ]
 
-- Test (should reproduce the input (100) )
main = do 
  print( resolve scheme ( compute scheme 100 ) )

LS0gQXBwbHkgYSBwcmljaW5nIHByb2NlZHVyZSA9IGEgbGlzdCBvZiBwZXJjZW50dWFsIG9yIGFic29sdXRlIGFkZGl0aW9ucwotLSAgIGZvcndhcmRzICgiY29tcHV0ZSIpIAotLSAgIGFuZCBiYWNrd2FyZHMgKCJyZXNvbHZlIiAtIHdoaWNoIGlzIHRoZSBwb2ludCBoZXJlKS4KCi0tIEVhY2ggY29uZGl0aW9uIGlzIGEgbGluZWFyIGZ1bmN0aW9uIG9uIGFueSBvZiB0aGUgZm9ybWVybHkgY29tcHV0ZWQsCi0tIGludGVybWVkaWF0ZSB0ZXJtcywgc28gYSBjb25kaXRpb24gaXMgYSBmdW5jdGlvbiBbYV0gLT4gYQoKcGVyY2VudCBwIHggPSBwICogeCAvIDEwMAoKLS0gTmVlZCBhIGRhdGEgdHlwZSBmb3IgY29uZGl0aW9ucywgCi0tIGluIG9yZGVyIHRvIGRpc3Rpbmd1aXNoIGFic29sdXRlIGZyb20gcmVsYXRpdmUgY29uZGl0aW9ucwpkYXRhIENvbmRpdGlvbiBhICA9IFJlbGF0aXZlQ29uZGl0aW9uIHsgYXBwbHkgOjogYSB9CiAgICAgICAgICAgICAgICAgIHwgQWJzb2x1dGVDb25kaXRpb24geyBhcHBseSA6OiBhIH0KCi0tIHByZWRpY2F0ZSBmdW5jdGlvbiBmb3IgZGV0ZWN0aW5nIHJlbGF0aXZlIHR5cGVzCmlzUmVsYXRpdmUgOjogQ29uZGl0aW9uIGEgLT4gQm9vbAppc1JlbGF0aXZlKCBSZWxhdGl2ZUNvbmRpdGlvbiBfICkgPSBUcnVlCmlzUmVsYXRpdmUoIF8gKSAgICAgICAgICAgICAgICAgICA9IEZhbHNlCgpjb25kUmVsIHAgICAgID0gUmVsYXRpdmVDb25kaXRpb24gKFwgeCAtPiAgcGVyY2VudCBwICggbGFzdCB4ICkgKQpjb25kUmVsQmFzZSBwID0gUmVsYXRpdmVDb25kaXRpb24gKFwgeCAtPiAgcGVyY2VudCBwICggaGVhZCB4ICkgKQpjb25kQWJzIHEgICAgID0gQWJzb2x1dGVDb25kaXRpb24gKFwgeCAtPiBxICkKCi0tIEhvdyB0byBjb21wdXRlIGEgc2NoZW1lOiAKLS0gQXBwbHkgZnVuY3Rpb25zIHN1Y2Nlc3NpdmVseSwgc3RhcnRpbmcgd2l0aCBiYXNlIHByaWNlCmNvbXB1dGUgc2NoZW1lIGJhc2UgPSBsYXN0ICggCiAgIGZvbGRsIChcIHggZiAtPiB4ICsrIFsgbGFzdCB4ICsgYXBwbHkgZiB4IF0gKQogICBbIGJhc2UgXSAKICAgc2NoZW1lIAogICApCgotLS0gUmVkdWNlZCBzY2hlbWUgY29uc2lzdHMgb25seSBvZiB0aGUgcmVsYXRpdmUgY29uZGl0aW9ucwpyZWR1Y2VkIHNjaGVtZSA9IGZpbHRlciBpc1JlbGF0aXZlIHNjaGVtZQoKLS0gSG93IHRvIHJlc29sdmUgYSBzY2hlbWUKcmVzb2x2ZSBzY2hlbWUgcmVzdWx0ID0gCiAgICggcmVzdWx0IC0gY29tcHV0ZSBzY2hlbWUgMCApIAogICAgIC8gY29tcHV0ZSAocmVkdWNlZCBzY2hlbWUpIDEKICAgICAKCi0tIEEgc2FtcGxlIGNhbGN1bGF0aW9uIHNjaGVtZQpzY2hlbWUgPSBbCiBjb25kQWJzICAgICAgMTAuMDAsCiBjb25kUmVsICAgICAgNS4wMCwKIGNvbmRSZWxCYXNlICAzLjI1LAogY29uZEFicyAgICAgMjAuMDAsCiBjb25kUmVsICAgICAgMy4wMCwKIGNvbmRSZWxCYXNlICAyLjAwLAogY29uZFJlbCAgICAgIDcuMDAsCiBjb25kQWJzICAgICAxMC4wMAogXQoKLS0gVGVzdCAoc2hvdWxkIHJlcHJvZHVjZSB0aGUgaW5wdXQgKDEwMCkgKQptYWluID0gZG8gCiAgcHJpbnQoIHJlc29sdmUgc2NoZW1lICggY29tcHV0ZSBzY2hlbWUgMTAwICkgKQ==