{-# LANGUAGE CPP #-}
{-# 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 .filled_shape { 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

    -- ** Hierarchical styles
    -- $hierarchicalDoc

    -- ** Shapes
    -- $shapeDoc

    -- * Functions
    svgOfDiagram
  , parseAsciiDiagram
  , saveAsciiDiagramAsSvg
  , imageOfDiagram
  , pdfOfDiagram

   -- * Customized rendering
  , svgOfDiagramAtSize 
  , GridSize( .. )
  , defaultGridSize
  , saveAsciiDiagramAsSvgAtSize
  , imageOfDiagramAtSize
  , pdfOfDiagramAtSize

    -- * Library
  , defaultLibrary

    -- * Document description
  , Diagram( .. ) 
  , TextZone( .. )
  , Shape( .. )
  , ShapeElement( .. )
  , Anchor( .. )
  , Segment( .. )
  , SegmentKind( .. )
  , SegmentDraw( .. )
  , Point
  ) where

#if !MIN_VERSION_base(4,8,0)
import Control.Applicative( (<$>) )
#endif

import Data.Monoid( (<>))
import Control.Monad( forM_ )
import Control.Monad.ST( runST )
import Data.Function( on )
import Data.List( partition, sortBy )
import qualified Data.ByteString.Lazy as LB
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( saveXmlFile )
import Graphics.Rasterific.Svg( renderSvgDocument, pdfOfSvgDocument )

{-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


pointsOfShape :: F.Foldable f => f Shape -> [Point]
pointsOfShape = F.concatMap (F.concatMap go . shapeElements) where
  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]]
    | sy == ey && sx >= ex = [V2 xx sy | xx <- [ex .. sx]]
    | 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 shapes]


pointComp :: Point -> Point -> Ordering
pointComp (V2 x1 y1) (V2 x2 y2) = case compare y1 y2 of
  EQ -> compare x1 x2
  a -> a

featuresOfClosedShape :: Shape -> [Point]
featuresOfClosedShape = F.fold . go . shapeElements where
   go [] = []
   -- If we got something like +----+ we skip the first anchor and
   -- the segment.
   go ( ShapeAnchor (V2 _ ay1) _
      : ShapeSegment Segment { _segStart = V2 _ sy, _segEnd = V2 _ ey }
      : rest@(ShapeAnchor (V2 _ ay2) _ : _)
      )
       | ay1 == ay2 && sy == ey && ay1 == sy = go rest
   go (ShapeAnchor p _: rest) = [p] : go rest
   go (ShapeSegment Segment { _segStart = V2 sx sy, _segEnd = V2 ex ey } : rest)
     | sx == ex && sy >= ey = [V2 sx yy | yy <- [ey .. sy]] : after
     | sx == ex             = [V2 sx yy | yy <- [sy .. ey]] : after
     | otherwise           = after
       where after = go rest

rangesOfOpenedShape :: Shape -> [(Point, Point)]
rangesOfOpenedShape s = fmap dup . sortBy pointComp $ pointsOfShape [s]
  where dup a = (a, a)

rangesOfClosedShape :: Shape -> [(Point, Point)]
rangesOfClosedShape 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 $ featuresOfClosedShape shape


class RangeDecomposable a where
  rangesOf :: a -> [(Point, Point)]

instance RangeDecomposable Shape where
  rangesOf s
     | shapeIsClosed s = rangesOfClosedShape s
     | otherwise = rangesOfOpenedShape s

instance RangeDecomposable TextZone where
  rangesOf txt = [(orig, V2 (x + txtLength) y)] where
    orig@(V2 x y) = _textZoneOrigin txt
    txtLength = T.length $ _textZoneContent txt


contains :: (RangeDecomposable a, RangeDecomposable b) => a -> b -> Bool
contains sa sb = go (rangesOf sa) (rangesOf sb) where
  go _      []    = True
  go []     (_:_) = False
  go ((V2 _ ya, _):rest1) rest2@((V2 _ yb, _):_)
    -- A part of second shape is before potentially englobing shpae
    -- so sa can't contain sb
    | ya > yb = False   
    -- sa may be bigger, just skip
    | ya < yb = go rest1 rest2
  -- here ya == yb
  go sal@((V2 xa1 _, V2 xa2 _):rest1)
     sar@((V2 xb1 _, V2 xb2 _):rest2)
    -- sb is before any range of sa, so we must have
    -- missed something, sa not containing sb
    | xb1 < xa1 = False
    -- sb is in the range bounds
    | xa1 <= xb1 && xb2 <= xa2 = go sal rest2
    -- Maybe sa has another range on the same line
    | xb1 > xa2 = go rest1 sar
    | otherwise = False
  
