use dependent types

haskell-igraph.cabal

@@ -65,6 +65,7 @@ library
     , hashable
     , hxt
     , split
+    , singletons
 
   extra-libraries:     igraph
   hs-source-dirs:      src

src/IGraph/Clique.chs

@@ -18,7 +18,7 @@ import IGraph.Internal.C2HS
 
 #include "haskell_igraph.h"
 
-cliques :: LGraph d v e
+cliques :: Graph d v e
         -> (Int, Int)  -- ^ Minimum and maximum size of the cliques to be returned.
                        -- No bound will be used if negative or zero
         -> [[Int]]     -- ^ cliques represented by node ids
@@ -27,13 +27,13 @@ cliques gr (lo, hi) = unsafePerformIO $ allocaVectorPtr $ \vptr -> do
     (map.map) truncate <$> toLists vptr
 {#fun igraph_cliques as ^ { `IGraph', castPtr `Ptr VectorPtr', `Int', `Int' } -> `CInt' void- #}
 
-largestCliques :: LGraph d v e -> [[Int]]
+largestCliques :: Graph d v e -> [[Int]]
 largestCliques gr = unsafePerformIO $ allocaVectorPtr $ \vptr -> do
     igraphLargestCliques (_graph gr) vptr
     (map.map) truncate <$> toLists vptr
 {#fun igraph_largest_cliques as ^ { `IGraph', castPtr `Ptr VectorPtr' } -> `CInt' void- #}
 
-maximalCliques :: LGraph d v e
+maximalCliques :: Graph d v e
                -> (Int, Int)  -- ^ Minimum and maximum size of the cliques to be returned.
                               -- No bound will be used if negative or zero
                -> [[Int]]     -- ^ cliques represented by node ids
@@ -42,7 +42,7 @@ maximalCliques gr (lo, hi) = unsafePerformIO $ allocaVectorPtr $ \vpptr -> do
     (map.map) truncate <$> toLists vpptr
 {#fun igraph_maximal_cliques as ^ { `IGraph', castPtr `Ptr VectorPtr', `Int', `Int' } -> `CInt' void- #}
 
-cliqueNumber :: LGraph d v e -> Int
+cliqueNumber :: Graph d v e -> Int
 cliqueNumber gr = unsafePerformIO $ igraphCliqueNumber $ _graph gr
 {#fun igraph_clique_number as ^
     { `IGraph'

src/IGraph/Community.chs

 {-# LANGUAGE ForeignFunctionInterface #-}
 {-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE DataKinds #-}
 module IGraph.Community
     ( modularity
     , findCommunity
@@ -25,8 +26,7 @@ import IGraph.Internal.C2HS
 
 #include "haskell_igraph.h"
 
-modularity :: Graph d
-           => LGraph d v e
+modularity :: Graph d v e
            -> [[Int]]   -- ^ Communities.
            -> Maybe [Double] -- ^ Weights
            -> Double
@@ -70,7 +70,7 @@ defaultSpinglass = Spinglass
     , _coolFact = 0.99
     , _gamma = 1.0 }
 
-findCommunity :: LGraph U v e
+findCommunity :: Graph 'U v e
               -> Maybe [Double]   -- ^ node weights
               -> CommunityMethod  -- ^ Community finding algorithms
               -> [[Int]]

src/IGraph/Exporter/GEXF.hs

@@ -9,12 +9,13 @@ module IGraph.Exporter.GEXF
     , writeGEXF
     ) where
 
-import           Data.Colour               (AlphaColour, alphaChannel, black,
-                                            opaque, over)
-import           Data.Colour.SRGB          (channelBlue, channelGreen,
-                                            channelRed, toSRGB24)
+import           Data.Colour       (AlphaColour, alphaChannel, black, opaque,
+                                    over)
+import           Data.Colour.SRGB  (channelBlue, channelGreen, channelRed,
+                                    toSRGB24)
 import           Data.Hashable
 import           Data.Serialize
+import           Data.Singletons   (SingI)
 import           GHC.Generics
 import           IGraph
 import           Text.XML.HXT.Core
@@ -71,7 +72,7 @@ defaultEdgeAttributes = EdgeAttr
     , _edgeZindex = 2
     }
 
-genXMLTree :: (ArrowXml a, Graph d) => LGraph d NodeAttr EdgeAttr -> a XmlTree XmlTree
+genXMLTree :: (SingI d, ArrowXml a) => Graph d NodeAttr EdgeAttr -> a XmlTree XmlTree
 genXMLTree gr = root [] [gexf]
   where
     gexf = mkelem "gexf" [ attr "version" $ txt "1.2"
@@ -124,7 +125,7 @@ genXMLTree gr = root [] [gexf]
         a = show $ alphaChannel $ _edgeColour at
 {-# INLINE genXMLTree #-}
 
-writeGEXF :: Graph d => FilePath -> LGraph d NodeAttr EdgeAttr -> IO ()
+writeGEXF :: SingI d => FilePath -> Graph d NodeAttr EdgeAttr -> IO ()
 writeGEXF fl gr = runX (genXMLTree gr >>> writeDocument config fl) >> return ()
   where
     config = [withIndent yes]

src/IGraph/Generators.chs

 {-# LANGUAGE ForeignFunctionInterface #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 module IGraph.Generators
     ( full
     , ErdosRenyiModel(..)
@@ -10,6 +12,7 @@ module IGraph.Generators
 import           Control.Monad                  (when)
 import           Data.Hashable                  (Hashable)
 import           Data.Serialize                 (Serialize)
+import Data.Singletons (SingI, Sing, sing, fromSing)
 import System.IO.Unsafe (unsafePerformIO)
 
 import qualified Foreign.Ptr as C2HSImp
@@ -23,14 +26,17 @@ import           IGraph.Mutable
 
 #include "haskell_igraph.h"
 
-full :: Graph d
+full :: forall d. SingI d
      => Int   -- ^ The number of vertices in the graph.
      -> Bool  -- ^ Whether to include self-edges (loops)
-     -> d     -- ^ U or D
-     -> LGraph d () ()
-full n hasLoop d = unsafePerformIO $ do
-    gr <- igraphFull n (isD d) hasLoop
-    unsafeFreeze $ MLGraph gr
+     -> Graph d () ()
+full n hasLoop = unsafePerformIO $ do
+    gr <- igraphFull n directed hasLoop
+    unsafeFreeze $ MGraph gr
+  where
+    directed = case fromSing (sing :: Sing d) of
+        D -> True
+        U -> False
 {#fun igraph_full as ^
     { allocaIGraph- `IGraph' addIGraphFinalizer*
     , `Int', `Bool', `Bool'
@@ -39,18 +45,21 @@ full n hasLoop d = unsafePerformIO $ do
 data ErdosRenyiModel = GNP Int Double
                      | GNM Int Int
 
-erdosRenyiGame :: Graph d
+erdosRenyiGame :: forall d. SingI d
                => ErdosRenyiModel
-               -> d     -- ^ directed
                -> Bool  -- ^ self-loop
-               -> IO (LGraph d () ())
-erdosRenyiGame (GNP n p) d self = do
-    gp <- igraphInit >> igraphErdosRenyiGame IgraphErdosRenyiGnp n p (isD d) self
-    unsafeFreeze $ MLGraph gp
-erdosRenyiGame (GNM n m) d self = do
-    gp <- igraphInit >> igraphErdosRenyiGame IgraphErdosRenyiGnm n
-        (fromIntegral m) (isD d) self
-    unsafeFreeze $ MLGraph gp
+               -> IO (Graph d () ())
+erdosRenyiGame model self = do
+    igraphInit
+    gr <- case model of
+        GNP n p -> igraphErdosRenyiGame IgraphErdosRenyiGnp n p directed self
+        GNM n m -> igraphErdosRenyiGame IgraphErdosRenyiGnm n (fromIntegral m)
+            directed self
+    unsafeFreeze $ MGraph gr
+  where
+    directed = case fromSing (sing :: Sing d) of
+        D -> True
+        U -> False
 {#fun igraph_erdos_renyi_game as ^
     { allocaIGraph- `IGraph' addIGraphFinalizer*
     , `ErdosRenyi', `Int', `Double', `Bool', `Bool'
@@ -59,24 +68,24 @@ erdosRenyiGame (GNM n m) d self = do
 -- | Generates a random graph with a given degree sequence.
 degreeSequenceGame :: [Int]   -- ^ Out degree
                    -> [Int]   -- ^ In degree
-                   -> IO (LGraph D () ())
+                   -> IO (Graph 'D () ())
 degreeSequenceGame out_deg in_deg = withList out_deg $ \out_deg' ->
     withList in_deg $ \in_deg' -> do
         gp <- igraphDegreeSequenceGame out_deg' in_deg' IgraphDegseqSimple
-        unsafeFreeze $ MLGraph gp
+        unsafeFreeze $ MGraph gp
 {#fun igraph_degree_sequence_game as ^
     { allocaIGraph- `IGraph' addIGraphFinalizer*
     , castPtr `Ptr Vector', castPtr `Ptr Vector', `Degseq'
     } -> `CInt' void- #}
 
 -- | Randomly rewires a graph while preserving the degree distribution.
-rewire :: (Graph d, Hashable v, Serialize v, Eq v, Serialize e)
+rewire :: (Hashable v, Serialize v, Eq v, Serialize e)
        => Int    -- ^ Number of rewiring trials to perform.
-       -> LGraph d v e
-       -> IO (LGraph d v e)
+       -> Graph d v e
+       -> IO (Graph d v e)
 rewire n gr = do
-    (MLGraph gptr) <- thaw gr
+    (MGraph gptr) <- thaw gr
     err <- igraphRewire gptr n IgraphRewiringSimple
     when (err /= 0) $ error "failed to rewire graph!"
-    unsafeFreeze $ MLGraph gptr
+    unsafeFreeze $ MGraph gptr
 {#fun igraph_rewire as ^ { `IGraph', `Int', `Rewiring' } -> `Int' #}

src/IGraph/Isomorphism.chs

 {-# LANGUAGE ForeignFunctionInterface #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 module IGraph.Isomorphism
     ( getSubisomorphisms
     , isomorphic
@@ -8,6 +9,7 @@ module IGraph.Isomorphism
     ) where
 
 import           System.IO.Unsafe               (unsafePerformIO)
+import Data.Singletons (SingI, Sing, sing, fromSing)
 
 import Foreign
 import Foreign.C.Types
@@ -19,9 +21,8 @@ import           IGraph.Mutable
 
 #include "haskell_igraph.h"
 
-getSubisomorphisms :: Graph d
-                   => LGraph d v1 e1  -- ^ graph to be searched in
-                   -> LGraph d v2 e2   -- ^ smaller graph
+getSubisomorphisms :: Graph d v1 e1  -- ^ graph to be searched in
+                   -> Graph d v2 e2   -- ^ smaller graph
                    -> [[Int]]
 getSubisomorphisms g1 g2 = unsafePerformIO $ allocaVectorPtr $ \vpptr -> do
     igraphGetSubisomorphismsVf2 gptr1 gptr2 nullPtr nullPtr nullPtr nullPtr vpptr
@@ -45,9 +46,8 @@ getSubisomorphisms g1 g2 = unsafePerformIO $ allocaVectorPtr $ \vpptr -> do
     } -> `CInt' void- #}
 
 -- | Determine whether two graphs are isomorphic.
-isomorphic :: Graph d
-           => LGraph d v1 e1
-           -> LGraph d v2 e2
+isomorphic :: Graph d v1 e1
+           -> Graph d v2 e2
            -> Bool
 isomorphic g1 g2 = unsafePerformIO $ alloca $ \ptr -> do
     _ <- igraphIsomorphic (_graph g1) (_graph g2) ptr
@@ -57,27 +57,32 @@ isomorphic g1 g2 = unsafePerformIO $ alloca $ \ptr -> do
 
 -- | Creates a graph from the given isomorphism class.
 -- This function is implemented only for graphs with three or four vertices.
-isoclassCreate :: Graph d
+isoclassCreate :: forall d. SingI d
                => Int   -- ^ The number of vertices to add to the graph.
                -> Int   -- ^ The isomorphism class
-               -> d
-               -> LGraph d () ()
-isoclassCreate size idx d = unsafePerformIO $ do
-    gp <- igraphInit >> igraphIsoclassCreate size idx (isD d)
-    unsafeFreeze $ MLGraph gp
+               -> Graph d () ()
+isoclassCreate size idx = unsafePerformIO $ do
+    gp <- igraphInit >> igraphIsoclassCreate size idx directed
+    unsafeFreeze $ MGraph gp
+  where
+    directed = case fromSing (sing :: Sing d) of
+        D -> True
+        U -> False
 {#fun igraph_isoclass_create as ^
     { allocaIGraph- `IGraph' addIGraphFinalizer*
     , `Int', `Int', `Bool'
     } -> `CInt' void- #}
 
-isoclass3 :: Graph d => d -> [LGraph d () ()]
-isoclass3 d = map (flip (isoclassCreate 3) d) n
+isoclass3 :: forall d. SingI d => [Graph d () ()]
+isoclass3 = map (isoclassCreate 3) (if directed then [0..15] else [0..3])
   where
-    n | isD d = [0..15]
-      | otherwise = [0..3]
+    directed = case fromSing (sing :: Sing d) of
+        D -> True
+        U -> False
 
-isoclass4 :: Graph d => d -> [LGraph d () ()]
-isoclass4 d = map (flip (isoclassCreate 4) d) n
+isoclass4 :: forall d. SingI d => [Graph d () ()]
+isoclass4 = map (isoclassCreate 4) (if directed then [0..217] else [0..10])
   where
-    n | isD d = [0..217]
-      | otherwise = [0..10]
+    directed = case fromSing (sing :: Sing d) of
+        D -> True
+        U -> False

src/IGraph/Layout.chs

@@ -61,7 +61,7 @@ defaultLGL = LGL
   where
     area x = fromIntegral $ x^2
 
-getLayout :: Graph d => LGraph d v e -> LayoutMethod -> IO [(Double, Double)]
+getLayout :: Graph d v e -> LayoutMethod -> IO [(Double, Double)]
 getLayout gr method = case method of
     KamadaKawai seed niter sigma initemp coolexp kkconst -> case seed of
         Nothing -> allocaMatrix $ \mat -> do

src/IGraph/Motif.chs

 {-# LANGUAGE ForeignFunctionInterface #-}
+{-# LANGUAGE DataKinds #-}
 module IGraph.Motif
     ( triad
     , triadCensus
@@ -32,7 +33,7 @@ import IGraph
 -- 120C: A->B->C, A<->C.
 -- 210: A->B<->C, A<->C.
 -- 300: A<->B<->C, A<->C, the complete graph.
-triad :: [LGraph D () ()]
+triad :: [Graph 'D () ()]
 triad = map make edgeList
   where
     edgeList =
@@ -53,10 +54,10 @@ triad = map make edgeList
          , [(0,1), (1,2), (2,1), (0,2), (2,0)]
          , [(0,1), (1,0), (1,2), (2,1), (0,2), (2,0)]
          ]
-    make :: [(Int, Int)] -> LGraph D () ()
+    make :: [(Int, Int)] -> Graph 'D () ()
     make xs = mkGraph (replicate 3 ()) $ zip xs $ repeat ()
 
-triadCensus :: (Hashable v, Eq v, Read v) => LGraph d v e -> [Int]
+triadCensus :: (Hashable v, Eq v, Read v) => Graph d v e -> [Int]
 triadCensus gr = unsafePerformIO $ allocaVector $ \result -> do
     igraphTriadCensus (_graph gr) result
     map truncate <$> toList result

src/IGraph/Mutable.hs

-{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE DataKinds           #-}
+{-# LANGUAGE KindSignatures      #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
 module IGraph.Mutable
     ( MGraph(..)
-    , MLGraph(..)
+    , new
+    , addNodes
+    , addLNodes
+    , delNodes
+    , addEdges
+    , addLEdges
+    , delEdges
     , setEdgeAttr
     , setNodeAttr
     )where
 
-import           Control.Monad                  (when, forM)
+import           Control.Monad                  (forM, when)
 import           Control.Monad.Primitive
 import           Data.Serialize                 (Serialize, encode)
-import           Foreign
+import           Data.Singletons.Prelude        (Sing, SingI, fromSing, sing)
+import           Foreign                        hiding (new)
 
 import           IGraph.Internal
 import           IGraph.Internal.Initialization
 import           IGraph.Types
 
 -- | Mutable labeled graph.
-newtype MLGraph m d v e = MLGraph IGraph
-
-class MGraph d where
-    -- | Create a new graph.
-    new :: PrimMonad m => Int -> m (MLGraph (PrimState m) d v e)
-
-    -- | Add nodes to the graph.
-    addNodes :: PrimMonad m
-             => Int  -- ^ The number of new nodes.
-             -> MLGraph(PrimState m) d v e -> m ()
-    addNodes n (MLGraph g) = unsafePrimToPrim $ igraphAddVertices g n nullPtr
-
-    -- | Add nodes with labels to the graph.
-    addLNodes :: (Serialize v, PrimMonad m)
-              => [v]  -- ^ vertices' labels
-              -> MLGraph (PrimState m) d v e -> m ()
-    addLNodes labels (MLGraph g) = unsafePrimToPrim $
-        withAttr vertexAttr labels $ \attr ->
-            withPtrs [attr] (igraphAddVertices g n . castPtr)
-      where
-        n = length labels
-
-    -- | Delete nodes from the graph.
-    delNodes :: PrimMonad m => [Int] -> MLGraph (PrimState m) d v e -> m ()
-    delNodes ns (MLGraph g) = unsafePrimToPrim $ withVerticesList ns $ \vs ->
-        igraphDeleteVertices g vs
-
-    -- | Add edges to the graph.
-    addEdges :: PrimMonad m => [(Int, Int)] -> MLGraph (PrimState m) d v e -> m ()
-    addEdges es (MLGraph g) = unsafePrimToPrim $ withList xs $ \vec ->
-        igraphAddEdges g vec nullPtr
-      where
-        xs = concatMap ( \(a,b) -> [a, b] ) es
-
-    -- | Add edges with labels to the graph.
-    addLEdges :: (PrimMonad m, Serialize e) => [LEdge e] -> MLGraph (PrimState m) d v e -> m ()
-    addLEdges es (MLGraph g) = unsafePrimToPrim $
-        withAttr edgeAttr vs $ \attr -> withList (concat xs) $ \vec ->
-            withPtrs [attr] (igraphAddEdges g vec . castPtr)
-      where
-        (xs, vs) = unzip $ map ( \((a,b),v) -> ([a, b], v) ) es
-
-    -- | Delete edges from the graph.
-    delEdges :: PrimMonad m => [(Int, Int)] -> MLGraph (PrimState m) d v e -> m ()
-
-instance MGraph U where
-    new n = unsafePrimToPrim $ igraphInit >>= igraphNew n False >>= return . MLGraph
-
-    delEdges es (MLGraph g) = unsafePrimToPrim $ do
-        eids <- forM es $ \(fr, to) -> igraphGetEid g fr to False True
-        withEdgeIdsList eids (igraphDeleteEdges g)
-
-instance MGraph D where
-    new n = unsafePrimToPrim $ igraphInit >>= igraphNew n True >>= return . MLGraph
-
-    delEdges es (MLGraph g) = unsafePrimToPrim $ do
-        eids <- forM es $ \(fr, to) -> igraphGetEid g fr to True True
-        withEdgeIdsList eids (igraphDeleteEdges g)
+newtype MGraph m (d :: EdgeType) v e = MGraph IGraph
+
+-- | Create a new graph.
+new :: forall m d v e. (SingI d, PrimMonad m)
+    => Int -> m (MGraph (PrimState m) d v e)
+new n = unsafePrimToPrim $ igraphInit >>= igraphNew n directed >>= return . MGraph
+  where
+    directed = case fromSing (sing :: Sing d) of
+        D -> True
+        U -> False
+
+-- | Add nodes to the graph.
+addNodes :: PrimMonad m
+         => Int  -- ^ The number of new nodes.
+         -> MGraph(PrimState m) d v e -> m ()
+addNodes n (MGraph g) = unsafePrimToPrim $ igraphAddVertices g n nullPtr
+
+-- | Add nodes with labels to the graph.
+addLNodes :: (Serialize v, PrimMonad m)
+          => [v]  -- ^ vertices' labels
+          -> MGraph (PrimState m) d v e -> m ()
+addLNodes labels (MGraph g) = unsafePrimToPrim $
+    withAttr vertexAttr labels $ \attr ->
+        withPtrs [attr] (igraphAddVertices g n . castPtr)
+  where
+    n = length labels
+
+-- | Delete nodes from the graph.
+delNodes :: PrimMonad m => [Int] -> MGraph (PrimState m) d v e -> m ()
+delNodes ns (MGraph g) = unsafePrimToPrim $ withVerticesList ns $ \vs ->
+    igraphDeleteVertices g vs
+
+-- | Add edges to the graph.
+addEdges :: PrimMonad m => [(Int, Int)] -> MGraph (PrimState m) d v e -> m ()
+addEdges es (MGraph g) = unsafePrimToPrim $ withList xs $ \vec ->
+    igraphAddEdges g vec nullPtr
+  where
+    xs = concatMap ( \(a,b) -> [a, b] ) es
+
+-- | Add edges with labels to the graph.
+addLEdges :: (PrimMonad m, Serialize e)
+          => [LEdge e] -> MGraph (PrimState m) d v e -> m ()
+addLEdges es (MGraph g) = unsafePrimToPrim $
+    withAttr edgeAttr vs $ \attr -> withList (concat xs) $ \vec ->
+        withPtrs [attr] (igraphAddEdges g vec . castPtr)
+  where
+    (xs, vs) = unzip $ map ( \((a,b),v) -> ([a, b], v) ) es
+
+-- | Delete edges from the graph.
+delEdges :: forall m d v e. (SingI d, PrimMonad m)
+         => [(Int, Int)] -> MGraph (PrimState m) d v e -> m ()
+delEdges es (MGraph g) = unsafePrimToPrim $ do
+    eids <- forM es $ \(fr, to) -> igraphGetEid g fr to directed True
+    withEdgeIdsList eids (igraphDeleteEdges g)
+  where
+    directed = case fromSing (sing :: Sing d) of
+        D -> True
+        U -> False
 
 -- | Set node attribute.
 setNodeAttr :: (PrimMonad m, Serialize v)
             => Int   -- ^ Node id
             -> v
-            -> MLGraph (PrimState m) d v e
+            -> MGraph (PrimState m) d v e
             -> m ()
-setNodeAttr nodeId x (MLGraph gr) = unsafePrimToPrim $
+setNodeAttr nodeId x (MGraph gr) = unsafePrimToPrim $
     withByteString (encode x) $ \bs -> do
         err <- igraphHaskellAttributeVASSet gr vertexAttr nodeId bs
         when (err /= 0) $ error "Fail to set node attribute!"
@@ -90,9 +100,9 @@ setNodeAttr nodeId x (MLGraph gr) = unsafePrimToPrim $
 setEdgeAttr :: (PrimMonad m, Serialize e)
             => Int   -- ^ Edge id
             -> e
-            -> MLGraph (PrimState m) d v e
+            -> MGraph (PrimState m) d v e
             -> m ()
-setEdgeAttr edgeId x (MLGraph gr) = unsafePrimToPrim $
+setEdgeAttr edgeId x (MGraph gr) = unsafePrimToPrim $
     withByteString (encode x) $ \bs -> do
         err <- igraphHaskellAttributeEASSet gr edgeAttr edgeId bs
         when (err /= 0) $ error "Fail to set edge attribute!"

src/IGraph/Read.hs

@@ -4,20 +4,21 @@ module IGraph.Read
     , readAdjMatrixWeighted
     ) where
 
-import qualified Data.ByteString.Char8 as B
-import Data.ByteString.Lex.Fractional (readSigned, readExponential)
-import Data.Maybe (fromJust)
+import qualified Data.ByteString.Char8          as B
+import           Data.ByteString.Lex.Fractional (readExponential, readSigned)
+import           Data.Maybe                     (fromJust)
+import           Data.Singletons                (SingI)
 
-import IGraph
+import           IGraph
 
 readDouble :: B.ByteString -> Double
 readDouble = fst . fromJust . readSigned readExponential
 {-# INLINE readDouble #-}
 
-readAdjMatrix :: Graph d => FilePath -> IO (LGraph d B.ByteString ())
+readAdjMatrix :: SingI d => FilePath -> IO (Graph d B.ByteString ())
 readAdjMatrix = fmap fromAdjMatrix . B.readFile
 
-fromAdjMatrix :: Graph d => B.ByteString -> LGraph d B.ByteString ()
+fromAdjMatrix :: SingI d => B.ByteString -> Graph d B.ByteString ()
 fromAdjMatrix bs =
     let (header:xs) = B.lines bs
         mat = map (map readDouble . B.words) xs
@@ -31,7 +32,7 @@ fromAdjMatrix bs =
     f ((i,j),v) = i < j && v /= 0
 {-# INLINE fromAdjMatrix #-}
 
-readAdjMatrixWeighted :: Graph d => FilePath -> IO (LGraph d B.ByteString Double)
+readAdjMatrixWeighted :: SingI d => FilePath -> IO (Graph d B.ByteString Double)
 readAdjMatrixWeighted fl = do
     c <- B.readFile fl
     let (header:xs) = B.lines c

src/IGraph/Structure.chs

@@ -15,6 +15,7 @@ import qualified Data.HashMap.Strict       as M
 import           Data.Serialize            (Serialize, decode)
 import           System.IO.Unsafe          (unsafePerformIO)
 import Data.Maybe
+import Data.Singletons (SingI)
 
 import Foreign
 import Foreign.C.Types
@@ -26,14 +27,14 @@ import           IGraph.Mutable
 
 #include "igraph/igraph.h"
 
-inducedSubgraph :: (Hashable v, Eq v, Serialize v) => LGraph d v e -> [Int] -> LGraph d v e
+inducedSubgraph :: (Hashable v, Eq v, Serialize v) => Graph d v e -> [Int] -> Graph d v e
 inducedSubgraph gr nds = unsafePerformIO $ withVerticesList nds $ \vs ->
     igraphInducedSubgraph (_graph gr) vs IgraphSubgraphCreateFromScratch >>=
-        unsafeFreeze . MLGraph
+        unsafeFreeze . MGraph
 
 -- | Closeness centrality
 closeness :: [Int]  -- ^ vertices
-          -> LGraph d v e
+          -> Graph d v e
           -> Maybe [Double]  -- ^ optional edge weights
           -> Neimode
           -> Bool   -- ^ whether to normalize
@@ -45,7 +46,7 @@ closeness nds gr ws mode normal = unsafePerformIO $ allocaVector $ \result ->
 
 -- | Betweenness centrality
 betweenness :: [Int]
-            -> LGraph d v e
+            -> Graph d v e
             -> Maybe [Double]
             -> [Double]
 betweenness nds gr ws = unsafePerformIO $ allocaVector $ \result ->
@@ -54,7 +55,7 @@ betweenness nds gr ws = unsafePerformIO $ allocaVector $ \result ->
         toList result
 
 -- | Eigenvector centrality
-eigenvectorCentrality :: LGraph d v e
+eigenvectorCentrality :: Graph d v e
                       -> Maybe [Double]
                       -> [Double]
 eigenvectorCentrality gr ws = unsafePerformIO $ allocaArpackOpt $ \arparck ->
@@ -63,8 +64,8 @@ eigenvectorCentrality gr ws = unsafePerformIO $ allocaArpackOpt $ \arparck ->
         toList result
 
 -- | Google's PageRank
-pagerank :: Graph d
-         => LGraph d v e
+pagerank :: SingI d
+         => Graph d v e
          -> Maybe [Double]  -- ^ edge weights
          -> Double  -- ^ damping factor, usually around 0.85
          -> [Double]
@@ -81,8 +82,8 @@ pagerank gr ws d
     m = nEdges gr
 
 -- | Personalized PageRank.
-personalizedPagerank :: Graph d
-                     => LGraph d v e
+personalizedPagerank :: SingI d
+                     => Graph d v e
                      -> [Double]   -- ^ reset probability
                      -> Maybe [Double]
                      -> Double

src/IGraph/Types.hs

+{-# LANGUAGE DataKinds              #-}
+{-# LANGUAGE EmptyCase              #-}
+{-# LANGUAGE FlexibleContexts       #-}
+{-# LANGUAGE FlexibleInstances      #-}
+{-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE GADTs                  #-}
+{-# LANGUAGE InstanceSigs           #-}
+{-# LANGUAGE MultiParamTypeClasses  #-}
+{-# LANGUAGE ScopedTypeVariables    #-}
+{-# LANGUAGE StandaloneDeriving     #-}
+{-# LANGUAGE TemplateHaskell        #-}
+{-# LANGUAGE TypeFamilies           #-}
+{-# LANGUAGE TypeOperators          #-}
+{-# LANGUAGE UndecidableInstances   #-}
 
 module IGraph.Types where
 
+import           Data.Singletons.Prelude
+import           Data.Singletons.TH
+
+$(singletons [d|
+    data EdgeType = D
+                  | U
+        deriving (Show, Read, Eq)
+    |])
+
 type Node = Int
 type LNode a = (Node, a)
 
 type Edge = (Node, Node)
 type LEdge a = (Edge, a)
 
--- | Undirected graph.
-data U
-
--- | Directed graph.
-data D
-
 vertexAttr :: String
 vertexAttr = "vertex_attribute"
 

tests/Test/Attributes.hs

+{-# LANGUAGE DataKinds #-}
 module Test.Attributes
     ( tests
     ) where
@@ -31,14 +32,14 @@ tests = testGroup "Attribute tests"
 nodeLabelTest :: TestTree
 nodeLabelTest = testCase "node label test" $ do
     let ns = sort $ map show [38..7000]
-        gr = mkGraph ns [] :: LGraph D String ()
+        gr = mkGraph ns [] :: Graph 'D String ()
     assertBool "" $ sort (map (nodeLab gr) $ nodes gr) == ns
 
 labelTest :: TestTree
 labelTest = testCase "edge label test" $ do
     dat <- randEdges 1000 10000
     let es = sort $ zipWith (\a b -> (a,b)) dat $ map show [1..]
-        gr = fromLabeledEdges es :: LGraph D Int String
+        gr = fromLabeledEdges es :: Graph 'D Int String
         es' = sort $ map (\(a,b) -> ((nodeLab gr a, nodeLab gr b), edgeLab gr (a,b))) $ edges gr
     assertBool "" $ es == es'
 
@@ -48,8 +49,8 @@ serializeTest = testCase "serialize test" $ do
     let es = map ( \(a, b) -> (
             ( defaultNodeAttributes{_nodeZindex=a}
             , defaultNodeAttributes{_nodeZindex=b}), defaultEdgeAttributes) ) dat
-        gr = fromLabeledEdges es :: LGraph D NodeAttr EdgeAttr
-        gr' :: LGraph D NodeAttr EdgeAttr
+        gr = fromLabeledEdges es :: Graph 'D NodeAttr EdgeAttr
+        gr' :: Graph 'D NodeAttr EdgeAttr
         gr' = case decode $ encode gr of
             Left msg -> error msg
             Right r  -> r

tests/Test/Basic.hs

+{-# LANGUAGE DataKinds #-}
 module Test.Basic
     ( tests
     ) where
@@ -33,8 +34,8 @@ graphCreation = testGroup "Graph creation"
   where
     edgeList = sort $ unsafePerformIO $ randEdges 1000 100
     m = length edgeList
-    gr = mkGraph (replicate 100 ()) $ zip edgeList $ repeat () :: LGraph D () ()
-    simple = mkGraph (replicate 3 ()) $ zip [(0,1),(1,2),(2,0)] $ repeat () :: LGraph D () ()
+    gr = mkGraph (replicate 100 ()) $ zip edgeList $ repeat () :: Graph 'D () ()
+    simple = mkGraph (replicate 3 ()) $ zip [(0,1),(1,2),(2,0)] $ repeat () :: Graph 'D () ()
 
 graphCreationLabeled :: TestTree
 graphCreationLabeled = testGroup "Graph creation -- with labels"
@@ -49,14 +50,14 @@ graphCreationLabeled = testGroup "Graph creation -- with labels"
         randEdges 10000 1000) $ repeat 1
     n = length $ nubSort $ concatMap (\((a,b),_) -> [a,b]) edgeList
     m = length edgeList
-    gr = fromLabeledEdges edgeList :: LGraph D String Int
-    gr' = unsafePerformIO $ fromLabeledEdges' edgeList yieldMany :: LGraph D String Int
+    gr = fromLabeledEdges edgeList :: Graph 'D String Int
+    gr' = unsafePerformIO $ fromLabeledEdges' edgeList yieldMany :: Graph 'D String Int
 
 graphEdit :: TestTree
 graphEdit = testGroup "Graph editing"
     [ testCase "" $ [(1,2)] @=? (sort $ edges simple') ]
   where
-    simple = mkGraph (replicate 3 ()) $ zip [(0,1),(1,2),(2,0)] $ repeat () :: LGraph U () ()
+    simple = mkGraph (replicate 3 ()) $ zip [(0,1),(1,2),(2,0)] $ repeat () :: Graph 'U () ()
     simple' = runST $ do
         g <- thaw simple
         delEdges [(0,1),(0,2)] g

tests/Test/Structure.hs

+{-# LANGUAGE DataKinds #-}
 module Test.Structure
     ( tests
     ) where
@@ -27,7 +28,7 @@ subGraphs = testGroup "generate induced subgraphs"
             , ["a","c"], [("a","c"), ("c","a")] )
     test (ori,ns,expect) = sort expect @=? sort result
       where
-        gr = fromLabeledEdges $ zip ori $ repeat () :: LGraph D String ()
+        gr = fromLabeledEdges $ zip ori $ repeat () :: Graph 'D String ()
         ns' = map (head . getNodes gr) ns
         gr' = inducedSubgraph gr ns'
         result = map (nodeLab gr' *** nodeLab gr') $ edges gr'