<?xml version="1.0" encoding="iso-8859-1"
?>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
<html xmlns="http://www.w3.org/1999/xhtml">
<head>
<title>Haskell eDSL Tutorial - Shared expenses</title>
<link rel="stylesheet" type="text/css" href="../../base-min.css" />
<link rel="stylesheet" type="text/css" href="../../style.css" />
<link rel="alternate" type="application/rss+xml" title="Whatsnew feed of Avulsos by Penz" href="http://feeds.feedburner.com/lpenz/avulsos/whatsnew.xml"/>
<link rel="alternate" type="application/rss+xml" title="Articles feed of Avulsos by Penz" href="http://feeds.feedburner.com/lpenz/avulsos/articles.xml"/>
<link rel="icon" type="image/png" href="../../logo.png" />
<meta name="generator" content="http://txt2tags.sf.net" />
</head>
<body>
<div id="header">
	<div id="logo">
		<a href="../../index.html"><img alt="Avulsos by Penz" src="../../logo.png" /></a>
	</div>
	<div id="breadcrumbs">
			<a href="../../index.html">Avulsos by Penz</a>
				&gt;
			<a href="../index.html">Articles</a>
				&gt;
			<a href="index.html">Haskell eDSL Tutorial - Shared expenses</a>
	</div>
	<ul id="nav">
		<li><a href="../../articles/index.html">Articles</a></li>
		<li><a href="../../debian/index.html">Debian</a></li>
		<li><a href="../../about/index.html">About</a></li>
	</ul>
</div>
<div id="contents">
	<h1 id="title">Haskell eDSL Tutorial - Shared expenses</h1>
	    
<p>
People have created
<a href="http://ashish.typepad.com/ashishs_niti/2007/06/another_dsl_emb.html">interesting</a>
and
<a href="http://augustss.blogspot.com/2009/02/more-basic-not-that-anybody-should-care.html">weird</a>
embedded domain-specific languages in haskell. In this article, we will see what
an eDSL really is by building one to record shared expenses and calculate the
payments.
</p>
<p>
This article is written in literal-haskell style, so that you can simply paste it in a
<i>file.lhs</i> and then <i>runhaskell file.lhs</i> to run it. That's why we need the
lines bellow:
</p>

<pre>

  &gt; import Data.Map as Map
  &gt; import Control.Monad.State

</pre>

<h1>Why haskell</h1>

<p>
The first reason to use haskell for an eDSL is that it has a very clean syntax:
</p>

<ul>
<li>a function and its arguments are separated by spaces, not by parenthesis and
  commas - parenthesis are only used to make nested function calls;
</li>
<li>there is a syntax sugar for monads that let us avoid writing the monadic
  operators <i>&gt;&gt;</i> and <i>&gt;&gt;=</i> - it allows us to bind monads by using newlines;
</li>
<li>type inference allows us to skip type annotations and declarations, even
  though we are using a strongly typed language.
</li>
</ul>

<p>
When combined, these features allow us to leave very little haskell in our
eDSL, as we will see.
</p>

<h1>The shared expenses problem</h1>

<p>
Lets say that you went on a trip with 3 friends, and there are some costs that
are shared by everyone. You want to record these expenses and then everyone can
pay up once the trip is over.
</p>
<p>
In other words, you want records to look like this:
</p>

<pre>

  &gt; trip = sharedexpenses $ do
  &gt;     dexter `spent` 5300
  &gt;     angel  `spent` 2700
  &gt;     debra  `spent`  800
  &gt;     harry  `spent` 1900
  &gt;     debra  `spent` 1700
  &gt;     angel  `spent` 2200

</pre>

<p>
Also, you want to be able to record transactions in which people lend money
straight to each other:
</p>

<pre>

  &gt;     dexter `gave` harry $ 2000
  &gt;     angel  `gave` debra $ 3200

</pre>

