diff --git a/README.md b/README.md index 8249091..a72ae18 100644 --- a/README.md +++ b/README.md @@ -9,9 +9,14 @@ First install Graphviz. For instance, in Ubuntu run: Then build and execute glance: ``` stack build -stack exec glance-exe -- -o images/fact.svg -w 500 examples/fact.hs - +stack exec glance-exe -- examples/fact.hs images/fact.svg 500 ``` -and display the SVG +To see the command line options run +``` +stack exec glance-exe -- --help +``` + +Now display the SVG image ``` firefox --new-window images/fact.svg ``` @@ -26,7 +31,7 @@ Glance is still in development, so for the time being, layout, routing, and icon ## Getting started Below is a getting started guide for Glance rendered by Glance itself ([source here](examples/tutorial.hs)). To generate this image run -`stack exec glance-exe -- -o examples/tutorial.svg -w 873 examples/tutorial.hs c` +`stack exec glance-exe -- examples/tutorial.hs examples/tutorial.svg 873 -c` Also, the [Glance wiki](../../wiki) has a brief introduction to the code architecture. diff --git a/app/Icons.hs b/app/Icons.hs index 7a212bc..4101962 100644 --- a/app/Icons.hs +++ b/app/Icons.hs @@ -361,10 +361,15 @@ nestedApplyDia flavor = case flavor of -- Text constants -- textBoxFontSize :: (Num a) => a textBoxFontSize = 1 + monoLetterWidthToHeightFraction :: (Fractional a) => a monoLetterWidthToHeightFraction = 0.61 + textBoxHeightFactor :: (Fractional a) => a -textBoxHeightFactor = 1.1 +textBoxHeightFactor = 1.4 + +textFont :: String +textFont = "monospace" -- BEGIN Text helper functions -- @@ -379,15 +384,15 @@ textBoxHeightFactor = 1.1 rectForText :: (InSpace V2 n t, TrailLike t) => Int -> t rectForText n = rect rectangleWidth (textBoxFontSize * textBoxHeightFactor) where - rectangleWidth = fromIntegral n * textBoxFontSize * monoLetterWidthToHeightFraction - + (textBoxFontSize * 0.2) + rectangleWidth = (fromIntegral n * textBoxFontSize * monoLetterWidthToHeightFraction) + + (textBoxFontSize * 0.3) -- END Text helper functions commentTextArea :: SpecialBackend b n => Colour Double -> String -> SpecialQDiagram b n commentTextArea textColor t = - alignL $ fontSize (local textBoxFontSize) (font "freemono" $ fc textColor $ topLeftText t) + alignL $ fontSize (local textBoxFontSize) (font textFont $ fc textColor $ topLeftText t) <> alignTL (lw none $ rectForText (length t)) multilineComment :: SpecialBackend b n => @@ -403,7 +408,7 @@ coloredTextBox :: SpecialBackend b n => Colour Double -> AlphaColour Double -> String -> SpecialQDiagram b n coloredTextBox textColor boxColor t = - fontSize (local textBoxFontSize) (bold $ font "freemono" $ fc textColor $ text t) + fontSize (local textBoxFontSize) (bold $ font textFont $ fc textColor $ text t) <> lwG (0.6 * defaultLineWidth) (lcA boxColor $ fcA (withOpacity (backgroundC colorScheme) 0.5) $ rectForText (length t)) transformCorrectedTextBox :: SpecialBackend b n => diff --git a/app/Main.hs b/app/Main.hs index 5be1a59..c48c812 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -4,18 +4,34 @@ import Prelude hiding (return) -- Note: (#) and (&) are hidden in all Glance source files, since they would require -- - an special case when translating when Glance is run on its own source code. -import Diagrams.Prelude hiding ((#), (&)) -import Diagrams.Backend.SVG.CmdLine ---import Diagrams.Backend.Rasterific.CmdLine +import qualified Diagrams.Prelude as Dia hiding ((#), (&)) + import qualified Language.Haskell.Exts as Exts +-- Options.Applicative does not seem to work qualified +import Options.Applicative + import Icons(ColorStyle(..), colorScheme, multilineComment) import Rendering(renderIngSyntaxGraph) import Translate(translateModuleToCollapsedGraphs) +import Util(customRenderSVG) +data CmdLineOptions = CmdLineOptions { + cmdInputFilename :: String, + cmdOutputFilename :: String, + cmdImageWidth :: Double, + cmdIncludeComments :: Bool + } -renderFile :: String -> String -> IO (Diagram B) -renderFile inputFilename includeComments = do +optionParser :: Parser CmdLineOptions +optionParser = CmdLineOptions + <$> argument str (metavar "INPUT_FILE" <> help "Input .hs filename") + <*> argument str (metavar "OUTPUT_FILE" <> help "Output .svg filename") + <*> argument auto (metavar "IMAGE_WIDTH" <> help "Output image width") + <*> switch (short 'c' <> help "Include comments between top level declarations.") + +renderFile :: CmdLineOptions -> IO () +renderFile (CmdLineOptions inputFilename outputFilename imageWidth includeComments) = do putStrLn $ "Translating file " ++ inputFilename ++ " into a Glance image." parseResult <- Exts.parseFileWithComments (Exts.defaultParseMode @@ -32,16 +48,30 @@ renderFile inputFilename includeComments = do diagrams <- traverse renderIngSyntaxGraph drawings let - commentsInBoxes = fmap (\(Exts.Comment _ _ c) -> alignL $ multilineComment white (opaque white) c) comments - diagramsAndComments = vsep 2 $ zipWith (\x y -> x === strutY 0.4 === y) commentsInBoxes (fmap alignL diagrams) - justDiagrams = vsep 1 $ fmap alignL diagrams - diagramsAndMaybeComments = if includeComments == "c" then diagramsAndComments else justDiagrams + commentsInBoxes = fmap (\(Exts.Comment _ _ c) -> Dia.alignL $ multilineComment Dia.white (Dia.opaque Dia.white) c) comments + diagramsAndComments = Dia.vsep 2 $ zipWith (\x y -> x Dia.=== Dia.strutY 0.4 Dia.=== y) commentsInBoxes (fmap Dia.alignL diagrams) + justDiagrams = Dia.vsep 1 $ fmap Dia.alignL diagrams + diagramsAndMaybeComments = if includeComments then diagramsAndComments else justDiagrams --print comments - pure (bgFrame 1 (backgroundC colorScheme) diagramsAndMaybeComments :: Diagram B) + finalDia = Dia.bgFrame 1 (backgroundC colorScheme) diagramsAndMaybeComments + customRenderSVG outputFilename (Dia.mkWidth imageWidth) finalDia + putStrLn $ "Successfully wrote " ++ outputFilename +translateFileMain :: IO () +translateFileMain = customExecParser parserPrefs opts >>= renderFile where + + parserPrefs = defaultPrefs{ + prefShowHelpOnError = True + + -- TODO enable this option when optparse-applicative has been upgraded + --prefShowHelpOnEmpty = True + } + + opts = info (helper <*> optionParser) + (fullDesc + <> progDesc "Translate a Haskell source file (.hs) into an SVG image." + <> header "Glance - a visual representation of Haskell") main :: IO () -main = do - mainWith renderFile - putStrLn "Successfully translated file." +main = translateFileMain diff --git a/app/Translate.hs b/app/Translate.hs index de1cddb..4403422 100644 --- a/app/Translate.hs +++ b/app/Translate.hs @@ -769,9 +769,13 @@ evalPatBind c (PatBind _ pat rhs maybeWhereBinds) = do -- TODO May want to trim whitespace from (prettyPrint typeForNames) evalTypeSig :: Decl -> State IDState (SyntaxGraph, NameAndPort) evalTypeSig (TypeSig _ names typeForNames) = makeBox - (intercalate "," (fmap prettyPrint names) + (intercalate "," (fmap prettyPrintWithoutNewlines names) ++ " :: " - ++ prettyPrint typeForNames) + ++ prettyPrintWithoutNewlines typeForNames) + where + -- TODO Make custom version of prettyPrint for type signitures. + -- Use (unwords . words) to convert consecutive whitspace characters to one space + prettyPrintWithoutNewlines = unwords . words . prettyPrint evalDecl :: EvalContext -> Decl -> State IDState SyntaxGraph evalDecl c d = case d of diff --git a/app/Util.hs b/app/Util.hs index 060bb95..99df434 100644 --- a/app/Util.hs +++ b/app/Util.hs @@ -22,14 +22,16 @@ module Util ( customRenderSVG )where -import Diagrams.Backend.SVG(renderSVG', Options(..)) +import Diagrams.Backend.SVG(renderSVG', Options(..), SVG) import Graphics.Svg.Attributes(bindAttr, AttrTag(..)) +import qualified Diagrams.Prelude as Dia import Control.Arrow(first) -- import Diagrams.Prelude(IsName, toName, Name) import Data.Maybe(fromMaybe) import qualified Debug.Trace import Data.Text(pack) +import Data.Typeable(Typeable) import Types(EdgeEnd(..), Edge(..), NameAndPort(..), Connection, NodeName(..), Port, SyntaxNode, SgNamedNode(..)) @@ -96,6 +98,12 @@ sgNamedNodeToSyntaxNode (SgNamedNode _ n) = n nodeNameToInt :: NodeName -> Int nodeNameToInt (NodeName x) = x + +customRenderSVG :: (Typeable n, Show n, RealFloat n) => + FilePath + -> Dia.SizeSpec Dia.V2 n + -> Dia.QDiagram SVG Dia.V2 n Dia.Any + -> IO () customRenderSVG outputFilename size = renderSVG' outputFilename svgOptions where -- This xml:space attribute preserves the whitespace in the svg text. attributes = [bindAttr XmlSpace_ (pack "preserve")] diff --git a/glance.cabal b/glance.cabal index 6c0fb4d..2e3aa58 100644 --- a/glance.cabal +++ b/glance.cabal @@ -39,6 +39,7 @@ executable glance-exe , diagrams-rasterific , text , svg-builder + , optparse-applicative default-language: Haskell2010 Other-modules: Icons, Rendering, Types, Util, Translate, TranslateCore, DrawingColors, GraphAlgorithms diff --git a/test/AllTests.hs b/test/AllTests.hs index 3786663..2a34508 100644 --- a/test/AllTests.hs +++ b/test/AllTests.hs @@ -1,6 +1,5 @@ import Prelude hiding (return) -import Diagrams.Backend.SVG (renderSVG) import Diagrams.Backend.SVG.CmdLine(B) import Diagrams.Prelude hiding ((#), (&)) diff --git a/todo.md b/todo.md index 0d4c33e..0717d2d 100644 --- a/todo.md +++ b/todo.md @@ -1,7 +1,9 @@ # Todo ## Todo Now -* Use customRenderSVG in app/Main.hs. +* Update tutorial code formatting. + +* Update Stackage lts (see todo in Main.hs) * Add wiki pages discussing: Why a visual language?, Glance design goals, History of Glance, FAQ's, How to contribute, Code guide [code style, ...], Related projects, examples demonstrating the utility of Glance etc.. @@ -31,3 +33,6 @@ * Add proper RecConstr, and RecUpdate support. * Special case for otherwise. + +### Command line todos +* Tab completion