Let me take a couple of minutes to summarize how the lens approach tackles the composition problem today without requiring confusing changes in the lexical structure of the language. <div><br></div><div>I&#39;ll digress a few times to showcase how this actually lets us make more powerful tools than are available in standard OOP programming frameworks as I go. </div>
<div><br></div><div>The API for lens was loosely inspired once upon a time by Erik Meijer&#39;s old &#39;the power is in the dot&#39; paper, but the bits and pieces have nicely become more orthogonal.<div><br></div><div>Lens unifies the notion of (.) from Haskell with the notion of (.) as a field accessor by choosing an interesting form for the domain and codomain of the functions it composes.<br>
<div><br></div><div><div>I did a far more coherent introduction at New York Haskell <a href="http://www.youtube.com/watch?v=cefnmjtAolY&amp;hd=1&amp;t=75s">http://www.youtube.com/watch?v=cefnmjtAolY&amp;hd=1&amp;t=75s</a> that may be worth sitting through if you have more time. </div>
<div><br></div><div>In particular in that talk I spend a lot of time talking about all of the other lens-like constructions you can work with. More resources including several blog posts, announcements, a tutorial, etc. are available on <a href="http://lens.github.com/">http://lens.github.com/</a></div>
</div><div><br></div><div>A lens that knows how to get a part p out of a whole w looks like</div><div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace">type Lens&#39; w p = forall f. Functor f =&gt; (p -&gt; f p) -&gt; w -&gt; f w</font></div>
<div><font face="courier new, monospace"><br></font></div><div><font face="arial, helvetica, sans-serif">In the talk I linked above, I show how this is equivalent to a getter/setter pair.</font></div><div><br></div><div>Interestingly because the function is already CPSd, this composition is the &#39;reverse&#39; composition you expect.</div>
<div><br></div><div>You can check that:</div><div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace">(.) :: Lens a b -&gt; Lens b c -&gt; Lens a c</font></div><div><br></div><div>
<div>The key here is that a lens is a function from a domain of (p -&gt; f p)   to a codomain of (w -&gt; f w) and therefore they compose with (.) from the Prelude.  </div></div><div><br></div><div>We can compose lenses that know how to access parts of a structure in a manner analogous to writing a Traversable instance.</div>
<div><br></div><div>Lets consider the lens that accesses the second half of a tuple:</div><div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace">_2 f (a,b) = (,) a &lt;$&gt; f b</font></div>
<div><br></div><div>We can write a combinator that use these lenses to read and write their respective parts:</div><div><br></div><div><br></div><div><br></div><div><font face="courier new, monospace">import Control.Applicative</font></div>
<div><pre><font face="courier new, monospace"><span class="hs-keyword" style="color:blue">infixl</span> <span class="hs-num">8</span> <span class="hs-varop">^.</span></font></pre><pre><font face="courier new, monospace">s ^. l = getConst (l Const s)</font></pre>
<pre><font face="courier new, monospace"><br></font></pre><pre><font face="arial, helvetica, sans-serif">With that combinator in hand:</font></pre></div><div><font face="courier new, monospace">(&quot;hello&quot;,&quot;world&quot;)^._2 = &quot;world&quot;</font></div>
<div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace">(1,(3,4))^._2._2 = 4 -- notice the use of (.) not (^.) when chaining these.</font></div><div><br></div><div>Again this is already in the order an &quot;OOP programmer&quot; expects when you go compose them!</div>
<div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace">_1 f (a,b) = (,b) &lt;$&gt; f a</font></div><div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace">(1,(3,4))^._2._1 = 3</font></div>
<div><br></div><div><div>The fixity of (^.) was chosen carefully so that the above parses as</div><div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace">(1,(3,4))^.(_2._1)</font></div>
<div><br></div></div><div>If you just write the definitions for the lenses I gave above and let type inference give you their types they turn out to be more general than the signature for Lens&#39;  above.</div><div><font face="courier new, monospace"><br>
</font></div><div><font face="courier new, monospace">type Lens s t a b = forall f. Functor f =&gt; (a -&gt; f b) -&gt; s -&gt; f t</font></div><div><br></div><div>With that type you could choose to write the signatures above as:</div>
<div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace">_1 :: Lens (a,c) (b,c) a b</font></div><div><font face="courier new, monospace">_2 :: Lens (c,a) (c,b) a b</font></div><div>
<pre><font face="courier new, monospace">(^.) :: s -&gt; ((a -&gt; Const a b) -&gt; s -&gt; Const a t) -&gt; a</font></pre><pre><span style="font-family:arial"><br></span></pre><pre><span style="font-family:arial">But we don&#39;t need the rank-2 aliases for anything other than clarity. In particular the code above can be written and typechecked entirely in Haskell 98.</span></pre>
<pre><span style="font-family:arial"><br></span></pre><pre><font face="arial, helvetica, sans-serif">We can also generate a &#39;getter&#39; from a normal haskell function such that it can be composed with lenses and other getters:</font></pre>
<pre><font face="courier new, monospace"><br></font></pre><pre><font face="courier new, monospace">to :: (s -&gt; a) -&gt; (a -&gt; Const r b) -&gt; s -&gt; Const r t</font></pre><pre><font face="courier new, monospace">to sa acr = Const . getConst . acr . sa</font></pre>
<pre><br></pre><pre><font face="courier new, monospace">x^.to f = getConst (to f Const s) = getConst ((Const . getConst . Const . f) s) = f s</font></pre><pre><br></pre><pre><font face="arial, helvetica, sans-serif">Then the examples where folks have asked to be able to just compose in an arbitrary Haskell function become:</font></pre>
<pre><font face="courier new, monospace"><br></font></pre><pre><font face="courier new, monospace">(1,&quot;hello&quot;)^._<a href="http://2.to">2.to</a> length = 5</font></pre><pre><br></pre><pre><font face="arial, helvetica, sans-serif">We can also write back through a lens:</font></pre>
<pre><font face="arial, helvetica, sans-serif"><br></font></pre><pre><span style="white-space:normal"><font face="arial, helvetica, sans-serif">They take on the more general pattern that actually allows type changing assignment.</font></span></pre>
<pre><span style="font-family:arial;white-space:normal"><br></span></pre><pre><font face="courier new, monospace">modify :: ((a -&gt; Identity b) -&gt; s -&gt; Identity t) -&gt; (a -&gt; b) -&gt; s -&gt; t</font></pre><pre>
<font face="courier new, monospace">modify l ab = runIdentity . l (Identity . ab)</font></pre><pre><font face="courier new, monospace"><br></font></pre><pre><font face="courier new, monospace">set l b = modify l (const b)</font></pre>
<pre><br></pre><pre><font face="arial">These can be written entirely using &#39;base&#39; rather than with Identity from transformers by replacing Identity with (-&gt;) ()</font></pre><pre><font face="arial"><br></font></pre>
<pre><font face="arial">With that in hand we can state the &#39;Setter&#39; laws:</font></pre><pre><font face="arial"><br></font></pre><pre><font face="courier new, monospace">modify l id = id</font></pre><pre><font face="courier new, monospace">modify l f . modify l g = modify l (f . g)</font></pre>
<pre><font face="arial"><br></font></pre><pre><font face="arial">These are just the Functor laws!</font></pre><pre><font face="arial"><br></font></pre><pre><font face="arial">and we can of course make a &#39;Setter&#39; for any Functor that you could pass to modify:</font></pre>
<pre><font face="courier new, monospace"><br></font></pre><pre><font face="courier new, monospace">mapped :: Functor f =&gt; (a -&gt; Identity b) -&gt; f a -&gt; Identity (f b)</font></pre><pre><font face="courier new, monospace">mapped aib = Identity . fmap (runIdentity . aib)</font></pre>
<pre><span style="font-family:arial"><br></span></pre><pre><span style="font-family:arial">then you can verify that </span></pre><pre><font face="courier new, monospace"><br></font></pre><pre><font face="courier new, monospace">modify mapped ab = runIdentity . Identity . fmap (Identity . runIdentity ab) = fmap ab</font></pre>
<pre><font face="courier new, monospace">modify (mapped.mapped) = fmap.fmap</font></pre><pre><span style="font-family:arial"><br></span></pre><pre><font face="arial">&#39;mapped&#39; isn&#39;t a full lens. You can&#39;t read from &#39;mapped&#39; with (^.). Try it. Similarly &#39;to&#39; gives you merely a &#39;Getter&#39;, not something suitable to modify. You can&#39;t &#39;modify the output of &#39;to&#39;, the types won&#39;t let you. </font><span style="font-family:arial,helvetica,sans-serif">(The lens type signatures are somewhat more complicated here because they want the errors to be in instance resolution rather than unification, for readability&#39;s sake)</span></pre>
<pre><br></pre><pre><span style="font-family:arial">But we can still use modify on any lens, because Identity is a perfectly cromulent Functor.</span></pre><pre><font face="courier new, monospace"><br></font></pre><pre><font face="courier new, monospace">modify _2 (+2) (1,2) = (1,4)</font></pre>
<pre><font face="courier new, monospace">modify _2 length (1,&quot;hello&quot;) = (1,5) -- notice the change of type!</font></pre><pre><font face="courier new, monospace">modify (_2._1) (+1) (1,(2,3)) = (1,(3,3))</font></pre>
<pre><font face="courier new, monospace">modify (_2.mapped) (+1) (1,[2,3,4]) = (1,[3,4,5])</font></pre><pre><br></pre><pre><pre><font face="arial">We can also define something very lens-like that has multiple targets. In fact we already know the canonical example of this, &#39;traverse&#39; from Data.Traversable. So we&#39;ll call them traversals.</font></pre>
<pre><span style="font-family:arial"><br></span></pre><pre><span style="font-family:arial">We can use modify on any &#39;traversal&#39; such as traverse:</span></pre><pre><span style="font-family:arial"><br></span></pre><pre>
<font face="courier new, monospace">modify traverse (+1) [1,2,3] = [2,3,4]</font></pre><pre><span style="font-family:arial"><br></span></pre><pre><span style="font-family:arial">This permits us to modify multiple targets with a lens in a coherent, possibly type changing manner.</span></pre>
<pre><span style="font-family:arial"><br></span></pre><pre><font face="arial">We can make new traversals that don&#39;t exactly match the types in Data.Traversable as well:</font></pre><pre><font face="courier new, monospace"><br>
</font></pre><pre><font face="courier new, monospace">type Traversal s t a b = forall f. Applicative f =&gt; (a -&gt; f b) -&gt; s -&gt; f t</font></pre><pre><font face="courier new, monospace"><br></font></pre><pre><font face="courier new, monospace">both :: Traversal (a,a) (b,b) a b</font></pre>
<pre><font face="courier new, monospace">both f (a,b) = (,) &lt;$&gt; f a &lt;*&gt; f b</font></pre><pre><span style="font-family:arial"><br></span></pre><pre><span style="font-family:arial">modify both (+1) (1,2) = (3,4)</span></pre>
<pre><span style="font-family:arial"><br></span></pre><pre><span style="font-family:arial">The laws for a traversal are a generalization of the Traversable laws.</span></pre><pre><span style="font-family:arial"><br></span></pre>
<pre><span style="font-family:arial">Compositions of traversals form valid traversals.</span></pre><pre><span style="font-family:arial"><br></span></pre><pre><font face="arial">Lens goes farther and provides generalizations of Foldables as &#39;Folds&#39;, read-only getters, etc. just by changing the constraints on &#39;f&#39; in the </font><span style="font-family:arial">(a -&gt; f b) -&gt; s -&gt; f t form.</span></pre>
<pre><span style="font-family:arial"><br></span></pre><pre><span style="font-family:arial">The key observation here is that we don&#39;t need to make up magic syntax rules for (.) just to get reverse application. We already have it!</span></pre>
<pre><span style="font-family:arial"><br></span></pre><pre><span style="font-family:arial">The only thing we needed was a slightly different (.)-like operator to start the chain ((^.) above.).</span></pre><pre><span style="font-family:arial"><br>
</span></pre><pre><span style="font-family:arial">This is nice because it allows us to talk about compositions of lenses as first class objects we can pass around.</span></pre><pre><span style="font-family:arial"><br></span></pre>
<pre><span style="font-family:arial">Moreover they compose naturally with traversals, and the idioms we already know how to use with traverse apply. In fact if you squint you can recognize the code for modify and (^.) from the code for foldMapDefault and fmapDefault in Data.Traversable, except we just pass in the notion of &#39;traverse&#39; as the extra lens-like argument.</span></pre>
<pre><span style="font-family:arial"><br></span></pre><pre><span style="font-family:arial">Every Lens is a valid Traversal. </span></pre><pre><br></pre><pre><font face="arial">modify (both._1) (+1) ((1,2),(3,4)) = ((2,2),(4,4))</font></pre>
<pre><span style="font-family:arial"><br></span></pre><pre><span style="font-family:arial">If you have a lens foo and a lens bar then baz = foo.bar is also a lens. </span></pre></pre><pre><br></pre><pre><span style="font-family:arial">We can make lenses that can access fairly complex structures. </span><font face="arial, helvetica, sans-serif">e.g. we can make lenses that let us both read and write whether or not something is in a Set:</font></pre>
<pre><span style="font-family:&#39;courier new&#39;,monospace">contains :: Ord k =&gt; k -&gt; Lens&#39; (Set k) Bool</span></pre></div><div><div><font face="courier new, monospace">contains k f s = (\b -&gt; if b then Set.insert k s else Set.delete k s) &lt;$&gt; f (Set.member k s)</font></div>
<div><span style="font-family:&#39;courier new&#39;,monospace"><br></span></div></div><div><font face="courier new, monospace"><br></font></div><div><div><span style="font-family:&#39;courier new&#39;,monospace">singleton 4 ^. contains 4 = True</span></div>
<div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace">singleton 4 ^. contains 5 = False</font></div><div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace">set (contains 5) True (singleton 4) = fromList [4,5]</font></div>
</div><div><font face="courier new, monospace"><br></font></div><div><font face="arial, helvetica, sans-serif">This sort of trick has been often used to idiomatically allow for sets of flags to be thrown in data types as a field.</font></div>
<div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace">data Flags = Foo | ...</font></div><div><font face="courier new, monospace">data Bar a = Bar { barA :: a,  barFlags :: Set Flags }</font></div>
<div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace">flags f (Bar a flgs) = Bar a &lt;$&gt; f flgs</font></div><div><br></div><div><font face="courier new, monospace">foo = flags.contains Foo</font></div>
<div><br></div><div><br></div><div><font face="arial, helvetica, sans-serif"><br></font></div><div><font face="arial, helvetica, sans-serif">We can similarly access the membership of a map as a lens.</font></div><div><font face="courier new, monospace"><br>
</font></div><div><font face="courier new, monospace">alterF :: Ord k =&gt; Int -&gt; (Maybe a -&gt; f (Maybe a)) -&gt; Map k a -&gt; f (Map k a)</font></div><div><br></div><div>This can be viewed as:</div><div><font face="courier new, monospace"><br>
</font></div><div><font face="courier new, monospace">alterF :: Ord k =&gt; Int -&gt; Lens&#39; (Map k a) (Maybe a)</font></div><div><font face="courier new, monospace"><br></font></div><div><br></div><div>or the lens that accesses a field out of a record type:</div>
<div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace">data Foo = Foo { _fooX, _fooY :: Int }</font></div><div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace">fooY f (Foo x y) = Foo x &lt;$&gt; f y</font></div>
<div><font face="courier new, monospace"><br></font></div><div><font face="arial, helvetica, sans-serif">The latter usecase is the only one that we&#39;ve been considering in the record debate, but having a solution that extends to cover all of these strikes me as valuable.</font></div>
<div><br></div><div>Defining these lenses do not take us outside of Haskell 98. They do not require anything that isn&#39;t currently provided by base.</div><div><br></div><div>Just a couple more notes: </div><div><br></div>
<div>I tried to keep the above more or less self-contained. It doesn&#39;t use very &#39;idiomatic&#39; lens code. Normally most of the lens users would use code like:</div><div><br></div><div>(1,2) &amp; _2 .~ &quot;hello&quot; = (1,&quot;hello&quot;)</div>
<div>  where</div><div>    x &amp; f = f x</div><div>    l .~ a = modify l (const a) -- with appropriate fixities, etc.</div><div><br></div><div>Also of concern to me is that it is already common practice among uses of lens to elide spaces around (.) when composing lenses, so such a syntactic change is going to break a lot of code or at least break a lot of habits.</div>
<div><br></div><div>The relevance to the discussion at hand I think is that (^.) is a rather simple combinator that can be defined in the language today. It is one that has been defined in multiple libraries (lens, lens-family, etc.) It doesn&#39;t require weird changes to the syntax of the language and notably once you &#39;start&#39; accessing into a structure with it, the subsequent dots are just Prelude dots and the result is more powerful in that it generalizes in more directions.</div>
<div><br></div><div>This approach already has hundreds of users (we have 90+ users in #haskell-lens 24 hours a day on freenode, packdeps shows ~80 reverse dependencies <a href="http://packdeps.haskellers.com/reverse/lens">http://packdeps.haskellers.com/reverse/lens</a>, etc.) and it doesn&#39;t break any existing code.</div>
<div><br></div><div><div>Simon, the &#39;makeLenses&#39; &#39;makeClassy&#39; and &#39;makeFields&#39; template-haskell functions for lens try to tackle the SORF/DORF-like aspects. These are what Greg Weber was referring to in that earlier email. Kickstarting that discussion probably belongs in another email as this one is far to long, as there a lot of points in the design space there that can be explored.</div>
</div><div><br></div><div>-Edward</div><div><br></div><div><div class="gmail_quote">On Wed, Jun 26, 2013 at 4:39 PM, Simon Peyton-Jones <span dir="ltr">&lt;<a href="mailto:simonpj@microsoft.com" target="_blank">simonpj@microsoft.com</a>&gt;</span> wrote:<br>
<blockquote class="gmail_quote" style="margin:0 0 0 .8ex;border-left:1px #ccc solid;padding-left:1ex"><div class="im">|  record projections.  I would prefer to have dot notation for a<br>
|  general, very tightly-binding reverse application, and the type of the record<br>
|  selector for a field f changed to &quot;forall r t. r { f :: t } =&gt; r -&gt; t&quot;<br>
|  instead of &quot;SomeRecordType -&gt; t&quot;.  Such a general reverse application dot would<br>
|  allow things like &quot;string.toUpper&quot; and for me personally, it would<br>
|  make a Haskell OO library that I&#39;m working on more elegant...<br>
<br>
</div>Actually I *hadn&#39;t* considered that.   I&#39;m sure it&#39;s been suggested before (there has been so much discussion), but I had not really thought about it in the context of our very modest proposal.<br>
<br>
We&#39;re proposing, in effect, that &quot;.f&quot; is a postfix function with type &quot;forall r t. r { f :: t } =&gt; r -&gt; t&quot;.   You propose to decompose that idea further, into (a) reverse function application and (b) a first class function f.<br>

<br>
It is kind of weird that<br>
        f . g  means    \x. f (g x)<br>
but     f.g    means    g f<br>
<br>
but perhaps it is not *more* weird than our proposal.<br>
<br>
Your proposal also allows things like<br>
<br>
        data T = MkT { f :: Int }<br>
<br>
        foo :: [T] -&gt; [Int]<br>
        foo = map f xs<br>
<br>
because the field selector &#39;f&#39; has the very general type you give, but the type signature would be enough to fix it.  Or, if foo lacks a type signature, I suppose we&#39;d infer<br>
<br>
        foo :: (r { f::a }) =&gt; [r] -&gt; [a]<br>
<br>
which is also fine.<br>
<br>
It also allows you to use record field names in prefix position, just as now, which is a good thing.<br>
<br>
In fact, your observation allows us to regard our proposal as consisting of two entirely orthogonal parts<br>
  * Generalise the type of record field selectors<br>
  * Introduce period as reverse function application<br>
<br>
Both have merit.<br>
<span class="HOEnZb"><font color="#888888"><br>
Simon<br>
</font></span><div class="HOEnZb"><div class="h5"><br>
|  -----Original Message-----<br>
|  From: <a href="mailto:glasgow-haskell-users-bounces@haskell.org">glasgow-haskell-users-bounces@haskell.org</a> [mailto:<a href="mailto:glasgow-haskell-users-">glasgow-haskell-users-</a><br>
|  <a href="mailto:bounces@haskell.org">bounces@haskell.org</a>] On Behalf Of Dominique Devriese<br>
|  Sent: 26 June 2013 13:16<br>
|  To: Adam Gundry<br>
|  Cc: <a href="mailto:glasgow-haskell-users@haskell.org">glasgow-haskell-users@haskell.org</a><br>
|  Subject: Re: Overloaded record fields<br>
|<br>
|  I think it&#39;s a good idea to push forward on the records design because<br>
|  it seems futile to hope for an ideal consensus proposal.<br>
|<br>
|  The only thing I dislike though is that dot notation is special-cased to<br>
|  record projections.  I would prefer to have dot notation for a<br>
|  general, very tightly-binding reverse application, and the type of the record<br>
|  selector for a field f changed to &quot;forall r t. r { f :: t } =&gt; r -&gt; t&quot;<br>
|  instead of<br>
|  &quot;SomeRecordType -&gt; t&quot;.  Such a general reverse application dot would<br>
|  allow things like &quot;string.toUpper&quot; and for me personally, it would<br>
|  make a Haskell OO library that I&#39;m working on more elegant...<br>
|<br>
|  But I guess you&#39;ve considered such a design and decided against it,<br>
|  perhaps because of the stronger backward compatibility implications of<br>
|  changing the selectors&#39; types?<br>
|<br>
|  Dominique<br>
|<br>
|  2013/6/24 Adam Gundry &lt;<a href="mailto:adam.gundry@strath.ac.uk">adam.gundry@strath.ac.uk</a>&gt;:<br>
|  &gt; Hi everyone,<br>
|  &gt;<br>
|  &gt; I am implementing an overloaded record fields extension for GHC as a<br>
|  &gt; GSoC project. Thanks to all those who gave their feedback on the<br>
|  &gt; original proposal! I&#39;ve started to document the plan on the GHC wiki:<br>
|  &gt;<br>
|  &gt; <a href="http://hackage.haskell.org/trac/ghc/wiki/Records/OverloadedRecordFields/Plan" target="_blank">http://hackage.haskell.org/trac/ghc/wiki/Records/OverloadedRecordFields/Plan</a><br>
|  &gt;<br>
|  &gt; If you have any comments on the proposed changes, or anything is unclear<br>
|  &gt; about the design, I&#39;d like to hear from you.<br>
|  &gt;<br>
|  &gt; Thanks,<br>
|  &gt;<br>
|  &gt; Adam Gundry<br>
|  &gt;<br>
|  &gt; _______________________________________________<br>
|  &gt; Glasgow-haskell-users mailing list<br>
|  &gt; <a href="mailto:Glasgow-haskell-users@haskell.org">Glasgow-haskell-users@haskell.org</a><br>
|  &gt; <a href="http://www.haskell.org/mailman/listinfo/glasgow-haskell-users" target="_blank">http://www.haskell.org/mailman/listinfo/glasgow-haskell-users</a><br>
|<br>
|  _______________________________________________<br>
|  Glasgow-haskell-users mailing list<br>
|  <a href="mailto:Glasgow-haskell-users@haskell.org">Glasgow-haskell-users@haskell.org</a><br>
|  <a href="http://www.haskell.org/mailman/listinfo/glasgow-haskell-users" target="_blank">http://www.haskell.org/mailman/listinfo/glasgow-haskell-users</a><br>
<br>
_______________________________________________<br>
Glasgow-haskell-users mailing list<br>
<a href="mailto:Glasgow-haskell-users@haskell.org">Glasgow-haskell-users@haskell.org</a><br>
<a href="http://www.haskell.org/mailman/listinfo/glasgow-haskell-users" target="_blank">http://www.haskell.org/mailman/listinfo/glasgow-haskell-users</a><br>
</div></div></blockquote></div><br></div></div></div>