mirror of
https://github.com/rgleichman/glance.git
synced 2024-09-11 15:05:41 +03:00
181 lines
5.1 KiB
Haskell
181 lines
5.1 KiB
Haskell
-- This file is formatted with Ormolu
|
|
{-# LANGUAGE ConstraintKinds #-}
|
|
{-# LANGUAGE DeriveFunctor #-}
|
|
{-# LANGUAGE FlexibleContexts #-}
|
|
{-# LANGUAGE NoMonomorphismRestriction #-}
|
|
|
|
module Types
|
|
( Named (..),
|
|
NamedIcon,
|
|
IconInfo,
|
|
Icon (..),
|
|
SyntaxNode (..),
|
|
NodeName (..),
|
|
Port (..),
|
|
NameAndPort (..),
|
|
Connection,
|
|
Edge (..),
|
|
EdgeOption (..),
|
|
Drawing (..),
|
|
IDState (..),
|
|
SpecialQDiagram,
|
|
SpecialBackend,
|
|
SpecialNum,
|
|
SgNamedNode,
|
|
IngSyntaxGraph,
|
|
LikeApplyFlavor (..),
|
|
CaseOrMultiIfTag (..),
|
|
Labeled (..),
|
|
EmbedDirection (..),
|
|
EmbedInfo (..),
|
|
AnnotatedGraph,
|
|
NodeInfo (..),
|
|
Embedder (..),
|
|
mkEmbedder,
|
|
EmbedderSyntaxNode,
|
|
)
|
|
where
|
|
|
|
import qualified Data.Graph.Inductive as ING
|
|
import qualified Data.IntMap as IM
|
|
import Data.Set (Set, empty)
|
|
import Data.Typeable (Typeable)
|
|
import Diagrams.Prelude (Any, IsName, Path, QDiagram, Renderable, V2)
|
|
import Diagrams.TwoD.Text (Text)
|
|
|
|
newtype NodeName = NodeName Int deriving (Typeable, Eq, Ord, Show)
|
|
|
|
instance IsName NodeName
|
|
|
|
data Named a = Named {naName :: NodeName, naVal :: a}
|
|
deriving (Show, Eq, Ord, Functor)
|
|
|
|
type NamedIcon = Named Icon
|
|
|
|
data Labeled a = Labeled {laValue :: a, laLabel :: String}
|
|
deriving (Show, Eq, Ord)
|
|
|
|
instance Functor Labeled where
|
|
fmap f (Labeled value str) = Labeled (f value) str
|
|
|
|
instance Applicative Labeled where
|
|
pure x = Labeled x ""
|
|
(Labeled f fStr) <*> (Labeled x xStr) = Labeled (f x) (fStr <> xStr)
|
|
|
|
type IconInfo = IM.IntMap Icon
|
|
|
|
-- | A datatype that represents an icon.
|
|
-- The TextBoxIcon's data is the text that appears in the text box.
|
|
data Icon
|
|
= TextBoxIcon String
|
|
| MultiIfIcon
|
|
Int -- Number of alternatives
|
|
| LambdaIcon
|
|
[String] -- Parameter labels
|
|
(Maybe NodeName) -- Function body expression
|
|
(Set NodeName) -- Nodes inside the lambda
|
|
| CaseIcon Int
|
|
| CaseResultIcon
|
|
| BindTextBoxIcon String
|
|
| NestedApply
|
|
LikeApplyFlavor -- apply or compose
|
|
(Maybe NodeName) -- The function for apply, or the argument for compose
|
|
[Maybe NodeName] -- list of arguments or functions
|
|
| NestedPApp
|
|
(Labeled (Maybe NamedIcon)) -- Data constructor
|
|
[Labeled (Maybe NamedIcon)] -- Arguments
|
|
| NestedCaseIcon [Maybe NodeName]
|
|
| NestedMultiIfIcon [Maybe NodeName]
|
|
deriving (Show, Eq, Ord)
|
|
|
|
data LikeApplyFlavor = ApplyNodeFlavor | ComposeNodeFlavor
|
|
deriving (Show, Eq, Ord)
|
|
|
|
data CaseOrMultiIfTag = CaseTag | MultiIfTag deriving (Show, Eq, Ord)
|
|
|
|
-- TODO The full edge does not need to be included, just the port.
|
|
data Embedder a = Embedder
|
|
{ -- | Set of embedded nodes
|
|
emEmbedded :: Set (NodeName, Edge),
|
|
emNode :: a
|
|
}
|
|
deriving (Show, Eq, Ord, Functor)
|
|
|
|
mkEmbedder :: a -> Embedder a
|
|
mkEmbedder = Embedder empty
|
|
|
|
type EmbedderSyntaxNode = Embedder SyntaxNode
|
|
|
|
type SgNamedNode = Named EmbedderSyntaxNode
|
|
|
|
-- TODO remove Ints from SyntaxNode data constructors.
|
|
data SyntaxNode
|
|
= -- Function application, composition, and applying to a composition
|
|
-- The list of nodes is unordered (replace with a map?)
|
|
ApplyNode LikeApplyFlavor Int
|
|
| PatternApplyNode String [Labeled (Maybe SgNamedNode)]
|
|
| NameNode String -- Identifiers or symbols
|
|
| BindNameNode String
|
|
| LiteralNode String -- Literal values like the string "Hello World"
|
|
| FunctionDefNode -- Function definition (ie. lambda expression)
|
|
[String] -- Parameter labels
|
|
(Set NodeName) -- Nodes inside the lambda
|
|
| CaseResultNode -- TODO remove caseResultNode
|
|
| CaseOrMultiIfNode CaseOrMultiIfTag Int
|
|
deriving (Show, Eq, Ord)
|
|
|
|
newtype Port = Port Int deriving (Typeable, Eq, Ord, Show)
|
|
|
|
instance IsName Port
|
|
|
|
data NameAndPort = NameAndPort NodeName (Maybe Port) deriving (Show, Eq, Ord)
|
|
|
|
type Connection = (NameAndPort, NameAndPort)
|
|
|
|
-- TODO Consider removing EdgeOption since it's unused.
|
|
data EdgeOption = EdgeInPattern deriving (Show, Eq, Ord)
|
|
|
|
-- | An Edge has an name of the source icon, and its optional port number,
|
|
-- and the name of the destination icon, and its optional port number.
|
|
data Edge = Edge
|
|
{ edgeOptions :: [EdgeOption],
|
|
edgeConnection :: Connection
|
|
}
|
|
deriving (Show, Eq, Ord)
|
|
|
|
-- | A drawing is a map from names to Icons, a list of edges,
|
|
-- and a map of names to subDrawings
|
|
data Drawing = Drawing [NamedIcon] [Edge] deriving (Show, Eq)
|
|
|
|
-- | IDState is an Abstract Data Type that is used as a state whose value is a
|
|
-- unique id.
|
|
newtype IDState = IDState Int deriving (Eq, Show)
|
|
|
|
type SpecialNum n =
|
|
(Floating n, RealFrac n, RealFloat n, Typeable n, Show n, Enum n)
|
|
|
|
-- Note that SpecialBackend is a constraint synonym, not a type synonym.
|
|
type SpecialBackend b n =
|
|
(SpecialNum n, Renderable (Path V2 n) b, Renderable (Text n) b)
|
|
|
|
type SpecialQDiagram b n = QDiagram b V2 n Any
|
|
|
|
type IngSyntaxGraph gr = gr SgNamedNode Edge
|
|
|
|
data EmbedDirection
|
|
= EdEmbedFrom -- The tail
|
|
| EdEmbedTo -- The head
|
|
deriving (Show, Eq)
|
|
|
|
-- A Nothing eiEmbedDir means the edge is not embedded.
|
|
data EmbedInfo a = EmbedInfo {eiEmbedDir :: Maybe EmbedDirection, eiVal :: a}
|
|
deriving (Show, Eq, Functor)
|
|
|
|
type AnnotatedGraph gr = gr (NodeInfo SgNamedNode) (EmbedInfo Edge)
|
|
|
|
data NodeInfo a = NodeInfo
|
|
{ niParent :: Maybe ING.Node,
|
|
niVal :: a
|
|
}
|
|
deriving (Show, Eq, Functor, Ord)
|