    {-# LANGUAGE CPP #-}
    {-# LANGUAGE FlexibleInstances #-}
    {-# LANGUAGE MultiParamTypeClasses #-}

    --------------------------------------------------------------------------------
    --  See end of this file for licence information.
    --------------------------------------------------------------------------------
    -- |
    --  Module      :  GraphMem
    --  Copyright   :  (c) 2003, Graham Klyne, 2009 Vasili I Galchin,
    --                 2011, 2012 Douglas Burke
    --  License     :  GPL V2
    --
    --  Maintainer  :  Douglas Burke
    --  Stability   :  experimental
    --  Portability :  CPP, FlexibleInstances, MultiParamTypeClasses
    --
    --  This module defines a simple memory-based graph instance.
    --
    --------------------------------------------------------------------------------

    ------------------------------------------------------------
    -- Simple labelled directed graph value
    ------------------------------------------------------------

    module Swish.GraphMem
        ( GraphMem(..)
        , LabelMem(..)
        , setArcs, getArcs, addGraphs, delete, extract, labels
        , labelIsVar, labelHash
          -- For debug/test:
        , matchGraphMem
        ) where

    import Swish.GraphClass
    import Swish.GraphMatch

    import Data.Hashable (Hashable(..))
    import Data.Monoid (Monoid(..))
    import Data.Ord (comparing)

    import qualified Data.Set as S

    -- | Simple memory-based graph type.

    data GraphMem lb = GraphMem { arcs :: ArcSet lb }

    instance (Label lb) => LDGraph GraphMem lb where
        emptyGraph   = GraphMem S.empty
        getArcs      = arcs
        setArcs g as = g { arcs=as }

    instance (Label lb) => Eq (GraphMem lb) where
        (==) = graphEq

    instance (Label lb) => Ord (GraphMem lb) where
        compare = comparing getArcs

    instance (Label lb) => Show (GraphMem lb) where
        show = graphShow

    instance (Label lb) => Monoid (GraphMem lb) where
        mempty  = emptyGraph
        mappend = addGraphs

    graphShow   :: (Label lb) => GraphMem lb -> String
    graphShow g = "Graph:" ++ S.foldr ((++) . ("\n    " ++) . show) "" (arcs g)

    -- |  Return Boolean graph equality

    graphEq :: (Label lb) => GraphMem lb -> GraphMem lb -> Bool
    graphEq g1 g2 = fst ( matchGraphMem g1 g2 )

    -- | GraphMem matching function accepting GraphMem value and returning
    --  node map if successful
    --
    matchGraphMem ::
      (Label lb)
      => GraphMem lb
      -> GraphMem lb
      -> (Bool,LabelMap (ScopedLabel lb))
      -- ^ if the first element is @True@ then the second value is a label
      --   map that maps each label to an equivalence-class identifier,
      --   otherwise `emptyMap`.
      --
    matchGraphMem g1 g2 =
        let
            gs1     = arcs g1
            gs2     = arcs g2
            matchable l1 l2
                | labelIsVar l1 && labelIsVar l2 = True
                | labelIsVar l1 || labelIsVar l2 = False
                | otherwise                      = l1 == l2
        in
            graphMatch matchable gs1 gs2

    {-
    -- |  Return bijection between two graphs, or empty list
    graphBiject :: (Label lb) => GraphMem lb -> GraphMem lb -> [(lb,lb)]
    graphBiject g1 g2 = if null lmap then [] else zip (sortedls g1) (sortedls g2)
        where
            lmap        = graphMatch g1 g2
            sortedls g  = map snd $
                          (sortBy indexComp) $
                          equivalenceClasses (graphLabels $ arcs g) lmap
            classComp ec1 ec2 = indexComp (classIndexVal ec1) (classIndexVal ec2)
            indexComp (g1,v1) (g2,v2)
                | g1 == g2  = compare v1 v2
                | otherwise = compare g1 g2
    -}

    -- |  Minimal graph label value - for testing

    data LabelMem
        = LF String
        | LV String

    instance Hashable LabelMem where
      hashWithSalt salt (LF l) = salt `hashWithSalt` (1::Int) `hashWithSalt` l
      hashWithSalt salt (LV l) = salt `hashWithSalt` (2::Int) `hashWithSalt` l
    #if !MIN_VERSION_hashable(1,2,0)
      hash (LF l) = 1 `hashWithSalt` l
      hash (LV l) = 2 `hashWithSalt` l
    #endif

    instance Label LabelMem where
        labelIsVar (LV _)   = True
        labelIsVar _        = False
        getLocal   (LV loc) = loc
        getLocal   lab      = error "getLocal of non-variable label: " ++ show lab
        makeLabel           = LV
        labelHash = hashWithSalt

    instance Eq LabelMem where
        (LF l1) == (LF l2)  = l1 == l2
        (LV l1) == (LV l2)  = l1 == l2
        _ == _              = False

    instance Ord LabelMem where
        (LF l1) `compare` (LF l2) = l1 `compare` l2
        (LV l1) `compare` (LV l2) = l1 `compare` l2
        (LF _)  `compare` _       = LT
        _       `compare` (LF _)  = GT

    instance Show LabelMem where
        show (LF l1)        = '!' : l1
        show (LV l2)        = '?' : l2

    --------------------------------------------------------------------------------
    --
    --  Copyright (c) 2003, Graham Klyne, 2009 Vasili I Galchin,
    --    2011, 2012 Douglas Burke
    --  All rights reserved.
    --
    --  This file is part of Swish.
    --
    --  Swish is free software; you can redistribute it and/or modify
    --  it under the terms of the GNU General Public License as published by
    --  the Free Software Foundation; either version 2 of the License, or
    --  (at your option) any later version.
    --
    --  Swish is distributed in the hope that it will be useful,
    --  but WITHOUT ANY WARRANTY; without even the implied warranty of
    --  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    --  GNU General Public License for more details.
    --
    --  You should have received a copy of the GNU General Public License
    --  along with Swish; if not, write to:
    --    The Free Software Foundation, Inc.,
    --    59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
    --
    --------------------------------------------------------------------------------