mirror of
https://github.com/rgleichman/glance.git
synced 2024-11-26 17:14:21 +03:00
82 lines
2.4 KiB
Haskell
82 lines
2.4 KiB
Haskell
{-# LANGUAGE NoMonomorphismRestriction, FlexibleContexts, TypeFamilies #-}
|
|
|
|
module Util (
|
|
portToPort,
|
|
iconToPort,
|
|
iconToIcon,
|
|
iconToIconEnds,
|
|
--iconHeadToPort,
|
|
iconTailToPort,
|
|
toNames,
|
|
makeSimpleEdge,
|
|
noEnds,
|
|
nameAndPort,
|
|
justName,
|
|
fromMaybeError,
|
|
mapFst,
|
|
printSelf,
|
|
eitherToMaybes,
|
|
maybeBoolToBool
|
|
)where
|
|
|
|
import Control.Arrow(first)
|
|
import Diagrams.Prelude(IsName, toName, Name)
|
|
import Data.Maybe(fromMaybe)
|
|
import qualified Debug.Trace
|
|
|
|
import Types(EdgeEnd(..), Edge(..), NameAndPort(..), Connection)
|
|
|
|
mapFst :: Functor f => (a -> b) -> f (a, c) -> f (b, c)
|
|
mapFst f = fmap (first f)
|
|
|
|
toNames :: (IsName a) => [(a, b)] -> [(Name, b)]
|
|
toNames = mapFst toName
|
|
|
|
noEnds :: (EdgeEnd, EdgeEnd)
|
|
noEnds = (EndNone, EndNone)
|
|
|
|
makeSimpleEdge :: Connection -> Edge
|
|
makeSimpleEdge = Edge [] noEnds
|
|
|
|
nameAndPort :: IsName a => a -> Int -> NameAndPort
|
|
nameAndPort n p = NameAndPort (toName n) (Just p)
|
|
|
|
justName :: IsName a => a -> NameAndPort
|
|
justName n = NameAndPort (toName n) Nothing
|
|
|
|
-- Edge constructors --
|
|
portToPort :: (IsName a, IsName b) => a -> Int -> b -> Int -> Edge
|
|
portToPort a b c d = makeSimpleEdge (nameAndPort a b, nameAndPort c d)
|
|
|
|
iconToPort :: (IsName a, IsName b) => a -> b -> Int -> Edge
|
|
iconToPort a c d = makeSimpleEdge (justName a, nameAndPort c d)
|
|
|
|
iconToIcon :: (IsName a, IsName b) => a -> b -> Edge
|
|
iconToIcon a c = makeSimpleEdge (justName a, justName c)
|
|
|
|
|
|
-- 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 [] (b, d) (justName a, justName c)
|
|
|
|
-- iconHeadToPort :: (IsName a, IsName b) => a -> EdgeEnd -> b -> Int -> Edge
|
|
-- iconHeadToPort a endHead c d = Edge (justName a, nameAndPort c d) (EndNone, endHead)
|
|
|
|
iconTailToPort :: (IsName a, IsName b) => a -> EdgeEnd -> b -> Int -> Edge
|
|
iconTailToPort a endTail c d = Edge [] (endTail, EndNone) (justName a, nameAndPort c d)
|
|
|
|
fromMaybeError :: String -> Maybe a -> a
|
|
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)
|
|
|
|
-- | (Just True) = True, Nothing = False
|
|
maybeBoolToBool :: Maybe Bool -> Bool
|
|
maybeBoolToBool = or
|