areaOfShape :: Shape -> Int
areaOfShape = F.sum . fmap dist . rangesOfClosedShape
  where
    -- we can use manathan distance here
    dist (V2 x1 y1, V2 x2 y2) = abs (x1 - x2) + abs (y1 - y2)

sortByArea :: [Shape] -> [Shape]
sortByArea shapes = sorted <> opened
  where
    (closed, opened) = partition shapeIsClosed shapes
    sorted =
        fmap snd . reverse $ sortBy (compare `on` fst) [(areaOfShape s, s) | s <- closed]

hierarchise :: [Shape] -> [TextZone] -> [TextZone] -> [Element]
hierarchise shapes allTexts = finalize . go areaSortedShapes allTexts where
  areaSortedShapes = sortByArea shapes

  finalize (topShapes, topText, _topTags) =
    (ElemShape <$> topShapes) <> (ElemText <$> topText)

  go [] texts tags = ([], texts, tags)
  go (x:xs) texts tags | not (shapeIsClosed x) = (x:outShapes, outTexts, outTags)
    where
      (outShapes, outTexts, outTags) = go xs texts tags
  go (x:xs) texts tags = (newShape : restShapes, restText, restTags)
    where
      (shapeInShape, shapeOutShape) = partition (x `contains`) xs
      (textInShape, textOutShape) = partition (x `contains`) texts
      (tagsInShape, tagsOutShape) = partition (x `contains`) tags

      (innerShapes, innerText, innerTags) = go shapeInShape textInShape tagsInShape
      (restShapes, restText, restTags) = go shapeOutShape textOutShape tagsOutShape

      newShape = x
        { shapeChildren =
            (ElemShape <$> innerShapes) <> (ElemText <$> innerText)
        , shapeTags = S.fromList $ _textZoneContent <$> innerTags
        }

