{-# LANGUAGE CPP, TypeFamilies, FlexibleContexts #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Data.Graph.Adjacency.Matrix
-- 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.AdjacencyMatrix
  ( AdjacencyMatrix(..)
  , AdjacencyMatrixGraph
  , ask
  ) where

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

newtype AdjacencyMatrix arr i a = AdjacencyMatrix { AdjacencyMatrix arr i a -> arr (i, i) Bool -> a
runAdjacencyMatrix :: arr (i,i) Bool -> a }

ask :: AdjacencyMatrix arr i (arr (i, i) Bool)
ask :: AdjacencyMatrix arr i (arr (i, i) Bool)
ask = (arr (i, i) Bool -> arr (i, i) Bool)
-> AdjacencyMatrix arr i (arr (i, i) Bool)
forall (arr :: * -> * -> *) i a.
(arr (i, i) Bool -> a) -> AdjacencyMatrix arr i a
AdjacencyMatrix arr (i, i) Bool -> arr (i, i) Bool
forall a. a -> a
id

instance Functor (AdjacencyMatrix arr i) where
  fmap :: (a -> b) -> AdjacencyMatrix arr i a -> AdjacencyMatrix arr i b
fmap a -> b
f (AdjacencyMatrix arr (i, i) Bool -> a
g) = (arr (i, i) Bool -> b) -> AdjacencyMatrix arr i b
forall (arr :: * -> * -> *) i a.
(arr (i, i) Bool -> a) -> AdjacencyMatrix arr i a
AdjacencyMatrix (a -> b
f (a -> b) -> (arr (i, i) Bool -> a) -> arr (i, i) Bool -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. arr (i, i) Bool -> a
g)
  a
b <$ :: a -> AdjacencyMatrix arr i b -> AdjacencyMatrix arr i a
<$ AdjacencyMatrix arr i b
_ = a -> AdjacencyMatrix arr i a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
b

instance Applicative (AdjacencyMatrix arr i) where
  pure :: a -> AdjacencyMatrix arr i a
pure = (arr (i, i) Bool -> a) -> AdjacencyMatrix arr i a
forall (arr :: * -> * -> *) i a.
(arr (i, i) Bool -> a) -> AdjacencyMatrix arr i a
AdjacencyMatrix ((arr (i, i) Bool -> a) -> AdjacencyMatrix arr i a)
-> (a -> arr (i, i) Bool -> a) -> a -> AdjacencyMatrix arr i a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> arr (i, i) Bool -> a
forall a b. a -> b -> a
const
  AdjacencyMatrix arr (i, i) Bool -> a -> b
f <*> :: AdjacencyMatrix arr i (a -> b)
-> AdjacencyMatrix arr i a -> AdjacencyMatrix arr i b
<*> AdjacencyMatrix arr (i, i) Bool -> a
a = (arr (i, i) Bool -> b) -> AdjacencyMatrix arr i b
forall (arr :: * -> * -> *) i a.
(arr (i, i) Bool -> a) -> AdjacencyMatrix arr i a
AdjacencyMatrix ((arr (i, i) Bool -> b) -> AdjacencyMatrix arr i b)
-> (arr (i, i) Bool -> b) -> AdjacencyMatrix arr i b
forall a b. (a -> b) -> a -> b
$ \arr (i, i) Bool
t -> arr (i, i) Bool -> a -> b
f arr (i, i) Bool
t (arr (i, i) Bool -> a
a arr (i, i) Bool
t)

instance Monad (AdjacencyMatrix arr i) where
#if !(MIN_VERSION_base(4,11,0))
  return = AdjacencyMatrix . const
#endif
  AdjacencyMatrix arr (i, i) Bool -> a
f >>= :: AdjacencyMatrix arr i a
-> (a -> AdjacencyMatrix arr i b) -> AdjacencyMatrix arr i b
>>= a -> AdjacencyMatrix arr i b
k = (arr (i, i) Bool -> b) -> AdjacencyMatrix arr i b
forall (arr :: * -> * -> *) i a.
(arr (i, i) Bool -> a) -> AdjacencyMatrix arr i a
AdjacencyMatrix ((arr (i, i) Bool -> b) -> AdjacencyMatrix arr i b)
-> (arr (i, i) Bool -> b) -> AdjacencyMatrix arr i b
forall a b. (a -> b) -> a -> b
$ \arr (i, i) Bool
t -> AdjacencyMatrix arr i b -> arr (i, i) Bool -> b
forall (arr :: * -> * -> *) i a.
AdjacencyMatrix arr i a -> arr (i, i) Bool -> a
runAdjacencyMatrix (a -> AdjacencyMatrix arr i b
k (arr (i, i) Bool -> a
f arr (i, i) Bool
t)) arr (i, i) Bool
t

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

instance (IArray arr Bool, Ix i) => AdjacencyMatrixGraph (AdjacencyMatrix arr i) where
  edge :: Vertex (AdjacencyMatrix arr i)
-> Vertex (AdjacencyMatrix arr i)
-> AdjacencyMatrix arr i (Maybe (Edge (AdjacencyMatrix arr i)))
edge Vertex (AdjacencyMatrix arr i)
i Vertex (AdjacencyMatrix arr i)
j = (arr (i, i) Bool -> Maybe (i, i))
-> AdjacencyMatrix arr i (Maybe (i, i))
forall (arr :: * -> * -> *) i a.
(arr (i, i) Bool -> a) -> AdjacencyMatrix arr i a
AdjacencyMatrix ((arr (i, i) Bool -> Maybe (i, i))
 -> AdjacencyMatrix arr i (Maybe (i, i)))
-> (arr (i, i) Bool -> Maybe (i, i))
-> AdjacencyMatrix arr i (Maybe (i, i))
forall a b. (a -> b) -> a -> b
$ \arr (i, i) Bool
a ->
    if ((i, i), (i, i)) -> (i, i) -> Bool
forall a. Ix a => (a, a) -> a -> Bool
inRange (arr (i, i) Bool -> ((i, i), (i, i))
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> (i, i)
bounds arr (i, i) Bool
a) (i, i)
ix Bool -> Bool -> Bool
&& (arr (i, i) Bool
a arr (i, i) Bool -> (i, i) -> Bool
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! (i, i)
ix)
    then (i, i) -> Maybe (i, i)
forall a. a -> Maybe a
Just (i, i)
ix
    else Maybe (i, i)
forall a. Maybe a
Nothing
    where ix :: (i, i)
ix = (i
Vertex (AdjacencyMatrix arr i)
i, i
Vertex (AdjacencyMatrix arr i)
j)