How to statically check a graph validity? - haskell

Consider the code below.
newtype NodeAT = NodeAT String deriving (Show,Read,Eq,Ord)
newtype NodeBT = NodeBT String deriving (Show,Read,Eq,Ord)
newtype NodeCT = NodeCT String deriving (Show,Read,Eq,Ord)
newtype NodeDT = NodeDT String deriving (Show,Read,Eq,Ord)
nodeA = NodeAT "nodeA"
nodeB = NodeBT "nodeB"
nodeC = NodeCT "nodeC"
nodeD = NodeDT "nodeD"
data Graph n m = Graph
{ vertices :: n
, edges :: m
}
graph1 = Graph (nodeA,nodeB,nodeC,nodeD) ((nodeA,nodeC),(nodeB,nodeC),(nodeA, nodeC))
Is there any possibility to use the type system to check that edges pairs are instances of nodes belonging to vertices tuple ?
This would make by construction
graph2 = Graph (nodeA, nodeB) (nodeA, nodeC)
illegal and failing at compile time ?

Not sure if it fits your needs, but you can come a long way with a bit of type-level programming.
Some extensions are needed of course:
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
Here is a closed type family for testing whether a type is a member of a type-level list of types:
type family Elem a as :: Bool where
Elem a '[] = False
Elem a (a : as) = True
Elem a (b : as) = Elem a as
Now, let's define types of vertices and edges where vertices are drawn from a given list of vertex types:
data Vertex :: [*] -> * where
V :: Elem a as ~ True => a -> Vertex as
type Edge as = (Vertex as, Vertex as)
Then, we can define a type of graphs where the vertices are stored in its type and its edges in a data constructor:
data Graph :: [*] -> * where
G :: [Edge as] -> Graph as
Here are some vertex types:
data NodeA = NodeA
data NodeB = NodeB
data NodeC = NodeC
With that, the following graph is well-typed:
graph1 :: Graph [NodeA, NodeB]
graph1 = G [(V NodeA, V NodeB)]
But the following is not:
graph2 :: Graph [NodeA, NodeB]
graph2 = G [(V NodeA, V NodeC)]
It fails with:
error:
• Couldn't match type ‘'False’ with ‘'True’
arising from a use of ‘V’
• In the expression: V NodeC
In the expression: (V NodeA, V NodeC)
In the first argument of ‘G’, namely ‘[(V NodeA, V NodeC)]’

Related

Is it possible to promote a value to type level?

