mirror of
https://github.com/rgleichman/glance.git
synced 2024-09-11 15:05:41 +03:00
Add Util.hs
This commit is contained in:
parent
fc59d7c82a
commit
041032dc94
44
app/Util.hs
Normal file
44
app/Util.hs
Normal file
@ -0,0 +1,44 @@
|
||||
{-# LANGUAGE NoMonomorphismRestriction, FlexibleContexts, TypeFamilies #-}
|
||||
|
||||
module Util (
|
||||
portToPort,
|
||||
iconToPort,
|
||||
iconToIcon,
|
||||
iconToIconEnds,
|
||||
iconHeadToPort,
|
||||
iconTailToPort,
|
||||
toNames
|
||||
)where
|
||||
|
||||
import Control.Arrow(first)
|
||||
import Diagrams.Prelude(IsName, toName, Name)
|
||||
|
||||
import Types(EdgeEnd(..), Edge(..))
|
||||
|
||||
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)
|
Loading…
Reference in New Issue
Block a user