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.1 +version: 1.3.1.2 synopsis: Pretty rendering of Ascii diagram into svg or png. description: Transform Ascii art diagram like this: @@ -88,40 +88,4 @@ , 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.2 August 2016 +-------------------- + * Removing test suite from production pacakge + v1.3.1.1 May 2016 ----------------- * Fix: GHC 8.0.1 compilation diff --git a/exec-src/docgen.hs b/exec-src/docgen.hs deleted file mode 100644 --- a/exec-src/docgen.hs +++ /dev/null @@ -1,381 +0,0 @@ - -{-# 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 deleted file mode 100644 --- a/exec-src/hitaa_test.hs +++ /dev/null @@ -1,95 +0,0 @@ -{-# 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 -