Type-level graphs via GADTs and DataKinds - haskell

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

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.

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 []
]

How to create a value in compdata

I've got the following compdata example code
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TemplateHaskell #-}
module Web.Rusalka.Hello (
iB, iV, Z) where
import Data.Comp
import Data.Comp.Ops
import Data.Comp.Show ()
import Data.Comp.Derive
data B e = B Bool
data V a e = V a
type Z a = Term (B :+: V a)
$(derive [makeFunctor, makeTraversable, makeFoldable,
makeEqF, makeShowF, smartConstructors, smartAConstructors,
makeArbitrary, makeArbitraryF]
[''B, ''V])
(You'll note that in fact, everything in Z is a leaf node.)
Now, as I understand it, this has created two functions, iB and iV, that can be used to create (Z a) s. However, I can't for the life of me figure
out how to create, for instance a (Z Int). What do I need to put in? (Or what am I misunderstanding?)
iB True :: Z Int or iV (1 :: Int) :: Z Int produce valid, printable expressions within this module.

How can I encode and enforce legal FSM state transitions with a type system?

Suppose I have a type Thing with a state property A | B | C,
and legal state transitions are A->B, A->C, C->A.
I could write:
transitionToA :: Thing -> Maybe Thing
which would return Nothing if Thing was in a state which cannot transition to A.
But I'd like to define my type, and the transition functions in such a way that transitions can only be called on appropriate types.
An option is to create separate types AThing BThing CThing but that doesn't seem maintainable in complex cases.
Another approach is to encode each state as it's own type:
data A = A Thing
data B = B Thing
data C = C Thing
and
transitionCToA :: C Thing -> A Thing
This seems cleaner to me. But it occurred to me that A,B,C are then functors where all of Things functions could be mapped except the transition functions.
With typeclasses I could create somthing like:
class ToA t where
toA :: t -> A Thing
Which seems cleaner still.
Are there other preferred approaches that would work in Haskell and PureScript?
Here's a fairly simple way that uses a (potentially phantom) type parameter to track which state a Thing is in:
{-# LANGUAGE DataKinds, KindSignatures #-}
-- note: not exporting the constructors of Thing
module Thing (Thing, transAB, transAC, transCA) where
data State = A | B | C
data Thing (s :: State) = {- elided; can even be a data family instead -}
transAB :: Thing A -> Thing B
transAC :: Thing A -> Thing C
transCA :: Thing C -> Thing A
transAB = {- elided -}
transAC = {- elided -}
transCA = {- elided -}
You could use a type class (available in PureScript) along with phantom types as John suggested, but using the type class as a final encoding of the type of paths:
data A -- States at the type level
data B
data C
class Path p where
ab :: p A B -- One-step paths
ac :: p A C
ca :: p C A
trans :: forall a b c. p c b -> p b a -> p c a -- Joining paths
refl :: forall a. p a a
Now you can create a type of valid paths:
type ValidPath a b = forall p. (Path p) => p a b
roundTrip :: ValidPath A A
roundTrip = trans ca ac
Paths can only be constructed by using the one-step paths you provide.
You can write instances to use your paths, but importantly, any instance has to respect the valid transitions at the type level.
For example, here is an interpretation which calculates lengths of paths:
newtype Length = Length Int
instance pathLength :: Path Length where
ab = Length 1
ac = Length 1
ca = Length 1
trans (Length n) (Length m) = Length (n + m)
refl = Length 0
Since your goal is to prevent developers from performing illegal transitions, you may want to look into phantom types. Phantom types allow you to model type-safe transitions without leveraging more advanced features of the type system; as such they are portable to many languages.
Here's a PureScript encoding of your above problem:
foreign import data A :: *
foreign import data B :: *
foreign import data C :: *
data Thing a = Thing
transitionToA :: Thing C -> Thing A
Phantom types work well to model valid state transitions when you have the property that two different states cannot transition to the same state (unless all states can transition to that state). You can workaround this limitation by using type classes (class CanTransitionToA a where trans :: Thing a -> Thing A), but at this point, you should investigate other approaches.
If you want to store a list of transitions so that you can process it later, you can do something like this:
{-# LANGUAGE DataKinds, GADTs, KindSignatures, PolyKinds #-}
data State = A | B | C
data Edge (a :: State) (b :: State) where
EdgeAB :: Edge A B
EdgeAC :: Edge A C
EdgeCA :: Edge C A
data Domino (f :: k -> k -> *) (a :: k) (b :: k) where
I :: Domino f a a
(:>>:) :: f a b -> Domino f b c -> Domino f a c
infixr :>>:
example :: Domino Edge A B
example = EdgeAC :>>: EdgeCA :>>: EdgeAB :>>: I
You can turn that into an instance of Path by writing a concatenation function for Domino:
{-# LANGUAGE FlexibleInstances #-}
instance Path (Domino Edge) where
ab = EdgeAB :>>: I
ac = EdgeAC :>>: I
ca = EdgeCA :>>: I
refl = I
trans I es' = es'
trans (e :>>: es) es' = e :>>: (es `trans` es')
In fact, this makes me wonder if Hackage already has a package that defines "indexed monoids":
class IMonoid (m :: k -> k -> *) where
imempty :: m a a
imappend :: m a b -> m b c -> m a c
instance IMonoid (Domino e) where
imempty = I
imappend I es' = es'
imappend (e :>>: es) es' = e :>>: (es `imappend` es')

Describing a typeclass for general graphs in Haskell

I'm trying to write a typeclass for graphs. Basically, the typeclass looks like:
class Graph g where
adjacentNodes :: g n -> n -> [n]
in which I use n to represent the type of nodes.
Then I have the following Graph defined like this:
data FiniteGraph n = FiniteGraph { runFiniteGraph :: Array n [n] }
where Array is adopted from the standard container Data.Array, the structure is to represent a finite graph in the way to map each node to their adjacent nodes.
Here comes the problem, when I try to make FiniteGraph an instance of Graph.
instance Graph FiniteGraph where
adjacentNodes g n = (runFiniteGraph g) ! n
Unfortunately this doesn't work, because the ! operator requires the constraint Ix n, but I find no where to declare it.
I expect the instance declaration to be some like:
instance (Ix n) => Graph (FiniteGraph n) where { ... }
But this requires the g in class Graph g to have the kind * instead of * -> *, such that I would have no where to show that n depend on g.
So what can I do with that? Thanks.
It can be done after you add a second param to the Graph class.
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE FlexibleInstances #-}
import Data.Array
class Graph g n | n -> g where
adjacentNodes :: g n -> n -> [n]
data FiniteGraph n = FiniteGraph { runFiniteGraph :: Array n [n] }
instance Ix n => Graph FiniteGraph n where
adjacentNodes g n = (runFiniteGraph g) ! n
That makes sense if you think about it: graph requires the notion of a vertex.

Resources