    {-# 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, 2014, 2016, 2018 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 qualified Data.Set as S

    import Swish.GraphClass
    import Swish.GraphMatch

    import Data.Hashable (Hashable(..))
    #if (!defined(__GLASGOW_HASKELL__)) || (__GLASGOW_HASKELL__ < 710)
    import Data.Monoid (Monoid(..))
    #endif
    import Data.Ord (comparing)

    #if !(MIN_VERSION_base(4, 11, 0))
    import Data.Semigroup
    #endif

    -- | Simple memory-based graph type.

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

    instance LDGraph GraphMem lb where
        emptyGraph :: GraphMem lb
    emptyGraph   = ArcSet lb -> GraphMem lb
    forall lb. ArcSet lb -> GraphMem lb
    GraphMem ArcSet lb
    forall a. Set a
    S.empty
        getArcs :: GraphMem lb -> ArcSet lb
    getArcs      = GraphMem lb -> ArcSet lb
    forall lb. GraphMem lb -> ArcSet lb
    arcs
        setArcs :: GraphMem lb -> ArcSet lb -> GraphMem lb
    setArcs g :: GraphMem lb
    g as :: ArcSet lb
    as = GraphMem lb
    g { arcs :: ArcSet lb
    arcs=ArcSet lb
    as }

    instance (Label lb) => Eq (GraphMem lb) where
        == :: GraphMem lb -> GraphMem lb -> Bool
    (==) = GraphMem lb -> GraphMem lb -> Bool
    forall lb. Label lb => GraphMem lb -> GraphMem lb -> Bool
    graphEq

    instance (Label lb) => Ord (GraphMem lb) where
        compare :: GraphMem lb -> GraphMem lb -> Ordering
    compare = (GraphMem lb -> ArcSet lb)
    -> GraphMem lb -> GraphMem lb -> Ordering
    forall a b. Ord a => (b -> a) -> b -> b -> Ordering
    comparing GraphMem lb -> ArcSet lb
    forall (lg :: * -> *) lb. LDGraph lg lb => lg lb -> ArcSet lb
    getArcs

    instance (Label lb) => Show (GraphMem lb) where
        show :: GraphMem lb -> String
    show = GraphMem lb -> String
    forall lb. Label lb => GraphMem lb -> String
    graphShow

    instance (Label lb) => Semigroup (GraphMem lb) where
        <> :: GraphMem lb -> GraphMem lb -> GraphMem lb
    (<>) = GraphMem lb -> GraphMem lb -> GraphMem lb
    forall (lg :: * -> *) lb.
    (LDGraph lg lb, Ord lb) =>
    lg lb -> lg lb -> lg lb
    addGraphs

    instance (Label lb) => Monoid (GraphMem lb) where
        mempty :: GraphMem lb
    mempty  = GraphMem lb
    forall (lg :: * -> *) lb. LDGraph lg lb => lg lb
    emptyGraph
    #if !(MIN_VERSION_base(4, 11, 0))
        mappend = (<>)
    #endif

    graphShow   :: (Label lb) => GraphMem lb -> String
    graphShow :: GraphMem lb -> String
    graphShow g :: GraphMem lb
    g = "Graph:" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ (Arc lb -> ShowS) -> String -> Set (Arc lb) -> String
    forall a b. (a -> b -> b) -> b -> Set a -> b
    S.foldr (String -> ShowS
    forall a. [a] -> [a] -> [a]
    (++) (String -> ShowS) -> (Arc lb -> String) -> Arc lb -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ("\n    " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++) ShowS -> (Arc lb -> String) -> Arc lb -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Arc lb -> String
    forall a. Show a => a -> String
    show) "" (GraphMem lb -> Set (Arc lb)
    forall lb. GraphMem lb -> ArcSet lb
    arcs GraphMem lb
    g)

    -- |  Return Boolean graph equality

    graphEq :: (Label lb) => GraphMem lb -> GraphMem lb -> Bool
    graphEq :: GraphMem lb -> GraphMem lb -> Bool
    graphEq g1 :: GraphMem lb
    g1 g2 :: GraphMem lb
    g2 = (Bool, LabelMap (ScopedLabel lb)) -> Bool
    forall a b. (a, b) -> a
    fst ( GraphMem lb -> GraphMem lb -> (Bool, LabelMap (ScopedLabel lb))
    forall lb.
    Label lb =>
    GraphMem lb -> GraphMem lb -> (Bool, LabelMap (ScopedLabel lb))
    matchGraphMem GraphMem lb
    g1 GraphMem lb
    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 :: GraphMem lb -> GraphMem lb -> (Bool, LabelMap (ScopedLabel lb))
    matchGraphMem g1 :: GraphMem lb
    g1 g2 :: GraphMem lb
    g2 =
        let
            gs1 :: ArcSet lb
    gs1     = GraphMem lb -> ArcSet lb
    forall lb. GraphMem lb -> ArcSet lb
    arcs GraphMem lb
    g1
            gs2 :: ArcSet lb
    gs2     = GraphMem lb -> ArcSet lb
    forall lb. GraphMem lb -> ArcSet lb
    arcs GraphMem lb
    g2
            matchable :: a -> a -> Bool
    matchable l1 :: a
    l1 l2 :: a
    l2
                | a -> Bool
    forall lb. Label lb => lb -> Bool
    labelIsVar a
    l1 Bool -> Bool -> Bool
    && a -> Bool
    forall lb. Label lb => lb -> Bool
    labelIsVar a
    l2 = Bool
    True
                | a -> Bool
    forall lb. Label lb => lb -> Bool
    labelIsVar a
    l1 Bool -> Bool -> Bool
    || a -> Bool
    forall lb. Label lb => lb -> Bool
    labelIsVar a
    l2 = Bool
    False
                | Bool
    otherwise                      = a
    l1 a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    == a
    l2
        in
            (lb -> lb -> Bool)
    -> ArcSet lb -> ArcSet lb -> (Bool, LabelMap (ScopedLabel lb))
    forall lb.
    Label lb =>
    (lb -> lb -> Bool)
    -> ArcSet lb -> ArcSet lb -> (Bool, LabelMap (ScopedLabel lb))
    graphMatch lb -> lb -> Bool
    forall a. Label a => a -> a -> Bool
    matchable ArcSet lb
    gs1 ArcSet lb
    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 :: Int -> LabelMem -> Int
    hashWithSalt salt :: Int
    salt (LF l :: String
    l) = Int
    salt Int -> Int -> Int
    forall a. Hashable a => Int -> a -> Int
    `hashWithSalt` (1::Int) Int -> String -> Int
    forall a. Hashable a => Int -> a -> Int
    `hashWithSalt` String
    l
      hashWithSalt salt :: Int
    salt (LV l :: String
    l) = Int
    salt Int -> Int -> Int
    forall a. Hashable a => Int -> a -> Int
    `hashWithSalt` (2::Int) Int -> String -> Int
    forall a. Hashable a => Int -> a -> Int
    `hashWithSalt` String
    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 :: LabelMem -> Bool
    labelIsVar (LV _)   = Bool
    True
        labelIsVar _        = Bool
    False
        getLocal :: LabelMem -> String
    getLocal   (LV loc :: String
    loc) = String
    loc
        getLocal   lab :: LabelMem
    lab      = ShowS
    forall a. HasCallStack => String -> a
    error "getLocal of non-variable label: " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ LabelMem -> String
    forall a. Show a => a -> String
    show LabelMem
    lab
        makeLabel :: String -> LabelMem
    makeLabel           = String -> LabelMem
    LV
        labelHash :: Int -> LabelMem -> Int
    labelHash = Int -> LabelMem -> Int
    forall a. Hashable a => Int -> a -> Int
    hashWithSalt

    instance Eq LabelMem where
        (LF l1 :: String
    l1) == :: LabelMem -> LabelMem -> Bool
    == (LF l2 :: String
    l2)  = String
    l1 String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    l2
        (LV l1 :: String
    l1) == (LV l2 :: String
    l2)  = String
    l1 String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    l2
        _ == _              = Bool
    False

    instance Ord LabelMem where
        (LF l1 :: String
    l1) compare :: LabelMem -> LabelMem -> Ordering
    `compare` (LF l2 :: String
    l2) = String
    l1 String -> String -> Ordering
    forall a. Ord a => a -> a -> Ordering
    `compare` String
    l2
        (LV l1 :: String
    l1) `compare` (LV l2 :: String
    l2) = String
    l1 String -> String -> Ordering
    forall a. Ord a => a -> a -> Ordering
    `compare` String
    l2
        (LF _)  `compare` _       = Ordering
    LT
        _       `compare` (LF _)  = Ordering
    GT

    instance Show LabelMem where
        show :: LabelMem -> String
    show (LF l1 :: String
    l1)        = '!' Char -> ShowS
    forall a. a -> [a] -> [a]
    : String
    l1
        show (LV l2 :: String
    l2)        = '?' Char -> ShowS
    forall a. a -> [a] -> [a]
    : String
    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
    --
    --------------------------------------------------------------------------------