{- Assignment #1: Labeled Digraph ADT, Using Haskell Maps
   CSci 556: Multiparadigm Programming, Spring 2015
   H. Conrad Cunningham, Professor
   Computer and Information Science
   University of Mississippi

1234567890123456789012345678901234567890123456789012345678901234567890

2015-02-04: Began development from List version
2015-02-05: Completed prototype Map-based implementation;
            partial testing

-}

module DigraphADT_Map
  ( Digraph,        -- constrain ops (Ord a, Show a, Eq b, Show b,
                    --                Eq c, Show c) 
    new_graph,      -- Digraph a b c
    is_empty,       -- Digraph a b c -> Bool
    add_vertex,     -- Digraph a b c -> a -> b -> Digraph a b c
    remove_vertex,  -- Digraph a b c -> a -> Digraph a b c
    update_vertex,  -- Digraph a b c -> a -> b -> Digraph a b c
    get_vertex,     -- Digraph a b c -> a -> b
    has_vertex,     -- Digraph a b c -> a -> Bool
    add_edge,       -- Digraph a b c -> a -> a -> c -> Digraph a b c
    remove_edge,    -- Digraph a b c -> a -> a -> Digraph a b c
    update_edge,    -- Digraph a b c -> a -> a -> c -> Digraph a b c
    get_edge,       -- Digraph a b c -> a -> a -> c
    has_edge,       -- Digraph a b c -> a -> a -> Bool
    all_vertices,   -- Digraph a b c -> [a]
    from_edges,     -- Digraph a b c -> a -> [a]
    all_vertices_labels,-- Digraph a b c -> [(a,b)]
    from_edges_labels   -- Digraph a b c -> a -> [(a,c)
  )
where

{- SPECIFICATION OF LABELED DIGRAPH ADT

See the specification of the Labeled Digraph ADT in the file with the
List-based implementation.  The spec includes the description of the
abstract model and the Interface Invariant plus the preconditions and
postconditions (which are also repeated along with operations below.

-}

{- MAP IMPLEMENTATION OF LABELED DIGRAPH ADT

** Type Parameters **

    VertexType is an instance of Haskell classes Ord and Show (i.e.,
    can be compared and also converted to strings)

    VertexLabelType is an instance of Haskell classes Eq and Show.

    EdgeLabelType is an instance of Haskell classes Eq and Show.

Note: In the List version of this ADT, VertexType is required to be in
classes Show and Eq (instead of Ord). The two label types did not
require Eq.  However, the use of the Map module for implementation
in this version requires the new type constraints.

** Labeled Digraph Representation **

This implementation represents a labeled digraph as an instance of the
Haskell algebraic data type Digraph, in particular data constructor
(Graph m), where m is from the Data.Map.Strict collection.  (This
collection is implemented as a balanced tree.)

An instance of (Graph m) corresponds to the abstract model as follows:

    The keys for Map m are from VertexLabelType.

    Map m is defined for all keys v1 in vertex set V and undefined for
    all other keys.

    For some vertex v1, the value of m at key v1 is a pair (l,es) 
    where
        - l is an element of VertexLabelType and is the unique label
          associated with v1, that is, l = VL(v1).

        - es is the list of all tuples (v2,el) such that
          (v1,v2) IN E, el IN EdgeLabelType, and el = EL((v1,v2)).
          That is, (v1,v2) is an edge and el is its unique label.

** Implementation Invariant **

    Any Haskell Digraph value (Graph m) with abstract model
    G = (V,E,VL,EL), appearing in either the arguments or return
    value of an operation, must also satisfy the following:

        (ForAll v1, l, es :: 
            ( m(v1) defined && m(v1) == (l,es) ) <=> 
            ( VL(v1) == l && 
                (ForAll v2, el :: (v2,el) IN es <=> 
                                  EL((v1,v2)) == el) ) )

-}

import qualified Data.Map.Strict as M

data Digraph a b c = Graph (M.Map a (b,[(a,c)]))

instance (Show a, Show b, Show c) => Show (Digraph a b c) where
    show (Graph m) = "(Digraph " ++ show (M.toAscList m) ++ ")"

{- new_graph creates and returns a new instance of the graph ADT.

   Pre:  True
   Post: G(Result) == ({},{},{},{})
-}

new_graph :: (Ord a, Show a, Eq b, Show b, Eq c, Show c) =>
                 Digraph a b c
new_graph = Graph M.empty


{- is_empty g returns true if and only if graph g is empty.

   Pre:  G(g) = (V,E,VL,EL)
   Post: Result == (V == {} && E == {}) 
-}

is_empty :: (Ord a, Show a, Eq b, Show b, Eq c, Show c) =>
                Digraph a b c -> Bool
is_empty (Graph m) = (M.size m == 0)


{- add_vertex g nv nl inserts vertex nv with label nl into graph g and
   returns the resulting graph.

   Pre:  G(g) = (V,E,VL,EL) && nv NOT_IN V 
   Post: G(Result) == (V UNION {nv}, E, VL UNION {(nv,nl)}, EL)
-}

add_vertex :: (Ord a, Show a, Eq b, Show b, Eq c, Show c) =>
                  Digraph a b c -> a -> b -> Digraph a b c
add_vertex g@(Graph m) nv nl
    | not (has_vertex g nv) = Graph (M.insert nv (nl,[]) m)
    | otherwise             = error has_nv
    where has_nv = "Vertex " ++ show nv ++ " already in digraph"


{- remove_vertex g ov deletes vertex ov from graph g and returns the
   resulting graph.

   Pre:  G(g) =  (V,E,VL,EL) && ov IN V
   Post: G(Result) == (V', E', VL', EL')
         where V'  = V  - {ov}
               E'  = E  - {(ov,*),(*,ov)}
               VL' = VL - {(ov,*)}
               EL' = EL - {((ov,*),*),((*,ov),*)}
-}

remove_vertex :: (Ord a, Show a, Eq b, Show b, Eq c, Show c) =>
                     Digraph a b c -> a -> Digraph a b c
remove_vertex g@(Graph m) ov
    | has_vertex g ov = Graph (M.delete ov m)
    | otherwise       = error no_ov
    where no_ov = "Vertex " ++ show ov ++ " not in digraph"


{- update_vertex g ov nl changes the label on vertex ov in graph g to
   be nl and returns the resulting graph.

   Pre:  G(g) =  (V,E,VL,EL) && ov IN V
   Post: G(Result) == (V - {ov}, E, VL', EL)
         where VL' = (VL - {(ov,VL(ov))}) UNION {(ov,nl)}
-}

update_vertex :: (Ord a, Show a, Eq b, Show b, Eq c, Show c) =>
                     Digraph a b c -> a -> b -> Digraph a b c
update_vertex g@(Graph m) ov nl
    | has_vertex g ov = Graph (M.insert ov (upd (M.lookup ov m)) m)
    | otherwise       = error no_ov
    where upd (Just (ol,edges)) = (nl,edges)
          upd _                 = error no_entry
          no_ov    = "Vertex " ++ show ov ++ " not in digraph"
          no_entry = "Missing/malformed value for vertex " ++ show ov

{- get_vertex g ov returns the label from vertex ov in graph g

   Pre:   G(g) = (V,E,VL,EL) && ov IN V
   Post:  Result == VL(ov)
-}

get_vertex :: (Ord a, Show a, Eq b, Show b, Eq c, Show c) =>
                  Digraph a b c -> a -> b
get_vertex g@(Graph m)  ov
    | has_vertex g ov = getlabel (M.lookup ov m)
    | otherwise       = error no_ov
    where getlabel (Just (ol,_)) = ol
          getentry  _            = error no_entry
          no_ov    = "Vertex " ++ show ov ++ " not in digraph"
          no_entry = "Missing/malformed value for vertex " ++ show ov


{- has_vertex g ov returns true if and only if ov is a vertex of 
   graph g.

   Pre:  G(g) = (V,E,VL,EL) && ov IN VertexLabelType
   Post: G(Result) == ov IN V
-}

has_vertex :: (Ord a, Show a, Eq b, Show b, Eq c, Show c) =>
                  Digraph a b c -> a -> Bool
has_vertex (Graph m) ov = M.member ov m


{- add_edge g v1 v2 nl inserts an edge from vertex v1 to vertex v2 in
   graph g and returns the resulting graph.

   Pre:  G(g) = (V,E,VL,EL) && v1 IN V && v2 IN V && (v1,v2) NOT_IN E
   Post: G(Result) == (V, E', VL, EL')
         where E'  = E  UNION {(v1,v2)}
               EL' = EL UNION {((v1,v2),nl)}
-}

add_edge :: (Ord a, Show a, Eq b, Show b, Eq c, Show c) =>
                Digraph a b c -> a -> a -> c -> Digraph a b c
add_edge g@(Graph m) v1 v2 nl
    | not (has_vertex g v1) = error no_v1
    | not (has_vertex g v2) = error no_v2
    | has_edge g v1 v2      = error has_e
    | otherwise             = Graph (adde (M.lookup v1 m))
    where adde (Just (ol,el)) = M.insert v1 (ol,(v2,nl):el) m
          adde  _             = error no_entry
          no_v1    = "Cannot add edge. Vertex " ++ show v1 ++
                     " not in digraph"
          no_v2    = "Cannot add edge. Vertex " ++ show v2 ++
                     " not in digraph"
          has_e    = "Edge (" ++ show v1 ++ "," ++ show v2 ++
                     ") already in digraph"
          no_entry = "Missing/malformed value for vertex " ++ show v1


{- remove_edge g v1 v2 deletes the edge from vertex v1 to vertex v2 
   from graph g and returns the resulting graph.

   Pre:  G(g) =  (V,E,VL,EL) V - {ov} && (v1,v2) IN E
   Post: G(Result) == (V, E - {(v1,v2)}, VL, EL - { ((v1,v2),*) }
-}

remove_edge :: (Ord a, Show a, Eq b, Show b, Eq c, Show c) =>
                   Digraph a b c -> a -> a -> Digraph a b c
remove_edge g@(Graph m) v1 v2 
    | has_edge g v1 v2 = Graph (reme (M.lookup v1 m))
    | otherwise        = error no_e
    where reme (Just (ol,el)) = M.insert v1 (ol, filter neqv2 el) m
          reme  _             = error no_entry
          neqv2 (v,_) = (v /= v2)
          no_e        = "Edge (" ++ show v1 ++ "," ++ show v2 ++
                        ") not in digraph"
          no_entry    = "Missing/malformed value for vertex " ++
                        show v1


{- update_edge g v1 v2 nl changes the label on the edge from vertex v1
   to vertex v2 in graph g to have label nl and returns the resulting
   graph.

   Pre:  G(g) = (V,E,VL,EL) && (v1,v2) IN E
   Post: G(Result) == (V, E, VL, EL')
         where EL' == (EL - {((v1,v2),*)}) UNION {((v2,v2),nl)
-}

update_edge :: (Ord a, Show a, Eq b, Show b, Eq c, Show c) =>
                   Digraph a b c -> a -> a -> c -> Digraph a b c
update_edge g@(Graph m) v1 v2 nl
    | has_edge g v1 v2 = Graph (upd (M.lookup v1 m))
    | otherwise        = error no_e
    where upd (Just (ol,el)) = M.insert v1 (ol, map chg el) m
          upd  _             = error no_entry
          chg (v,m) = if v == v2 then (v2,nl) else (v,m)
          no_e      = "Edge (" ++ show v1 ++ "," ++ show v2 ++
                       ") not in digraph"
          no_entry  = "Missing/malformed value for vertex " ++ show v1


{- get_edge g v1 v2 returns the label on the edge from vertex v1 to 
   vertex v2 in graph g.

   Pre:  G(g) = (V,E,VL,EL) && (v1,v2) IN E
   Post: Result == EL((v1,v2))
-}

get_edge :: (Ord a, Show a, Eq b, Show b, Eq c, Show c) =>
                Digraph a b c -> a -> a -> c
get_edge g@(Graph m) v1 v2
    | has_edge g v1 v2 = gete (M.lookup v1 m)
    | otherwise        = error no_e
    where gete (Just (ol,el)) = snd (head (filter eqv2 el))
          gete  _             = error no_entry
          eqv2 (v,_) = (v == v2)
          no_e       = "Edge (" ++ show v1 ++ "," ++ show v2 ++
                        ") not in digraph"
          no_entry   = "Missing/malformed value for vertex " ++
                       show v1


{- has_edge g v1 v2 returns true if and only if there is an edge
   from a vertex v1 to a vertex v2 in graph g.

   Pre:  G(g) = (V,E,VL,EL) 
   Post: Result == (v1,v2) IN E
-}

has_edge :: (Ord a, Show a, Eq b, Show b, Eq c, Show c) =>
                Digraph a b c -> a -> a -> Bool
has_edge (Graph m) v1 v2 = chke (M.lookup v1 m)
    where chke (Just (ol,el)) = ((filter eqv2 el) /= [])
          chke  _             = False
          eqv2 (v,_)          = (v == v2)


{- all_vertices g returns a sequence of all the vertices in graph g. 
   The sequence is represented by a builtin Haskell list.

   Pre:  G(g) = (V,E,VL,EL)
   Post: (ForAll ov: ov IN Result <=> ov IN V) && 
         length(Result) == size(V)
-}

all_vertices :: (Ord a, Show a, Eq b, Show b, Eq c, Show c) =>
                    Digraph a b c -> [a]
all_vertices (Graph m) = M.keys m


{- from_edges g v1 returns a sequence of all vertices v2 such that
   there is an edge from vertex v1 to vertex v2 in graph g.  The
   sequence is represented by a builtin Haskell list.

   Pre:  G(g) = (V,E,VL,EL) && v1 IN V
   Post: (ForAll v2: v2 IN Result <=> (v1,v2) IN E) &&
         length(Result) == (# v2 :: (v1,v2) IN E)
-}

from_edges :: (Ord a, Show a, Eq b, Show b, Eq c, Show c) =>
                  Digraph a b c -> a -> [a]
from_edges g@(Graph m) v1
    | has_vertex g v1 = edges (M.lookup v1 m)
    | otherwise       = error no_v1
    where edges (Just (ol,el)) = map fst el -- not sorted
          edges  _             = error no_entry
          no_v1    = "Vertex " ++ show v1 ++ " not in digraph"
          no_entry = "Missing/malformed value for vertex " ++ show v1


{- all_vertices_labels g returns a sequence of all pairs (v,l) such
   that v is a vertex and l is it's label in graph g.  The sequence is
   represented by a builtin Haskell list.

   Pre:  G(g) = (V,E,VL,EL)
   Post: (ForAll v, l: (v,l) IN Result <=> (v,l) IN VL) && 
         length(Result) == size(VL)
-}

all_vertices_labels :: (Ord a, Show a, Eq b, Show b, Eq c, Show c) =>
                           Digraph a b c -> [(a,b)]
all_vertices_labels (Graph m) = map getl (M.toAscList m)
    where getl (v, (l,_)) = (v,l)
          getl (v,_)      = error (no_entry v)
          no_entry v      = "Missing/malformed value for vertex " ++
                            show v


{- from_edges_labels g v1 returns a sequence of all pairs (v2,l) such
   that there is an edge (v1,v2) labeled with l in graph g.

   Pre:  G(g) = (V,E,VL,EL) && v1 IN V
   Post: (ForAll v2, l :: (v2,l) IN Result <=> ((v1,v2),l) IN EL) &&
         length(Result) == (# v2 :: (v1,v2 ) IN E)
-}

from_edges_labels :: (Ord a, Show a, Eq b, Show b, Eq c, Show c) =>
                         Digraph a b c -> a -> [(a,c)]
from_edges_labels g@(Graph m) v1 
    | has_vertex g v1 = edges (M.lookup v1 m)
    | otherwise       = error no_v1
    where edges (Just (ol,el)) = el -- not sorted
          edges  _             = error no_entry
          no_v1    = "Vertex " ++ show v1 ++ " not in digraph"
          no_entry = "Missing/malformed value for vertex " ++ show v1