Permalink
Browse files

Use customRenderSVG in Main.hs. Change font to monospace. Use optpars…

…e-applicative for Main.
  • Loading branch information...
1 parent 69589f7 commit 71f6d55df31ea214ca5430c7c3db6553ef8b13f5 @rgleichman committed Jan 4, 2017
Showing with 83 additions and 26 deletions.
  1. +8 −3 README.md
  2. +10 −5 app/Icons.hs
  3. +43 −13 app/Main.hs
  4. +6 −2 app/Translate.hs
  5. +9 −1 app/Util.hs
  6. +1 −0 glance.cabal
  7. +0 −1 test/AllTests.hs
  8. +6 −1 todo.md
View
@@ -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.
View
@@ -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 =>
View
@@ -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
+ }
+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 :: String -> String -> IO (Diagram B)
-renderFile inputFilename includeComments = do
+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
View
@@ -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
View
@@ -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")]
View
@@ -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
View
@@ -1,6 +1,5 @@
import Prelude hiding (return)
-import Diagrams.Backend.SVG (renderSVG)
import Diagrams.Backend.SVG.CmdLine(B)
import Diagrams.Prelude hiding ((#), (&))
View
@@ -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

0 comments on commit 71f6d55

Please sign in to comment.