mirror of
https://github.com/rgleichman/glance.git
synced 2024-09-11 15:05:41 +03:00
Rename and refactor exported translation functions in Translate.hs.
This commit is contained in:
parent
00f6d4bd31
commit
7ac515ceaa
@ -11,7 +11,7 @@ import qualified Language.Haskell.Exts as Exts
|
||||
|
||||
import Icons(ColorStyle(..), colorScheme, multilineComment)
|
||||
import Rendering(renderIngSyntaxGraph)
|
||||
import Translate(drawingsFromModule)
|
||||
import Translate(translateModuleToCollapsedGraphs)
|
||||
|
||||
|
||||
renderFile :: String -> String -> IO (Diagram B)
|
||||
@ -25,7 +25,7 @@ renderFile inputFilename includeComments = do
|
||||
inputFilename
|
||||
let
|
||||
(parsedModule, comments) = Exts.fromParseResult parseResult
|
||||
drawings = drawingsFromModule parsedModule
|
||||
drawings = translateModuleToCollapsedGraphs parsedModule
|
||||
--print parsedModule
|
||||
--print "\n\n"
|
||||
--print drawings
|
||||
|
@ -1,9 +1,8 @@
|
||||
{-# LANGUAGE NoMonomorphismRestriction, FlexibleContexts, TypeFamilies #-}
|
||||
module Translate(
|
||||
translateString,
|
||||
drawingFromDecl,
|
||||
drawingsFromModule,
|
||||
stringToSyntaxGraph
|
||||
translateStringToSyntaxGraph,
|
||||
translateStringToCollapsedGraphAndDecl,
|
||||
translateModuleToCollapsedGraphs
|
||||
) where
|
||||
|
||||
import Diagrams.Prelude((<>))
|
||||
@ -604,26 +603,24 @@ showTopLevelBinds gr = do
|
||||
newGraph <- mconcat <$> mapM addBind binds
|
||||
pure $ newGraph <> gr
|
||||
|
||||
-- TODO Rename these functions to not have "drawing" in them.
|
||||
drawingFromDecl :: Decl -> IngSyntaxGraph FGR.Gr
|
||||
drawingFromDecl d = drawing
|
||||
where
|
||||
translateDeclToSyntaxGraph :: Decl -> SyntaxGraph
|
||||
translateDeclToSyntaxGraph d = graph where
|
||||
evaluatedDecl = evalDecl mempty d >>= showTopLevelBinds
|
||||
syntaxGraph = evalState evaluatedDecl initialIdState
|
||||
drawing = collapseNodes $ syntaxGraphToFglGraph syntaxGraph
|
||||
--drawing = syntaxGraphToFglGraph syntaxGraph
|
||||
graph = evalState evaluatedDecl initialIdState
|
||||
|
||||
-- | Convert a single function declaration into a SyntaxGraph
|
||||
translateStringToSyntaxGraph :: String -> SyntaxGraph
|
||||
translateStringToSyntaxGraph = translateDeclToSyntaxGraph . fromParseResult . parseDecl
|
||||
|
||||
translateDeclToCollapsedGraph :: Decl -> IngSyntaxGraph FGR.Gr
|
||||
translateDeclToCollapsedGraph = collapseNodes . syntaxGraphToFglGraph . translateDeclToSyntaxGraph
|
||||
|
||||
-- Profiling: about 1.5% of total time.
|
||||
translateString :: String -> (IngSyntaxGraph FGR.Gr, Decl)
|
||||
translateString s = (drawing, decl) where
|
||||
translateStringToCollapsedGraphAndDecl :: String -> (IngSyntaxGraph FGR.Gr, Decl)
|
||||
translateStringToCollapsedGraphAndDecl s = (drawing, decl) where
|
||||
decl = fromParseResult (parseDecl s) -- :: ParseResult Module
|
||||
drawing = drawingFromDecl decl
|
||||
drawing = translateDeclToCollapsedGraph decl
|
||||
|
||||
drawingsFromModule :: Module -> [IngSyntaxGraph FGR.Gr]
|
||||
drawingsFromModule (Module _ _ _ _ _ _ decls) = fmap drawingFromDecl decls
|
||||
|
||||
stringToSyntaxGraph :: String -> SyntaxGraph
|
||||
stringToSyntaxGraph s = graph where
|
||||
decl = fromParseResult (parseDecl s)
|
||||
evaluatedDecl = evalDecl mempty decl >>= showTopLevelBinds
|
||||
graph = evalState evaluatedDecl initialIdState
|
||||
-- TODO Put the type declarations in a box below the image.
|
||||
translateModuleToCollapsedGraphs :: Module -> [IngSyntaxGraph FGR.Gr]
|
||||
translateModuleToCollapsedGraphs (Module _ _ _ _ _ _ decls) = fmap translateDeclToCollapsedGraph decls
|
||||
|
@ -9,7 +9,7 @@ import qualified Data.Graph.Inductive.PatriciaTree as FGR
|
||||
|
||||
import Data.List(foldl', sort, sortOn)
|
||||
|
||||
import Translate(stringToSyntaxGraph)
|
||||
import Translate(translateStringToSyntaxGraph)
|
||||
import TranslateCore(syntaxGraphToFglGraph, SyntaxGraph(..), Reference)
|
||||
import Types(SgNamedNode, Edge(..), SyntaxNode(..),
|
||||
IngSyntaxGraph, NodeName(..), LikeApplyFlavor(..), NameAndPort(..))
|
||||
@ -24,7 +24,7 @@ assertAllEqual items = case items of
|
||||
(first : rest) -> TestList $ fmap (first ~=?) rest
|
||||
|
||||
assertEqualSyntaxGraphs :: [String] -> Test
|
||||
assertEqualSyntaxGraphs ls = assertAllEqual $ fmap (renameGraph . stringToSyntaxGraph) ls
|
||||
assertEqualSyntaxGraphs ls = assertAllEqual $ fmap (renameGraph . translateStringToSyntaxGraph) ls
|
||||
|
||||
-- BEGIN renameGraph --
|
||||
type NameMap = [(NodeName, NodeName)]
|
||||
@ -103,12 +103,12 @@ renameGraph (SyntaxGraph nodes edges sinks sources embedMap) =
|
||||
-- 2:(toName "x1",LiteralNode "x")->[(Edge {edgeOptions = [], edgeEnds = (EndNone,EndNone), edgeConnection = (NameAndPort (toName "x1") Nothing,NameAndPort (toName "app02") (Just 2))},0)]
|
||||
-- 3:(toName "y3",NameNode "y")->[(Edge {edgeOptions = [], edgeEnds = (EndNone,EndNone), edgeConnection = (NameAndPort (toName "y3") Nothing,NameAndPort (toName "app02") (Just 1))},0)]
|
||||
singleApplyGraph :: FGR.Gr SgNamedNode Edge
|
||||
singleApplyGraph = syntaxGraphToFglGraph $ stringToSyntaxGraph "y = f x"
|
||||
singleApplyGraph = syntaxGraphToFglGraph $ translateStringToSyntaxGraph "y = f x"
|
||||
|
||||
makeTreeRootTest :: (String, [Maybe SgNamedNode], String) -> Test
|
||||
makeTreeRootTest (testName, expected, haskellString) = TestCase $ assertEqual testName expected actual where
|
||||
actual = fmap (ING.lab graph) treeRoots
|
||||
graph = syntaxGraphToFglGraph $ stringToSyntaxGraph haskellString
|
||||
graph = syntaxGraphToFglGraph $ translateStringToSyntaxGraph haskellString
|
||||
treeRoots = GraphAlgorithms.findTreeRoots graph
|
||||
|
||||
treeRootTests :: Test
|
||||
|
@ -12,7 +12,7 @@ import qualified Data.GraphViz.Attributes.Complete as GVA
|
||||
import qualified Data.Graph.Inductive.PatriciaTree as FGR
|
||||
|
||||
import Types(SpecialQDiagram, SpecialBackend, SyntaxNode(..), NameAndPort(..), SgNamedNode, Edge(..))
|
||||
import Translate(stringToSyntaxGraph)
|
||||
import Translate(translateStringToSyntaxGraph)
|
||||
import TranslateCore(syntaxGraphToFglGraph)
|
||||
import GraphAlgorithms(collapseNodes)
|
||||
import Rendering(customLayoutParams)
|
||||
@ -77,7 +77,7 @@ makeCollapseTest str = do
|
||||
afterText,
|
||||
afterCollapse]
|
||||
where
|
||||
fglGraph = syntaxGraphToFglGraph $ stringToSyntaxGraph str
|
||||
fglGraph = syntaxGraphToFglGraph $ translateStringToSyntaxGraph str
|
||||
collapsedGraph = collapseNodes fglGraph
|
||||
customTextBox = coloredTextBox white (opaque lime)
|
||||
expressionText = alignL $ coloredTextBox white (opaque yellow) str -- :: Diagram B
|
||||
|
@ -9,9 +9,8 @@ import qualified Data.Graph.Inductive.Graph as ING
|
||||
import Data.List(intercalate)
|
||||
|
||||
import Types(SpecialQDiagram, SpecialBackend, NodeName(..))
|
||||
import Translate(translateString, stringToSyntaxGraph)
|
||||
import Translate(translateStringToCollapsedGraphAndDecl, translateStringToSyntaxGraph)
|
||||
import TranslateCore(syntaxGraphToFglGraph, SyntaxGraph(..))
|
||||
import GraphAlgorithms(collapseNodes)
|
||||
import Rendering(renderIngSyntaxGraph)
|
||||
import Icons(textBox)
|
||||
|
||||
@ -236,10 +235,9 @@ translateStringToDrawing :: SpecialBackend b Double => String -> IO (SpecialQDia
|
||||
translateStringToDrawing s = do
|
||||
putStrLn $ "Translating string: " ++ s
|
||||
let
|
||||
(drawing, decl) = translateString s
|
||||
syntaxGraph = stringToSyntaxGraph s
|
||||
(collapsedGraph, decl) = translateStringToCollapsedGraphAndDecl s
|
||||
syntaxGraph = translateStringToSyntaxGraph s
|
||||
fglGraph = syntaxGraphToFglGraph syntaxGraph
|
||||
collapsedGraph = collapseNodes fglGraph
|
||||
let
|
||||
printAction = do
|
||||
print decl
|
||||
@ -251,7 +249,7 @@ translateStringToDrawing s = do
|
||||
print collapsedGraph
|
||||
putStr "\n\n"
|
||||
-- printAction
|
||||
renderIngSyntaxGraph drawing
|
||||
renderIngSyntaxGraph collapsedGraph
|
||||
-- renderIngSyntaxGraph fglGraph
|
||||
|
||||
visualTranslateTests :: SpecialBackend b Double => IO (SpecialQDiagram b Double)
|
||||
|
7
todo.txt
7
todo.txt
@ -1,14 +1,11 @@
|
||||
-- TODO Now --
|
||||
Unit tests for let expressions.
|
||||
|
||||
Put the name and type for top-level-binds in a text box below drawings.
|
||||
Translate (.) into compose
|
||||
|
||||
-- TODO Later --
|
||||
-- Add documentation.
|
||||
|
||||
-- Testing todos:
|
||||
Add unit tests for the equality of different apply/compose/$/infix strings.
|
||||
Fix the arrowheads being too big for SyntaxGraph drawings.
|
||||
|
||||
-- Visual todos:
|
||||
@ -17,15 +14,11 @@ Case icon that can embed literals
|
||||
-- Make an icon font/library with labeled ports. E.g. the apply icon would have text labels "function", "result", "arg 0", "arg 1", etc.
|
||||
-- Don't rotate text and nested icons, give them rectangular bounding boxes in GraphViz. (Perhaps use a typeclass for isRotateAble)
|
||||
-- Give lines a black border to make line crossings easier to see.
|
||||
-- Line intersections should have a small circle. This could probably be done with
|
||||
-- a line ending.
|
||||
-- Let each bool, value pair in Guard icon be flipped to reduce line crossings. Do the same for case.
|
||||
-- Let lines connect to ports in multiple locations (e.g. case value, or guard result)
|
||||
-- Use different line styles (e.g. dashed, solid, wavy) in addition to colors
|
||||
Use diagrams to shrink the drawing until icons start overlapping.
|
||||
|
||||
-- Translate todos:
|
||||
Refactor evaluateAppExpression and all sub-expressions (add unit tests first).
|
||||
|
||||
Fix this test so that the line colors are correct. Consider connecting the t line to the origial rhs (3,4), not the pattern result.
|
||||
y = let {t@(_,_) = (3,4)} in t + 3
|
||||
|
Loading…
Reference in New Issue
Block a user