Move toNames and Edge constructors to Util.hs.

This commit is contained in:
Robbie Gleichman 2016-01-22 18:28:55 -08:00
parent 77761e9611
commit cc058bb321
3 changed files with 5 additions and 45 deletions

View File

@ -9,21 +9,20 @@ import Data.Maybe (fromMaybe)
import Data.Typeable(Typeable)
import Icons(guardIcon, apply0NDia, colorScheme, ColorStyle(..))
import Rendering(toNames, portToPort, iconToPort, iconToIcon,
iconToIconEnds, iconHeadToPort, iconTailToPort, renderDrawing)
import Rendering(renderDrawing)
import Util(toNames, portToPort, iconToPort, iconToIcon,
iconToIconEnds, iconHeadToPort, iconTailToPort)
import Types(Icon(..), Drawing(..), EdgeEnd(..))
-- TODO Now --
-- todo: consider moving portToPort etc. to a new file
-- TODO Later --
-- Add a small black border to lines to help distinguish line crossings.
-- todo: Find out how to hide unqualified names such that recursive drawings are connected correctly
-- todo: Find out and fix why connectinos to sub-icons need to be qualified twice (eg. "lam0" .> "arg" .> "arg")
-- todo: Rotate based on difference from ideal tangent angle, not line distance.
-- todo: Try using connectPerim for port ot port connections. Hopefully this will draw a spline.
-- todo: Try using connectPerim for port to port connections. Hopefully this will draw a spline.
-- todo: layout and rotate considering external connections.
-- todo: figure out local vs. global icon positions
(d0A, d0B, d0Res, d0Foo, d0Bar) = ("A", "B", "res", "foo", "bar")
d0Icons = toNames

View File

@ -1,14 +1,6 @@
{-# LANGUAGE NoMonomorphismRestriction, FlexibleContexts, TypeFamilies #-}
module Rendering (
Drawing(..),
portToPort,
iconToPort,
iconToIcon,
iconToIconEnds,
iconHeadToPort,
iconTailToPort,
toNames,
renderDrawing
) where
@ -29,8 +21,6 @@ import Data.Typeable(Typeable)
import Icons(colorScheme, Icon(..), iconToDiagram, nameDiagram, defaultLineWidth, ColorStyle(..))
import Types(Edge(..), Connection, Drawing(..), EdgeEnd(..))
import Control.Arrow(first)
-- | Convert a map of names and icons, to a list of names and diagrams.
-- The first argument is the subdiagram map used for the inside of lambdaIcons
@ -39,41 +29,12 @@ makeNamedMap :: IsName name => [(Name, Diagram B)] -> [(name, Icon)] -> [(name,
makeNamedMap subDiagramMap =
map (\(name, icon) -> (name, iconToDiagram icon subDiagramMap # nameDiagram name))
mapFst :: (a -> b) -> [(a, c)] -> [(b, c)]
mapFst f = map (first f)
toNames :: (IsName a) => [(a, b)] -> [(Name, b)]
toNames = mapFst toName
noEnds = (EndNone, EndNone)
-- Edge constructors --
portToPort :: (IsName a, IsName b) => a -> Int -> b -> Int -> Edge
portToPort a b c d = Edge (toName a, Just b, toName c, Just d) noEnds
iconToPort :: (IsName a, IsName b) => a -> b -> Int -> Edge
iconToPort a c d = Edge (toName a, Nothing, toName c, Just d) noEnds
iconToIcon :: (IsName a, IsName b) => a -> b -> Edge
iconToIcon a c = Edge (toName a, Nothing, toName c, Nothing) noEnds
-- If there are gaps between the arrow and the icon, try switching the first two arguments
-- with the last two arguments
iconToIconEnds :: (IsName a, IsName b) => a -> EdgeEnd -> b -> EdgeEnd -> Edge
iconToIconEnds a b c d = Edge (toName a, Nothing, toName c, Nothing) (b, d)
iconHeadToPort a endHead c d = Edge (toName a, Nothing, toName c, Just d) (EndNone, endHead)
iconTailToPort a endTail c d = Edge (toName a, Nothing, toName c, Just d) (endTail, EndNone)
-- | Make an inductive Graph from a list of node names, and a list of Connections.
edgesToGraph :: (Ord v) => [v] -> [(v, t, v , t1)] -> Gr v ()
edgesToGraph names edges = mkGraph names simpleEdges
where
simpleEdges = map (\(a, _, c, _) -> (a, c, ())) edges
-- | Custom arrow tail for the arg1 result circle.
-- The ArrowHT type does not seem to be documented.
arg1ResT :: (RealFloat n) => ArrowHT n

View File

@ -33,7 +33,7 @@ executable glance-exe
, containers
, fgl
default-language: Haskell2010
Other-modules: Icons, Rendering, Types
Other-modules: Icons, Rendering, Types, Util
test-suite glance-test
type: exitcode-stdio-1.0