-- | Analyze an ascii diagram and extract all it's features.
parseAsciiDiagram :: T.Text -> Diagram
parseAsciiDiagram content = Diagram
    { _diagramElements = S.fromList allElements
    , _diagramCellWidth = maximum $ fmap T.length textLines
    , _diagramCellHeight = length textLines - length styleLines
    , _diagramStyles = reverse styleLines
    }
  where
    textLines = T.lines content
    allElements = hierarchise (S.toList validShapes) nonEmptyZones tags

    nonEmptyZones = [t | t <- zones, not . T.null $ _textZoneContent t]
    (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

-- | Helper function helping you save a diagram as
-- a SVG file on disk with a customized grid size.
saveAsciiDiagramAsSvgAtSize :: FilePath -> GridSize -> Diagram -> IO ()
saveAsciiDiagramAsSvgAtSize fileName gridSize =
  saveXmlFile fileName . svgOfDiagramAtSize gridSize (defaultLibrary gridSize)

-- | Render a Diagram as an image. The Dpi
-- is 96. The IO dependency is there to allow loading of the
-- font files used in the document.
imageOfDiagram :: FontCache -> Diagram -> IO (Image PixelRGBA8)
imageOfDiagram cache = 
  fmap fst . renderSvgDocument cache Nothing 96 . svgOfDiagram

-- | Render a Diagram as an image with a custom grid size. The Dpi
-- is 96. The IO dependency is there to allow loading of the
-- font files used in the document.
imageOfDiagramAtSize :: FontCache -> GridSize -> Diagram -> IO (Image PixelRGBA8)
imageOfDiagramAtSize cache gridSize =
  fmap fst . renderSvgDocument cache Nothing 96
           . svgOfDiagramAtSize gridSize (defaultLibrary gridSize)

-- | Render a Diagram into a PDF file. IO dependency to allow
-- loading of the font files used in the document.
pdfOfDiagram :: FontCache -> Diagram -> IO LB.ByteString
pdfOfDiagram cache =
  fmap fst . pdfOfSvgDocument cache Nothing 96 . svgOfDiagram

-- | Render a Diagram into a PDF file with a custom grid size.
-- IO dependency to allow loading of the font files used in the document.
pdfOfDiagramAtSize :: FontCache -> GridSize -> Diagram -> IO LB.ByteString
pdfOfDiagramAtSize cache size =
  fmap fst . pdfOfSvgDocument cache Nothing 96
           . svgOfDiagramAtSize size (defaultLibrary size)

-- $introDoc
-- Ascii diagram, transform your ASCII art drawing to a nicer
-- representation
-- 
-- 
-- @
--                 \/---------+
-- +---------+     |         |
-- |  ASCII  +----\>| Diagram |
-- +---------+     |         |
-- |{flat}   |     +--+------\/
-- \\---*-----\/\<=======\/
-- ::: .flat .filled_shape { fill: #DED; }
-- @
-- <<docimages/baseExample.svg>>
-- 

-- $linesdoc
-- The basic syntax of asciidiagrams is made of lines made out
-- of \'-\' and \'|\' characters. They can be connected with anchors
-- like \'+\' (direct connection) or \'\\\' and \'\/\' (smooth connections)
-- 
-- 
-- @
--  -----       
--    -------   
--              
--  |  |        
--  |  |        
--  |  \\----    
--  |           
--  +-----      
-- @
-- <<docimages/simple_lines.svg>>
-- 
-- You can use dashed lines by using ':' for vertical lines or '=' for
-- horizontal line
-- 
-- 
-- @
--  -----       
--    -=-----   
--              
--  |  :        
--  |  |        
--  |  \\----    
--  |           
--  +--=--      
-- @
-- <<docimages/dashed_lines.svg>>
-- 
-- Arrows are made out of the \'\<\', \'\>\', \'^\' and \'v\'
-- characters.
-- If the arrows are not connected to any lines, the text is left as is.
-- 
-- 
-- @
--      ^
--      |
--      |
-- \<----+----\>
--      |  \< \> 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 .filled_shape { fill: #AAF; }
-- ::: .dst .filled_shape { 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 applied on every dashed element.
-- 
--  * "filled_shape" is applied on every closed shape.
-- 
--  * "arrow_head" is applied on arrow head.
-- 
--  * "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.
-- 

-- $hierarchicalDoc
-- Starting with version 1.3, all shapes, text and lines are
-- hierachised, a shape within a shape will be integrated within
-- the same group. This allows more complex styling: 
-- 
-- 
-- @
--  \/------------------------------------------------------\\ .
--  |s100                                                  |
--  |    \/----------------------------\\                    |
--  |    |s1         \/--------\\       |  e1    \/--------\\  |
--  |    |      *---\>|  s2    |       +-------\>|  s10   |  |
--  |    +----+      \\---+----\/       |        \\--------\/  |
--  |    | i4 |          |            |           ^        |
--  |    |{ii}+---------\\| e1  {lo}   |           |        |
--  |    +----+         vv            | ealarm    |        |   e0      \/-------------\\ .
--  |    |            \/--------\\      +-----------\/        +----------\>|    s50      |
--  |    +----\\       | s3 {lu}|      |                    |           \\-------------\/
--  |    | o5 |   e2  \\--+-----\/      |                    |
--  |    |{oo}|\<---------\/            |\<-\\                 |
--  |    \\-+--+--------------------+--\/  |                 |
--  |      |                       |     | eReset          |
--  |      |                       \\-----\/                 |
--  |      v                                               |
--  |  \/--------\\                                          |
--  |  |  s20   |                  {li}                    |
--  |  \\--------\/                                          |
--  \\------------------------------------------------------\/
-- 
-- ::: .li .line_element { stroke: purple; }
-- ::: .li .arrow_head, .li text { fill: gray; }
-- ::: .lo .line_element { stroke: blue; }
-- ::: .lo .arrow_head, .lo text { fill: green; }
-- ::: .lu .line_element { stroke: red; }
-- ::: .lu .arrow_head, .lu text { fill: orange; }
-- ::: .ii .filled_shape { fill: #DDF; }
-- ::: .ii text { fill: blue; }
-- ::: .oo .filled_shape { fill: #DFD; }
-- ::: .oo text { fill: pink; }
-- @
-- <<docimages/deepStyleExample.svg>>
-- 
-- In the previous example, we can see that the lines color are
-- 'shape scoped' and the tag applied to the shape above them
-- applies to them
-- 

-- $shapeDoc
-- From version 1.3, you can substitute the shape of your element
-- with one from a shape library. Right now the shape library is
-- relatively small:
-- 
-- 
-- @
--  +---------+  +----------+
--  |         |  |          |
--  | circle  |  |          |
--  |         |  |    io    |
--  |{circle} |  | {io}     |
--  +---------+  +----------+
-- 
--  +----------+  +----------+
--  |document  |  |          |
--  |          |  |          |
--  |          |  | storage  |
--  |{document}|  | {storage}|
--  +----------+  +----------+
-- 
-- ::: .circle .filled_shape { shape: circle; }
-- ::: .document .filled_shape { shape: document; }
-- ::: .storage .filled_shape { shape: storage; }
-- ::: .io .filled_shape { shape: io; }
-- @
-- <<docimages/shapeExample.svg>>
-- 
-- The mechanism use CSS styling to change the shape, if a CSS rule
-- possess a `shape` pseudo attribute, then the generated shape is replaced
-- with a SVG `use` tag with the value of the shape attribute as `href`
-- 
-- But, you can create your own style library and change the default
-- stylesheet. You can retrieve the default one with the shell command
-- `asciidiagram --dump-library default-lib.svg`
-- 
-- You can then add your own symbols tag in it and use it by calling
-- `asciidiagram --with-library your-lib.svg`.
--