conic-graphs (empty) → 0.0.1.0

raw patch · 5 files changed

+223/−0 lines, 5 filesdep +basedep +fcf-graphsdep +fcf-vinyl

Dependencies added: base, fcf-graphs, fcf-vinyl, first-class-families, vinyl

Files

ChangeLog.md +7/−0
LICENSE +30/−0
README.md +73/−0
conic-graphs.cabal +39/−0
src/Data/Conic/Graph.hs +74/−0

+ ChangeLog.md view

@@ -0,0 +1,7 @@+# Changelog for conic-graphs++## v0.0.1.0++* Add `RGraph` definition.+* Add `rmap`, `rapply`, `rtraverse`.+* Add `vertexList`.

+ LICENSE view

@@ -0,0 +1,30 @@+Copyright Daniel Firth (c) 2021++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Daniel Firth nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

+ README.md view

@@ -0,0 +1,73 @@+# conic-graphs++Vinyl-style extensible graphs.++A [vinyl](https://hackage.haskell.org/package/vinyl) style extensible record is+a hetrogenous list, using a type-level list to track the indicies. The+constructors of `Rec` mirror the constructors of the list used to index them.++```{.haskell}+data Rec :: (u -> *) -> [u] -> * where+  RNil :: Rec f '[]+  (:&) :: !(f r) -> !(Rec f rs) -> Rec f (r ': rs)+```++We can apply the same method to the+[algebraic-graphs](https://hackage.haskell.org/package/algebraic-graphs)+definition, albeit with four constructors instead of two.++```{.haskell}+data RGraph :: (u -> *) -> Graph u -> * where+  REmpty :: RGraph f 'Empty+  RVertex :: !(f r) -> RGraph f ('Vertex r)+  ROverlay :: !(RGraph f xs) -> !(RGraph f ys) -> RGraph f ('Overlay xs ys)+  RConnect :: !(RGraph f xs) -> !(RGraph f ys) -> RGraph f ('Connect xs ys)+```++Then each vertex of the `RGraph` may be of a different type, with the types+tracked in the type level `Graph`.++```{.haskell}+type G = 'Connect ('Vertex Int) ('Vertex String)++myGraph :: RGraph Identity G+myGraph = RConnect (RVertex (Identity 5)) (RVertex (Identity "foo"))+```++Using [fcf-graphs](https://hackage.haskell.org/package/fcf-graphs), we are able+to perform type-level graph computations to match the operations at the term+level.++```{.haskell}+edge :: f a -> f b -> RGraph f (Eval (Edge a b))+edge x y = RConnect (RVertex x) (RVertex y)+```++Including, collapsing RGraphs to vinyl Recs by computing the type level list of+vertex types.++```{.haskell}+data VertexList :: Graph a -> Exp [a]++type instance Eval (VertexList 'Empty) = '[]++type instance Eval (VertexList ('Vertex x)) = '[x]++type instance Eval (VertexList ('Overlay x y)) = Eval (LiftM2 (++) (VertexList x) (VertexList y))++type instance Eval (VertexList ('Connect x y)) = Eval (LiftM2 (++) (VertexList x) (VertexList y))++vertexList :: RGraph f xs -> Rec f (Eval (VertexList xs))+vertexList REmpty = RNil+vertexList (RVertex x) = x :& RNil+vertexList (ROverlay x y) = rappend (vertexList x) (vertexList y)+vertexList (RConnect x y) = rappend (vertexList x) (vertexList y)+```++```+ghci> vertexList myGraph+{5, "foo"}+```++(Note, we use a different version of rappend that makes it more obvious to fcf+that this is what we mean, defined in [fcf-vinyl](https://hackage.haskell.org/package/fcf-vinyl).

+ conic-graphs.cabal view

