{-# LANGUAGE CPP, TypeFamilies, FlexibleContexts #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Data.Graph.Adjacency.List
-- Copyright   :  (C) 2011 Edward Kmett
-- License     :  BSD-style (see the file LICENSE)
--
-- Maintainer  :  Edward Kmett <ekmett@gmail.com>
-- Stability   :  experimental
-- Portability :  type families
--
----------------------------------------------------------------------------

module Data.Graph.AdjacencyList
  ( AdjacencyList(..)
  , AdjacencyListGraph
  , ask
  ) where

#if __GLASGOW_HASKELL__ < 710
import Control.Applicative
#endif
import Data.Ix
import Data.Array
import Data.Graph.PropertyMap
import Data.Graph.Class
import Data.Graph.Class.AdjacencyList

newtype AdjacencyList i a = AdjacencyList { AdjacencyList i a -> Array i [i] -> a
runAdjacencyList :: Array i [i] -> a }

ask :: AdjacencyList i (Array i [i])
ask :: AdjacencyList i (Array i [i])
ask = (Array i [i] -> Array i [i]) -> AdjacencyList i (Array i [i])
forall i a. (Array i [i] -> a) -> AdjacencyList i a
AdjacencyList Array i [i] -> Array i [i]
forall a. a -> a
id

instance Functor (AdjacencyList i) where
  fmap :: (a -> b) -> AdjacencyList i a -> AdjacencyList i b
fmap a -> b
f (AdjacencyList Array i [i] -> a
g) = (Array i [i] -> b) -> AdjacencyList i b
forall i a. (Array i [i] -> a) -> AdjacencyList i a
AdjacencyList (a -> b
f (a -> b) -> (Array i [i] -> a) -> Array i [i] -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Array i [i] -> a
g)
  a
b <$ :: a -> AdjacencyList i b -> AdjacencyList i a
<$ AdjacencyList i b
_ = a -> AdjacencyList i a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
b

instance Applicative (AdjacencyList i) where
  pure :: a -> AdjacencyList i a
pure = (Array i [i] -> a) -> AdjacencyList i a
forall i a. (Array i [i] -> a) -> AdjacencyList i a
AdjacencyList ((Array i [i] -> a) -> AdjacencyList i a)
-> (a -> Array i [i] -> a) -> a -> AdjacencyList i a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Array i [i] -> a
forall a b. a -> b -> a
const
  AdjacencyList Array i [i] -> a -> b
f <*> :: AdjacencyList i (a -> b) -> AdjacencyList i a -> AdjacencyList i b
<*> AdjacencyList Array i [i] -> a
a = (Array i [i] -> b) -> AdjacencyList i b
forall i a. (Array i [i] -> a) -> AdjacencyList i a
AdjacencyList ((Array i [i] -> b) -> AdjacencyList i b)
-> (Array i [i] -> b) -> AdjacencyList i b
forall a b. (a -> b) -> a -> b
$ \Array i [i]
t -> Array i [i] -> a -> b
f Array i [i]
t (Array i [i] -> a
a Array i [i]
t)

instance Monad (AdjacencyList i) where
#if !(MIN_VERSION_base(4,11,0))
  return = AdjacencyList . const
#endif
  AdjacencyList Array i [i] -> a
f >>= :: AdjacencyList i a -> (a -> AdjacencyList i b) -> AdjacencyList i b
>>= a -> AdjacencyList i b
k = (Array i [i] -> b) -> AdjacencyList i b
forall i a. (Array i [i] -> a) -> AdjacencyList i a
AdjacencyList ((Array i [i] -> b) -> AdjacencyList i b)
-> (Array i [i] -> b) -> AdjacencyList i b
forall a b. (a -> b) -> a -> b
$ \Array i [i]
t -> AdjacencyList i b -> Array i [i] -> b
forall i a. AdjacencyList i a -> Array i [i] -> a
runAdjacencyList (a -> AdjacencyList i b
k (Array i [i] -> a
f Array i [i]
t)) Array i [i]
t

instance Ord i => Graph (AdjacencyList i) where
  type Vertex (AdjacencyList i) = i
  type Edge (AdjacencyList i) = (i, i)
  vertexMap :: a -> AdjacencyList i (VertexMap (AdjacencyList i) a)
vertexMap = PropertyMap (AdjacencyList i) i a
-> AdjacencyList i (PropertyMap (AdjacencyList i) i a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PropertyMap (AdjacencyList i) i a
 -> AdjacencyList i (PropertyMap (AdjacencyList i) i a))
-> (a -> PropertyMap (AdjacencyList i) i a)
-> a
-> AdjacencyList i (PropertyMap (AdjacencyList i) i a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> PropertyMap (AdjacencyList i) i a
forall (m :: * -> *) k v.
(Monad m, Ord k) =>
v -> PropertyMap m k v
propertyMap
  edgeMap :: a -> AdjacencyList i (EdgeMap (AdjacencyList i) a)
edgeMap = PropertyMap (AdjacencyList i) (i, i) a
-> AdjacencyList i (PropertyMap (AdjacencyList i) (i, i) a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PropertyMap (AdjacencyList i) (i, i) a
 -> AdjacencyList i (PropertyMap (AdjacencyList i) (i, i) a))
-> (a -> PropertyMap (AdjacencyList i) (i, i) a)
-> a
-> AdjacencyList i (PropertyMap (AdjacencyList i) (i, i) a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> PropertyMap (AdjacencyList i) (i, i) a
forall (m :: * -> *) k v.
(Monad m, Ord k) =>
v -> PropertyMap m k v
propertyMap

instance Ix i => AdjacencyListGraph (AdjacencyList i) where
  adjacentVertices :: Vertex (AdjacencyList i)
-> AdjacencyList i [Vertex (AdjacencyList i)]
adjacentVertices Vertex (AdjacencyList i)
v = (Array i [i] -> [i]) -> AdjacencyList i [i]
forall i a. (Array i [i] -> a) -> AdjacencyList i a
AdjacencyList ((Array i [i] -> [i]) -> AdjacencyList i [i])
-> (Array i [i] -> [i]) -> AdjacencyList i [i]
forall a b. (a -> b) -> a -> b
$ \Array i [i]
g -> if (i, i) -> i -> Bool
forall a. Ix a => (a, a) -> a -> Bool
inRange (Array i [i] -> (i, i)
forall i e. Array i e -> (i, i)
bounds Array i [i]
g) i
Vertex (AdjacencyList i)
v
                                     then Array i [i]
g Array i [i] -> i -> [i]
forall i e. Ix i => Array i e -> i -> e
! i
Vertex (AdjacencyList i)
v
                                     else []
  source :: Edge (AdjacencyList i)
-> AdjacencyList i (Vertex (AdjacencyList i))
source (a, _) = i -> AdjacencyList i i
forall (f :: * -> *) a. Applicative f => a -> f a
pure i
a
  target :: Edge (AdjacencyList i)
-> AdjacencyList i (Vertex (AdjacencyList i))
target (_, b) = i -> AdjacencyList i i
forall (f :: * -> *) a. Applicative f => a -> f a
pure i
b
  outEdges :: Vertex (AdjacencyList i)
-> AdjacencyList i [Edge (AdjacencyList i)]
outEdges = Vertex (AdjacencyList i)
-> AdjacencyList i [Edge (AdjacencyList i)]
forall (g :: * -> *).
AdjacencyListGraph g =>
Vertex g -> g [(Vertex g, Vertex g)]
defaultOutEdges