mirror of
https://github.com/rgleichman/glance.git
synced 2024-09-11 15:05:41 +03:00
Use nested function apply icon even when the function is not text.
This commit is contained in:
parent
e083af823a
commit
21727bc9f1
13
app/Icons.hs
13
app/Icons.hs
@ -23,6 +23,7 @@ import Diagrams.Prelude hiding ((&), (#))
|
||||
-- import Diagrams.Backend.SVG(B)
|
||||
--import Diagrams.TwoD.Text(Text)
|
||||
import Data.Typeable(Typeable)
|
||||
import Data.Maybe(fromMaybe)
|
||||
|
||||
import Types(Icon(..), SpecialQDiagram, SpecialBackend)
|
||||
import Util(fromMaybeError)
|
||||
@ -139,18 +140,20 @@ transformCorrectedTextBox str textCol borderCol reflect angle =
|
||||
reflectIfTrue shouldReflect dia = if shouldReflect then reflectX dia else dia
|
||||
|
||||
nestedApplyDia :: SpecialBackend b =>
|
||||
String -> [Maybe (Name, Icon)] -> TransformableDia b
|
||||
Maybe String -> [Maybe (Name, Icon)] -> TransformableDia b
|
||||
nestedApplyDia = generalNestedDia (textBoxC colorScheme) (apply0C colorScheme)
|
||||
|
||||
nestedPAppDia :: SpecialBackend b =>
|
||||
String -> [Maybe (Name, Icon)] -> TransformableDia b
|
||||
Maybe String -> [Maybe (Name, Icon)] -> TransformableDia b
|
||||
nestedPAppDia = generalNestedDia (patternTextC colorScheme) (patternC colorScheme)
|
||||
|
||||
generalNestedDia :: SpecialBackend b =>
|
||||
Colour Double -> Colour Double-> String -> [Maybe (Name, Icon)] -> TransformableDia b
|
||||
generalNestedDia textCol borderCol funText args reflect angle = centerXY $ transformedText ||| centerY finalDia
|
||||
Colour Double -> Colour Double-> Maybe String -> [Maybe (Name, Icon)] -> TransformableDia b
|
||||
generalNestedDia textCol borderCol maybeFunText args reflect angle = centerXY $ transformedText ||| centerY finalDia
|
||||
where
|
||||
transformedText = transformCorrectedTextBox funText textCol borderCol reflect angle
|
||||
transformedText = case maybeFunText of
|
||||
Just funText -> transformCorrectedTextBox funText textCol borderCol reflect angle
|
||||
Nothing -> mempty
|
||||
seperation = circleRadius * 1.5
|
||||
verticalSeperation = circleRadius
|
||||
trianglePortsCircle = hsep seperation $
|
||||
|
11
app/Main.hs
11
app/Main.hs
@ -14,20 +14,13 @@ import Translate(drawingsFromModule)
|
||||
|
||||
|
||||
-- TODO Now --
|
||||
-- otherwise Guard special case
|
||||
-- Ues nesting apply icon even when the function is a line.
|
||||
-- Fix icon nesting if a non-nestable icon (eg. flatLambdaIcon) is part of the expression.
|
||||
-- - eg. y = f $ g (\x -> x)
|
||||
-- Fix rotation missing edges to nested diagrams.
|
||||
|
||||
-- Add a maximum nesting depth.
|
||||
-- Clean up Rendering and Icons.
|
||||
|
||||
-- Refactor Translate
|
||||
-- Add documentation.
|
||||
|
||||
-- TODO Later --
|
||||
-- Why is totalLengthOfLines not nesting?
|
||||
-- Add documentation.
|
||||
|
||||
-- Visual todos:
|
||||
-- Don't rotate text and nested icons, give them rectangualar bounding boxes in GraphViz. (Perhaps use a typeclass for isRotateAble)
|
||||
@ -50,6 +43,8 @@ import Translate(drawingsFromModule)
|
||||
-- Add proper RecConstr, and RecUpdate support.
|
||||
-- Eliminate BranchIcon in Alts.
|
||||
-- Eliminate BranchIcon for the identity funciton "y x = x"
|
||||
-- Add a maximum nesting depth.
|
||||
-- Special case for otherwise.
|
||||
|
||||
renderFile :: String -> String -> IO (Diagram B)
|
||||
renderFile inputFilename includeComments = do
|
||||
|
@ -20,7 +20,7 @@ import Data.Maybe(catMaybes)
|
||||
|
||||
import Types(Drawing(..), NameAndPort(..), IDState,
|
||||
initialIdState, Edge)
|
||||
import Util(toNames, makeSimpleEdge, nameAndPort, justName, mapFst)
|
||||
import Util(toNames, makeSimpleEdge, nameAndPort, justName, mapFst, eitherToMaybes)
|
||||
import Icons(Icon(..))
|
||||
import TranslateCore(Reference, IconGraph(..), Sink, EvalContext, GraphAndRef,
|
||||
iconGraphFromIcons, iconGraphFromIconsEdges, getUniqueName, combineExpressions,
|
||||
@ -56,7 +56,7 @@ evalPApp name patterns = do
|
||||
evaledPatterns <- mapM evalPattern patterns
|
||||
let
|
||||
constructorName = qNameToString name
|
||||
gr = makeTextApplyGraph True patName constructorName evaledPatterns (length evaledPatterns)
|
||||
gr = makeTextApplyGraph True patName (Left constructorName) evaledPatterns (length evaledPatterns)
|
||||
pure gr
|
||||
|
||||
evalPLit :: Exts.Sign -> Exts.Literal -> State IDState (IconGraph, NameAndPort)
|
||||
@ -96,8 +96,6 @@ strToGraphRef c str = fmap mapper (makeBox str) where
|
||||
else fmap Right gr
|
||||
|
||||
evalQName :: QName -> EvalContext -> State IDState (IconGraph, Reference)
|
||||
-- TODO Not sure if using (mempty, Left "") is the right thing to do here for "otherwise".
|
||||
evalQName (UnQual (Ident "otherwise")) _ = pure (mempty, Left "")
|
||||
evalQName qName@(UnQual _) c = strToGraphRef c (qNameToString qName)
|
||||
evalQName qName@(Qual _ _) c = strToGraphRef c (qNameToString qName)
|
||||
evalQName qName _ = fmap Right <$> makeBox (qNameToString qName)
|
||||
@ -115,9 +113,10 @@ decideIfNested :: ((IconGraph, t1), t) ->
|
||||
decideIfNested ((IconGraph [nameAndIcon] [] [] sinks bindings, _), _) = (Nothing, Just nameAndIcon, sinks, bindings)
|
||||
decideIfNested valAndPort = (Just valAndPort, Nothing, [], [])
|
||||
|
||||
makeTextApplyGraph :: Bool -> DIA.Name -> String -> [GraphAndRef] -> Int -> (IconGraph, NameAndPort)
|
||||
makeTextApplyGraph inPattern applyIconName funStr argVals numArgs = result
|
||||
makeTextApplyGraph :: Bool -> DIA.Name -> Either String GraphAndRef-> [GraphAndRef] -> Int -> (IconGraph, NameAndPort)
|
||||
makeTextApplyGraph inPattern applyIconName funStrOrVal argVals numArgs = result
|
||||
where
|
||||
(funStr, maybeFunVal) = eitherToMaybes funStrOrVal
|
||||
result = nestedApplyResult
|
||||
argumentPorts = map (nameAndPort applyIconName) [2,3..]
|
||||
(unnestedArgsAndPort, nestedArgs, nestedSinks, nestedBindings) = unzip4 $ map decideIfNested (zip argVals argumentPorts)
|
||||
@ -130,8 +129,16 @@ makeTextApplyGraph inPattern applyIconName funStr argVals numArgs = result
|
||||
Left _ -> ref
|
||||
Right (NameAndPort n p) -> Right $ NameAndPort (applyIconName DIA..> n) p
|
||||
|
||||
combinedGraph = combineExpressions inPattern $ catMaybes unnestedArgsAndPort
|
||||
icon = if inPattern then NestedPApp else NestedApply
|
||||
functionPort = nameAndPort applyIconName 0
|
||||
|
||||
originalPortExpPairs = (catMaybes unnestedArgsAndPort)
|
||||
portExpressionPairs = case maybeFunVal of
|
||||
Just funVal -> (funVal, functionPort) : originalPortExpPairs
|
||||
Nothing -> originalPortExpPairs
|
||||
combinedGraph = combineExpressions inPattern portExpressionPairs
|
||||
icon = if inPattern
|
||||
then NestedPApp
|
||||
else NestedApply
|
||||
icons = [(applyIconName, icon funStr nestedArgs)]
|
||||
newGraph = IconGraph icons [] [] qualifiedSinks qualifiedBinds
|
||||
nestedApplyResult = (newGraph <> combinedGraph, nameAndPort applyIconName 1)
|
||||
@ -160,14 +167,14 @@ evalApp c exps@(funExp, argExps) = case funExp of
|
||||
else do
|
||||
argVals <- mapM (evalExp c) argExps
|
||||
applyIconName <- DIA.toName <$> getUniqueName "app0"
|
||||
pure $ makeTextApplyGraph False applyIconName funStr argVals (length argExps)
|
||||
pure $ makeTextApplyGraph False applyIconName (Left funStr) argVals (length argExps)
|
||||
|
||||
evalAppNoText :: EvalContext -> (Exp, [Exp]) -> State IDState (IconGraph, NameAndPort)
|
||||
evalAppNoText c (funExp, argExps) = do
|
||||
funVal <- evalExp c funExp
|
||||
argVals <- mapM (evalExp c) argExps
|
||||
applyIconName <- DIA.toName <$> getUniqueName "app0"
|
||||
pure $ makeApplyGraph False applyIconName funVal argVals (length argExps)
|
||||
pure $ makeTextApplyGraph False applyIconName (Right funVal) argVals (length argExps)
|
||||
|
||||
qOpToExp :: QOp -> Exp
|
||||
qOpToExp (QVarOp n) = Var n
|
||||
@ -335,7 +342,7 @@ evalTuple :: EvalContext -> [Exp] -> State IDState (IconGraph, NameAndPort)
|
||||
evalTuple c exps = do
|
||||
argVals <- mapM (evalExp c) exps
|
||||
applyIconName <- DIA.toName <$> getUniqueName "tupleApp"
|
||||
pure $ makeTextApplyGraph False applyIconName (nTupleString (length exps)) argVals (length exps)
|
||||
pure $ makeTextApplyGraph False applyIconName (Left $ nTupleString (length exps)) argVals (length exps)
|
||||
|
||||
makeVarExp :: String -> Exp
|
||||
makeVarExp = Var . UnQual . Ident
|
||||
@ -353,7 +360,7 @@ evalRightSection c op e = do
|
||||
applyIconName <- DIA.toName <$> getUniqueName "tupleApp"
|
||||
-- TODO: A better option would be for makeApplyGraph to take the list of expressions as Maybes.
|
||||
neverUsedPort <- Left <$> getUniqueName "unusedArgument"
|
||||
pure $ makeTextApplyGraph False applyIconName (qOpToString op) [(mempty, neverUsedPort), expVal] 2
|
||||
pure $ makeTextApplyGraph False applyIconName (Left $ qOpToString op) [(mempty, neverUsedPort), expVal] 2
|
||||
|
||||
-- evalEnums is only used by evalExp
|
||||
evalEnums :: EvalContext -> String -> [Exp] -> State IDState (IconGraph, Reference)
|
||||
|
@ -97,7 +97,7 @@ combineExpressions inPattern portExpPairs = mconcat $ fmap mkGraph portExpPairs
|
||||
iconGraphToDrawing :: IconGraph -> Drawing
|
||||
iconGraphToDrawing (IconGraph icons edges subDrawings _ _) = Drawing icons edges subDrawings
|
||||
|
||||
makeApplyGraph :: Bool -> DIA.Name -> (IconGraph, Reference) -> [(IconGraph, Reference)] -> Int -> (IconGraph, NameAndPort)
|
||||
makeApplyGraph :: Bool -> DIA.Name -> GraphAndRef -> [GraphAndRef] -> Int -> (IconGraph, NameAndPort)
|
||||
makeApplyGraph inPattern applyIconName funVal argVals numArgs = (newGraph <> combinedGraph, nameAndPort applyIconName 1)
|
||||
where
|
||||
argumentPorts = map (nameAndPort applyIconName) [2,3..]
|
||||
|
@ -30,8 +30,8 @@ data Icon = ResultIcon | BranchIcon | TextBoxIcon String | GuardIcon Int
|
||||
| TextApplyAIcon Int String | PAppIcon Int String | CaseIcon Int | CaseResultIcon
|
||||
| BindTextBoxIcon String
|
||||
-- TODO: NestedApply should have the type NestedApply (Maybe (Name, Icon)) [Maybe (Name, Icon)]
|
||||
| NestedApply String [Maybe (Name, Icon)]
|
||||
| NestedPApp String [Maybe (Name, Icon)]
|
||||
| NestedApply (Maybe String) [Maybe (Name, Icon)]
|
||||
| NestedPApp (Maybe String) [Maybe (Name, Icon)]
|
||||
deriving (Show, Eq)
|
||||
|
||||
data NameAndPort = NameAndPort Name (Maybe Int) deriving (Show, Eq)
|
||||
|
@ -14,7 +14,8 @@ module Util (
|
||||
justName,
|
||||
fromMaybeError,
|
||||
mapFst,
|
||||
printSelf
|
||||
printSelf,
|
||||
eitherToMaybes
|
||||
)where
|
||||
|
||||
import Control.Arrow(first)
|
||||
@ -69,3 +70,7 @@ fromMaybeError s = fromMaybe (error s)
|
||||
|
||||
printSelf :: (Show a) => a -> a
|
||||
printSelf a = Debug.Trace.trace (show a ++ "\n\n") a
|
||||
|
||||
eitherToMaybes :: Either a b -> (Maybe a, Maybe b)
|
||||
eitherToMaybes (Left x) = (Just x, Nothing)
|
||||
eitherToMaybes (Right y) = (Nothing, Just y)
|
||||
|
@ -86,7 +86,8 @@ y = (\x -> 3 * x) 7-
|
||||
y = (\x -> 3 * x) 7
|
||||
|
||||
{-A more complex example:
|
||||
f x y = max (2 * y) (f (x + y - 40) x*2 )
|
||||
-f x y = let q = (f (x + y - 40) x*2 ) in
|
||||
-- max (2 * y) q
|
||||
If you have some drawing implements handy, you might want to try drawing this
|
||||
yourself before scrolling down. One place to start is to figure out how functions
|
||||
with "multiple parameters" are defined (which is of course syntactic sugar since
|
||||
@ -131,9 +132,11 @@ Drawing below:
|
||||
-
|
||||
-
|
||||
-
|
||||
f x y = max (2 * y) (f (x + y - 40) x*2 )
|
||||
-f x y = let q = (f (x + y - 40) x*2 ) in
|
||||
-- max (2 * y) q
|
||||
-}
|
||||
f x y = max (2 * y) (f (x + y - 40) x*2 )
|
||||
f x y = let q = (f (x + y - 40) x*2 ) in
|
||||
max (2 * y) q
|
||||
|
||||
{-Something different about Glance is that Glance does not have any code regions
|
||||
where, for example, the icons composing the body of a function would be restricted
|
||||
|
File diff suppressed because one or more lines are too long
Before Width: | Height: | Size: 376 KiB After Width: | Height: | Size: 367 KiB |
Loading…
Reference in New Issue
Block a user