@@ -0,0 +1,39 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.34.4.+--+-- see: https://github.com/sol/hpack++name:           conic-graphs+version:        0.0.1.0+synopsis:       Vinyl-style extensible graphs.+description:    Vinyl-style extensible graphs.+category:       Graphs, Vinyl+author:         Daniel Firth+maintainer:     dan.firth@homotopic.tech+copyright:      Daniel Firth+license:        BSD3+license-file:   LICENSE+build-type:     Simple+extra-source-files:+    README.md+    ChangeLog.md++source-repository head+  type: git+  location: https://gitlab.homotopic.tech/haskell/conic-graphs++library+  exposed-modules:+      Data.Conic.Graph+  other-modules:+      Paths_conic_graphs+  hs-source-dirs:+      src+  build-depends:+      base >=4.7 && <5+    , fcf-graphs+    , fcf-vinyl+    , first-class-families+    , vinyl+  default-language: Haskell2010

+ src/Data/Conic/Graph.hs view

@@ -0,0 +1,74 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}++module Data.Conic.Graph where++import qualified Data.Vinyl as V+import Data.Vinyl.Functor+import Fcf+import Fcf.Data.Graph+import Fcf.Data.Vinyl++data RGraph :: (u -> *) -> Graph u -> * where+  REmpty :: RGraph f 'Empty+  RVertex :: !(f r) -> RGraph f ('Vertex r)+  ROverlay :: !(RGraph f xs) -> !(RGraph f ys) -> RGraph f ('Overlay xs ys)+  RConnect :: !(RGraph f xs) -> !(RGraph f ys) -> RGraph f ('Connect xs ys)++instance Eq (RGraph f 'Empty) where+  _ == _ = True++instance Eq (f r) => Eq (RGraph f ('Vertex r)) where+  RVertex x == RVertex y = x == y++instance (Eq (RGraph f x), Eq (RGraph f y)) => Eq (RGraph f ('Overlay x y)) where+  ROverlay x y == ROverlay x' y' = x == x' && y == y'++instance (Eq (RGraph f x), Eq (RGraph f y)) => Eq (RGraph f ('Connect x y)) where+  RConnect x y == RConnect x' y' = x == x' && y == y'++edge :: f a -> f b -> RGraph f (Eval (Edge a b))+edge x y = RConnect (RVertex x) (RVertex y)++data VertexList :: Graph a -> Exp [a]++type instance Eval (VertexList 'Empty) = '[]++type instance Eval (VertexList ('Vertex x)) = '[x]++type instance Eval (VertexList ('Overlay x y)) = Eval (LiftM2 (++) (VertexList x) (VertexList y))++type instance Eval (VertexList ('Connect x y)) = Eval (LiftM2 (++) (VertexList x) (VertexList y))++vertexList :: RGraph f xs -> V.Rec f (Eval (VertexList xs))+vertexList REmpty = V.RNil+vertexList (RVertex x) = x V.:& V.RNil+vertexList (ROverlay x y) = rappend (vertexList x) (vertexList y)+vertexList (RConnect x y) = rappend (vertexList x) (vertexList y)++rmap :: (forall x. f x -> g x) -> RGraph f rs -> RGraph g rs+rmap f REmpty = REmpty+rmap f (RVertex x) = RVertex (f x)+rmap f (ROverlay x y) = ROverlay (rmap f x) (rmap f y)+rmap f (RConnect x y) = RConnect (rmap f x) (rmap f y)++rtraverse :: Applicative h => (forall x. f x -> h (g x)) -> RGraph f rs -> h (RGraph g rs)+rtraverse f REmpty = pure REmpty+rtraverse f (RVertex x) = RVertex <$> f x+rtraverse f (ROverlay x y) = ROverlay <$> rtraverse f x <*> rtraverse f y+rtraverse f (RConnect x y) = RConnect <$> rtraverse f x <*> rtraverse f y++rapply :: RGraph (Lift (->) f g) xs -> RGraph f xs -> RGraph g xs+rapply _ REmpty = REmpty+rapply (RVertex f) (RVertex x) = RVertex (getLift f x)+rapply (ROverlay f g) (ROverlay x y) = ROverlay (rapply f x) (rapply g y)+rapply (RConnect f g) (RConnect x y) = RConnect (rapply f x) (rapply g y)++rzipWith :: (forall x. f x -> g x -> h x) -> RGraph f xs -> RGraph g xs -> RGraph h xs+rzipWith f = rapply . rmap (Lift . f)