<p>
The haskell leaks we have in the records are the backticks (<code>`</code>) and the
<code>$</code>. We could get rid of them also, but the plumbing would get a lot more
convoluted. We also avoid using floating point numbers for a similar reason.
</p>

<h1>The state monad</h1>

<p>
By programming a new monad you get the "programmable semicolon" that people talk
so much about. That allows you to make a custom program flow different from
the standard top-down - it allows built-in backtracking, for instance.
</p>
<p>
But that is not an eDSL requirement. For our shared-expenses example, top-down
is just fine. The only thing we need is a way to store the expenses each person
had, and a simple
<a href="http://hackage.haskell.org/packages/archive/mtl/latest/doc/html/Control-Monad-State.html">state monad</a>
with a
<a href="http://hackage.haskell.org/packages/archive/containers/latest/doc/html/Data-Map.html">map</a>
inside can solve our problem.
</p>
<p>
In the next step we define what a person is and who our friends are:
</p>

<pre>

  &gt; newtype Person = Person { name :: String } deriving (Eq, Ord, Show)

  &gt; dexter = Person "Dexter"
  &gt; angel  = Person "Angel"
  &gt; debra  = Person "Debra"
  &gt; harry  = Person "Harry"

</pre>

<p>
We could skip this step and just use strings here, but that would make typos a
runtime mistake; by using a strong type and defining the friends explicitly, we
make typos a compile error.
</p>

<h1>Spending and giving</h1>

<p>
<i>spent</i> and <i>gave</i> are functions that update our state:
</p>

<pre>

  &gt; spent payer money = modify $ insertWith (+) payer money

  &gt; gave lender borrower money = modify $ (adjust (+ money) lender) . (adjust (\ m -&gt; m - money) borrower)

</pre>

<p>
<i>spent</i> adds the given amount to the element indexed by the person in the map,
while <i>gave</i> adds the amount to the lender and subtract it from the borrower.
</p>

<h1>Solving</h1>

<p>
To solve the shared expenses problem, we will use a simple algorithm: he who
owes more pays to the one that has more credit until everybody gets paid.
</p>

<pre>

  &gt; solve st = solve' err $ Map.map ( \ m -&gt; m - avg) st
  &gt;     where
  &gt;         err = 1 + size st
  &gt;         avg = round $ (toRational $ fold (+) 0 st) / (toRational $ size st)

  &gt; solve' _   st | Map.null st = []
  &gt; solve' err st =
  &gt;     (name payer ++ " pays " ++ show amount ++ " to " ++ name receiver) : solve' err newstate
  &gt;     where
  &gt;         (payer,    debt)   = foldrWithKey (getpers True)  (Person "", 0) st
  &gt;         (receiver, credit) = foldrWithKey (getpers False) (Person "", 0) st
  &gt;         getpers True  p m (_,  m0) | m &lt; m0 = (p, m) -- Gets payer.
  &gt;         getpers False p m (_,  m0) | m &gt; m0 = (p, m) -- Gets receiver.
  &gt;         getpers _     _ _ e                 = e
  &gt;         amount = min (-debt) credit
  &gt;         newstate = Map.filter ( \ c -&gt; c &lt; -err || err &lt; c) $ mapWithKey statefix st
  &gt;         statefix p m | p == receiver = m - amount
  &gt;         statefix p m | p == payer = m + amount
  &gt;         statefix _ m = m

</pre>

<p>
The <i>solve</i> functions subtracts from everybody the amount that each person is
supposed to spend (the average); the map now has the amount each person is
supposed to pay (negative) or receive (positive). When the amount in the map is
near 0, the person will not be involved in further transactions and is removed
from the map. "Near" here has a precise meaning: we take the number of persons
as the error (plus one), as we had to divide the total amount spent by it in
order to get the average spent - we will not be able to be more precise that
that using integers. Well, we are talking about money, it's useless to be more
precise than a cent anyway.
</p>
<p>
The <i>solve'</i> function recursively registers payments and removes persons from
the map until it is empty. That does not guarantee the least amount of payments,
but we get good enough results most of the times - and it is a lot simpler than
linear programming.
</p>

<h1>Plumbing</h1>

<p>
The function <code>sharedexpenses</code> is the one that glues the eDSL and the state
monad, while the <code>main</code> function is the one that plugs it with
the <code>solve</code> function and prints the results:
</p>

<pre>

  &gt; sharedexpenses :: State (Map Person Int) () -&gt; Map Person Int
  &gt; sharedexpenses f = execState f empty

  &gt; main = mapM_ putStrLn $ solve trip

</pre>

<p>
Running this program provides us the following results:
</p>

<pre>
  Debra pays 4350 to Angel
  Harry pays 3650 to Dexter
  Harry pays 100 to Angel
</pre>

<h1>Conclusions</h1>

<p>
We have seen what is an eDSL by building a solution to a real, day-to-day
problem. No hidden enchantments or dark arts involved: you don't have to build a
custom monad or start with something that looks like
<i>data Expr a = ...</i>; you can just define how you want your language to look
like, think about what the state needs to store and build the plumbing around
the state monad - or even around the
<a href="http://hackage.haskell.org/packages/archive/mtl/latest/doc/html/Control-Monad-Writer.html">writer monad</a>.
You can also use nested state monads to define heterogeneous environments with
different "syntaxes" verified by the type system. The only drawback is that
every user of your language will need a haskell compiler installed, but with
the <a href="http://hackage.haskell.org/platform/">haskell platform</a> available, that
shouldn't be a problem.
</p>

<h1>Further reading</h1>

<ul>
<li><a href="http://paulspontifications.blogspot.com/2008/01/why-haskell-is-good-for-embedded-domain.html">http://paulspontifications.blogspot.com/2008/01/why-haskell-is-good-for-embedded-domain.html</a>:
  Why Haskell is Good for Embedded Domain Specific Languages
</li>
<li><a href="http://cgi.cse.unsw.edu.au/~dons/blog/2007/03">http://cgi.cse.unsw.edu.au/~dons/blog/2007/03</a>: Practical Haskell: shell
  scripting with error handling and privilege separation
</li>
<li><a href="http://gbacon.blogspot.com/2009/07/programmable-semicolon-explained.html">http://gbacon.blogspot.com/2009/07/programmable-semicolon-explained.html</a>:
  Programmable semicolon explained
</li>
</ul>


</div>


<div id="disqus_top">

<div id="disqus_thread"></div>
<script type="text/javascript">
  /**
    * var disqus_identifier; [Optional but recommended: Define a unique identifier (e.g. post id or slug) for this thread] 
    */
  var disqus_url = "http://lpenz.org/articles/hedsl-sharedexpenses/index.html";
  var disqus_identifier = "hedsl-sharedexpenses";
  (function() {
   var dsq = document.createElement('script'); dsq.type = 'text/javascript'; dsq.async = true;
   dsq.src = 'http://avulsosbypenz.disqus.com/embed.js';
   (document.getElementsByTagName('head')[0] || document.getElementsByTagName('body')[0]).appendChild(dsq);
  })();
</script>
<noscript>Please enable JavaScript to view the <a href="http://disqus.com/?ref_noscript=avulsosbypenz">comments powered by Disqus.</a></noscript>
<a href="http://disqus.com" class="dsq-brlink">blog comments powered by <span class="logo-disqus">Disqus</span></a>

</div>


<div id="footer">
		<a rel="license" href="http://creativecommons.org/licenses/by-sa/3.0/"><img alt="Creative Commons License" style="border-width:0; vertical-align:middle;" src="http://i.creativecommons.org/l/by-sa/3.0/80x15.png" /></a>
		This work by <a href="mailto:lpenz@lpenz.org">Leandro Lisboa Penz</a> is licensed under a <a rel="license" href="http://creativecommons.org/licenses/by-sa/3.0/">Creative Commons Attribution-ShareAlike 3.0 Unported License</a>.
</div>
<script type="text/javascript"> var gaJsHost = (("https:" == document.location.protocol) ? "https://ssl." : "http://www."); document.write(unescape("%3Cscript src='" + gaJsHost + "google-analytics.com/ga.js' type='text/javascript'%3E%3C/script%3E")); </script> <script type="text/javascript"> try { var pageTracker = _gat._getTracker("UA-4182011-2"); pageTracker._trackPageview(); } catch(err) {}</script>


<script type="text/javascript">
var disqus_shortname = 'avulsosbypenz';
(function () {
  var s = document.createElement('script'); s.async = true;
  s.src = 'http://disqus.com/forums/avulsosbypenz/count.js';
  (document.getElementsByTagName('HEAD')[0] || document.getElementsByTagName('BODY')[0]).appendChild(s);
}());
</script>


</body>
</html>
<!-- vim: ft=html
-->

