diff --git a/asciidiagram.cabal b/asciidiagram.cabal --- a/asciidiagram.cabal +++ b/asciidiagram.cabal @@ -1,7 +1,7 @@ -- Initial hitaa.cabal generated by cabal init. For further documentation, -- see http://haskell.org/cabal/users-guide/ name: asciidiagram -version: 1.3.1 +version: 1.3.1.1 synopsis: Pretty rendering of Ascii diagram into svg or png. description: Transform Ascii art diagram like this: @@ -40,7 +40,7 @@ Source-Repository this Type: git Location: git://github.com/Twinside/asciidiagram.git - Tag: v1.3.1 + Tag: v1.3.1.1 library ghc-options: -O2 -Wall @@ -56,7 +56,7 @@ , Text.AsciiDiagram.SvgRender -- containers >= 0.5.2.1 for Set.elemAt - build-depends: base >=4.6 && <4.9 + build-depends: base >=4.6 && < 5 , vector >= 0.10 , bytestring , text >= 1.2 && < 1.3 @@ -64,9 +64,9 @@ , containers >= 0.5 , mtl >= 2.1 && < 2.3 , lens >= 4.6 && < 5.0 - , svg-tree >= 0.5 && < 0.6 - , rasterific-svg >= 0.3 && < 0.4 - , FontyFruity >= 0.5 && < 0.6 + , svg-tree >= 0.5.1.1 && < 0.6 + , rasterific-svg >= 0.3.1.2 && < 0.4 + , FontyFruity >= 0.5 && < 0.6 , JuicyPixels >= 3.2 hs-source-dirs: src @@ -88,4 +88,40 @@ , svg-tree , text , FontyFruity + +Test-suite docgen + type: exitcode-stdio-1.0 + default-language: Haskell2010 + Main-Is: docgen.hs + ghc-options: -Wall + Hs-Source-Dirs: exec-src + Build-Depends: base >= 4.6 + , asciidiagram + , text + , containers + , svg-tree + , directory + , filepath + , rasterific-svg + , JuicyPixels + + +Test-Suite test + type: exitcode-stdio-1.0 + default-language: Haskell2010 + Main-Is: hitaa_test.hs + ghc-options: -Wall -O2 + ghc-prof-options: -rtsopts -Wall -prof -auto-all + Hs-Source-Dirs: exec-src + Build-Depends: base >= 4.6 + , asciidiagram + , text + , containers + --, groom + , svg-tree + , blaze-html + , directory + , filepath + , rasterific-svg + , JuicyPixels diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,6 +1,10 @@ Change log ========== +v1.3.1.1 May 2016 +----------------- + * Fix: GHC 8.0.1 compilation + v1.3.1 March 2016 ----------------- * Fix: CSS problems in case of bullet on closed shapes. diff --git a/exec-src/docgen.hs b/exec-src/docgen.hs new file mode 100644 --- /dev/null +++ b/exec-src/docgen.hs @@ -0,0 +1,381 @@ + +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TupleSections #-} +import Control.Applicative( (<$>) ) +import Data.Monoid( (<>) ) +import qualified Data.Text as T +import qualified Data.Text.IO as STIO +import System.Directory( createDirectoryIfMissing ) +import System.FilePath( () ) + +import Text.AsciiDiagram +import Codec.Picture( writePng ) +import Graphics.Svg +import Graphics.Rasterific.Svg( renderSvgDocument + , loadCreateFontCache ) + +docOutputFolder :: FilePath +docOutputFolder = "docimages" + +toSvg :: [(String, T.Text)] -> IO () +toSvg lst = do + createDirectoryIfMissing True docOutputFolder + mapM_ go lst + where + go (name, content) = do + let fileName = name ++ ".svg" + svgDoc = svgOfDiagram $ parseAsciiDiagram content + saveXmlFile (docOutputFolder fileName) svgDoc + +toPng :: [(String, T.Text)] -> IO () +toPng lst = do + createDirectoryIfMissing True docOutputFolder + cache <- loadCreateFontCache "asciidiagram-fonty-fontcache" + mapM_ (go cache) lst + where + go cache (name, content) = do + let fileName = name ++ ".png" + svgDoc = svgOfDiagram $ parseAsciiDiagram content + (img, _) <- renderSvgDocument cache Nothing 96 svgDoc + writePng (docOutputFolder fileName) img + +simpleLines :: T.Text +simpleLines = T.unlines + [ " ----- " + , " ------- " + , " " + , " | | " + , " | | " + , " | \\---- " + , " | " + , " +----- " + ] + +dashedLines :: T.Text +dashedLines = T.unlines + [ " ----- " + , " -=----- " + , " " + , " | : " + , " | | " + , " | \\---- " + , " | " + , " +--=-- " + ] + +arrows :: T.Text +arrows = T.unlines + [ " ^" + , " |" + , " |" + , "<----+---->" + , " | < > v ^" + , " |" + , " v" + , "" + ] + +complexClosed :: T.Text +complexClosed = T.unlines + [ " +------+" + , " | |" + , " | +--+" + , " | | |" + , " +---+--+ |" + , " | |" + , " +-----+" + ] + +dashingClosed :: T.Text +dashingClosed = T.unlines + [ " +--+ +--+ +=-+ +=-+" + , " | | : | | | | :" + , " +--+ +--+ +--+ +-=+" + ] + +curvedCorner :: T.Text +curvedCorner = T.unlines + [ " /--+ +--\\ +--+ /--+" + , " | | | | | | | |" + , " +--+ +--+ \\--+ +--+" + , "" + , " /--+ /--\\ /--+ /--\\ ." + , " | | | | | | | |" + , " +--/ +--+ \\--/ +--/" + , "" + , " /--\\ ." + , " | |" + , " \\--/" + , "." + ] + +bulletTest :: T.Text +bulletTest = T.unlines + [ " *-*-*" + , " | | *----*" + , " +---/ |" + , " * * *" + ] + +styleExample :: T.Text +styleExample = T.unlines + [ " +--------+ +--------+" + , " | Source +-------->| op1 |" + , " | {src} | \\---+----/" + , " +--------+ |" + , " +-------*<--/" + , " +------+<--| op2 |" + , " | Dest | +-------+" + , " |{dst} |" + , " +------+" + , "" + , "::: .src .filled_shape { fill: #AAF; }" + , "::: .dst .filled_shape { stroke: #FAA; stroke-width: 3px; }" + ] + +cabalExample :: T.Text +cabalExample = T.unlines + [ " /---------+" + , "+---------+ | |" + , "| ASCII +---->| Diagram |" + , "+---------+ | |" + , "| | +--+------/" + , "\\---*-----/<=======/" + ] + +baseExample :: T.Text +baseExample = T.unlines + [ " /---------+" + , "+---------+ | |" + , "| ASCII +---->| Diagram |" + , "+---------+ | |" + , "| {flat} | +--+------/" + , "\\---*-----/<=======/" + , "::: .flat .filled_shape { fill: #DED; }" + ] + +shapeExample :: T.Text +shapeExample = T.unlines + [ " +---------+ +----------+" + , " | | | |" + , " | 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; }" + ] + +deepStyleExample :: T.Text +deepStyleExample = T.unlines + [ " /------------------------------------------------------\\ ." + , " |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; }" + ] + +data Doc + = P T.Text + | Schema FilePath T.Text + +toHaddock :: [Doc] -> [T.Text] +toHaddock = concatMap go where + go (P t) = T.lines t ++ [""] + go (Schema n v) = + ["", "@"] + ++ (cleanupHaddock <$> T.lines v) + ++ ["@" + , "<<" <> T.pack docOutputFolder <> "/" <> T.pack n <> ".svg>>" + ,"" + ] + +pp :: [T.Text] -> Doc +pp = P . T.unlines + +linesDoc :: [Doc] +linesDoc = + [pp [ "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)" + ] + ,Schema "simple_lines" simpleLines + ,pp ["You can use dashed lines by using ':' for vertical lines or '=' for" + ,"horizontal line"] + ,Schema "dashed_lines" dashedLines + ,pp [ "Arrows are made out of the \\'\\<\\', \\'\\>\\', \\'^\\' and \\'v\\'" + , "characters." + , "If the arrows are not connected to any lines, the text is left as is." + ] + ,Schema "arrows" arrows + ] + +shapesDoc :: [Doc] +shapesDoc = + [pp [ "If the lines are closed, then it is detected as such and rendered" + , "differently" + ] + ,Schema "complexClosed" complexClosed + ,pp [ "If any of the segment posess one of the dashing markers (\\':\\' or \\'=\\')" + , "Then the full shape will be dashed." + ] + ,Schema "dashingClosed" dashingClosed + ,pp [ "Any of the angle of a shape can curved one of the smooth corner anchor" + , "(\\'\\\\\\' or \\'\\/\\')" + ] + ,Schema "curvedCorner" curvedCorner + ] + +bulletDoc :: [Doc] +bulletDoc = + [pp [ "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." + ] + ,Schema "bulletTest" bulletTest + ,pp ["When used at connection points, it behaves like the \\'+\\' anchor."] + ] + +styleDoc :: [Doc] +styleDoc = + [P $ T.unlines + ["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." + ] + ,Schema "styleExample" styleExample + ,P $ T.unlines + ["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" + ] + ,P $ T.unlines + ["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 :: [Doc] +hierarchicalDoc = + [pp [ "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: " + ] + ,Schema "deepStyleExample" deepStyleExample + ,pp [ "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 :: [Doc] +shapeDoc = + [pp [ "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:" + ] + ,Schema "shapeExample" shapeExample + ,pp [ "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`" + ] + ,pp [ "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`." + ] + ] + +introDoc :: [Doc] +introDoc = + [ pp ["Ascii diagram, transform your ASCII art drawing to a nicer" + , "representation" + ] + , Schema "baseExample" baseExample + ] + +doc :: [(T.Text, [Doc])] +doc = + [("cabal", [Schema "cabalSchema" cabalExample]) + ,("introDoc", introDoc) + ,("linesdoc", linesDoc) + ,("shapesdoc", shapesDoc) + ,("bulletdoc", bulletDoc) + ,("styledoc", styleDoc) + ,("hierarchicalDoc", hierarchicalDoc) + ,("shapeDoc", shapeDoc) + ] + +cleanupHaddock :: T.Text -> T.Text +cleanupHaddock = T.concatMap escape where + escape '<' = "\\<" + escape '>' = "\\>" + escape '\'' = "\\'" + escape '\\' = "\\\\" + escape '/' = "\\/" + escape c = T.singleton c + +toHaskellFile :: [(T.Text, [T.Text])] -> IO () +toHaskellFile docs = + STIO.writeFile "src/Text/AsciiDiagram/doc.hs" . T.unlines $ concatMap hsFile docs + where + hsFile (tag, lns) = "": ("-- $" <> tag) : fmap prepare lns + prepare t = "-- " <> t + +main :: IO () +main = do + toSvg [(f, c) | Schema f c <- concatMap snd doc] + toPng [(f, c) | Schema f c <- concatMap snd doc] + toHaskellFile $ [(t, toHaddock d) | (t, d) <- doc] + diff --git a/exec-src/hitaa_test.hs b/exec-src/hitaa_test.hs new file mode 100644 --- /dev/null +++ b/exec-src/hitaa_test.hs @@ -0,0 +1,95 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TupleSections #-} +{-# LANGUAGE CPP #-} + +#if !MIN_VERSION_base(4,8,0) +import Control.Applicative( (<$>) ) +import Data.Monoid( mempty ) +#endif + +import Control.Monad( foldM, forM ) +import Data.Monoid( (<>) ) +import Data.List( isSuffixOf, sort ) +import qualified Data.Text as T +import qualified Data.Text.IO as STIO +import qualified Data.Text.Lazy.IO as TIO +import System.Directory( getDirectoryContents + , createDirectoryIfMissing ) +import System.FilePath( () ) +import qualified Text.Blaze.Html5 as H +import qualified Text.Blaze.Html5.Attributes as H +import Text.Blaze.Html.Renderer.Text + +import Graphics.Rasterific.Svg( renderSvgDocument + , loadCreateFontCache ) + +import Codec.Picture( writePng ) +import Text.AsciiDiagram +{-import Text.Groom-} +import Graphics.Svg + +testOutputFolder :: FilePath +testOutputFolder = "test_output" + +loadLibrary :: Maybe FilePath -> IO Document +loadLibrary filePath = case filePath of + Nothing -> return defaultLib + Just p -> loadLib p + where + defaultLib = defaultLibrary defaultGridSize + loadLib p = do + putStrLn $ "Loading shape lib " ++ p + f <- loadSvgFile p + case f of + Just doc -> return doc + Nothing -> do + putStrLn "Invalid library file, using default lib" + return defaultLib + +toSvg :: [(String, T.Text, Maybe FilePath)] -> IO () +toSvg lst = do + createDirectoryIfMissing True testOutputFolder + cache <- loadCreateFontCache "asciidiagram-fonty-fontcache" + (hDoc, _) <- foldM go (mempty, cache) lst + let html = renderHtml . H.html $ H.body hDoc + TIO.writeFile (testOutputFolder "test.html") html + where + go (acc, cache) (name, content, lib) = do + shapeLib <- loadLibrary lib + let diagram = parseAsciiDiagram content + fileName = name ++ ".svg" + pngname = name ++ ".png" + svgDoc = svgOfDiagramAtSize defaultGridSize shapeLib diagram + putStrLn name + {-putStrLn $ show diagram-} + + saveXmlFile (testOutputFolder fileName) svgDoc + (img, _) <- renderSvgDocument cache Nothing 96 svgDoc + writePng (testOutputFolder pngname) img + return . (, cache) $ acc + <> H.table + (H.tr $ H.td (H.img H.! H.src (H.toValue fileName)) + <> H.td (H.img H.! H.src (H.toValue pngname))) + <> H.pre (H.toHtml (name ++ "\n") <> H.toHtml content) + +loadTests :: IO [(String, T.Text, Maybe FilePath)] +loadTests = do + let folder = "tests" "text" + content <- -- return ["shaper.txt"] + sort . filter (".txt" `isSuffixOf`) + . filter (`notElem` [".", "", ".."]) <$> getDirectoryContents folder + forM content $ \f -> do + fileContent <- STIO.readFile (folder f) + let contentLines = T.lines fileContent + libMarker = "|LIB_TO_LOAD=" + case contentLines of + [] -> return (f, fileContent, Nothing) + (x:xs) | libMarker `T.isPrefixOf` x -> + return (f, T.unlines xs, (folder ) . T.unpack <$> T.stripPrefix libMarker x) + _ -> return (f, fileContent, Nothing) + +main :: IO () +main = do + tests <- loadTests + toSvg tests +