packages feed

asciidiagram (empty) → 1.0

raw patch · 21 files changed

+2580/−0 lines, 21 filesdep +FontyFruitydep +JuicyPixelsdep +asciidiagramsetup-changed

Dependencies added: FontyFruity, JuicyPixels, asciidiagram, base, containers, filepath, lens, linear, mtl, optparse-applicative, rasterific-svg, svg-tree, text, vector

Files

+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple
+main = defaultMain
+ asciidiagram.cabal view
@@ -0,0 +1,85 @@+-- Initial hitaa.cabal generated by cabal init.  For further documentation,
+--  see http://haskell.org/cabal/users-guide/
+name:                asciidiagram
+version:             1.0
+synopsis:            Pretty rendering of Ascii diagram into svg or png.
+description:         
+    Asciidiagram Ascii art diagram like this:
+    .
+    @
+    ,               \/---------+
+    +---------+     |         |
+    |  ASCII  +----\>| Diagram |
+    +---------+     |         |
+    |         |     +--+------\/
+    \\---*-----\/\<=======\/
+    @
+    .
+    Into this:
+    .
+    <<data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAR0AAABnCAQAAACXrV7jAAAH+UlEQVR4Xu3cbZCVZRkH8N++srssirgqqIKKGK4WphWQMjJjilCUaASklgCZKr6RpgphlRWK0kiZVqmmY5ImyppbZiU1lglqUCqb4bsk5oq87sKyu3dfmWGneFzZPQ9evw87c87HM//538+e67qPnSyEEEIIIYQQQgghhBBCCCGEEEIIodguqMjOFIbudsmWUS3Vg159foC8Kequ6IQe1XdWjbms58n2kT/V/zcbpXaOUF79h08eeVNVufzqluiEqu+MGPLTKlI8wGUS9mubfkNPmUXrhNNOaesryShaJ+wx/rNVsovWCeuPHCrJLFontJX2kl20Tthrt82pQmbROmG3yq2yi9YJNm8pSbKLGVYgrZFvfSiKAyt06YGVolE7J71vo2OjfKsWuik6SXYhWgftdh0hWidaJ6ITIjphgekas7dORCdMcJxJFsssohP6etQ8szQD0ToyCDOMMU5DZ6KzxAO+qvf785/zla7S240AWOReL6swwFx9wD/dYrk2g0x3OG73CICxJmK2FwBc6GNyYrCnzTLP/3WfhSixr7GOAcDN6n3UuPdn6/zS4zY5x+GAH5pjsrFarLRVwmKTDfZp5ZZ5Si0OMtxrbvdlexsg4YP2tsQjZqKPJDcqXW+sSVZD0jFetNQFWjxjvEmuVQy4wkeMkt6v0Zns5+rUAuaaajaAZJ2zjHCLUkDCCCMsdbvPqUXCqSj3sHNB0glf19VG+ofpfuF/6uk8UG+qY4zDSs+gnyaVgEaP+bcyw3wQ0OhXmvRThLFK8FuD1aizzmj90eZxDZoNcrwyySInWeAQQ92jj9GFG50GrxmtUZ3LAKUatCoB8Ij1vqZE2qGwpl14EJHAaLXudzKWud1mz3pAH8AYPQy0ymzzTMQSnzfMvuZr8mFjFGOWT3nAnprN81v9fd+tjsD1jrBQmXNMs9zTpvuzJ/3eYYUanUVqHKnRAisNBN90sROdbbSe4O/KHSx1GJokbfcOKPTWucq2FptktR1Waxk41ale9nEA1NsTXOAaE3Gd4e7EaKe5VhngJ64xySZHqzPdF10IlvqMJxyLFyyyvz+pc7TnCjc6DxkrGarMQpeA8Qa7wQyzzHQ61usn0XF08t86zds+JicdIyEBKm2VOvwU+kg22uBAiyS85RgJB+BtCXCaiZIqX7CPZHcJb6nBWglTJMWmKdZDq1SY48/nrTRXuyonqDcDcLgfW2W+y202RZV3tNteQrv27d7JlQbjNMhotRod+54btdqqVCsY5U4n6usaexkCYE/AFeBJF3tRBQCq0aq6sAcR9RivFcXarbYPgH3N8bx6kw223vMGZTiw8iLrV4IJbPGkCR22Tr3r/NRJuNVsCS/r7wobHeVeFVIH3dzkdMd7WCX2lyS2+1uQ0fm1MSaBFlPd5xxJEaDFegMlJ/imK92mJ2hRDkiQ3+is3nYQseMH1jsu0+QLUgefwrOqjJK0WIKkTZ3rTAAkQJIkAGtscKIKST2StG0gJQozOq9b4QrHAkZa6Gyvm+hDettqqXXmS/bwPRcaYbgSy53pTCzwqLX4hl5OMg5zvOQVRc7CWY5W4H5hukaZrDHZJsvUuMMB4EcabMB8NUY4xTHmm+Ygv7IHKHG8S8zVS6VBzneI7e3nEN/1nL97UWl+BhFvu8hwCXCex7To40tesU4P04xTJeET/uAh/1JqqtES9nEYhoO9JByowmFOAr0kBW5i1tYeBiqda4RiCdQ4ALWgt2SYuz2oyTX2Vydp8ppRxtui0W1O9ziYqlYCwF3u8Jbj3eQOg7S7WD/JVxwkmeowqUtWv9ML8m0gRbpPetV76Xem+KODwPfN7YJe6U9R/sefsSXoQCWucrIqK93s80qk2E3eEWGghe6xwFb7m+NTsXQRrbPjhhgCIBV2dD4ghOzRoUinhBS/Ix5C3DnPIFpn96Z1+1kVd84zi+iUt6mItfbsgs1l1kd0sovWsaHCW/GVYGZho5LWNtE6mUXrPKnXsrURnexCfdPae0V0sorW+Y+HStwV0cksfG1T8c1WRXQyidbZ6sqmJcubr4yliwxCo9+4aVNTfdMZWuim1gkfkC8Hv/JS/7KNPR7ecJ0nOrlg+oZ860eRLEKx9s6PPx39XKrV9cIEG9TrHu3v0Vr7KvlW27TuUKvkzY3+4eY8L130KGlLJXKtR5sK+dPfw+Q5OlvaSpJ8ay6zXv5s8FzO16FKWp4pq5JnAygSurx1VL+8YtBRuZ/8doOITutjTw36sPxaus3kN0dGWWpNzqOz6b76z07tJbce7HjyW+MHJipUlX5mSO5bx0Mr2t+0t3x6s+PJ70h361vA0fmyv3oz/9HReu3My368m056xxwPYqzL7aGrzNx+8lvpajMUst1dagzkPzrXP3HaDYeeX6oT2kxxgjWYbYp7lHTX5Hew+w1W2Jqdbfmucldpr6q/DNvv0sqDvVuPuMcfAcf5nBO6bvK7BQAzXK0y7rV2ZXToUTqt54yNA6qbm8tbymXnSt8GzPSd7pj89nW3kVDA0RnpapO8FjcktzVu6J1/7QkM2/TEGe7v4snvBD9Qs13PjjQSLLaYbn41ybe0+roFcqfUzlS3YtVFB3+7lJmtK1aps3O1y5+/OdkzthOtQ03vmzaMo9f9a8/RqIvk7MAS0SkonX9MDvEjKfMcpUGI6GSnwVHmeZdCGOkNSXYhqLHALiqEEEIIIYQQQgghhBBCCCGE8F9DWMtlMskJNQAAAABJRU5ErkJggg==>>
+    .
+    See the documentation of the Text.AsciiDiagram module for the
+    description of the input format.
+
+license:             BSD3
+--license-file:        
+author:              Vincent Berthoux
+maintainer:          vincent.berthoux@gmail.com
+-- copyright:           
+category:            Text, Diagram
+build-type:          Simple
+extra-source-files:  changelog
+extra-doc-files:     docimages/*.svg
+cabal-version:       >=1.10
+
+Source-Repository head
+    Type:      git
+    Location:  git://github.com/Twinside/asciidiagram.git
+
+Source-Repository this
+    Type:      git
+    Location:  git://github.com/Twinside/asciidiagram.git
+    Tag:       v1.0
+
+library
+  ghc-options: -O2 -Wall
+  exposed-modules: Text.AsciiDiagram
+
+  other-modules: Text.AsciiDiagram.DiagramCleaner
+               , Text.AsciiDiagram.Geometry
+               , Text.AsciiDiagram.Graph
+               , Text.AsciiDiagram.Parser
+               , Text.AsciiDiagram.Reconstructor
+               , Text.AsciiDiagram.SvgRender
+
+  -- containers >= 0.5.2.1 for Set.elemAt
+  build-depends: base >=4.6 && <4.9
+               , vector >= 0.10
+               , text       >= 1.2 && < 1.3
+               , linear     >= 1.16
+               , containers >= 0.5
+               , mtl        >= 2.1 && < 2.3
+               , lens       >= 4.6 && < 4.8
+               , svg-tree       >= 0.1 && < 0.2
+               , rasterific-svg >= 0.1 && < 0.2
+               , FontyFruity    >= 0.5 && < 0.6
+               , JuicyPixels    >= 3.2
+
+  hs-source-dirs:      src
+  default-language:    Haskell2010
+
+Executable asciidiagram
+  Main-Is: asciidiagram.hs
+  default-language:    Haskell2010
+  ghc-options: -O2 -Wall
+  Hs-Source-Dirs: exec-src
+  Build-Depends: base >= 4.6
+               , optparse-applicative
+               , rasterific-svg
+               , JuicyPixels
+               , filepath
+               , asciidiagram
+               , svg-tree
+               , text
+
+ changelog view
@@ -0,0 +1,5 @@+-*-change-log-*-
+
+v0.1
+ * Initial version
+
+ docimages/arrows.svg view
@@ -0,0 +1,43 @@+<?xml version='1.0' ?>
+<svg xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink" version="1.1" width="165.0" height="117.0">
+  <style type="text/css">text {
+  font-family: Consolas , &quot;DejaVu Sans Mono&quot; , monospace;
+  font-size: 16.0px;
+}
+.dashed_elem {
+  stroke-dasharray: 4.0 , 3.0;
+}
+.filled_shape {
+  fill: url(#shape_light);
+}
+.bullet {
+  stroke-width: 1.0px;
+  fill: #FFFFFF;
+  stroke: #000000;
+}
+</style>
+  <defs>
+    <linearGradient id="shape_light" x2="0%" y2="100%">
+      <stop offset="0%" stop-color="#F5F5F5" />
+      <stop offset="100%" stop-color="#D8D8D8" />
+    </linearGradient>
+  </defs>
+  <path stroke-width="1.0" stroke="#000000" fill="none" class="line_element" d="M60.0,56.0 L60.0,56.0" />
+  <g stroke-width="1.0" stroke="#000000" fill="none" class="line_element">
+    <path class="" d="M60.0,56.0 L60.0,56.0 L20.0,56.0 L10.0,56.0" />
+    <path stroke-width="0.0" stroke="none" fill="#000000" class="" d="M10.0,49.0 L0.0,56.0 L10.0,63.0 Z" />
+  </g>
+  <g stroke-width="1.0" stroke="#000000" fill="none" class="line_element">
+    <path class="" d="M60.0,56.0 L60.0,56.0 L60.0,28.0 L60.0,14.0" />
+    <path stroke-width="0.0" stroke="none" fill="#000000" class="" d="M55.0,14.0 L65.0,14.0 L60.0,0.0 Z" />
+  </g>
+  <g stroke-width="1.0" stroke="#000000" fill="none" class="line_element">
+    <path class="" d="M60.0,56.0 L60.0,56.0 L100.0,56.0 L110.0,56.0" />
+    <path stroke-width="0.0" stroke="none" fill="#000000" class="" d="M110.0,49.0 L120.0,56.0 L110.0,63.0 Z" />
+  </g>
+  <g stroke-width="1.0" stroke="#000000" fill="none" class="line_element">
+    <path class="" d="M60.0,98.0 L60.0,98.0 L60.0,70.0 L60.0,56.0" />
+    <path stroke-width="0.0" stroke="none" fill="#000000" class="" d="M55.0,98.0 L65.0,98.0 L60.0,112.0 Z" />
+  </g>
+  <text class="" x="85.5" y="77.5">&lt; &gt; v ^</text>
+</svg>
+ docimages/baseExample.svg view
@@ -0,0 +1,46 @@+<?xml version='1.0' ?>
+<svg xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink" version="1.1" width="285.0" height="103.0">
+  <style type="text/css">text {
+  font-family: Consolas , &quot;DejaVu Sans Mono&quot; , monospace;
+  font-size: 16.0px;
+}
+.dashed_elem {
+  stroke-dasharray: 4.0 , 3.0;
+}
+.filled_shape {
+  fill: url(#shape_light);
+}
+.bullet {
+  stroke-width: 1.0px;
+  fill: #FFFFFF;
+  stroke: #000000;
+}
+.flat {
+  fill: #DDDDDD;
+}
+</style>
+  <defs>
+    <linearGradient id="shape_light" x2="0%" y2="100%">
+      <stop offset="0%" stop-color="#F5F5F5" />
+      <stop offset="100%" stop-color="#D8D8D8" />
+    </linearGradient>
+  </defs>
+  <path stroke-width="1.0" stroke="#000000" class="filled_shape" d="M11.5,42.0 L11.5,42.0 L11.5,54.5 L100.0,54.5 L108.5,54.5 L108.5,42.0 L108.5,29.5 L20.0,29.5 L11.5,29.5 Z" />
+  <g stroke-width="1.0" stroke="#000000" class="filled_shape">
+    <path class="flat" d="M11.5,70.0 L11.5,70.0 S10.0,84.0 20.0,82.5 L40.0,82.5 L50.0,82.5 L100.0,82.5 S110.0,84.0 108.5,70.0 L108.5,70.0 L108.5,57.5 L20.0,57.5 L11.5,57.5 Z" />
+    <circle class="bullet" cx="50.0" cy="82.5" r="3.0" />
+  </g>
+  <path stroke-width="1.0" stroke="#000000" class="filled_shape" d="M171.5,28.0 L171.5,56.0 L171.5,68.5 L190.0,68.5 L200.0,68.5 L260.0,68.5 S270.0,70.0 268.5,56.0 L268.5,28.0 L268.5,15.5 L180.0,15.5 S170.0,14.0 171.5,28.0 Z" />
+  <g stroke-width="1.0" stroke="#000000" fill="none" class="line_element">
+    <path class="" d="M160.0,42.0 L160.0,42.0 L120.0,42.0 L110.0,42.0" />
+    <path stroke-width="0.0" stroke="none" fill="#000000" class="" d="M160.0,35.0 L170.0,42.0 L160.0,49.0 Z" />
+  </g>
+  <path stroke-width="1.0" stroke="#000000" fill="none" class="line_element" d="M200.0,70.0 L200.0,70.0" />
+  <g stroke-width="1.0" stroke="#000000" fill="none" class="line_element">
+    <path class="dashed_elem" d="M200.0,70.0 L200.0,70.0 S200.0,84.0 190.0,84.0 L130.0,84.0 L120.0,84.0" />
+    <path stroke-width="0.0" stroke="none" fill="#000000" class="" d="M120.0,77.0 L110.0,84.0 L120.0,91.0 Z" />
+  </g>
+  <text class="" x="35.5" y="49.5">ASCII </text>
+  <text class="" x="185.5" y="49.5">Diagram </text>
+  <text class="" x="85.5" y="77.5"></text>
+</svg>
+ docimages/bulletTest.svg view
@@ -0,0 +1,38 @@+<?xml version='1.0' ?>
+<svg xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink" version="1.1" width="165.0" height="75.0">
+  <style type="text/css">text {
+  font-family: Consolas , &quot;DejaVu Sans Mono&quot; , monospace;
+  font-size: 16.0px;
+}
+.dashed_elem {
+  stroke-dasharray: 4.0 , 3.0;
+}
+.filled_shape {
+  fill: url(#shape_light);
+}
+.bullet {
+  stroke-width: 1.0px;
+  fill: #FFFFFF;
+  stroke: #000000;
+}
+</style>
+  <defs>
+    <linearGradient id="shape_light" x2="0%" y2="100%">
+      <stop offset="0%" stop-color="#F5F5F5" />
+      <stop offset="100%" stop-color="#D8D8D8" />
+    </linearGradient>
+  </defs>
+  <g stroke-width="1.0" stroke="#000000" class="filled_shape">
+    <path class="" d="M31.5,28.0 L31.5,28.0 L31.5,40.5 L60.0,40.5 S70.0,42.0 68.5,28.0 L68.5,28.0 L68.5,15.5 L60.0,15.5 L50.0,15.5 L40.0,15.5 L31.5,15.5 Z" />
+    <circle class="bullet" cx="68.5" cy="15.5" r="3.0" />
+    <circle class="bullet" cx="50.0" cy="15.5" r="3.0" />
+    <circle class="bullet" cx="31.5" cy="15.5" r="3.0" />
+  </g>
+  <g stroke-width="1.0" stroke="#000000" fill="none" class="line_element">
+    <path class="" d="M150.0,56.0 L150.0,56.0 L150.0,42.0 L150.0,28.0 L110.0,28.0 L100.0,28.0" />
+    <circle class="bullet" cx="150.0" cy="56.0" r="3.0" />
+    <circle class="bullet" cx="150.0" cy="28.0" r="3.0" />
+    <circle class="bullet" cx="100.0" cy="28.0" r="3.0" />
+  </g>
+  <text class="" x="105.5" y="63.5">* * </text>
+</svg>
+ docimages/cabalSchema.svg view
@@ -0,0 +1,42 @@+<?xml version='1.0' ?>
+<svg xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink" version="1.1" width="285.0" height="103.0">
+  <style type="text/css">text {
+  font-family: Consolas , &quot;DejaVu Sans Mono&quot; , monospace;
+  font-size: 16.0px;
+}
+.dashed_elem {
+  stroke-dasharray: 4.0 , 3.0;
+}
+.filled_shape {
+  fill: url(#shape_light);
+}
+.bullet {
+  stroke-width: 1.0px;
+  fill: #FFFFFF;
+  stroke: #000000;
+}
+</style>
+  <defs>
+    <linearGradient id="shape_light" x2="0%" y2="100%">
+      <stop offset="0%" stop-color="#F5F5F5" />
+      <stop offset="100%" stop-color="#D8D8D8" />
+    </linearGradient>
+  </defs>
+  <path stroke-width="1.0" stroke="#000000" class="filled_shape" d="M11.5,42.0 L11.5,42.0 L11.5,54.5 L100.0,54.5 L108.5,54.5 L108.5,42.0 L108.5,29.5 L20.0,29.5 L11.5,29.5 Z" />
+  <g stroke-width="1.0" stroke="#000000" class="filled_shape">
+    <path class="" d="M11.5,70.0 L11.5,70.0 S10.0,84.0 20.0,82.5 L40.0,82.5 L50.0,82.5 L100.0,82.5 S110.0,84.0 108.5,70.0 L108.5,70.0 L108.5,57.5 L20.0,57.5 L11.5,57.5 Z" />
+    <circle class="bullet" cx="50.0" cy="82.5" r="3.0" />
+  </g>
+  <path stroke-width="1.0" stroke="#000000" class="filled_shape" d="M171.5,28.0 L171.5,56.0 L171.5,68.5 L190.0,68.5 L200.0,68.5 L260.0,68.5 S270.0,70.0 268.5,56.0 L268.5,28.0 L268.5,15.5 L180.0,15.5 S170.0,14.0 171.5,28.0 Z" />
+  <g stroke-width="1.0" stroke="#000000" fill="none" class="line_element">
+    <path class="" d="M160.0,42.0 L160.0,42.0 L120.0,42.0 L110.0,42.0" />
+    <path stroke-width="0.0" stroke="none" fill="#000000" class="" d="M160.0,35.0 L170.0,42.0 L160.0,49.0 Z" />
+  </g>
+  <path stroke-width="1.0" stroke="#000000" fill="none" class="line_element" d="M200.0,70.0 L200.0,70.0" />
+  <g stroke-width="1.0" stroke="#000000" fill="none" class="line_element">
+    <path class="dashed_elem" d="M200.0,70.0 L200.0,70.0 S200.0,84.0 190.0,84.0 L130.0,84.0 L120.0,84.0" />
+    <path stroke-width="0.0" stroke="none" fill="#000000" class="" d="M120.0,77.0 L110.0,84.0 L120.0,91.0 Z" />
+  </g>
+  <text class="" x="35.5" y="49.5">ASCII </text>
+  <text class="" x="185.5" y="49.5">Diagram </text>
+</svg>
+ docimages/complexClosed.svg view
@@ -0,0 +1,27 @@+<?xml version='1.0' ?>
+<svg xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink" version="1.1" width="145.0" height="117.0">
+  <style type="text/css">text {
+  font-family: Consolas , &quot;DejaVu Sans Mono&quot; , monospace;
+  font-size: 16.0px;
+}
+.dashed_elem {
+  stroke-dasharray: 4.0 , 3.0;
+}
+.filled_shape {
+  fill: url(#shape_light);
+}
+.bullet {
+  stroke-width: 1.0px;
+  fill: #FFFFFF;
+  stroke: #000000;
+}
+</style>
+  <defs>
+    <linearGradient id="shape_light" x2="0%" y2="100%">
+      <stop offset="0%" stop-color="#F5F5F5" />
+      <stop offset="100%" stop-color="#D8D8D8" />
+    </linearGradient>
+  </defs>
+  <path stroke-width="1.0" stroke="#000000" class="filled_shape" d="M31.5,28.0 L31.5,56.0 L31.5,68.5 L60.0,68.5 L70.0,68.5 L90.0,68.5 L98.5,68.5 L98.5,56.0 L98.5,42.0 L98.5,28.0 L98.5,15.5 L40.0,15.5 L31.5,15.5 Z" />
+  <path stroke-width="1.0" stroke="#000000" class="filled_shape" d="M71.5,84.0 L71.5,84.0 L71.5,96.5 L120.0,96.5 L128.5,96.5 L128.5,56.0 L128.5,43.5 L110.0,43.5 L101.5,43.5 L101.5,56.0 L101.5,71.5 L80.0,71.5 L71.5,71.5 Z" />
+</svg>
+ docimages/curvedCorner.svg view
@@ -0,0 +1,37 @@+<?xml version='1.0' ?>
+<svg xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink" version="1.1" width="275.0" height="187.0">
+  <style type="text/css">text {
+  font-family: Consolas , &quot;DejaVu Sans Mono&quot; , monospace;
+  font-size: 16.0px;
+}
+.dashed_elem {
+  stroke-dasharray: 4.0 , 3.0;
+}
+.filled_shape {
+  fill: url(#shape_light);
+}
+.bullet {
+  stroke-width: 1.0px;
+  fill: #FFFFFF;
+  stroke: #000000;
+}
+</style>
+  <defs>
+    <linearGradient id="shape_light" x2="0%" y2="100%">
+      <stop offset="0%" stop-color="#F5F5F5" />
+      <stop offset="100%" stop-color="#D8D8D8" />
+    </linearGradient>
+  </defs>
+  <path stroke-width="1.0" stroke="#000000" class="filled_shape" d="M31.5,28.0 L31.5,28.0 L31.5,40.5 L50.0,40.5 L58.5,40.5 L58.5,28.0 L58.5,15.5 L40.0,15.5 S30.0,14.0 31.5,28.0 Z" />
+  <path stroke-width="1.0" stroke="#000000" class="filled_shape" d="M31.5,84.0 L31.5,84.0 L31.5,96.5 L50.0,96.5 S60.0,98.0 58.5,84.0 L58.5,84.0 L58.5,71.5 L40.0,71.5 S30.0,70.0 31.5,84.0 Z" />
+  <path stroke-width="1.0" stroke="#000000" class="filled_shape" d="M31.5,140.0 L31.5,140.0 S30.0,154.0 40.0,152.5 L50.0,152.5 S60.0,154.0 58.5,140.0 L58.5,140.0 S60.0,126.0 50.0,127.5 L40.0,127.5 S30.0,126.0 31.5,140.0 Z" />
+  <path stroke-width="1.0" stroke="#000000" class="filled_shape" d="M91.5,28.0 L91.5,28.0 L91.5,40.5 L110.0,40.5 L118.5,40.5 L118.5,28.0 S120.0,14.0 110.0,15.5 L100.0,15.5 L91.5,15.5 Z" />
+  <path stroke-width="1.0" stroke="#000000" class="filled_shape" d="M91.5,84.0 L91.5,84.0 L91.5,96.5 L110.0,96.5 L118.5,96.5 L118.5,84.0 S120.0,70.0 110.0,71.5 L100.0,71.5 S90.0,70.0 91.5,84.0 Z" />
+  <path stroke-width="1.0" stroke="#000000" class="filled_shape" d="M151.5,28.0 L151.5,28.0 S150.0,42.0 160.0,40.5 L170.0,40.5 L178.5,40.5 L178.5,28.0 L178.5,15.5 L160.0,15.5 L151.5,15.5 Z" />
+  <path stroke-width="1.0" stroke="#000000" class="filled_shape" d="M151.5,84.0 L151.5,84.0 S150.0,98.0 160.0,96.5 L170.0,96.5 S180.0,98.0 178.5,84.0 L178.5,84.0 L178.5,71.5 L160.0,71.5 S150.0,70.0 151.5,84.0 Z" />
+  <path stroke-width="1.0" stroke="#000000" class="filled_shape" d="M211.5,28.0 L211.5,28.0 L211.5,40.5 L230.0,40.5 L238.5,40.5 L238.5,28.0 L238.5,15.5 L220.0,15.5 S210.0,14.0 211.5,28.0 Z" />
+  <path stroke-width="1.0" stroke="#000000" class="filled_shape" d="M211.5,84.0 L211.5,84.0 L211.5,96.5 L230.0,96.5 S240.0,98.0 238.5,84.0 L238.5,84.0 S240.0,70.0 230.0,71.5 L220.0,71.5 S210.0,70.0 211.5,84.0 Z" />
+  <text class="" x="255.5" y="77.5">.</text>
+  <text class="" x="75.5" y="133.5">. </text>
+  <text class="" x="5.5" y="175.5">. </text>
+</svg>
+ docimages/dashed_lines.svg view
@@ -0,0 +1,30 @@+<?xml version='1.0' ?>
+<svg xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink" version="1.1" width="145.0" height="131.0">
+  <style type="text/css">text {
+  font-family: Consolas , &quot;DejaVu Sans Mono&quot; , monospace;
+  font-size: 16.0px;
+}
+.dashed_elem {
+  stroke-dasharray: 4.0 , 3.0;
+}
+.filled_shape {
+  fill: url(#shape_light);
+}
+.bullet {
+  stroke-width: 1.0px;
+  fill: #FFFFFF;
+  stroke: #000000;
+}
+</style>
+  <defs>
+    <linearGradient id="shape_light" x2="0%" y2="100%">
+      <stop offset="0%" stop-color="#F5F5F5" />
+      <stop offset="100%" stop-color="#D8D8D8" />
+    </linearGradient>
+  </defs>
+  <path stroke-width="1.0" stroke="#000000" fill="none" class="line_element" d="M20.0,112.0 L20.0,112.0 L20.0,56.0" />
+  <path stroke-width="1.0" stroke="#000000" fill="none" class="line_element" d="M20.0,14.0 L60.0,14.0" />
+  <path stroke-width="1.0" stroke="#000000" fill="none" class="line_element dashed_elem" d="M70.0,112.0 L30.0,112.0 L20.0,112.0" />
+  <path stroke-width="1.0" stroke="#000000" fill="none" class="line_element dashed_elem" d="M40.0,28.0 L100.0,28.0" />
+  <path stroke-width="1.0" stroke="#000000" fill="none" class="line_element dashed_elem" d="M90.0,84.0 L60.0,84.0 S50.0,84.0 50.0,70.0 L50.0,56.0" />
+</svg>
+ docimages/dashingClosed.svg view
@@ -0,0 +1,29 @@+<?xml version='1.0' ?>
+<svg xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink" version="1.1" width="255.0" height="61.0">
+  <style type="text/css">text {
+  font-family: Consolas , &quot;DejaVu Sans Mono&quot; , monospace;
+  font-size: 16.0px;
+}
+.dashed_elem {
+  stroke-dasharray: 4.0 , 3.0;
+}
+.filled_shape {
+  fill: url(#shape_light);
+}
+.bullet {
+  stroke-width: 1.0px;
+  fill: #FFFFFF;
+  stroke: #000000;
+}
+</style>
+  <defs>
+    <linearGradient id="shape_light" x2="0%" y2="100%">
+      <stop offset="0%" stop-color="#F5F5F5" />
+      <stop offset="100%" stop-color="#D8D8D8" />
+    </linearGradient>
+  </defs>
+  <rect stroke-width="1.0" stroke="#000000" class="filled_shape" width="27.0" height="25.0" x="31.5" y="15.5" />
+  <rect stroke-width="1.0" stroke="#000000" class="filled_shape dashed_elem" width="27.0" height="25.0" x="91.5" y="15.5" />
+  <rect stroke-width="1.0" stroke="#000000" class="filled_shape dashed_elem" width="27.0" height="25.0" x="151.5" y="15.5" />
+  <rect stroke-width="1.0" stroke="#000000" class="filled_shape dashed_elem" width="27.0" height="25.0" x="211.5" y="15.5" />
+</svg>
+ docimages/simple_lines.svg view
@@ -0,0 +1,30 @@+<?xml version='1.0' ?>
+<svg xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink" version="1.1" width="145.0" height="131.0">
+  <style type="text/css">text {
+  font-family: Consolas , &quot;DejaVu Sans Mono&quot; , monospace;
+  font-size: 16.0px;
+}
+.dashed_elem {
+  stroke-dasharray: 4.0 , 3.0;
+}
+.filled_shape {
+  fill: url(#shape_light);
+}
+.bullet {
+  stroke-width: 1.0px;
+  fill: #FFFFFF;
+  stroke: #000000;
+}
+</style>
+  <defs>
+    <linearGradient id="shape_light" x2="0%" y2="100%">
+      <stop offset="0%" stop-color="#F5F5F5" />
+      <stop offset="100%" stop-color="#D8D8D8" />
+    </linearGradient>
+  </defs>
+  <path stroke-width="1.0" stroke="#000000" fill="none" class="line_element" d="M20.0,112.0 L20.0,112.0 L20.0,56.0" />
+  <path stroke-width="1.0" stroke="#000000" fill="none" class="line_element" d="M20.0,14.0 L60.0,14.0" />
+  <path stroke-width="1.0" stroke="#000000" fill="none" class="line_element" d="M70.0,112.0 L30.0,112.0 L20.0,112.0" />
+  <path stroke-width="1.0" stroke="#000000" fill="none" class="line_element" d="M40.0,28.0 L100.0,28.0" />
+  <path stroke-width="1.0" stroke="#000000" fill="none" class="line_element" d="M90.0,84.0 L60.0,84.0 S50.0,84.0 50.0,70.0 L50.0,56.0" />
+</svg>
+ docimages/styleExample.svg view
@@ -0,0 +1,58 @@+<?xml version='1.0' ?>
+<svg xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink" version="1.1" width="465.0" height="159.0">
+  <style type="text/css">text {
+  font-family: Consolas , &quot;DejaVu Sans Mono&quot; , monospace;
+  font-size: 16.0px;
+}
+.dashed_elem {
+  stroke-dasharray: 4.0 , 3.0;
+}
+.filled_shape {
+  fill: url(#shape_light);
+}
+.bullet {
+  stroke-width: 1.0px;
+  fill: #FFFFFF;
+  stroke: #000000;
+}
+.dst {
+  stroke: #FFAAAA;
+  stroke-width: 3.0px;
+}
+.src {
+  fill: #AAAAFF;
+}
+</style>
+  <defs>
+    <linearGradient id="shape_light" x2="0%" y2="100%">
+      <stop offset="0%" stop-color="#F5F5F5" />
+      <stop offset="100%" stop-color="#D8D8D8" />
+    </linearGradient>
+  </defs>
+  <path stroke-width="1.0" stroke="#000000" class="filled_shape src" d="M21.5,28.0 L21.5,42.0 L21.5,54.5 L100.0,54.5 L108.5,54.5 L108.5,42.0 L108.5,28.0 L108.5,15.5 L30.0,15.5 L21.5,15.5 Z" />
+  <rect stroke-width="1.0" stroke="#000000" class="filled_shape dst" width="67.0" height="39.0" x="21.5" y="85.5" />
+  <g stroke-width="1.0" stroke="#000000" class="filled_shape">
+    <path class="" d="M131.5,84.0 L131.5,84.0 L131.5,96.5 L200.0,96.5 L208.5,96.5 L208.5,84.0 L208.5,71.5 L140.0,71.5 L131.5,71.5 Z" />
+    <circle class="bullet" cx="208.5" cy="71.5" r="3.0" />
+  </g>
+  <path stroke-width="1.0" stroke="#000000" class="filled_shape" d="M211.5,28.0 L211.5,28.0 S210.0,42.0 220.0,40.5 L240.0,40.5 L250.0,40.5 L290.0,40.5 S300.0,42.0 298.5,28.0 L298.5,28.0 L298.5,15.5 L220.0,15.5 L211.5,15.5 Z" />
+  <g stroke-width="1.0" stroke="#000000" fill="none" class="line_element">
+    <path class="" d="M200.0,28.0 L200.0,28.0 L120.0,28.0 L110.0,28.0" />
+    <path stroke-width="0.0" stroke="none" fill="#000000" class="" d="M200.0,21.0 L210.0,28.0 L200.0,35.0 Z" />
+  </g>
+  <path stroke-width="1.0" stroke="#000000" fill="none" class="line_element" d="M250.0,42.0 L250.0,42.0" />
+  <g stroke-width="1.0" stroke="#000000" fill="none" class="line_element">
+    <path class="" d="M250.0,42.0 L250.0,42.0 L250.0,56.0 S250.0,70.0 240.0,70.0 L230.0,70.0 L220.0,70.0" />
+    <path stroke-width="0.0" stroke="none" fill="#000000" class="" d="M220.0,63.0 L210.0,70.0 L220.0,77.0 Z" />
+  </g>
+  <g stroke-width="1.0" stroke="#000000" fill="none" class="line_element">
+    <path class="" d="M120.0,84.0 L110.0,84.0 L100.0,84.0" />
+    <path stroke-width="0.0" stroke="none" fill="#000000" class="" d="M100.0,77.0 L90.0,84.0 L100.0,91.0 Z" />
+  </g>
+  <text class="" x="35.5" y="35.5">Source </text>
+  <text class="" x="225.5" y="35.5">op1 </text>
+  <text class="" x="95.5" y="49.5"></text>
+  <text class="" x="145.5" y="91.5">op2 </text>
+  <text class="" x="35.5" y="105.5">Dest </text>
+  <text class="" x="85.5" y="119.5"></text>
+</svg>
+ exec-src/asciidiagram.hs view
@@ -0,0 +1,109 @@+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TupleSections #-}
+{-# LANGUAGE CPP #-}
+
+#if !MIN_VERSION_base(4,8,0)
+import Control.Applicative( (<*>), pure )
+#endif
+
+import Control.Applicative( (<$>), (<|>) )
+import Control.Monad( when )
+import Data.Monoid( (<>) )
+
+import qualified Data.Text.IO as STIO
+import System.FilePath( replaceExtension
+                      , takeExtension )
+
+import Graphics.Rasterific.Svg( renderSvgDocument
+                              , loadCreateFontCache )
+
+import Codec.Picture( writePng )
+import Options.Applicative( Parser
+                          , ParserInfo
+                          , argument
+                          , execParser
+                          , flag
+                          , fullDesc
+                          , header
+                          , help
+                          , helper
+                          , info
+                          , long
+                          , metavar
+                          , progDesc
+                          , str
+                          , switch
+                          )
+import Text.AsciiDiagram
+import Graphics.Svg
+
+data Options = Options
+  { _inputFile  :: !FilePath
+  , _outputFile :: !FilePath
+  , _verbose    :: !Bool
+  , _format     :: !(Maybe Format)
+  }
+
+data Format = FormatSvg | FormatPng
+
+argParser :: Parser Options
+argParser = Options
+  <$> ( argument str
+            (metavar "INPUTFILE"
+            <> help "Text file of the Ascii diagram to parse."))
+  <*> ( argument str
+            (metavar "OUTPUTFILE"
+            <> help ("Output file name, same as input with"
+                    <> " different extension if unspecified."))
+        <|> pure "" )
+  <*> ( switch (long "verbose" <> help "Display more information") )
+  <*> ( flag Nothing (Just FormatSvg)
+            (  long "svg"
+            <> help "Force the use of the SVG format (deduced from extension otherwise)")
+     <|> flag Nothing (Just FormatPng)
+            ( long "png"
+            <> help "Force the use of the PNG format (deduced from extension otherwise) (by default)")
+      )
+
+progOptions :: ParserInfo Options
+progOptions = info (helper <*> argParser)
+      ( fullDesc
+     <> progDesc "Convert INPUTFILE into a svg or png OUTPUTFILE"
+     <> header "asciidiagram - A pretty printer for ASCII art diagram to SVG." )
+
+formatOfOuputFilename :: FilePath -> Format
+formatOfOuputFilename f = case takeExtension f of
+    ".png" -> FormatPng
+    ".svg" -> FormatSvg
+    _ -> FormatPng
+
+runConversion :: Options -> IO ()
+runConversion opt = do
+  verbose . putStrLn $ "Loading file " ++ _inputFile opt
+  inputData <- STIO.readFile $ _inputFile opt
+  let svgDoc = svgOfDiagram $ parseAsciiDiagram inputData
+  case (_format opt, formatOfOuputFilename $ _outputFile opt) of
+    (Nothing, FormatSvg) -> saveDoc svgDoc
+    (Just FormatSvg, _) -> saveDoc svgDoc
+    (Nothing, FormatPng) -> savePng svgDoc
+    (Just FormatPng, _) -> savePng svgDoc
+  where
+    verbose = when $ _verbose opt
+    saveDoc doc = do
+      verbose . putStrLn $ "Writing SVG file " ++ _outputFile opt
+      saveXmlFile (savingPath "svg") doc
+
+    savingPath ext = case _outputFile opt of
+      "" -> replaceExtension (_inputFile opt) ext
+      p -> p
+
+    savePng doc = do
+      verbose . putStrLn $ "Loading/Building font cache (can be long)"
+      cache <- loadCreateFontCache "asciidiagram-fonty-fontcache"
+      verbose . putStrLn $ "Writing PNG file " ++ _outputFile opt
+      (img, _) <- renderSvgDocument cache Nothing 96 doc
+      writePng (savingPath "png") img
+
+main :: IO ()
+main = execParser progOptions >>= runConversion
+
+ src/Text/AsciiDiagram.hs view
@@ -0,0 +1,417 @@+{-# LANGUAGE TupleSections #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE FlexibleContexts #-}
+-- | This module gives access to the ascii diagram parser and
+-- SVG renderer.
+--
+-- Ascii diagram, transform your ASCII art drawing to a nicer
+-- representation
+-- 
+-- @
+--                 \/---------+
+-- +---------+     |         |
+-- |  ASCII  +----\>| Diagram |
+-- +---------+     |         |
+-- |{flat}   |     +--+------\/
+-- \\---*-----\/\<=======\/
+-- ::: .flat { fill: #DDD; }
+-- @
+-- <<docimages/baseExample.svg>>
+-- 
+-- To render the diagram as a PNG file, you have to use the
+-- library rasterific-svg and JuicyPixels.
+--
+-- As a sample usage, to save a diagram to png, you can use
+-- the following snippet.
+--
+-- > import Codec.Picture( writePng )
+-- > import Text.AsciiDiagram( imageOfDiagram )
+-- > import Graphics.Rasterific.Svg( loadCreateFontCache )
+-- >
+-- > saveDiagramToFile :: FilePath -> Diagram -> IO ()
+-- > saveDiagramToFile path diag = do
+-- >   cache <- loadCreateFontCache "asciidiagram-fonty-fontcache"
+-- >   imageOfDiagram cache 96 diag
+-- >   writePng path img
+--
+module Text.AsciiDiagram
+  ( 
+    -- $introDoc
+    -- * Diagram format
+
+    -- ** Lines
+    -- $linesdoc
+
+    -- ** Shapes
+    -- $shapesdoc
+
+    -- ** Bullets
+    -- $bulletdoc
+
+    -- ** Styles
+    -- $styledoc
+
+    -- * Usage example
+    -- $example
+
+    -- * Functions
+    svgOfDiagram
+  , parseAsciiDiagram
+  , saveAsciiDiagramAsSvg
+  , imageOfDiagram
+
+    -- * Document description
+  , Diagram( .. ) 
+  , TextZone( .. )
+  , Shape( .. )
+  , ShapeElement( .. )
+  , Anchor( .. )
+  , Segment( .. )
+  , SegmentKind( .. )
+  , SegmentDraw( .. )
+  , Point
+  ) where
+
+import Data.Monoid( (<>))
+import Control.Applicative( (<$>) )
+import Control.Monad( forM_ )
+import Control.Monad.ST( runST )
+import Control.Monad.State.Strict( runState, put, get )
+import Data.Function( on )
+import Data.List( partition, sortBy )
+import qualified Data.Foldable as F
+import qualified Data.Set as S
+import qualified Data.Text as T
+import qualified Data.Vector.Unboxed as VU
+import qualified Data.Vector.Unboxed.Mutable as VUM
+import Linear( V2( V2 ) )
+
+import Text.AsciiDiagram.Parser
+import Text.AsciiDiagram.Reconstructor
+import Text.AsciiDiagram.SvgRender
+import Text.AsciiDiagram.Geometry
+import Text.AsciiDiagram.DiagramCleaner
+
+import Codec.Picture( Image, PixelRGBA8 )
+import Graphics.Text.TrueType( FontCache )
+import Graphics.Svg( Dpi, saveXmlFile )
+import Graphics.Rasterific.Svg( renderSvgDocument )
+
+{-import Debug.Trace-}
+{-import Text.Groom-}
+{-import Text.Printf-}
+
+data CharBoard = CharBoard
+  { _boardWidth  :: !Int
+  , _boardHeight :: !Int
+  , _boardData   :: !(VU.Vector Char)
+  }
+  deriving (Eq, Show)
+
+textOfCharBoard :: CharBoard -> [T.Text]
+textOfCharBoard board = fetch <$> zip [0 .. h - 1] [0, w..] where
+  w = _boardWidth board
+  h = _boardHeight board
+  charData = _boardData board
+
+  fetch (_, startIdx) =
+      T.pack . VU.toList . VU.take w $ VU.drop startIdx charData
+
+charBoardOfText :: [T.Text] -> CharBoard
+charBoardOfText textLines = CharBoard
+  { _boardWidth  = twidth
+  , _boardHeight = theight
+  , _boardData   = charData
+  }
+  where
+    twidth = maximum $ fmap T.length textLines
+    theight = length textLines
+ 
+    lineIndices = zip [0, twidth ..] textLines
+
+    charData = runST $ do
+      emptyBoard <- VUM.replicate (twidth * theight) ' '
+
+      forM_ lineIndices $ \(lineIndex, l) -> do
+        let chars = zip [lineIndex, lineIndex + 1 ..] $ T.unpack l
+        forM_ chars $ \(idx, c) -> do
+          VUM.unsafeWrite emptyBoard idx c
+
+      VU.unsafeFreeze emptyBoard
+
+data HorizontalPoints
+  = WithHorizontalSegments
+  | WithoutHorizontalSegments
+  deriving Eq
+
+allowsHorizontal :: HorizontalPoints -> Bool
+allowsHorizontal WithHorizontalSegments = True
+allowsHorizontal WithoutHorizontalSegments = False
+
+pointsOfShape :: F.Foldable f => HorizontalPoints -> f Shape -> [Point]
+pointsOfShape horizInfo = F.concatMap (F.concatMap go . shapeElements) where
+  withHorizontal = allowsHorizontal horizInfo
+
+  go (ShapeAnchor p _) = [p]
+  go (ShapeSegment Segment { _segStart = V2 sx sy, _segEnd = V2 ex ey })
+    | sx == ex && sy >= ey = [V2 sx yy | yy <- [ey .. sy]]
+    | sx == ex             = [V2 sx yy | yy <- [sy .. ey]]
+    | withHorizontal && sy == ey && sx >= ex =
+        [V2 xx sy | xx <- [ex .. sx]]
+    | withHorizontal && sy == ey =
+        [V2 xx sy | xx <- [sx .. ex]]
+    | otherwise            = []
+
+cleanLines :: [Int] -> CharBoard -> CharBoard
+cleanLines idxs board = board { _boardData = _boardData board VU.// toSet }
+  where
+    xMax = _boardWidth board - 1
+    toSet = [(lineIndex + column, ' ')
+                          | lineNum <- idxs
+                          , let lineIndex = lineNum * _boardWidth board
+                          , column <- [0 .. xMax]
+                          ]
+
+cleanupShapes :: (F.Foldable f) => f Shape -> CharBoard -> CharBoard
+cleanupShapes shapes board = board { _boardData = _boardData board VU.// toSet }
+  where toSet = [(x + y * _boardWidth board, ' ')
+                    | V2 x y <- pointsOfShape WithHorizontalSegments shapes]
+
+
+pointComp :: Point -> Point -> Ordering
+pointComp (V2 x1 y1) (V2 x2 y2) = case compare y1 y2 of
+  EQ -> compare x1 x2
+  a -> a
+
+rangesOfShapes :: Shape -> [(Point, Point)]
+rangesOfShapes shape = pairAssoc sortedPoints
+  where
+   pairAssoc  [] = []
+   pairAssoc [_] = []
+   pairAssoc (p1@(V2 _ y1):lst@(p2@(V2 _ y2):rest))
+      | y1 == y2 = (p1, p2) : pairAssoc rest
+      | otherwise = pairAssoc lst
+
+   sortedPoints = sortBy pointComp
+                $ pointsOfShape WithoutHorizontalSegments [shape]
+
+
+associateTags :: [Shape] -> [TextZone] -> ([Shape], [TextZone])
+associateTags shapes tagZones =
+  expandTag $ runState (mapM go shapes) sortedZones where
+
+  sortedZones =
+    sortBy (pointComp `on` _textZoneOrigin) tagZones
+
+  isInRange (V2 px py) (V2 x1 y1, V2 x2 y2) =
+    py == y1 && py == y2 && x1 < px && px < x2
+  
+  expandTag (s, zones) = (s, fmap expander zones) where
+    expander t = t { _textZoneContent = "{" <> _textZoneContent t <> "}" }
+
+  insertAlls shape =
+    foldr S.insert (shapeTags shape) . fmap _textZoneContent
+
+  go shape | not $ shapeIsClosed shape = return shape
+  go shape = do
+    zones <- get
+
+    let ranges = rangesOfShapes shape
+        isInShape TextZone { _textZoneOrigin = orig } =
+          any (isInRange orig) ranges
+        (inRanges, other) = partition isInShape zones
+
+    put other
+
+    return shape { shapeTags = insertAlls shape inRanges }
+
+
+-- | Analyze an ascii diagram and extract all it's features.
+parseAsciiDiagram :: T.Text -> Diagram
+parseAsciiDiagram content = Diagram
+    { _diagramShapes = S.fromList taggedShape
+    , _diagramTexts = zones ++ unusedTags
+    , _diagramCellWidth = maximum $ fmap T.length textLines
+    , _diagramCellHeight = length textLines - length styleLines
+    , _diagramStyles = styleLines
+    }
+  where
+    textLines = T.lines content
+    (taggedShape, unusedTags) = associateTags (S.toList validShapes) tags
+
+    (tags, zones) = detectTagFromTextZone
+                  $ extractTextZones shapeCleanedText 
+
+    (styleLineNumber, styleLines) = unzip $ styleLine parsed
+
+    shapeCleanedText =
+      textOfCharBoard . cleanLines styleLineNumber
+                      . cleanupShapes validShapes
+                      $ charBoardOfText textLines
+    
+    parsed = parseTextLines textLines
+    reconstructed =
+      reconstruct (anchorMap parsed) $ segmentSet parsed
+    validShapes = S.filter isShapePossible reconstructed
+
+-- | Helper function helping you save a diagram as
+-- a SVG file on disk.
+saveAsciiDiagramAsSvg :: FilePath -> Diagram -> IO ()
+saveAsciiDiagramAsSvg fileName diagram =
+  saveXmlFile fileName $ svgOfDiagram diagram
+
+-- | Render a Diagram as an image. a good value for the Dpi
+-- is 96. The IO dependency is there to allow loading of the
+-- font files used in the document.
+imageOfDiagram :: FontCache -> Dpi -> Diagram -> IO (Image PixelRGBA8)
+imageOfDiagram cache dpi = 
+  fmap fst . renderSvgDocument cache Nothing dpi . svgOfDiagram
+
+-- $linesdoc
+-- The basic syntax of asciidiagrams is made of lines made out\nof \'-\' and \'|\' characters. They can be connected with anchors\nlike \'+\' (direct connection) or \'\\\' and \'\/\' (smooth connections)\n
+-- 
+-- >-----       
+-- >  -------   
+-- >            
+-- >|  |        
+-- >|  |        
+-- >|  \----    
+-- >|           
+-- >+-----      
+--
+-- <<docimages/simple_lines.svg>>
+-- 
+-- You can use dashed lines by using ':' for vertical lines or '=' for\nhorizontal lines.
+-- 
+-- 
+-- @
+--  -----       
+--    -=-----   
+--              
+--  |  :        
+--  |  |        
+--  |  \\----    
+--  |           
+--  +--=--      
+-- @
+-- <<docimages/dashed_lines.svg>>
+-- 
+-- Arrows are made out of the \'\<\', \'\>\', \'^\' and \'v\'\ncharacters.\nIf the arrows are not connected to any lines, the text is left as is.\n
+-- 
+-- 
+-- @
+--      ^
+--      |
+--      |
+-- \<----+----\>
+--      |  \< \> v ^
+--      |
+--      v
+-- @
+-- <<docimages/arrows.svg>>
+-- 
+
+-- $shapesdoc
+-- If the lines are closed, then it is detected as such and rendered
+-- differently
+-- 
+-- 
+-- @
+--   +------+
+--   |      |
+--   |      +--+
+--   |      |  |
+--   +---+--+  |
+--       |     |
+--       +-----+
+-- @
+-- <<docimages/complexClosed.svg>>
+-- 
+-- If any of the segment posess one of the dashing markers (\':\' or \'=\')
+-- Then the full shape will be dashed.
+-- 
+-- 
+-- @
+--   +--+  +--+  +=-+  +=-+
+--   |  |  :  |  |  |  |  :
+--   +--+  +--+  +--+  +-=+
+-- @
+-- <<docimages/dashingClosed.svg>>
+-- 
+-- Any of the angle of a shape can curved one of the smooth corner anchor
+-- (\'\\\' or \'\/\')
+-- 
+-- 
+-- @
+--   \/--+  +--\\  +--+  \/--+
+--   |  |  |  |  |  |  |  |
+--   +--+  +--+  \\--+  +--+
+-- 
+--   \/--+  \/--\\  \/--+  \/--\\ .
+--   |  |  |  |  |  |  |  |
+--   +--\/  +--+  \\--\/  +--\/
+-- 
+--   \/--\\ .
+--   |  |
+--   \\--\/
+-- .
+-- @
+-- <<docimages/curvedCorner.svg>>
+-- 
+
+-- $bulletdoc
+-- Adding a \'*\' on a line or on a shape add a little circle on it.
+-- If the bullet is not attached to any shape or lines, then it
+-- will be render like any other text.
+-- 
+-- 
+-- @
+--   *-*-*
+--   |   |  *----*
+--   +---\/       |
+--           * * *
+-- @
+-- <<docimages/bulletTest.svg>>
+-- 
+-- When used at connection points, it behaves like the \'+\' anchor.
+-- 
+
+-- $styledoc
+-- The shapes can ba annotated with a tag like `{tagname}`.
+-- Tags will be inserted in the class attribute of the shape
+-- and can then be stylized with a CSS.
+-- 
+-- 
+-- @
+--  +--------+         +--------+
+--  | Source +--------\>| op1    |
+--  | {src}  |         \\---+----\/
+--  +--------+             |
+--             +-------*\<--\/
+--  +------+\<--| op2   |
+--  | Dest |   +-------+
+--  |{dst} |
+--  +------+
+-- 
+-- ::: .src { fill: #AAF; }
+-- ::: .dst { stroke: #FAA; stroke-width: 3px; }
+-- @
+-- <<docimages/styleExample.svg>>
+-- 
+-- Inline css styles are introduced with the ":::" prefix
+-- at the beginning of the line. They are introduced in the
+-- style section of the generated CSS file
+-- 
+-- The generated geometry also possess some predefined class
+-- which are overidable:
+-- 
+--  * `dashed_elem` is applyied on every dashed element.
+-- 
+--  * `filled_shape` is applyied on every closed shape.
+-- 
+--  * `bullet` on every bullet placed on a shape or line.
+-- 
+--  * `line_element` on every line element, this include the arrow head.
+-- 
+-- You can then customize the appearance of the diagram as you want.
+--
+ src/Text/AsciiDiagram/DiagramCleaner.hs view
@@ -0,0 +1,131 @@+{-# LANGUAGE ViewPatterns #-}
+{-# LANGUAGE CPP #-}
+module Text.AsciiDiagram.DiagramCleaner
+    ( isShapePossible
+    ) where
+
+#if !MIN_VERSION_base(4,8,0)
+import Data.Monoid( mempty )
+import Control.Applicative( Applicative, (<*>) )
+#endif
+
+import Control.Applicative( (<$>), liftA2 )
+import Data.List( tails )
+import Text.AsciiDiagram.Geometry
+import Linear( V2( V2 )
+             , (^-^)
+             )
+
+compareDirections :: Applicative f
+                  => (Int -> Int -> Bool) -> f Int -> f Int -> f Bool
+compareDirections f = liftA2 diffSign
+  where
+    diffSign 0 0 = True
+    diffSign aa bb = f aa bb
+
+checkRoundedCorners :: (Int -> Int -> Bool)
+                    -> Segment -> Point -> Point -> Segment
+                    -> Bool
+checkRoundedCorners f s1 ap1 ap2 s2 = okX && okY
+  where
+    V2 dirX dirY = ap2 ^-^ ap1
+    fromS1 = _segEnd s1 ^-^ ap1
+    fromS2 = _segStart s2 ^-^ ap2 
+
+    signDirs = signum <$> V2 dirY dirX
+
+    V2 okX okY = (&&)
+       <$> (compareDirections f signDirs (signum <$> fromS1))
+       <*> (compareDirections f signDirs (signum <$> fromS2))
+
+checkClosedShape :: Shape -> Bool
+checkClosedShape shape = all checkClosed elements where
+  elements =
+    (++ shapeElements shape) <$> tails (shapeElements shape) 
+
+
+
+checkClosed :: [ShapeElement] -> Bool
+--   dir              fromS1       fromS1
+--  --->             ----->       <----               ^ 2 \--- 3
+--   /\         | 1 /---- 0      0 ----/ 1 |          |    \
+-- 1/  \2   dir |  /                  /    | dir  dir |    /
+--  |  |        |  \                  \    |          | 1 /--- 0
+-- 0|  |3       v 2 \---- 3      3 ----\ 2 v
+--                   ----->       <----
+--                    fromS2      fromS2
+-- 
+--   OK                OK         BAD                    BAD
+checkClosed
+      ( ShapeSegment s1
+      : ShapeAnchor ap1 AnchorFirstDiag   -- '/'
+      : ShapeAnchor ap2 AnchorSecondDiag  -- '\'
+      : ShapeSegment s2
+      : _) = checkRoundedCorners (==) s1 ap1 ap2 s2
+
+--   dir              fromS1       fromS1
+--  --->             ----->       <----               ^ 1 \--- 0
+--   /\         | 2 /---- 3      3 ----/ 2 |          |    \
+-- 2/  \1   dir |  /                  /    | dir  dir |    /
+--  |  |        |  \                  \    |          | 2 /--- 3
+-- 3|  |0       v 1 \---- 0      0 ----\ 1 v
+--                   ----->       <----
+--                    fromS2      fromS2
+-- 
+--   OK                OK         BAD                    BAD
+checkClosed
+      ( ShapeSegment s1
+      : ShapeAnchor ap1 AnchorSecondDiag  -- '\'
+      : ShapeAnchor ap2 AnchorFirstDiag   -- '/'
+      : ShapeSegment s2
+      : _) = checkRoundedCorners (/=) s1 ap1 ap2 s2
+
+checkClosed
+      ( ShapeAnchor _ AnchorFirstDiag
+      : ShapeAnchor _ AnchorSecondDiag
+      : ShapeAnchor _ AnchorFirstDiag
+      : ShapeAnchor _ AnchorSecondDiag
+      : _) = False
+
+checkClosed
+      ( ShapeAnchor _ AnchorSecondDiag
+      : ShapeAnchor _ AnchorFirstDiag
+      : ShapeAnchor _ AnchorSecondDiag
+      : ShapeAnchor _ AnchorFirstDiag
+      : _) = False
+
+checkClosed _ = True
+
+isBullet :: ShapeElement -> Bool
+isBullet (ShapeAnchor _ AnchorBullet) = True
+isBullet _ = False
+
+checkOpened :: [ShapeElement] -> Bool
+checkOpened
+      [ ShapeAnchor _ AnchorFirstDiag
+      , ShapeAnchor _ AnchorSecondDiag] = False
+checkOpened [ ShapeAnchor _ AnchorSecondDiag
+            , ShapeAnchor _ AnchorFirstDiag] = False
+checkOpened (all isBullet -> True) = False
+checkOpened
+      ( ShapeAnchor ap1 AnchorFirstDiag   -- '/'
+      : ShapeAnchor ap2 AnchorSecondDiag  -- '\'
+      : ShapeSegment s2
+      : _) = checkRoundedCorners (==) s1 ap1 ap2 s2
+    where s1 = mempty { _segEnd = ap1 }
+checkOpened
+      ( ShapeAnchor ap1 AnchorSecondDiag  -- '\'
+      : ShapeAnchor ap2 AnchorFirstDiag   -- '/'
+      : ShapeSegment s2
+      : _) = checkRoundedCorners (/=) s1 ap1 ap2 s2
+    where s1 = mempty { _segEnd = ap1 }
+checkOpened _ = True
+
+checkOpenedShape :: Shape -> Bool
+checkOpenedShape = checkOpened . shapeElements
+
+isShapePossible :: Shape -> Bool
+isShapePossible shape
+    | shapeIsClosed shape = checkClosedShape shape
+    | otherwise = checkOpenedShape shape
+
+ src/Text/AsciiDiagram/Geometry.hs view
@@ -0,0 +1,125 @@+{-# LANGUAGE CPP #-}
+-- | Defines the geometry extracted from the asciidiagram.
+module Text.AsciiDiagram.Geometry( Point
+                                 , Vector
+                                 , Anchor( .. )
+                                 , Shape( .. )
+                                 , Segment( .. )
+                                 , SegmentDraw( .. )
+                                 , SegmentKind( .. )
+                                 , ShapeElement( .. )
+                                 , Diagram( .. )
+                                 , TextZone( .. )
+                                 ) where
+
+#if !MIN_VERSION_base(4,8,0)
+import Data.Monoid( Monoid( mappend, mempty ))
+#endif
+
+import qualified Data.Set as S
+import qualified Data.Text as T
+import Linear( V2( .. ) )
+
+-- | Position of a an element in the character grids
+type Point = V2 Int
+
+-- | Direction in the character grid.
+type Vector = V2 Int
+
+-- | Describe the geomtry of a full Ascii Diagram
+-- document
+data Diagram = Diagram
+  { -- | All the extracted tshapes
+    _diagramShapes     :: S.Set Shape
+    -- | All the extracted text zones
+  , _diagramTexts      :: [TextZone]
+    -- | Width in characters of the document
+  , _diagramCellWidth  :: !Int
+    -- | Height in characters of the document
+  , _diagramCellHeight :: !Int
+    -- | CSS styles associated to the document.
+  , _diagramStyles     :: [T.Text]
+  }
+  deriving (Eq, Show)
+
+-- | Describe where to place a text snippet.
+data TextZone = TextZone
+  { _textZoneOrigin  :: Point
+  , _textZoneContent :: T.Text
+  }
+  deriving (Eq, Show)
+
+-- | Define the different connection points
+-- between the segments.
+data Anchor
+  = AnchorMulti       -- ^ Associated to '+'
+  | AnchorFirstDiag   -- ^ Associated to '/'
+  | AnchorSecondDiag  -- ^ Associated to '\'
+
+  | AnchorPoint       -- ^ Kind of "end anchor", without continuation.
+  | AnchorBullet      -- ^ Used as a '*'
+
+  | AnchorArrowUp     -- ^ Associated to '^'
+  | AnchorArrowDown   -- ^ Associated to 'V'
+  | AnchorArrowLeft   -- ^ Associated to '<'
+  | AnchorArrowRight  -- ^ Associated to '>'
+  deriving (Eq, Ord, Show)
+
+-- | Helper data for segment composed of only
+-- one character
+data SegmentKind
+  = SegmentHorizontal
+  | SegmentVertical
+  deriving (Eq, Ord, Show)
+
+-- | Differentiate between elements drawn with a
+-- solid line or with dashed lines.
+data SegmentDraw
+  = SegmentSolid
+  | SegmentDashed
+  deriving (Eq, Ord, Show)
+
+-- | Define an horizontal or vertical segment.
+data Segment = Segment
+  { _segStart :: {-# UNPACK #-} !Point
+  , _segEnd   :: {-# UNPACK #-} !Point
+  , _segKind  :: !SegmentKind
+  , _segDraw  :: !SegmentDraw
+  }
+  deriving (Eq, Ord)
+
+instance Show Segment where
+    showsPrec d (Segment s e k dr) =
+      showParen (d >= 10) $
+          showString "Segment " . start . end . kind . (' ':) . draw
+      where
+        start = showParen True $ shows s
+        end = showParen True $ shows e
+        kind = shows k
+        draw = shows dr
+
+instance Monoid Segment where
+    mempty = Segment 0 0 SegmentVertical SegmentSolid
+    mappend (Segment a _ _ _) (Segment _ b k d) =
+        Segment a b k d
+
+-- | Describe a composant of shapes. Can
+-- be composed of anchors like "+*/\\" or
+-- segments.
+data ShapeElement
+  = ShapeAnchor !Point !Anchor
+  | ShapeSegment !Segment
+  deriving (Eq, Ord, Show)
+
+-- | Shape extracted from the text
+data Shape = Shape
+  { -- | Elements composing the shape.
+    shapeElements :: [ShapeElement]
+    -- | When False it's just lines possibly with
+    -- an arrow, when True it's a polygon.
+  , shapeIsClosed :: Bool
+    -- | Tags "{tagname}" placed inside the shape.
+  , shapeTags     :: S.Set T.Text
+  }
+  deriving (Eq, Ord, Show)
+
+ src/Text/AsciiDiagram/Graph.hs view
@@ -0,0 +1,336 @@+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE CPP #-}
+module Text.AsciiDiagram.Graph
+  ( Graph( .. )
+  , PlanarVertice( .. )
+  , Filament
+  , Cycle
+  , graphOfVertices
+  , extractAllPrimitives
+  , addVertice
+  , connect
+  , vertices
+  , edges
+  ) where
+
+#if !MIN_VERSION_base(4,8,0)
+import Data.Monoid( Monoid( .. ), mempty )
+#endif
+
+import Control.Applicative( (<$>) )
+import Control.Monad( forM_, when )
+import Control.Monad.State.Strict( execState )
+import Control.Monad.State.Class( MonadState )
+import Data.Function( on )
+import Data.Maybe( fromMaybe )
+import qualified Data.Map as M
+import qualified Data.Set as S
+import Control.Lens( Lens'
+                   , lens
+                   , (&)
+                   , (.~)
+                   , (?~)
+                   , (%=)
+                   , (.=)
+                   , itraverse_
+                   , contains
+                   , at
+                   , use
+                   )
+
+{-import Debug.Trace-}
+{-import Text.Printf-}
+{-import Text.Groom-}
+
+data Graph vertex vinfo edgeInfo = Graph
+  { _vertices :: M.Map vertex vinfo
+  , _edges    :: M.Map (vertex, vertex) edgeInfo
+  }
+  deriving (Eq, Ord, Show)
+
+vertices :: Lens' (Graph vertex vinfo edgeInfo) (M.Map vertex vinfo)
+vertices = lens _vertices setVertices where
+  setVertices g v = g { _vertices = v }
+
+edges :: Lens' (Graph vertex vinfo edgeInfo)
+               (M.Map (vertex, vertex) edgeInfo)
+edges = lens _edges setEdge where
+  setEdge g e = g { _edges = e }
+
+graphOfVertices :: (Ord vertex) => M.Map vertex vinfo -> Graph vertex vinfo a
+graphOfVertices vertMap = emptyGraph & vertices .~ vertMap 
+
+emptyGraph :: (Ord v) => Graph v vi e
+emptyGraph = Graph
+  { _vertices = mempty
+  , _edges = mempty
+  }
+
+instance (Ord v) => Monoid (Graph v vi e) where
+  mempty = emptyGraph
+  mappend a b = Graph
+    { _vertices = (mappend `on` _vertices) a b
+    , _edges = (mappend `on` _edges) a b
+    }
+
+addVertice :: Ord v
+           => v -> vinfo -> Graph v vinfo edgeInfo
+           -> Graph v vinfo edgeInfo
+addVertice v info g = g & vertices . at v ?~ info
+
+
+connect :: Ord v
+        => v -> v -> edgeInfo -> Graph v vinfo edgeInfo
+        -> Graph v vinfo edgeInfo
+connect a b info g = g & edges . at (linkOf a b)  ?~ info
+
+adjacencyMapOfGraph :: (Ord v) => Graph v vi ei -> M.Map v (Int, S.Set v)
+adjacencyMapOfGraph = flip execState mempty . itraverse_ go . _edges where
+  inserter p Nothing = Just (1, S.singleton p)
+  inserter p (Just (n, s)) = Just (n + 1, S.insert p s)
+
+  go (k1, k2) _ = do
+    at k1 %= inserter k2
+    at k2 %= inserter k1
+
+type Filament v = [v]
+type Cycle v = [v]
+
+data MinimalCycleFinderState v vi ei = MinimalCycleFinderState
+  { _adjacency      :: M.Map v (Int, S.Set v)
+  , _graph          :: Graph v vi ei
+  , _visited        :: S.Set v
+  , _cycleEdges     :: S.Set (v, v)
+  , _foundFilaments :: [Filament v]
+  , _foundCycles    :: [Cycle v]
+  }
+
+emptyCycleFinderState :: (Ord v, Show v, Show vi, Show ei)
+                      => Graph v vi ei -> MinimalCycleFinderState v vi ei 
+emptyCycleFinderState g = MinimalCycleFinderState
+  { _adjacency = adjacencyMapOfGraph g
+  , _graph = g
+  , _visited = mempty
+  , _cycleEdges = mempty
+  , _foundFilaments = mempty
+  , _foundCycles = mempty
+  }
+
+
+visited :: Lens' (MinimalCycleFinderState v vi ei)
+                 (S.Set v)
+visited = lens _visited setter where
+  setter a b = a { _visited = b }
+
+foundFilaments :: Lens' (MinimalCycleFinderState v vi ei)
+                        [Filament v]
+foundFilaments = lens _foundFilaments setter where
+  setter a b = a { _foundFilaments = b }
+
+foundCycles :: Lens' (MinimalCycleFinderState v vi ei)
+                     [Cycle v]
+foundCycles = lens _foundCycles setter where
+  setter a b = a { _foundCycles = b }
+
+cycleEdges :: Lens' (MinimalCycleFinderState v vi ei)
+                    (S.Set (v, v))
+cycleEdges = lens _cycleEdges setter where
+  setter a b = a { _cycleEdges = b }
+
+adjacency :: Lens' (MinimalCycleFinderState v vi ei)
+                   (M.Map v (Int, S.Set v))
+adjacency = lens _adjacency setter where
+  setter a b = a { _adjacency = b }
+
+graph :: Lens' (MinimalCycleFinderState v vi ei)
+               (Graph v vi ei)
+graph = lens _graph  setter where
+  setter a b = a { _graph = b }
+
+linkOf :: (Ord v) => v -> v -> (v, v)
+linkOf p1 p2 | p1 < p2 = (p1, p2)
+             | otherwise = (p2, p1)
+
+
+isInCycle :: (Ord v, MonadState (MinimalCycleFinderState v vi ei) m)
+          => v -> v -> m Bool
+isInCycle a b = use $ cycleEdges . contains (linkOf a b)
+
+removeEdge :: ( MonadState (MinimalCycleFinderState v vi ei) m
+              , Ord v, Show v )
+           => v -> v -> m ()
+removeEdge a b = do
+  let remEdge p (n, s) = (n - 1, S.delete p s)
+  adjacency . at a %= fmap (remEdge b)
+  adjacency . at b %= fmap (remEdge a)
+  graph . edges . at (linkOf a b) .= Nothing
+
+
+removeVertice :: ( MonadState (MinimalCycleFinderState v vi ei) m
+                 , Ord v
+                 , Show v )
+              => v -> m ()
+removeVertice v = graph . vertices . at v .= Nothing
+
+adjacencyInfoOfVertice :: ( MonadState (MinimalCycleFinderState v vi ei) m
+                          , Ord v
+                          , Functor m )
+                       => v -> m (Int, S.Set v)
+adjacencyInfoOfVertice v =
+  fromMaybe (0, mempty) <$> use (adjacency . at v)
+
+extractFilament :: ( MonadState (MinimalCycleFinderState v vi ei) m
+                   , Ord v
+                   , Functor m
+                   , Show v)
+                => v -> v -> m [v]
+extractFilament fromVertice toVertice = do
+  mustCycle <- isInCycle fromVertice toVertice
+  (fromCount, _) <- adjacencyInfoOfVertice fromVertice
+  (toCount, toAdjacents) <- adjacencyInfoOfVertice toVertice
+  if fromCount >= 3 then do
+    removeEdge fromVertice toVertice
+    let startVertice
+          | toCount == 1 = S.findMin toAdjacents
+          | otherwise = toVertice
+    retIfNoCycle mustCycle $
+      follow mustCycle [fromVertice] startVertice
+  else
+    retIfNoCycle mustCycle $
+      follow mustCycle [] fromVertice
+  where
+    retIfNoCycle False act = act
+    retIfNoCycle True act = do
+        _ <- act
+        return []
+        
+    follow mustCycle history currentVertice = do
+      (count, adjacent) <- adjacencyInfoOfVertice currentVertice
+      case count of
+        0 -> do
+          removeVertice currentVertice
+          return $ currentVertice : history
+
+        1 -> do
+          let nextVertice = S.findMin adjacent
+          inCycle <- isInCycle currentVertice nextVertice
+          if mustCycle && not inCycle then
+            return $ currentVertice : history
+          else do
+            removeEdge currentVertice nextVertice
+            removeVertice currentVertice
+            follow mustCycle (currentVertice : history) nextVertice
+
+        _ ->
+          return $ currentVertice : history
+
+class (Ord v, Show v) => PlanarVertice v where
+  getClockwiseMost :: S.Set v -> Maybe v -> v
+                   -> Maybe v
+  getCounterClockwiseMost :: S.Set v -> Maybe v -> v
+                          -> Maybe v
+
+findClockwiseMost :: ( MonadState (MinimalCycleFinderState v vi ei) m
+                     , Functor m
+                     , PlanarVertice v )
+                  => Maybe v -> v -> m (Maybe v)
+findClockwiseMost mv v = do
+  adj <- maybe mempty snd <$> use (adjacency . at v)
+  return $ getClockwiseMost adj mv v
+
+findCounterClockwiseMost
+    :: ( MonadState (MinimalCycleFinderState v vi ei) m
+       , Functor m
+       , PlanarVertice v )
+    => Maybe v -> v -> m (Maybe v)
+findCounterClockwiseMost mv v = do
+  adj <- maybe mempty snd <$> use (adjacency . at v)
+  return $ getCounterClockwiseMost adj mv v
+
+setElemAtOne :: S.Set a -> a
+-- S.elemAt requires containers >= 0.5
+setElemAtOne = extract . S.toList where
+  extract (_:v:_) = v
+  extract _ = error "Bad set size."
+
+extractFilamentFromMiddle
+  :: ( MonadState (MinimalCycleFinderState v vi ei) m
+     , Functor m
+     , Ord v
+     , Show v )
+  => v -> v -> m [v]
+extractFilamentFromMiddle = go where
+  go prev curr = do
+    (adjCount, adjs) <- adjacencyInfoOfVertice curr
+    let nextVertice = S.findMin adjs
+    if adjCount /= 2 then
+      extractFilament curr prev
+    else if prev /= nextVertice then
+      go curr nextVertice
+    else
+      go curr $ setElemAtOne adjs
+
+addFilament :: ( MonadState (MinimalCycleFinderState v vi ei) m
+               , Show v )
+            => Filament v -> m ()
+addFilament [] = return ()
+addFilament filament = foundFilaments %= (filament:)
+
+extractCycle :: ( MonadState (MinimalCycleFinderState v vi ei) m
+                , Functor m 
+                , PlanarVertice v )
+             => v -> m ()
+extractCycle rootNode = do
+  startNode <- findClockwiseMost Nothing rootNode
+  let starting = fromMaybe rootNode startNode
+
+      follow _history prevVertice Nothing = do
+        filament <- extractFilament prevVertice prevVertice
+        addFilament filament
+      follow history prevVertice (Just v) | v == rootNode = do
+        foundCycles %= (history:)
+        let edgesOfCycle = (prevVertice, v) : zip history (tail history)
+        forM_ edgesOfCycle $ \(a, b) ->
+          cycleEdges . contains (linkOf a b)  .= True
+        removeEdge rootNode starting
+        extractIfAlone rootNode
+        extractIfAlone starting
+      follow history prevVertice (Just v) = do
+        wasVisited <- use $ visited . contains v
+        if wasVisited then do
+          filament <- extractFilamentFromMiddle starting rootNode
+          addFilament filament
+        else do
+          nextVertice <-
+              findCounterClockwiseMost (Just prevVertice) v
+          follow (v:history) v nextVertice
+
+  follow [rootNode] rootNode startNode
+  where
+    extractIfAlone node = do
+      (startCount, adjs) <- adjacencyInfoOfVertice node
+      when (startCount == 1) $ do
+        filament <- extractFilament node $ S.findMin adjs
+        addFilament filament
+
+extractAllPrimitives :: (PlanarVertice v, Show ei, Show vi)
+                     => Graph v vi ei -> ([Cycle v], [Filament v])
+extractAllPrimitives initGraph = extract $ execState go initialState where
+  initialState = emptyCycleFinderState initGraph
+  extract s = (_foundCycles s, _foundFilaments s)
+
+  go = do
+    vs <- use $ graph . vertices
+    if M.null vs then return ()
+    else do
+      let (toFollow, _) = M.findMin vs
+      (adjCount, _) <- adjacencyInfoOfVertice toFollow
+      case adjCount of
+        0 -> removeVertice toFollow
+        1 -> do
+          filament <- extractFilament toFollow toFollow
+          addFilament filament
+        _ -> extractCycle toFollow
+      go
+ src/Text/AsciiDiagram/Parser.hs view
@@ -0,0 +1,224 @@+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ViewPatterns #-}
+{-# LANGUAGE CPP #-}
+-- | Module in charge of finding the various segment
+-- in an ASCII text and the various anchors.
+module Text.AsciiDiagram.Parser( ParsingState( .. )
+                               , parseText
+                               , parseTextLines
+                               , extractTextZones
+                               , detectTagFromTextZone
+                               ) where
+
+#if !MIN_VERSION_base(4,8,0)
+import Data.Monoid( mempty )
+#endif
+
+import Control.Applicative( (<$>) )
+import Control.Monad( foldM, when )
+import Control.Monad.State.Strict( State
+                                 , execState
+                                 , modify )
+import qualified Data.Foldable as F
+import qualified Data.Map as M
+import qualified Data.Set as S
+import qualified Data.Text as T
+import qualified Data.Traversable as TT
+import qualified Data.Vector.Unboxed as VU
+import Linear( V2( .. ) )
+
+import Text.AsciiDiagram.Geometry
+
+isAnchor :: Char -> Bool
+isAnchor c = c `VU.elem` anchors
+  where
+    anchors = VU.fromList "<>^vV+/\\*"
+  
+anchorOfChar :: Char -> Anchor
+anchorOfChar '+' = AnchorMulti
+anchorOfChar '/' = AnchorFirstDiag
+anchorOfChar '\\' = AnchorSecondDiag
+anchorOfChar '>' = AnchorArrowRight
+anchorOfChar '<' = AnchorArrowLeft
+anchorOfChar '^' = AnchorArrowUp
+anchorOfChar 'V' = AnchorArrowDown
+anchorOfChar 'v' = AnchorArrowDown
+anchorOfChar '*' = AnchorBullet
+anchorOfChar _ = AnchorMulti
+
+isHorizontalLine :: Char -> Bool
+isHorizontalLine c = c `VU.elem` horizontalLineElements
+  where
+    horizontalLineElements = VU.fromList "-="
+
+isVerticalLine :: Char -> Bool
+isVerticalLine c = c `VU.elem` verticalLineElements
+  where
+    verticalLineElements = VU.fromList ":|"
+
+isDashed :: Char -> Bool
+isDashed c = case c of
+  ':' -> True
+  '=' -> True
+  _ -> False
+
+
+data ParsingState = ParsingState
+  { anchorMap      :: !(M.Map Point Anchor)
+  , segmentSet     :: !(S.Set Segment)
+  , currentSegment :: !(Maybe Segment)
+  , styleLine      :: [(Int, T.Text)]
+  }
+  deriving Show
+
+emptyParsingState :: ParsingState
+emptyParsingState = ParsingState
+    { anchorMap      = mempty
+    , segmentSet     = mempty
+    , currentSegment = Nothing
+    , styleLine      = mempty
+    }
+
+type Parsing = State ParsingState
+
+type LineNumber = Int
+
+addAnchor :: Point -> Char -> Parsing ()
+addAnchor p c = modify $ \s ->
+   s { anchorMap = M.insert p (anchorOfChar c) $ anchorMap s }
+
+addSegment :: Segment -> Parsing ()
+addSegment seg = modify $ \s ->
+   s { segmentSet = S.insert seg $ segmentSet s }
+
+addStyleLine :: (Int, T.Text) -> Parsing ()
+addStyleLine l = modify $ \s ->
+   s { styleLine = l : styleLine s }
+
+continueHorizontalSegment :: Point -> Parsing ()
+continueHorizontalSegment p = modify $ \s ->
+   s { currentSegment = Just . update $ currentSegment s }
+  where update Nothing = mempty { _segStart = p
+                                , _segEnd = p
+                                , _segKind = SegmentHorizontal
+                                }
+        update (Just seg) = seg { _segEnd = p
+                                , _segKind = SegmentHorizontal
+                                }
+
+setHorizontaDashing :: Parsing ()
+setHorizontaDashing = modify $ \s ->
+    s { currentSegment = setDashed <$> currentSegment s }
+  where
+    setDashed seg = seg { _segDraw = SegmentDashed }
+
+stopHorizontalSegment :: Parsing ()
+stopHorizontalSegment = modify $ \s ->
+    s { segmentSet = inserter (currentSegment s) $ segmentSet s
+      , currentSegment = Nothing
+      }
+  where
+    inserter Nothing s = s
+    inserter (Just seg) s = S.insert seg s
+
+continueVerticalSegment :: Maybe Segment -> Point -> Parsing (Maybe Segment)
+continueVerticalSegment Nothing p = return $ Just seg where
+  seg = mempty { _segStart = p
+               , _segEnd = p
+               , _segKind = SegmentVertical }
+continueVerticalSegment (Just seg) p =
+    return $ Just seg { _segEnd = p, _segKind = SegmentVertical }
+
+stopVerticalSegment :: Maybe Segment -> Parsing (Maybe a)
+stopVerticalSegment Nothing = return Nothing
+stopVerticalSegment (Just seg) = do
+    addSegment seg
+    return Nothing
+
+parseLine :: [Maybe Segment] -> (LineNumber, T.Text)
+          -> Parsing [Maybe Segment]
+parseLine prevSegments (n, T.stripPrefix ":::" -> Just txt) = do
+    addStyleLine (n, txt)
+    return prevSegments
+parseLine prevSegments (lineNumber, txt) = do
+    ret <- TT.mapM go $ zip3 [0 ..] prevSegments stringLine
+    stopHorizontalSegment
+    return ret
+  where
+    stringLine = T.unpack txt ++ repeat ' '
+
+    go (columnNumber, vertical, c) | isHorizontalLine c = do
+        let point = V2 columnNumber lineNumber
+        continueHorizontalSegment point
+        when (isDashed c) $ setHorizontaDashing
+        stopVerticalSegment vertical
+
+    go (columnNumber, vertical, c) | isVerticalLine c = do
+        let point = V2 columnNumber lineNumber
+            dashingSet seg
+                | isDashed c = seg { _segDraw = SegmentDashed }
+                | otherwise = seg
+        stopHorizontalSegment
+        fmap dashingSet <$> continueVerticalSegment vertical point
+
+    go (columnNumber, vertical, c) | isAnchor c = do
+        let point = V2 columnNumber lineNumber
+        addAnchor point c
+        stopHorizontalSegment
+        stopVerticalSegment vertical
+
+    go (_, vertical, _) = do
+        stopHorizontalSegment
+        stopVerticalSegment vertical
+
+maximumLineLength :: [T.Text] -> Int
+maximumLineLength [] = 0
+maximumLineLength lst = maximum $ T.length <$> lst
+
+parseTextLines :: [T.Text] -> ParsingState
+parseTextLines lst = flip execState emptyParsingState $ do
+  let initialLine = replicate (maximumLineLength lst) Nothing
+  lastVerticalLine <- foldM parseLine initialLine $ zip [0 ..] lst
+  mapM_ stopVerticalSegment lastVerticalLine 
+    
+
+-- | Extract the segment information of a given text.
+parseText :: T.Text -> ParsingState
+parseText = parseTextLines . T.lines
+
+zoneFromLine :: (Int, T.Text) -> [TextZone]
+zoneFromLine (lineIndex, line) = eatSpaces 0 $ T.split (== ' ') line where
+  eatSpaces ix lst = case lst of
+     [] -> []
+     ("":rest) -> eatSpaces (ix + 1) rest
+     _ -> createZoneFrom ix lst
+
+  createZoneFrom ix = go ix where
+    go endIdx [] | ix == endIdx = []
+    go      _ [] = [TextZone (V2 ix lineIndex) $ T.drop ix line]
+    go endIdx ("":rest) = zone : eatSpaces (endIdx + 1) rest
+      where origin = V2 ix lineIndex
+            zone = TextZone origin . T.drop ix $ T.take endIdx line
+    go endIdx (x:xs) = go (endIdx + T.length x + 1) xs
+
+extractTextZones :: [T.Text] -> [TextZone]
+extractTextZones = F.concatMap zoneFromLine . zip [0 ..]
+
+detectTagFromTextZone :: [TextZone] -> ([TextZone], [TextZone])
+detectTagFromTextZone zones = (concat foundTags, concat normalZones) where
+  (foundTags, normalZones) = unzip $ fmap findTag zones
+
+  findTag zone@(TextZone (V2 x y) txt) =
+    case splitTags y x $ T.split (== ' ') txt of
+      ([], _) -> ([], [zone])
+      tagsAndText -> tagsAndText
+
+  splitTags _  _ [] = ([], [])
+  splitTags y ix (thisTxt : rest)
+     | tlength >= 3 && T.head thisTxt == '{' && T.last thisTxt == '}' = 
+        (TextZone (V2 ix y) tagText: afterTags, normalTexts)
+     | otherwise = (afterTags, TextZone (V2 ix y) thisTxt : normalTexts)
+    where tlength = T.length thisTxt
+          tagText = T.init $ T.drop 1 thisTxt
+          (afterTags, normalTexts) = splitTags y (ix + tlength + 1) rest
+
+ src/Text/AsciiDiagram/Reconstructor.hs view
@@ -0,0 +1,266 @@+{-# LANGUAGE ViewPatterns #-}
+{-# LANGUAGE TupleSections #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE CPP #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+-- | This module will try to reconstruct closed shapes and
+-- lines from -- the set of anchors and segments.
+--
+-- The output of this module may be duplicated, needing
+-- deduplication as post processing.
+--
+-- This is mostly a depth first search in the set of anchors
+-- and segments.
+module Text.AsciiDiagram.Reconstructor( reconstruct ) where
+
+#if !MIN_VERSION_base(4,8,0)
+import Data.Monoid( mempty )
+#endif
+
+import Control.Applicative( (<$>) )
+import Control.Monad( when )
+import Control.Monad.State.Strict( execState )
+import Control.Monad.State.Class( get )
+import Data.Function( on )
+import Data.List( sortBy )
+import Data.Maybe( catMaybes )
+import qualified Data.Foldable as F
+import qualified Data.Set as S
+import qualified Data.Map as M
+import qualified Data.Vector as V
+import Linear( V2( .. ), (^+^), (^-^) )
+
+import Text.AsciiDiagram.Geometry
+import Text.AsciiDiagram.Graph
+import Control.Lens
+
+{-import Debug.Trace-}
+{-import Text.Printf-}
+{-import Text.Groom-}
+
+data Direction
+  = LeftToRight
+  | RightToLeft
+  | TopToBottom
+  | BottomToTop
+  | NoDirection
+  deriving (Eq, Show)
+
+
+
+directionOfVector :: Vector -> Direction
+directionOfVector (V2 0 n)
+  | n > 0 = TopToBottom
+  | otherwise = BottomToTop
+directionOfVector (V2 n 0)
+  | n > 0 = LeftToRight
+  | otherwise = RightToLeft
+directionOfVector _ = NoDirection
+
+
+
+--
+--         ****|****
+--      ***    |    ***
+--    **       1       **
+--   *         |         *
+--   -----0----+---2------
+--   *         ^         *
+--    **       :       **
+--      ***    :    ***
+--         ****:****
+--
+--
+--         ****|****
+--      ***    |    ***
+--    **       0       **
+--   *         |         *
+--   =========>+---1------
+--   *         |         *
+--    **       2       **
+--      ***    |    ***
+--         ****|****
+--
+--
+--         ****|****
+--      ***    |    ***
+--    **       2       **
+--   *         |         *
+--   -----1----+<=========
+--   *         |         *
+--    **       0       **
+--      ***    |    ***
+--         ****|****
+--
+--
+--         ****:****
+--      ***    :    ***
+--    **       :       **
+--   *         V         *
+--   -----2----+---0------
+--   *         |         *
+--    **       1       **
+--      ***    |    ***
+--         ****|****
+--
+vectorsForAnchor :: Anchor -> Direction -> [Vector]
+vectorsForAnchor anchor dir = case (anchor, dir) of
+  (AnchorArrowUp, _) -> [down]
+  (AnchorArrowDown, _) -> [up]
+  (AnchorArrowLeft, _) -> [right]
+  (AnchorArrowRight, _) -> [left]
+
+  (_, LeftToRight) -> [up, right, down, left]
+  (_, TopToBottom) -> [right, down, left, up]
+  (_, NoDirection) -> [right, down, left, up]
+  (_, RightToLeft) -> [down, left, up, right]
+  (_, BottomToTop) -> [left, up, right, down]
+
+  where
+    left = V2 (-1) 0
+    up = V2 0 (-1)
+    right = V2 1 0
+    down = V2 0 1
+
+directionVectorOf :: Point -> Point -> Vector
+directionVectorOf a b = signum <$> a ^-^ b
+
+nextDirectionAfterAnchor :: Anchor -> Point -> Point -> [Point]
+nextDirectionAfterAnchor anchor previousPoint anchorPosition =
+    [delta | delta <- deltas
+           , let nextPoint = anchorPosition ^+^ delta
+           , nextPoint /= previousPoint]
+  where
+    directionVector = directionVectorOf anchorPosition previousPoint
+    direction = directionOfVector directionVector
+    deltas = vectorsForAnchor anchor direction
+
+nextPointAfterAnchor :: Anchor -> Point -> Point -> [Point]
+nextPointAfterAnchor anchor prev p =
+    (^+^ p) <$> nextDirectionAfterAnchor anchor prev p
+
+segmentManathanLength :: Segment -> Int
+segmentManathanLength seg = x + y where
+  V2 x y = abs <$> _segEnd seg ^-^ _segStart seg
+
+
+segmentDirectionMap :: S.Set Segment -> M.Map Point SegmentKind
+segmentDirectionMap = S.fold go mempty where
+  go seg = M.insert (_segEnd seg) k . M.insert (_segStart seg) k
+    where
+      k = _segKind seg
+
+toGraph :: M.Map Point Anchor -> S.Set Segment
+        -> Graph Point ShapeElement Segment
+toGraph anchors segs = execState graphCreator baseGraph where
+  baseGraph = graphOfVertices $ M.mapWithKey ShapeAnchor anchors
+
+  segDirs = segmentDirectionMap segs
+
+  graphCreator = do
+    F.traverse_ linkSegments segs
+    F.traverse_ linkAnchors $ M.assocs anchors
+
+  linkOf p1 p2 | p1 < p2 = (p1, p2)
+               | otherwise = (p2, p1)
+
+  linkAnchors (p, a) = F.traverse_ createLinks nextPoints where
+    nextPoints = nextPointAfterAnchor a (V2 (-1) (-1)) p
+    createLinks nextPoint = do
+      nextExists <- has (vertices . ix nextPoint) <$> get
+      let dirNext = nextPoint ^-^ p
+          nextP = M.lookup nextPoint anchors
+          nextS = M.lookup nextPoint segDirs
+          nextIsOk = case (nextP, nextS) of
+            (Just AnchorArrowUp, _) -> V2 0 (-1) == dirNext
+            (Just AnchorArrowDown, _) -> V2 0 1 == dirNext
+            (Just AnchorArrowLeft, _) -> V2 (-1) 0 == dirNext
+            (Just AnchorArrowRight, _) -> V2 1 0 == dirNext
+            (Just _, _) -> True
+            (Nothing, Nothing) -> True
+            (Nothing, Just SegmentHorizontal) ->
+                (abs <$> dirNext) == V2 1 0
+            (Nothing, Just SegmentVertical) ->
+                (abs <$> dirNext) == V2 0 1
+
+      alreadyLinked <- has (edges . ix (linkOf p nextPoint)) <$> get
+      when (nextExists && nextIsOk && not alreadyLinked) $
+         edges . at (linkOf p nextPoint) ?= mempty
+
+  linkSegments seg | segmentManathanLength seg == 0 = do
+      vertices . at (_segStart seg ) ?= ShapeSegment seg
+  linkSegments seg@(Segment { _segStart = p1, _segEnd = p2 }) = do
+      vertices . at p1 ?= ShapeSegment seg
+      vertices . at p2 ?= ShapeSegment seg
+      edges . at (linkOf p1 p2) ?= seg
+
+findClockwisePossible :: S.Set Point -> Maybe Point -> Point
+                      -> [Point]
+findClockwisePossible adjacents Nothing p =
+    findClockwisePossible adjacents (Just p) p
+findClockwisePossible adjacents (Just prev) p =
+    fmap snd $ sortBy (compare `on` fst) indexedAdjacents
+  where
+    -- don't care about specific direction, restrictions should have
+    -- been made during the construction of the graph.
+    dirArray = V.fromList $ nextDirectionAfterAnchor AnchorMulti prev p
+    zipIndex k = (V.elemIndex dir dirArray, k)
+      where dir = directionVectorOf k p
+    indexedAdjacents =
+        [(idx, nextPoint)
+                  | (Just idx, nextPoint) <- zipIndex <$> S.elems adjacents
+                  , nextPoint /= prev]
+
+safeHead :: [a] -> Maybe a
+safeHead [] = Nothing
+safeHead (x:_) = Just x
+
+instance PlanarVertice (V2 Int) where
+  getClockwiseMost adj prev =
+      safeHead . findClockwisePossible adj prev
+  getCounterClockwiseMost adj prev =
+      safeHead . reverse . findClockwisePossible adj prev
+
+dedupEqual :: Eq a => [a] -> [a]
+dedupEqual [] = []
+dedupEqual (x:rest@(y:_)) | x == y = dedupEqual rest
+dedupEqual (x:xs) = x : dedupEqual xs
+
+
+-- | Break filaments at multi anchor to ensure proper dashing
+-- of the segments.
+breakFilaments :: Filament ShapeElement -> [Filament ShapeElement]
+breakFilaments = go where
+  go lst = f : fs
+    where (f, fs) = breaker lst
+
+  breaker [] = ([], [])
+  breaker [a@(ShapeAnchor _ AnchorMulti)] = ([a], [])
+  breaker (a@(ShapeAnchor _ AnchorMulti):xs) = ([a], (a:filamentRest):others)
+    where (filamentRest, others) = breaker xs
+  breaker (x:xs) = (x:filamentRest, others)
+    where (filamentRest, others) = breaker xs
+
+
+-- | Main call of the reconstruction function
+reconstruct :: M.Map Point Anchor -> S.Set Segment
+            -> S.Set Shape
+reconstruct anchors segments =
+   S.fromList $ fmap toShapes cycles 
+             ++ concatMap toFilaments filaments
+  where
+    graph = toGraph anchors segments
+    (cycles, filaments) = extractAllPrimitives graph
+
+    toElems = dedupEqual
+            . filter (/= ShapeSegment mempty)
+            . catMaybes
+            . fmap (`M.lookup` _vertices graph)
+
+    toFilaments shapes =
+      [Shape piece False mempty | piece <- breakFilaments $ toElems shapes] 
+
+    toShapes shapes = Shape (toElems shapes) True mempty
+
+ src/Text/AsciiDiagram/SvgRender.hs view
@@ -0,0 +1,500 @@+{-# LANGUAGE CPP #-}
+{-# LANGUAGE OverloadedStrings #-}
+module Text.AsciiDiagram.SvgRender( svgOfDiagram ) where
+
+#if !MIN_VERSION_base(4,8,0)
+import Data.Monoid( mempty )
+#endif
+
+import Control.Applicative( (<$>) )
+import Control.Monad.State.Strict( execState )
+import Data.Monoid( Last( .. ), (<>) )
+
+import Graphics.Svg.Types
+                   ( HasDrawAttributes( .. )
+                   , Texture( ColorRef )
+                   , Document( .. )
+                   , drawAttr )
+import Graphics.Svg( cssRulesOfText )
+
+import Codec.Picture( PixelRGBA8( PixelRGBA8 ) )
+import qualified Graphics.Svg.Types as Svg
+import qualified Data.Map as M
+import qualified Data.Set as S
+import qualified Data.Text as T
+import Text.Printf
+import Linear( V2( .. )
+             , (^+^)
+             , (^-^)
+             , (^*)
+             , perp
+             , normalize
+             )
+import Control.Lens( zoom, (.=), (%=), (%~), (&) )
+
+import Text.AsciiDiagram.Geometry
+import Text.AsciiDiagram.DiagramCleaner
+
+{-import Debug.Trace-}
+{-import Text.Groom-}
+
+data GridSize = GridSize
+  { _gridCellWidth        :: !Float
+  , _gridCellHeight       :: !Float
+  , _gridShapeContraction :: !Float
+  }
+  deriving (Eq, Show)
+
+
+toSvg :: GridSize -> Point -> Svg.RPoint
+toSvg s (V2 x y) =
+  V2 (_gridCellWidth s * fromIntegral (x + 1))
+     (_gridCellHeight s * fromIntegral (y + 1))
+
+
+setDashingInformation :: (Svg.WithDrawAttributes a) => a -> a
+setDashingInformation = execState $ do
+  drawAttr . attrClass %= ("dashed_elem":)
+
+isShapeDashed :: Shape -> Bool
+isShapeDashed = any isDashed . shapeElements where
+  isDashed (ShapeAnchor _ _) = False
+  isDashed (ShapeSegment Segment { _segDraw = SegmentSolid }) = False
+  isDashed (ShapeSegment Segment { _segDraw = SegmentDashed }) = True
+
+applyDefaultShapeDrawAttr :: (Svg.WithDrawAttributes a) => a -> a
+applyDefaultShapeDrawAttr = execState . zoom drawAttr $ do
+    strokeColor .= toLC 0 0 0 255
+    attrClass %= ("filled_shape":) 
+    strokeWidth .= toL (Svg.Num 1)
+  where
+    toL = Last . Just
+    toLC r g b a =
+        toL . ColorRef $ PixelRGBA8 r g b a
+
+applyLineArrowDrawAttr :: (Svg.WithDrawAttributes a) => a -> a
+applyLineArrowDrawAttr = execState . zoom drawAttr $ do
+    fillColor .= toLC 0 0 0 255
+    strokeColor .= toL Svg.FillNone
+    strokeWidth .= toL (Svg.Num 0)
+  where
+    toL = Last . Just
+    toLC r g b a =
+        toL . ColorRef $ PixelRGBA8 r g b a
+
+applyBulletDrawAttr :: (Svg.WithDrawAttributes a) => a -> a
+applyBulletDrawAttr = execState . zoom drawAttr $ do
+    attrClass %= ("bullet":)
+
+applyDefaultLineDrawAttr :: (Svg.WithDrawAttributes a) => a -> a
+applyDefaultLineDrawAttr = execState . zoom drawAttr $ do
+    attrClass %= ("line_element":)
+    fillColor .= toL Svg.FillNone
+    strokeColor .= toLC 0 0 0 255
+    strokeWidth .= toL (Svg.Num 1)
+  where
+    toL = Last . Just
+    toLC r g b a =
+        toL . ColorRef $ PixelRGBA8 r g b a
+
+
+startPointOf :: ShapeElement -> Point
+startPointOf (ShapeAnchor p _) = p
+startPointOf (ShapeSegment seg) = _segStart seg
+
+
+manathanDistance :: Point -> Point -> Int
+manathanDistance a b = x + y where
+  V2 x y = abs <$> a ^-^ b
+
+
+isNearBy :: Point -> Point -> Bool
+isNearBy a b = manathanDistance a b <= 1
+
+
+initialPrevious :: Bool -> [ShapeElement] -> Maybe Point
+initialPrevious False _ = Nothing
+initialPrevious True [] = Nothing
+initialPrevious True lst@(x:_) = Just point
+  where
+    sp = startPointOf x
+
+    point = case last lst of
+      ShapeAnchor pp _ -> pp
+      ShapeSegment seg
+        | manathanDistance sp (_segStart seg) <
+          manathanDistance sp (_segEnd seg) -> _segStart seg
+      ShapeSegment seg -> _segEnd seg
+
+
+swapSegment :: Segment -> Segment
+swapSegment seg =
+  seg { _segStart = _segEnd seg, _segEnd = _segStart seg }
+
+
+rollToSegment :: Shape -> Shape
+rollToSegment shape | not $ shapeIsClosed shape = shape
+rollToSegment shape = shape { shapeElements = segments ++ anchorPrefix } where
+  (anchorPrefix, segments) = span isAnchor $ shapeElements shape
+
+  isAnchor (ShapeSegment _) = False
+  isAnchor (ShapeAnchor _ _) = True
+
+
+reorderShapePoints :: Shape -> [(Maybe Point, ShapeElement)]
+reorderShapePoints shape = outList where
+  outList = go initialPrev elements
+  elements = shapeElements shape
+  initialPrev = initialPrevious (shapeIsClosed shape) elements
+
+  go _ [] = []
+  go prev (a@(ShapeAnchor p _):rest) =
+      (prev, a) : go (Just p) rest
+  go prev (s@(ShapeSegment seg):rest)
+    | start == _segEnd seg = (prev, s) : go (Just start) rest
+      where start = _segStart seg
+  go prev@(Just prevPoint) (s@(ShapeSegment seg):rest)
+    | prevPoint `isNearBy` start =
+        (prev, s) : go (Just end) rest
+    | otherwise =
+        (prev, ShapeSegment $ swapSegment seg) : go (Just start) rest
+      where start = _segStart seg
+            end = _segEnd seg
+  go Nothing (s@(ShapeSegment seg):rest@(nextShape:_)) =
+    case nextShape of
+      ShapeAnchor p _ | p `isNearBy` start ->
+          (Nothing, ShapeSegment $ swapSegment seg) : go (Just start) rest
+      ShapeAnchor _ _ ->
+          (Nothing, s) : go (Just $ _segEnd seg) rest
+      ShapeSegment _ -> (Nothing, s) : go (Just $ _segEnd seg) rest
+      where start = _segStart seg
+  go Nothing [e@(ShapeSegment _)] = [(Nothing, e)]
+
+
+associateNextPoint :: Bool -> [(a, ShapeElement)]
+                   -> [(a, ShapeElement, Maybe Point)]
+associateNextPoint isClosed elements = go elements where
+  startingPoint =
+    Just . startPointOf . head $ map snd elements
+
+  go [] = []
+  go [(p, s)]
+    | isClosed = [(p, s, startingPoint)]
+    | otherwise = [(p, s, Nothing)]
+  go ((p, s):xs@((_, y):_)) =
+    (p, s, Just $ startPointOf y) : go xs
+
+
+-- >
+-- >       ^ perp:(0, -n)
+-- >       |
+-- > (x, y)|                  (x + n, y)
+-- >       +-------------------+ b
+-- >      a|
+-- >       v correction
+--
+correctionVectorOf :: Integral a => GridSize -> V2 a -> V2 a -> V2 Float
+correctionVectorOf size a b = normalize dir ^* _gridShapeContraction size
+  where
+    dir = fromIntegral . negate <$> perp (b ^-^ a)
+
+
+startPoint :: GridSize -> [(Maybe Point, ShapeElement, Maybe Point)]
+           -> Svg.RPoint
+startPoint gscale shapeElems = case shapeElems of
+    [] -> V2 0 0
+    (Just before, ShapeAnchor p _, Just after):_ -> toS p ^+^ combined
+        where v1 = correctionVector before p
+              v2 = correctionVector p after
+              combined | v1 == v2 = v1
+                       | otherwise = v1 ^+^ v2
+    (before, ShapeSegment seg, _):_ -> pp ^+^ vc where
+       vc = segmentCorrectionVector gscale before seg
+       pp = toS $ _segStart seg
+    (_, ShapeAnchor p _, _):_ -> toS p
+  where
+    correctionVector = correctionVectorOf gscale
+    toS = toSvg gscale
+
+
+anchorCorrection :: GridSize -> Point -> Point -> Point
+                 -> Svg.RPoint
+anchorCorrection scale before p after
+  | v1 == v2 = v1
+  | otherwise = v1 ^+^ v2
+  where v1 = correctionVectorOf scale before p
+        v2 = correctionVectorOf scale p after
+
+
+moveTo, lineTo :: Svg.RPoint -> Svg.PathCommand
+moveTo p = Svg.MoveTo Svg.OriginAbsolute [p]
+lineTo p = Svg.LineTo Svg.OriginAbsolute [p]
+
+
+smoothCurveTo :: Svg.RPoint -> Svg.RPoint -> Svg.PathCommand
+smoothCurveTo p1 p =
+  Svg.SmoothCurveTo Svg.OriginAbsolute [(p1, p)]
+
+
+shapeClosing :: Shape -> [Svg.PathCommand]
+shapeClosing Shape { shapeIsClosed = True } = [Svg.EndPath]
+shapeClosing _ = []
+
+
+segmentCorrectionVector :: GridSize -> Maybe Point -> Segment -> Svg.RPoint
+segmentCorrectionVector gscale before seg | _segStart seg == _segEnd seg =
+  case (before, _segKind seg) of
+    (Just v1, _) -> correctionVectorOf gscale v1 (_segEnd seg)
+    (Nothing, SegmentHorizontal) -> V2 0 $ _gridShapeContraction gscale
+    (Nothing, SegmentVertical) -> V2 (negate $ _gridShapeContraction gscale) 0
+segmentCorrectionVector gscale _ seg =
+    correctionVectorOf gscale (_segStart seg) (_segEnd seg)
+
+
+straightCorner :: GridSize -> Bool -> Maybe Point -> Point -> Maybe Point
+               -> ([Svg.PathCommand], [Svg.Tree])
+straightCorner gscale isBullet pBefore p pAfter
+    | isBullet = ([lineTo finalPoint], [renderBullet gscale finalPoint])
+    | otherwise =  ([lineTo finalPoint], [])
+  where
+    pSvg = toSvg gscale p
+    finalPoint = case (pBefore, pAfter) of
+       (Just before, Just after) ->
+          anchorCorrection gscale before p after ^+^ pSvg
+       (Just before, _) -> 
+          correctionVectorOf gscale before p ^+^ pSvg
+       _ -> pSvg
+
+curveCorner :: GridSize -> Maybe Point -> Point -> Maybe Point -> Svg.PathCommand
+curveCorner gscale _ p (Just after) =
+    smoothCurveTo (toS p) $ toS after ^+^ correction
+  where correction = correctionVectorOf gscale p after
+        toS = toSvg gscale
+curveCorner gscale (Just before) p Nothing =
+    smoothCurveTo (toS p) $ toS p ^+^ vec
+  where vec = correctionVectorOf gscale before p
+        toS = toSvg gscale
+curveCorner gscale _ p _ = lineTo $ toSvg gscale p
+
+
+roundedCorner :: GridSize -> Point -> Point -> Maybe Point -> Svg.PathCommand
+roundedCorner gscale p1 p2 (Just lastPoint) =
+    Svg.CurveTo Svg.OriginAbsolute [(toS p1, toS p2, toS lastPoint ^+^ vec)]
+  where toS = toSvg gscale
+        vec = correctionVectorOf gscale p2 lastPoint
+roundedCorner gscale p1 p2 after =
+    curveCorner gscale (Just p1) p2 after
+
+toPathRooted :: [Svg.RPoint] -> GridSize -> Point -> Svg.Tree
+toPathRooted pts gscale p =
+    applyLineArrowDrawAttr . Svg.PathTree $ Svg.Path mempty pathCommands
+  where
+    pt = fromIntegral <$> p
+    sizes = V2 (_gridCellWidth gscale) (_gridCellHeight gscale)
+
+    toGrid pp = lineTo $ (pt ^+^ pp) * sizes
+    pathCommands = case pts of
+      [] -> []
+      x:xs -> moveTo ((pt ^+^ x) * sizes)
+                : fmap toGrid xs ++ [Svg.EndPath]
+
+toRightArrow :: GridSize -> Point -> Svg.Tree
+toRightArrow =
+  toPathRooted [ V2 1 0.5
+               , V2 2 1
+               , V2 1 1.5
+               ]
+
+toLeftArrow :: GridSize -> Point -> Svg.Tree
+toLeftArrow =
+  toPathRooted [ V2 1 0.5
+               , V2 0 1
+               , V2 1 1.5
+               ]
+
+toTopArrow :: GridSize -> Point -> Svg.Tree
+toTopArrow =
+  toPathRooted [ V2 0.5 1
+               , V2 1.5 1
+               , V2 1   0
+               ]
+
+toBottomArrow :: GridSize -> Point -> Svg.Tree
+toBottomArrow =
+  toPathRooted [ V2 0.5 1
+               , V2 1.5 1
+               , V2 1   2
+               ]
+
+renderBullet :: GridSize -> Svg.RPoint -> Svg.Tree
+renderBullet gscale (V2 x y) = applyBulletDrawAttr $ Svg.CircleTree Svg.defaultSvg
+  { Svg._circleCenter = (Svg.Num x, Svg.Num y)
+  , Svg._circleRadius = Svg.Num $ halfWidth - 2
+  }
+  where halfWidth = _gridCellWidth gscale / 2
+
+dashingSet :: (Svg.WithDrawAttributes a) => Shape -> a -> a
+dashingSet shape
+  | isShapeDashed shape = setDashingInformation
+  | otherwise = id
+
+classSet :: (Svg.WithDrawAttributes a) => Shape -> a -> a
+classSet shape e =
+  e & drawAttr . attrClass %~ (++ S.toList (shapeTags shape))
+
+shapeToTree :: GridSize -> Shape -> Svg.Tree
+shapeToTree gscale shape@Shape
+    { shapeIsClosed = True
+    , shapeElements =
+        [ ShapeSegment _
+        , ShapeAnchor p0 AnchorMulti
+        , ShapeSegment _
+        , ShapeAnchor p1 AnchorMulti
+        , ShapeSegment _
+        , ShapeAnchor p2 AnchorMulti
+        , ShapeSegment _
+        , ShapeAnchor p3 AnchorMulti ]
+    } = classSet shape
+      . dashingSet shape
+      . Svg.RectangleTree
+      $ Svg.defaultSvg
+          { Svg._rectWidth = Svg.Num sWidth
+          , Svg._rectHeight = Svg.Num sHeight
+          , Svg._rectUpperLeftCorner = (Svg.Num px, Svg.Num py) }
+  where
+    pts = [p0, p1, p2, p3]
+    mini = minimum pts
+    maxi = maximum pts
+    contraction = _gridShapeContraction gscale
+    contractionVector = V2 contraction contraction
+
+    maxiPoint = toSvg gscale maxi ^-^ contractionVector
+    pt@(V2 px py) = toSvg gscale mini ^+^ contractionVector 
+    V2 sWidth sHeight = maxiPoint ^-^ pt
+
+
+
+shapeToTree gscale shape =
+  case concat arrows of
+    [] -> svgPath
+    lst -> Svg.GroupTree $ Svg.defaultSvg { Svg._groupChildren = svgPath : lst }
+  where
+    toS = toSvg gscale
+    shapeElems = associateNextPoint (shapeIsClosed shape)
+               . reorderShapePoints
+               $ rollToSegment shape
+
+    svgPath = classSet shape . dashingSet shape . Svg.PathTree
+            $ Svg.Path mempty pathCommands
+
+    pathCommands =
+      moveTo (startPoint gscale shapeElems)
+          : concat pathes ++ shapeClosing shape
+    (pathes, arrows) = unzip $ toPath shapeElems
+
+    toPath [] = []
+    toPath ((before, ShapeSegment seg, Just _):rest) =
+        ([lineTo (vc ^+^ toS (_segEnd seg))], []) : toPath rest
+      where vc = segmentCorrectionVector gscale before seg
+    toPath ((before, ShapeSegment seg, Nothing):rest) =
+        ([lineTo (vc ^+^ toS (_segEnd seg))], []) : toPath rest
+      where vc = segmentCorrectionVector gscale before seg'
+            extension = signum <$> (_segEnd seg ^-^ _segStart seg)
+            seg' = seg { _segEnd = _segEnd seg ^+^ extension }
+    toPath ((_, ShapeAnchor p1 AnchorFirstDiag, _)
+           :(_, ShapeAnchor p2 AnchorSecondDiag, after)
+           :rest) = ([roundedCorner gscale p1 p2 after], []) : toPath rest
+    toPath ((_, ShapeAnchor p1 AnchorSecondDiag, _)
+           :(_, ShapeAnchor p2 AnchorFirstDiag, after)
+           :rest) = ([roundedCorner gscale p1 p2 after], []) : toPath rest
+    toPath ((before, ShapeAnchor p a, after):rest) = anchorJoin : toPath rest
+      where
+        anchorJoin = case a of
+          AnchorPoint -> straightCorner gscale False before p after
+          AnchorMulti -> straightCorner gscale False before p after
+          AnchorBullet -> straightCorner gscale True before p after
+            
+          AnchorFirstDiag -> ([curveCorner gscale before p after], [])
+          AnchorSecondDiag -> ([curveCorner gscale before p after], [])
+
+          AnchorArrowUp -> ([lineTo $ toS p], [toTopArrow gscale p])
+          AnchorArrowDown -> ([lineTo $ toS p], [toBottomArrow gscale p])
+          AnchorArrowLeft -> ([lineTo $ toS p], [toLeftArrow gscale p])
+          AnchorArrowRight -> ([lineTo $ toS p], [toRightArrow gscale p])
+
+
+textToTree :: GridSize -> TextZone -> Svg.Tree
+textToTree gscale zone = Svg.TextTree Nothing txt
+  where
+    correction =
+        V2 (negate $ _gridCellWidth gscale)
+           (_gridCellHeight gscale) ^* 0.5
+    V2 x y = toSvg gscale (_textZoneOrigin zone) ^+^ correction
+    txt = Svg.textAt (Svg.Num (x+0.5), Svg.Num (y+0.5)) $ _textZoneContent zone
+
+defaultCss :: Float -> T.Text
+defaultCss textSize = T.pack $ printf
+  ("\n" <>
+   "text { font-family: Consolas, \"DejaVu Sans Mono\", monospace; font-size: %dpx }\n" <>
+   ".dashed_elem { stroke-dasharray: 4, 3 }\n" <>
+   ".filled_shape { fill: url(#shape_light) }\n" <>
+   ".bullet { stroke-width: 1px; fill: white; stroke: black }\n"
+  )
+  (2 + floor textSize :: Int)
+
+lightShapeGradient :: Svg.Element
+lightShapeGradient = Svg.ElementLinearGradient $
+    Svg.defaultSvg
+        { Svg._linearGradientStart = (Svg.Percent 0, Svg.Percent 0)
+        , Svg._linearGradientStop =  (Svg.Percent 0, Svg.Percent 1)
+        , Svg._linearGradientStops =
+            [ Svg.GradientStop 0 $ PixelRGBA8 245 245 245 255
+            , Svg.GradientStop 1 $ PixelRGBA8 216 216 216 255
+            ]
+        }
+
+-- | Transform an Ascii diagram to a SVG document which
+-- can be saved or converted to an image.
+svgOfDiagram :: Diagram -> Svg.Document
+svgOfDiagram diagram = Document
+  { _viewBox = Nothing
+  , _width =
+      toSvgSize _gridCellWidth $ _diagramCellWidth diagram + 1
+  , _height =
+      toSvgSize _gridCellHeight $ _diagramCellHeight diagram + 1
+  , _elements = closedSvg ++ lineSvg ++ textSvg
+  , _definitions = M.fromList
+        [("shape_light", lightShapeGradient)]
+  , _description = ""
+  , _styleRules = defaultCssRules ++ customCssRules
+  , _documentLocation = ""
+  }
+  where
+    (closed, opened) = S.partition shapeIsClosed shapes
+
+    defaultCssRules =
+      cssRulesOfText . defaultCss $ _gridCellHeight scale
+
+    customCssRules = 
+      cssRulesOfText . T.unlines $ _diagramStyles diagram
+
+    shapes = _diagramShapes diagram
+
+    closedSvg =
+        applyDefaultShapeDrawAttr . shapeToTree scale <$> filter isShapePossible
+                                                            (S.toList closed)
+    lineSvg =
+        applyDefaultLineDrawAttr . shapeToTree strokeScale <$> S.toList opened
+
+    toSvgSize accessor var =
+        Just . Svg.Num $ fromIntegral var * accessor scale + 5
+
+    textSvg = textToTree scale <$> _diagramTexts diagram
+
+    strokeScale = scale { _gridShapeContraction = 0 }
+    scale = GridSize
+      { _gridCellWidth = 10
+      , _gridCellHeight = 14
+      , _gridShapeContraction = 1.5
+      }
+