Dagoba

0-README.md

Attempting to port the examples in http://www.aosabook.org/en/500L/dagoba-an-in-memory-graph-database.html to Haskell

NOTE: This has been moved to a repo proper.

Notes

1. If I were better at Lens, it would probably make this much shorter. Alas.

2. The "Graph", once I was done implementing all the way to Example, only needed to be a map of { Id: Vertex a } (where a is whatever data you care about). So I ripped out the Arrays and simplified the pointers from the JavaScript version. A lack of mutability actually forced me to this (IMO better) direction, FWIW.

3. The vertices can be traversed by their edges and those edge's Id pointers. And so a "Query" is just a monadic building up of results while traversing. Again, I feel Lens (well, Prisms) would fit really well here, but I don't know them.

4. All discussion of non-strict semantics and the related machinery is unneeded; the accumlated results are lazy so there's no need to implement all the pipetype or gremlin stuff to get the needed non-strict semantics.

5. I'm pretty sure layering in the filter, map, and alias stuff will be trivial, so I might not even do it:

   -- Transformations
   mapQ = modify . map
   
   filterQ pred = modify $ filter pred
   
   -- Aliases
   parents = out
   
   grandParents = out >> out

6. I find the in/out terminology very confusing and error-prone, I wonder if the type system can help here. If you aren't careful, you can easily introduce a logic error without the type-checker noticing (because a result of following "in" vs "out" would still be the right type, even if it was the wrong direction).

1-Elements.hs

module Dagoba.Elements
    ( Id
    , Vertex(..)
    , vertex
    , Edge(..)
    , to
    ) where

type Id = Int

data Vertex a = Vertex
    { vId :: Id
    , vValue :: a
    , vIn :: [Edge]
    , vOut :: [Edge]
    }

vertex :: Id -> a -> Vertex a
vertex i a = Vertex i a [] []

instance Show a => Show (Vertex a) where
    show v = "{ " ++ show (vValue v) ++ " }"

data Edge = Edge
    { eIn :: Id
    , eOut :: Id
    }

-- Instead of saying "Edge 1 2", we can say "1 `to` 2"
to :: Id -> Id -> Edge
to = Edge

2-Graph.hs

module Dagoba.Graph
    ( Graph
    , empty
    , findVertextById
    , filterVertices
    , addVertices
    , addEdges
    ) where

import Dagoba.Elements

import Data.Maybe (fromMaybe)

import qualified Data.Map as M

newtype Graph a = Graph { gVerticesById :: M.Map Id (Vertex a) }

empty :: Graph a
empty = Graph M.empty

findVertextById :: Graph a -> Id -> Maybe (Vertex a)
findVertextById g i = M.lookup i $ gVerticesById g

filterVertices :: (a -> Bool) -> Graph a -> [Vertex a]
filterVertices pred = M.elems . M.filter (pred . vValue) . gVerticesById

addVertices :: [Vertex a] -> Graph a -> Graph a
addVertices = flip $ foldr addVertex

addEdges :: [Edge] -> Graph a -> Graph a
addEdges = flip $ foldr addEdge

-- N.B. clobbers existing values
addVertex :: Vertex a -> Graph a -> Graph a
addVertex v g = g { gVerticesById = M.insert (vId v) v $ gVerticesById g }

-- Returns graph as-is if identified vertices are not present
addEdge :: Edge -> Graph a -> Graph a
addEdge e@(Edge i o) g = fromMaybe g $ do
    evi <- findVertextById g i
    evo <- findVertextById g o

    let vertices =
            [ evi { vIn = e : vIn evi }
            , evo { vOut = e : vOut evo }
            ]

    return $ addVertices vertices g

3-Query.hs

module Dagoba.Query
    ( Query
    , runQuery
    , val
    , out
    , in_
    ) where

import Dagoba.Elements
import Dagoba.Graph

import Control.Monad.Trans.Class
import Control.Monad.Trans.Reader
import Control.Monad.Trans.State
import Data.Maybe (mapMaybe)

-- | The Query Monad
--
-- Each query action can read and write the current (lazy) results, or ask for
-- the original graph.
--
type Query a = StateT [Vertex a] (Reader (Graph a)) ()

-- | Run a query on a graph for the results
runQuery :: Graph a -> Query a -> [Vertex a]
runQuery g f = runReader (execStateT f []) g

-- | Begin a query on the given vertex
val :: Eq a => a -> Query a
val a = put . filterVertices (== a) =<< lift ask

-- | Update results to those vertices with edges pointed at us
out :: Query a
out = followEdges vOut eIn

-- | Update results to those vertices to which our edges point
--
-- N.B. "in" is a keyword, unfortunately
--
in_ :: Query a
in_ = followEdges vIn eOut

followEdges :: (Vertex a -> [Edge]) -> (Edge -> Id) -> Query a
followEdges fv fe = do
    g <- lift ask
    modify $ mapMaybe (findVertextById g . fe) . concatMap fv

4-Example.hs

module Main where

import Dagoba.Elements
import Dagoba.Graph
import Dagoba.Query

import Data.Function ((&))

main :: IO ()
main = do
    -- parents: [Mom, Dad]
    print $ runQuery graph $ do
        val "Me"
        out

    -- children: [Bro, Me]
    print $ runQuery graph $ do
        val "Mom"
        in_

    -- siblings: [Bro, Me, Bro, Me]
    print $ runQuery graph $ do
        val "Me"
        out
        in_

    -- cousins: [Cuz, Bro, Me]
    print $ runQuery graph $ do
        val "Me"
        out
        out
        in_
        in_

graph :: Graph String
graph = empty
    & addVertices
        [ vertex 1 "Me"
        , vertex 2 "Mom"
        , vertex 3 "Dad"
        , vertex 4 "Bro"
        , vertex 5 "Uncle"
        , vertex 6 "Cuz"
        , vertex 7 "Gran"
        ]
    & addEdges
        [ 2 `to` 1 -- The rents to me
        , 3 `to` 1
        , 2 `to` 4 -- The rents to my brother
        , 3 `to` 4
        , 7 `to` 2 -- Gran to my mom and her brother
        , 7 `to` 5
        , 5 `to` 6 -- My uncle's kid
        ]