Doing this just for fun but I don't end up figuring this out.
Say I have a typeclass that unifies coordinate system on squares and hexagons:
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
import Data.Proxy
data Shape = Square | Hexagon
class CoordSystem (k :: Shape) where
type Coord k
-- all coordinates arranged in a 2D list
-- given a side length of the shape
allCoords :: forall p. p k -> Int -> [[Coord k]]
-- neighborhoods of a coordinate.
neighborsOf :: forall p. p k -> Int -> Coord k -> [Coord k]
-- omitting implementations
instance CoordSystem 'Square
instance CoordSystem 'Hexagon
Now suppose I want to use this interface with a s :: Shape that is only known at runtime. But to make use of this interface, at some point I'll need a function like this:
-- none of those two works:
-- promote :: CoordSystem k => Shape -> Proxy (k :: Shape) -- signature 1
-- promote :: Shape -> forall k. CoordSystem k => Proxy (k :: Shape)
promote s = case s of
Square -> Proxy #'Square
Hexagon -> Proxy #'Hexagon
However this does not work, if signature 1 is uncommented:
• Couldn't match type ‘k’ with ‘'Square’
‘k’ is a rigid type variable bound by
the type signature for:
promote :: forall (k :: Shape). CoordSystem k => Shape -> Proxy k
at SO.hs:28:1-55
Expected type: Proxy k
Actual type: Proxy 'Square
Understandably, none of 'Square, 'Hexagon, k :: Shape unifies with others, so I have no idea whether this is possible.
I also feel type erasure shouldn't be an issue here as alternatives of Shape can use to uniquely identify the instance - for such reason I feel singletons could be of use but I'm not familiar with that package to produce any working example either.
The usual way is to use either an existential type or its Church encoding. The encoded version is actually easier to understand at first, I think, and closer to what you already attempted. The problem with your forall k. CoordSystem k => {- ... thing mentioning k -} is that it promises to polymorph into whatever k the user likes (so long as the user likes CoordSystems!). To fix it, you can demand that the user polymorph into whatever k you like.
-- `a` must not mention `k`, since `k` is not
-- in scope in the final return type
promote :: forall a. Shape -> (forall k. CoordSystem k => Tagged k a) -> a
promote Square a = unTagged (a #Square)
promote Hexagon a = unTagged (a #Hexagon)
-- usage example
test = promote Hexagon (unproxy $ \p -> length (allCoords p 15))
Note that on the right hand side of the = sign, a has the type forall k. CoordSystem k => {- ... -} that says the user gets to choose k, but this time you're the user.
Another common option is to use an existential:
data SomeSystem where
-- Proxy to be able to name the wrapped type when matching on a SomeSystem;
-- in some future version of GHC we may be able to name it via pattern-matching
-- on a type application instead, which would be better
SomeSystem :: CoordSystem k => Proxy k -> SomeSystem
Then you would write something like
promote :: Shape -> SomeSystem
promote Square = SomeSystem (Proxy #Square)
promote Hexagon = SomeSystem (Proxy #Hexagon)
-- usage example
test = case promote Hexagon of SomeSystem p -> length (allCoords p 15)
and then the user would pattern match to extract the CoordSystem instance from it.
A final choice is singletons:
data ShapeS k where
SquareS :: ShapeS Square
HexagonS :: ShapeS Hexagon
Here we have made a direct connection between SquareS at the computation level and Square at the type level (resp. HexagonS and Hexagon). Then you can write:
-- N.B. not a rank-2 type, and in particular `a` is
-- now allowed to mention `k`
promote :: ShapeS k -> (CoordSystem k => a) -> a
promote SquareS a = a
promote HexagonS a = a
The singletons package offers tools for automatically deriving the singleton types that correspond to your ADTs.

DataKind Unions

I'm not sure if it is the right terminology, but is it possible to declare function types that take in an 'union' of datakinds?
For example, I know I can do the following:
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
...
data Shape'
= Circle'
| Square'
| Triangle'
data Shape :: Shape' -> * where
Circle :: { radius :: Int} -> Shape Circle'
Square :: { side :: Int} -> Shape Square'
Triangle
:: { a :: Int
, b :: Int
, c :: Int}
-> Shape Triangle'
test1 :: Shape Circle' -> Int
test1 = undefined
However, what if I want to take in a shape that is either a circle or a square? What if I also want to take in all shapes for a separate function?
Is there a way for me to either define a set of Shape' kinds to use, or a way for me to allow multiple datakind definitions per data?
Edit:
The usage of unions doesn't seem to work:
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
...
type family Union (a :: [k]) (r :: k) :: Constraint where
Union (x ': xs) x = ()
Union (x ': xs) y = Union xs y
data Shape'
= Circle'
| Square'
| Triangle'
data Shape :: Shape' -> * where
Circle :: { radius :: Int} -> Shape Circle'
Square :: { side :: Int} -> Shape Square'
Triangle
:: { a :: Int
, b :: Int
, c :: Int}
-> Shape Triangle'
test1 :: Union [Circle', Triangle'] s => Shape s -> Int
test1 Circle {} = undefined
test1 Triangle {} = undefined
test1 Square {} = undefined
The part above compiles
You can accomplish something like this in (I think) a reasonably clean way using a type family together with ConstraintKinds and PolyKinds:
type family Union (a :: [k]) (r :: k) :: Constraint where
Union (x ': xs) x = ()
Union (x ': xs) y = Union xs y
test1 :: Union [Circle', Triangle'] s => Shape s -> Int
test1 = undefined
The () above is the empty constraint (it's like an empty "list" of type class constraints).
The first "equation" of the type family makes use of the nonlinear pattern matching available in type families (it uses x twice on the left hand side). The type family also makes use of the fact that if none of the cases match, it will not give you a valid constraint.
You should also be able to use a type-level Boolean instead of ConstraintKinds. That would be a bit more cumbersome and I think it would be best to avoid using a type-level Boolean here (if you can).
Side-note (I can never remember this and I had to look it up for this answer): You get Constraint in-scope by importing it from GHC.Exts.
Edit: Partially disallowing unreachable definitions
Here is a modification to get it to (partially) disallow unreachable definitions as well as invalid calls. It is slightly more roundabout, but it seems to work.
Modify Union to give a * instead of a constraint, like this:
type family Union (a :: [k]) (r :: k) :: * where
Union (x ': xs) x = ()
Union (x ': xs) y = Union xs y
It doesn't matter too much what the type is, as long as it has an inhabitant you can pattern match on, so I give back the () type (the unit type).
This is how you would use it:
test1 :: Shape s -> Union [Circle', Triangle'] s -> Int
test1 Circle {} () = undefined
test1 Triangle {} () = undefined
-- test1 Square {} () = undefined -- This line won't compile
If you forget to match on it (like, if you put a variable name like x instead of matching on the () constructor), it is possible that an unreachable case can be defined. It will still give a type error at the call-site when you actually try to reach that case, though (so, even if you don't match on the Union argument, the call test1 (Square undefined) () will not type check).
Note that it seems the Union argument must come after the Shape argument in order for this to work (fully as described, anyway).
This is getting kind of awful, but I guess you could require a proof that it's either a circle or a square using Data.Type.Equality:
test1 :: Either (s :~: Circle') (s :~: Square') -> Shape s -> Int
Now the user has to give an extra argument (a "proof term") saying which one it is.
In fact you can use the proof term idea to "complete" bradm's solution, with:
class MyOpClass sh where
myOp :: Shape sh -> Int
shapeConstraint :: Either (sh :~: Circle') (sh :~: Square')
Now nobody can go adding any more instances (unless they use undefined, which would be impolite).
You could use typeclasses:
class MyOpClass sh where
myOp :: Shape sh -> Int
instance MyOpClass Circle' where
myOp (Circle r) = _
instance MyOpClass Square' where
myOP (Square s) = _
This doesn't feel like a particularly 'complete' solution to me - anyone could go back and add another instance MyOpClass Triangle' - but I can't think of any other solution. Potentially you could avoid this problem simply by not exporting the typeclass however.
Another solution I've noticed, though pretty verbose, is to create a kind that has a list of feature booleans. You can then pattern match on the features when restricting the type:
-- [circleOrSquare] [triangleOrSquare]
data Shape' =
Shape'' Bool
Bool
data Shape :: Shape' -> * where
Circle :: { radius :: Int} -> Shape (Shape'' True False)
Square :: { side :: Int} -> Shape (Shape'' True True)
Triangle
:: { a :: Int
, b :: Int
, c :: Int}
-> Shape (Shape'' False True)
test1 :: Shape (Shape'' True x) -> Int
test1 Circle {} = 2
test1 Square {} = 2
test1 Triangle {} = 2
Here, Triangle will fail to match:
• Couldn't match type ‘'True’ with ‘'False’
Inaccessible code in
a pattern with constructor:
Triangle :: Int -> Int -> Int -> Shape ('Shape'' 'False 'True),
in an equation for ‘test1’
• In the pattern: Triangle {}
In an equation for ‘test1’: test1 Triangle {} = 2
|
52 | test1 Triangle {} = 2
| ^^^^^^^^^^^
Unfortunately, I don't think you can write this as a record, which may be clearer and avoids the ordering of the features.
This might be usable in conjunction with the class examples for readability.

Impose nesting limits on recursive data structure

Consider a recursive data structure like the following:
data Tree level
= Leaf String
| Node level [ Tree level ]
Now, if level is an instance of Ord, I would like to impose at the type level the following limitation on the data structure: a node must contain only Trees with a higher level.
You can safely assume that level is a simple sum type like
Level
= Level1
| Level2
...
| LevelN
but where N is not known a priori. In this case I would be able to have that all the subnodes of a node have a higher level.
For example
tree = Node Level1
[ Node Level2 []
, Node Level3 []
]
should compile, while
tree = Node Level2
[ Node Level1 []
]
should not.
Is it possible to model such a thing in Haskell?
Here's the basic idea. The easiest way to encode recursion limits like this is to use Peano numbers. Let's define such a type.
data Number = Zero | Succ Number
A number is either zero or the successor of another number. This is a nice way to define numbers here, as it will get along nicely with our tree recursion. Now, we want the Level to be a type, not a value. If it's a value, we can't limit its value at the type level. So we use GADTs to restrict the way we can initialize things.
data Tree (lvl :: Number) where
Leaf :: String -> Tree lvl
Node :: [Tree lvl] -> Tree ('Succ lvl)
lvl is the depth. A Leaf node can have any depth, but a Node node is restricted in its depth and must be strictly greater than that of its children (here, strictly one greater, which works in most simple cases. Allowing it to be strictly greater in general would require some more complicated type-level tricks, possibly with -XTypeInType). Notice that we use 'Succ at the type level. This is a promoted type, enabled with -XDataKinds. We also need -XKindSignatures to enable the :: Number constraint.
Now let's write a function.
f :: Tree ('Succ 'Zero) -> String
f _ = "It works!"
This function only takes trees that go at most one level deep. We can try to call it.
f (Leaf "A") -- It works!
f (Node [Leaf "A"]) -- It works!
f (Node [Node [Leaf "A"]]) -- Type error
So it will fail at compile-time if the depth is too much.
Complete example (including compiler extensions):
{-# LANGUAGE GADTs, KindSignatures, DataKinds #-}
data Number = Zero | Succ Number
data Tree (lvl :: Number) where
Leaf :: String -> Tree lvl
Node :: [Tree lvl] -> Tree ('Succ lvl)
f :: Tree ('Succ 'Zero) -> String
f _ = "It works!"
This isn't everything you can do with this. There's certainly expansions to be made, but it gets the point across and will hopefully point you in the right direction.
So there are a number of difficulties with this question. Peano numbers are a good place to start, though:
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ConstraintKinds #-}
data Nat = Z | S Nat
Next, we'll need some way of saying one number is "bigger" than another. We can do so by first defining an inductive class for "n is less than or equal to m"
class (n :: Nat) <= (m :: Nat)
instance Z <= n
instance n <= m => (S n <= S m)
We can then define "less than" in terms of this:
type n < m = S n <= m
Finally, here's the Tree and Levels:
data Tree n where
Leaf :: String -> Tree n
Node :: n < z => Level z -> [Tree z] -> Tree n
data Level n where
Level0 :: Level Z
Level1 :: Level (S Z)
Level2 :: Level (S (S Z))
Level3 :: Level (S (S (S Z)))
Level4 :: Level (S (S (S (S Z))))
And, as desired, the first example compiles:
tree = Node Level1
[ Node Level2 []
, Node Level3 []
]
While the second does not:
tree = Node Level2
[ Node Level1 []
]
Just for extra fun, we can now add a "custom type error" (this will need UndecidableInstances:
import GHC.TypeLits (TypeError, ErrorMessage(Text))
instance TypeError (Text "Nodes must contain trees of a higher level") => S n < Z
So when you write:
tree = Node Level2
[ Node Level1 []
]
You get the following:
• Nodes must contain trees of a higher level
• In the expression: Node Level1 []
In the second argument of ‘Node’, namely ‘[Node Level1 []]’
In the expression: Node Level2 [Node Level1 []]
If you want to make "level" more generic, you'll need a couple more extensions:
{-# LANGUAGE TypeApplications, RankNTypes, AllowAmbiguousTypes, TypeFamilies #-}
import qualified GHC.TypeLits as Lits
data Level n where
Level0 :: Level Z
LevelS :: !(Level n) -> Level (S n)
class HasLevel n where level :: Level n
instance HasLevel Z where level = Level0
instance HasLevel n => HasLevel (S n) where level = LevelS level
type family ToPeano (n :: Lits.Nat) :: Nat where
ToPeano 0 = Z
ToPeano n = S (ToPeano (n Lits.- 1))
node :: forall q z n m. (ToPeano q ~ z, HasLevel z, n < z) => [Tree z] -> Tree n
node = Node level
tree =
node #1
[ node #2 []
, node #3 []
]

Type-level graphs via GADTs and DataKinds

I'm trying to encode a type-level graph with some constraints on the construction of edges (via a typeclass) but I'm running into an "Illegal constraint in type" error when I try to alias a constructed graph. What's causing this issue? If it's unworkable, is there another way to encode the graph structure such that it can be built by type and folded over to yield a value-level representation of the graph?
Edit: Desiderata
I would like to be able to constrain the construction of a graph subject to the input and output nodes of any two operations.
For the sake of clarity, let's take the well-known case of length-indexed vectors.
An operation would take an input of some shape and potentially change it's length to the the length of output. An edge between two operations would need to ensure that the output of the first was compatible -- for some instance-defined notion of compatability -- with the input of the second. (Below, these constraints are omitted; the application requires dependently typed verification of the constraints and calculation of the types at compile.)
In order to define a new operation, S, that can be used with the existing operation(s) T (et al.), one should only need to add the data type S, the implementation of S _ and the necessary constraints for the function of S as an instance of the Edge typeclass.
--Pragmas are needed additionally for the project in which this snippet is included
{-# LANGUAGE TypeInType, DataKinds, PolyKinds, ScopedTypeVariables,
FlexibleInstances, FlexibleContexts, GADTs, TypeFamilies,
RankNTypes, LambdaCase, TypeOperators, TemplateHaskell,
ConstraintKinds, PolyKinds, NoImplicitPrelude,
UndecidableInstances, MultiParamTypeClasses, GADTSyntax,
AllowAmbiguousTypes, InstanceSigs, DeriveFunctor,
FunctionalDependencies #-}
-- Algebra.Graph is from the algebraic-graphs package
import qualified Algebra.Graph as AG
import Data.Singletons
import Data.Singletons.Prelude
import Data.Singletons.TypeLits
import Data.Kind
data T (ln::Nat) c = T c
class Edge operation n o
instance
-- This would be something like: (LengthIsValidPrime x ~ True, y ~ DependentlyTypedCalculationForOpabc x) =>
Edge (T l c) x y
data Flow :: * -> * where
Empty :: Flow (a)
Vertex :: (Edge a n o) => a -> Flow (a)
Connect ::
(Edge a x y, Edge a y z, Edge a x z) =>
Flow (a) -> Flow (a) -> Flow (a)
Overlay ::
(Edge a x y, Edge a y z, Edge a x z) =>
Flow (a) -> Flow (a) -> Flow (a)
type Test c = Connect (Vertex (T 24 c )) (Vertex (T 3 c))
--which fails with
--error:
-- • Illegal constraint in a type: Edge a0 x0 z0
-- • In the type ‘Connect (Vertex (T 24 c)) (Vertex (T 3 c))’
-- In the type declaration for ‘Test’
-- We want to be able to define a graph like so:
type InputNode c = Vertex (T 100 c )
type ForkNode c = Vertex (T 10 c )
type NodeB c = Vertex (T 1 c )
type NodeC c = Vertex (T 1 c )
type PathA c = Connect (InputNode c) (ForkNode c)
type PathAB c = Connect (PathA c) (NodeB c)
type PathAC c = Connect (PathA c) (NodeC c)
type Output c = Vertex (T 2 c )
type Subgraph c = Overlay (Connect (PathAC c) (Output c)) (Connect (PathAB c) (Output c))
-- and eventually the trascription from the type-level graph to a value graph defined by Algebra.Graph
--foldFlow :: Flow a -> AG.Graph (Flow a)
--foldFlow Empty = AG.empty
--foldFlow vt#(Vertex x) = AG.vertex vt
--foldFlow (Overlay x y) = AG.overlay (foldFlow x) (foldFlow y)
--foldFlow (Connect x y) = AG.connect (foldFlow x) (foldFlow y)
--runGraph :: Subgraph c
--runGraph = ...create a term-level Subgraph c so we can fold over it.
gist here

Can't match class type with specific type in haskell

I have the following situation in my code (simplified but semantically identical)
class Graph a where
edges :: EdgeSet c => a -> c
I have many subtypes that fulfill the graph interface. One of them is a tree
data Tree = Tree
instance Graph Tree where
edges tree = DirectedEdgeSet
A call on the edges method should return a DirectedEdgeSet. This should be OK since DirectedEdgeSet implements the EdgeSet class:
type Edge = (Int, Int)
data DirectedEdgeSet = DirectedEdgeSet (Set Edge) Int
class EdgeSet c where
content :: c -> Set Edge
size :: c -> Int
instance EdgeSet DirectedEdgeSet where
content (DirectedEdgeSet es _) = es
size (DirectedEdgeSet _ x) = x
This example does not compile:
• Couldn't match expected type ‘c’
with actual type ‘DirectedEdgeSet’
‘c’ is a rigid type variable bound by
the type signature for:
edges :: forall c. EdgeSet c => Tree -> c
at Tree.hs:10:5
• In the expression: DirectedEdgeSet
In an equation for ‘edges’: edges tree = DirectedEdgeSet
In the instance declaration for ‘Graph Tree’
• Relevant bindings include
edges :: Tree -> c (bound at Tree.hs:10:5)
Can someone tell me what I am doing wrong?
You are misunderstanding the type of the class method; edges :: EdgeSet c => a -> c is a function which takes any a (constrained with a being an instance of Graph) and returns any c (constrained with c being an instance of EdgeSet c). You probably instead want to say it returns some c obeying the aforementioned constraint.
Haskell 98 solution
You could just require that edges return an actual Set (like the one from Data.Set) for all graphs:
class Graph a where
edges :: a -> Data.Set Edge
ExistentialQuantification solution
Otherwise, you can use the ExistentialQuantification extension and modify the class method:
{-# LANGUAGE ExistentialQuantification #-}
data SomeEdgeSet = forall c. EdgeSet c => SomeEdgeSet c
class Graph a where
edges :: a -> SomeEdgeSet
instance Graph Tree where
edges tree = SomeEdgeSet DirectedEdgeSet
As you can tell, each one of your instances of Graph all return SomeEdgeSet when edges is used, but that SomeEdgeSet contains anything, as long as that thing is an instance of EdgeSet.
TypeFamilies solution
This is the solution I recommend. In general, for any Graph, you will only ever have one type of Edges it returns. Then, there is this cool feature with TypeFamilies where you can declare a type inside a class:
{-# LANGUAGE TypeFamilies, UndecideableInstances #-}
class (EdgeSet (Edges a)) => Graph a where
type Edges a
edges :: a -> Edges a
Then, suppose that your representation of edges for Graph Tree is DirectedEdgeSet, your instance will look like:
class Graph Tree where
type Edges Tree = DirectedEdgeSet -- `DirectedEdgeSet` is the type here
edges tree = DirectedEdgeSet -- `DirectedEdgeSet` is the constructor here
In edges, the type variable c is universally quantified. That means that edges must work for all types which are instances of EdgeSet. Your implementation fixes a concrete type and thus does not work for all EdgeSet instances.
To fix this, you can specify the concrete type of edge set that the instance uses via type families:
{-# LANGUAGE TypeFamilies #-}
data Tree = Tree
data DirectedEdgeSet = DirectedEdgeSet
class Graph a where
type GraphEdgeSet a :: *
edges :: a -> GraphEdgeSet a
instance Graph Tree where
type GraphEdgeSet Tree = DirectedEdgeSet
edges tree = DirectedEdgeSet

Resources