--------------------------------------------------------------------------------
--  See end of this file for licence information.
--------------------------------------------------------------------------------
-- |
--  Module      :  GraphPartition
--  Copyright   :  (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011, 2012 Douglas Burke
--  License     :  GPL V2
--
--  Maintainer  :  Douglas Burke
--  Stability   :  experimental
--  Portability :  H98
--
--  This module contains functions for partitioning a graph into subgraphs
--  that rooted from different subject nodes.
--
--------------------------------------------------------------------------------

module Swish.GraphPartition
    ( PartitionedGraph(..), getArcs, getPartitions
    , GraphPartition(..), node, toArcs
    , partitionGraph, comparePartitions
    , partitionShowP
    )
where

import Swish.GraphClass (Label(..), Arc(..))

import Control.Monad.State (MonadState(..), State)
import Control.Monad.State (evalState)

import Data.List (foldl', partition)
import Data.List.NonEmpty (NonEmpty(..), (<|))
import Data.Maybe (mapMaybe)

import qualified Data.List.NonEmpty as NE

------------------------------------------------------------
--  Data type for a partitioned graph
------------------------------------------------------------

-- |Representation of a graph as a collection of (possibly nested)
--  partitions.  Each node in the graph appears at least once as the
--  root value of a 'GraphPartition' value:
--
--  * Nodes that are the subject of at least one statement appear as
--    the first value of exactly one 'PartSub' constructor, and may
--    also appear in any number of 'PartObj' constructors.
--
--  * Nodes appearing only as objects of statements appear only in
--    'PartObj' constructors.

data PartitionedGraph lb = PartitionedGraph [GraphPartition lb]
    deriving (PartitionedGraph lb -> PartitionedGraph lb -> Bool
(PartitionedGraph lb -> PartitionedGraph lb -> Bool)
-> (PartitionedGraph lb -> PartitionedGraph lb -> Bool)
-> Eq (PartitionedGraph lb)
forall lb.
Label lb =>
PartitionedGraph lb -> PartitionedGraph lb -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PartitionedGraph lb -> PartitionedGraph lb -> Bool
$c/= :: forall lb.
Label lb =>
PartitionedGraph lb -> PartitionedGraph lb -> Bool
== :: PartitionedGraph lb -> PartitionedGraph lb -> Bool
$c== :: forall lb.
Label lb =>
PartitionedGraph lb -> PartitionedGraph lb -> Bool
Eq, Int -> PartitionedGraph lb -> ShowS
[PartitionedGraph lb] -> ShowS
PartitionedGraph lb -> String
(Int -> PartitionedGraph lb -> ShowS)
-> (PartitionedGraph lb -> String)
-> ([PartitionedGraph lb] -> ShowS)
-> Show (PartitionedGraph lb)
forall lb. Label lb => Int -> PartitionedGraph lb -> ShowS
forall lb. Label lb => [PartitionedGraph lb] -> ShowS
forall lb. Label lb => PartitionedGraph lb -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PartitionedGraph lb] -> ShowS
$cshowList :: forall lb. Label lb => [PartitionedGraph lb] -> ShowS
show :: PartitionedGraph lb -> String
$cshow :: forall lb. Label lb => PartitionedGraph lb -> String
showsPrec :: Int -> PartitionedGraph lb -> ShowS
$cshowsPrec :: forall lb. Label lb => Int -> PartitionedGraph lb -> ShowS
Show)

-- | Returns all the arcs in the partitioned graph.
getArcs :: PartitionedGraph lb -> [Arc lb]
getArcs :: PartitionedGraph lb -> [Arc lb]
getArcs (PartitionedGraph [GraphPartition lb]
ps) = (GraphPartition lb -> [Arc lb]) -> [GraphPartition lb] -> [Arc lb]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap GraphPartition lb -> [Arc lb]
forall lb. GraphPartition lb -> [Arc lb]
toArcs [GraphPartition lb]
ps

-- | Returns a list of partitions.
getPartitions :: PartitionedGraph lb -> [GraphPartition lb]
getPartitions :: PartitionedGraph lb -> [GraphPartition lb]
getPartitions (PartitionedGraph [GraphPartition lb]
ps) = [GraphPartition lb]
ps

-- Note: do not use the LabelledPartition local type here since we do
-- not want it to appear in the documentation.

-- | Represent a partition of a graph by a node and (optional) contents.
data GraphPartition lb
    = PartObj lb
    | PartSub lb (NonEmpty (lb,GraphPartition lb))

-- | Returns the node for the partition.
node :: GraphPartition lb -> lb
node :: GraphPartition lb -> lb
node (PartObj lb
ob)   = lb
ob
node (PartSub lb
sb NonEmpty (lb, GraphPartition lb)
_) = lb
sb

-- | Creates a list of arcs from the partition. The empty
-- list is returned for `PartObj`.
toArcs :: GraphPartition lb -> [Arc lb]
toArcs :: GraphPartition lb -> [Arc lb]
toArcs (PartObj lb
_)      = []
toArcs (PartSub lb
sb NonEmpty (lb, GraphPartition lb)
prs) = ((lb, GraphPartition lb) -> [Arc lb])
-> [(lb, GraphPartition lb)] -> [Arc lb]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (lb, GraphPartition lb) -> [Arc lb]
toArcs1 ([(lb, GraphPartition lb)] -> [Arc lb])
-> [(lb, GraphPartition lb)] -> [Arc lb]
forall a b. (a -> b) -> a -> b
$ NonEmpty (lb, GraphPartition lb) -> [(lb, GraphPartition lb)]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty (lb, GraphPartition lb)
prs
    where
        toArcs1 :: (lb, GraphPartition lb) -> [Arc lb]
toArcs1 (lb
pr,GraphPartition lb
ob) = lb -> lb -> lb -> Arc lb
forall lb. lb -> lb -> lb -> Arc lb
Arc lb
sb lb
pr (GraphPartition lb -> lb
forall lb. GraphPartition lb -> lb
node GraphPartition lb
ob) Arc lb -> [Arc lb] -> [Arc lb]
forall a. a -> [a] -> [a]
: GraphPartition lb -> [Arc lb]
forall lb. GraphPartition lb -> [Arc lb]
toArcs GraphPartition lb
ob

-- | Equality is based on total structural equivalence
-- rather than graph equality.
instance (Label lb) => Eq (GraphPartition lb) where
    (PartObj lb
o1)    == :: GraphPartition lb -> GraphPartition lb -> Bool
== (PartObj lb
o2)    = lb
o1 lb -> lb -> Bool
forall a. Eq a => a -> a -> Bool
== lb
o2
    (PartSub lb
s1 NonEmpty (lb, GraphPartition lb)
p1) == (PartSub lb
s2 NonEmpty (lb, GraphPartition lb)
p2) = lb
s1 lb -> lb -> Bool
forall a. Eq a => a -> a -> Bool
== lb
s2 Bool -> Bool -> Bool
&& NonEmpty (lb, GraphPartition lb)
p1 NonEmpty (lb, GraphPartition lb)
-> NonEmpty (lb, GraphPartition lb) -> Bool
forall a. Eq a => a -> a -> Bool
== NonEmpty (lb, GraphPartition lb)
p2
    GraphPartition lb
_               == GraphPartition lb
_               = Bool
False

-- Chose ordering to be "more information" first/smaller (arbitrary choice).
instance (Label lb) => Ord (GraphPartition lb) where
    (PartSub lb
s1 NonEmpty (lb, GraphPartition lb)
p1) compare :: GraphPartition lb -> GraphPartition lb -> Ordering
`compare` (PartSub lb
s2 NonEmpty (lb, GraphPartition lb)
p2) = (lb
s1,NonEmpty (lb, GraphPartition lb)
p1) (lb, NonEmpty (lb, GraphPartition lb))
-> (lb, NonEmpty (lb, GraphPartition lb)) -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` (lb
s2,NonEmpty (lb, GraphPartition lb)
p2)
    (PartObj lb
o1)    `compare` (PartObj lb
o2)    = lb
o1 lb -> lb -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` lb
o2
    (PartSub lb
_ NonEmpty (lb, GraphPartition lb)
_)   `compare` GraphPartition lb
_               = Ordering
LT
    GraphPartition lb
_               `compare` (PartSub lb
_ NonEmpty (lb, GraphPartition lb)
_)   = Ordering
GT

instance (Label lb) => Show (GraphPartition lb) where
    show :: GraphPartition lb -> String
show = GraphPartition lb -> String
forall lb. Label lb => GraphPartition lb -> String
partitionShow

-- can we just say 
--  partitionShow = partitionShowP ""
-- ?
partitionShow :: (Label lb) => GraphPartition lb -> String
partitionShow :: GraphPartition lb -> String
partitionShow (PartObj lb
ob)             = lb -> String
forall a. Show a => a -> String
show lb
ob
partitionShow (PartSub lb
sb ((lb, GraphPartition lb)
pr :| [(lb, GraphPartition lb)]
prs)) =
    String
"("String -> ShowS
forall a. [a] -> [a] -> [a]
++ lb -> String
forall a. Show a => a -> String
show lb
sb String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (lb, GraphPartition lb) -> String
forall a a. (Show a, Show a) => (a, a) -> String
showpr (lb, GraphPartition lb)
pr String -> ShowS
forall a. [a] -> [a] -> [a]
++ ((lb, GraphPartition lb) -> String)
-> [(lb, GraphPartition lb)] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((String
" ; "String -> ShowS
forall a. [a] -> [a] -> [a]
++)ShowS
-> ((lb, GraphPartition lb) -> String)
-> (lb, GraphPartition lb)
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(lb, GraphPartition lb) -> String
forall a a. (Show a, Show a) => (a, a) -> String
showpr) [(lb, GraphPartition lb)]
prs String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
    where
        showpr :: (a, a) -> String
showpr (a
a,a
b) = a -> String
forall a. Show a => a -> String
show a
a String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
b

-- only used in Swish.Commands  

-- | Convert a partition into a string with a leading separator string.
partitionShowP :: 
    (Label lb) => 
    String 
    -> GraphPartition lb 
    -> String
partitionShowP :: String -> GraphPartition lb -> String
partitionShowP String
_    (PartObj lb
ob)             = lb -> String
forall a. Show a => a -> String
show lb
ob
partitionShowP String
pref (PartSub lb
sb ((lb, GraphPartition lb)
pr :| [(lb, GraphPartition lb)]
prs)) =
    String
prefString -> ShowS
forall a. [a] -> [a] -> [a]
++String
"("String -> ShowS
forall a. [a] -> [a] -> [a]
++ lb -> String
forall a. Show a => a -> String
show lb
sb String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (lb, GraphPartition lb) -> String
forall lb a. (Label lb, Show a) => (a, GraphPartition lb) -> String
showpr (lb, GraphPartition lb)
pr String -> ShowS
forall a. [a] -> [a] -> [a]
++ ((lb, GraphPartition lb) -> String)
-> [(lb, GraphPartition lb)] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (((String
prefString -> ShowS
forall a. [a] -> [a] -> [a]
++String
"  ; ")String -> ShowS
forall a. [a] -> [a] -> [a]
++)ShowS
-> ((lb, GraphPartition lb) -> String)
-> (lb, GraphPartition lb)
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(lb, GraphPartition lb) -> String
forall lb a. (Label lb, Show a) => (a, GraphPartition lb) -> String
showpr) [(lb, GraphPartition lb)]
prs String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
    where
        showpr :: (a, GraphPartition lb) -> String
showpr (a
a,GraphPartition lb
b) = a -> String
forall a. Show a => a -> String
show a
a String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> GraphPartition lb -> String
forall lb. Label lb => String -> GraphPartition lb -> String
partitionShowP (String
prefString -> ShowS
forall a. [a] -> [a] -> [a]
++String
"  ") GraphPartition lb
b

------------------------------------------------------------
--  Creating partitioned graphs
------------------------------------------------------------
--
-- |Turning a partitioned graph into a flat graph is easy.
--  The interesting challenge is to turn a flat graph into a
--  partitioned graph that is more useful for certain purposes.
--  Currently, I'm interested in:
--        
--  (1) isolating differences between graphs
--        
--  (2) pretty-printing graphs
--
--  For (1), the goal is to separate subgraphs that are known
--  to be equivalent from subgraphs that are known to be different,
--  such that: 
--
--  * different sub-graphs are minimized,
--
--  * different
--  sub-graphs are placed into 1:1 correspondence (possibly with null
--  subgraphs), and
--
--  * only deterministic matching decisions are made.
--
--  For (2), the goal is to decide when a subgraph is to be treated
--  as nested in another partition, or treated as a new top-level partition.
--  If a subgraph is referenced by exactly one graph partition, it should
--  be nested in that partition, otherwise it should be a new top-level
--  partition.
--
--  Strategy.  Examining just subject and object nodes:
--
--  * all non-blank subject nodes are the root of a top-level partition
--
--  * blank subject nodes that are not the object of exactly one statement
--     are the root of a top-level partition.
--
--  * blank nodes referenced as the object of exactly 1 statement
--     of an existing partition are the root of a sub-partition of the
--     refering partition.
--
--  * what remain are circular chains of blank nodes not referenced
--     elsewhere:  for each such chain, pick a root node arbitrarily.
--
partitionGraph :: (Label lb) => [Arc lb] -> PartitionedGraph lb
partitionGraph :: [Arc lb] -> PartitionedGraph lb
partitionGraph [] = [GraphPartition lb] -> PartitionedGraph lb
forall lb. [GraphPartition lb] -> PartitionedGraph lb
PartitionedGraph []
partitionGraph [Arc lb]
arcs =
    [LabelledArcs lb]
-> [LabelledArcs lb] -> [LabelledArcs lb] -> PartitionedGraph lb
forall lb.
Eq lb =>
[LabelledArcs lb]
-> [LabelledArcs lb] -> [LabelledArcs lb] -> PartitionedGraph lb
makePartitions [LabelledArcs lb]
fixs [LabelledArcs lb]
topv1 [LabelledArcs lb]
intv1
    where
        ([LabelledArcs lb]
fixs,[LabelledArcs lb]
vars)  = (LabelledArcs lb -> Bool)
-> [LabelledArcs lb] -> ([LabelledArcs lb], [LabelledArcs lb])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition LabelledArcs lb -> Bool
forall b. (lb, b) -> Bool
isNonVar ([LabelledArcs lb] -> ([LabelledArcs lb], [LabelledArcs lb]))
-> [LabelledArcs lb] -> ([LabelledArcs lb], [LabelledArcs lb])
forall a b. (a -> b) -> a -> b
$ (Arc lb -> lb) -> [Arc lb] -> [LabelledArcs lb]
forall b a. Eq b => (a -> b) -> [a] -> [(b, NonEmpty a)]
collect Arc lb -> lb
forall lb. Arc lb -> lb
arcSubj [Arc lb]
arcs
        vars1 :: [(lb, (NonEmpty (Arc lb), [Arc lb]))]
vars1        = (Arc lb -> lb)
-> [Arc lb]
-> [LabelledArcs lb]
-> [(lb, (NonEmpty (Arc lb), [Arc lb]))]
forall b a c.
Eq b =>
(a -> b) -> [a] -> [(b, c)] -> [(b, (c, [a]))]
collectMore Arc lb -> lb
forall lb. Arc lb -> lb
arcObj [Arc lb]
arcs [LabelledArcs lb]
vars
        ([(lb, (NonEmpty (Arc lb), [Arc lb]))]
intv,[(lb, (NonEmpty (Arc lb), [Arc lb]))]
topv)  = ((lb, (NonEmpty (Arc lb), [Arc lb])) -> Bool)
-> [(lb, (NonEmpty (Arc lb), [Arc lb]))]
-> ([(lb, (NonEmpty (Arc lb), [Arc lb]))],
    [(lb, (NonEmpty (Arc lb), [Arc lb]))])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (lb, (NonEmpty (Arc lb), [Arc lb])) -> Bool
forall a a a. (a, (a, [a])) -> Bool
objOnce [(lb, (NonEmpty (Arc lb), [Arc lb]))]
vars1
        intv1 :: [LabelledArcs lb]
intv1        = ((lb, (NonEmpty (Arc lb), [Arc lb])) -> LabelledArcs lb)
-> [(lb, (NonEmpty (Arc lb), [Arc lb]))] -> [LabelledArcs lb]
forall a b. (a -> b) -> [a] -> [b]
map (lb, (NonEmpty (Arc lb), [Arc lb])) -> LabelledArcs lb
forall a b b. (a, (b, b)) -> (a, b)
stripObj [(lb, (NonEmpty (Arc lb), [Arc lb]))]
intv
        topv1 :: [LabelledArcs lb]
topv1        = ((lb, (NonEmpty (Arc lb), [Arc lb])) -> LabelledArcs lb)
-> [(lb, (NonEmpty (Arc lb), [Arc lb]))] -> [LabelledArcs lb]
forall a b. (a -> b) -> [a] -> [b]
map (lb, (NonEmpty (Arc lb), [Arc lb])) -> LabelledArcs lb
forall a b b. (a, (b, b)) -> (a, b)
stripObj [(lb, (NonEmpty (Arc lb), [Arc lb]))]
topv
        isNonVar :: (lb, b) -> Bool
isNonVar     = Bool -> Bool
not (Bool -> Bool) -> ((lb, b) -> Bool) -> (lb, b) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. lb -> Bool
forall lb. Label lb => lb -> Bool
labelIsVar (lb -> Bool) -> ((lb, b) -> lb) -> (lb, b) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (lb, b) -> lb
forall a b. (a, b) -> a
fst
        objOnce :: (a, (a, [a])) -> Bool
objOnce      = [a] -> Bool
forall a. [a] -> Bool
isSingle ([a] -> Bool) -> ((a, (a, [a])) -> [a]) -> (a, (a, [a])) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, [a]) -> [a]
forall a b. (a, b) -> b
snd ((a, [a]) -> [a])
-> ((a, (a, [a])) -> (a, [a])) -> (a, (a, [a])) -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, (a, [a])) -> (a, [a])
forall a b. (a, b) -> b
snd
        isSingle :: [a] -> Bool
isSingle [a
_] = Bool
True
        isSingle [a]
_   = Bool
False
        stripObj :: (a, (b, b)) -> (a, b)
stripObj (a
k,(b
s,b
_)) = (a
k,b
s)

-- Local state type for partitioning function
type LabelledArcs lb = (lb, NonEmpty (Arc lb))
type LabelledPartition lb = (lb, GraphPartition lb)
type MakePartitionState lb = ([LabelledArcs lb], [LabelledArcs lb], [LabelledArcs lb])
type PState lb = State (MakePartitionState lb)

makePartitions :: 
    (Eq lb) =>
    [LabelledArcs lb]
    -> [LabelledArcs lb]
    -> [LabelledArcs lb]
    -> PartitionedGraph lb
makePartitions :: [LabelledArcs lb]
-> [LabelledArcs lb] -> [LabelledArcs lb] -> PartitionedGraph lb
makePartitions [LabelledArcs lb]
fixs [LabelledArcs lb]
topv [LabelledArcs lb]
intv =
    [GraphPartition lb] -> PartitionedGraph lb
forall lb. [GraphPartition lb] -> PartitionedGraph lb
PartitionedGraph ([GraphPartition lb] -> PartitionedGraph lb)
-> [GraphPartition lb] -> PartitionedGraph lb
forall a b. (a -> b) -> a -> b
$ State (MakePartitionState lb) [GraphPartition lb]
-> MakePartitionState lb -> [GraphPartition lb]
forall s a. State s a -> s -> a
evalState ([LabelledArcs lb]
-> State (MakePartitionState lb) [GraphPartition lb]
forall lb.
Eq lb =>
[LabelledArcs lb] -> PState lb [GraphPartition lb]
makePartitions1 []) ([LabelledArcs lb]
fixs,[LabelledArcs lb]
topv,[LabelledArcs lb]
intv)

-- Use a state monad to keep track of arcs that have been incorporated into
-- the resulting list of graph partitions.  The collections of arcs used to
-- generate the list of partitions are supplied as the initial state of the
-- monad (see call of evalState above).
--
makePartitions1 :: 
    (Eq lb) =>
    [LabelledArcs lb] 
    -> PState lb [GraphPartition lb]
makePartitions1 :: [LabelledArcs lb] -> PState lb [GraphPartition lb]
makePartitions1 [] = do
    [LabelledArcs lb]
s <- PState lb [LabelledArcs lb]
forall lb. PState lb [LabelledArcs lb]
pickNextSubject
    if [LabelledArcs lb] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LabelledArcs lb]
s then [GraphPartition lb] -> PState lb [GraphPartition lb]
forall (m :: * -> *) a. Monad m => a -> m a
return [] else [LabelledArcs lb] -> PState lb [GraphPartition lb]
forall lb.
Eq lb =>
[LabelledArcs lb] -> PState lb [GraphPartition lb]
makePartitions1 [LabelledArcs lb]
s
makePartitions1 (LabelledArcs lb
sub:[LabelledArcs lb]
subs) = do
    [GraphPartition lb]
ph <- LabelledArcs lb -> PState lb [GraphPartition lb]
forall lb.
Eq lb =>
LabelledArcs lb -> PState lb [GraphPartition lb]
makePartitions2 LabelledArcs lb
sub
    [GraphPartition lb]
pt <- [LabelledArcs lb] -> PState lb [GraphPartition lb]
forall lb.
Eq lb =>
[LabelledArcs lb] -> PState lb [GraphPartition lb]
makePartitions1 [LabelledArcs lb]
subs
    [GraphPartition lb] -> PState lb [GraphPartition lb]
forall (m :: * -> *) a. Monad m => a -> m a
return ([GraphPartition lb] -> PState lb [GraphPartition lb])
-> [GraphPartition lb] -> PState lb [GraphPartition lb]
forall a b. (a -> b) -> a -> b
$ [GraphPartition lb]
ph[GraphPartition lb] -> [GraphPartition lb] -> [GraphPartition lb]
forall a. [a] -> [a] -> [a]
++[GraphPartition lb]
pt

makePartitions2 :: 
    (Eq lb) =>
    LabelledArcs lb
    -> PState lb [GraphPartition lb]
makePartitions2 :: LabelledArcs lb -> PState lb [GraphPartition lb]
makePartitions2 LabelledArcs lb
subs = do
    (GraphPartition lb
part,[LabelledArcs lb]
moresubs) <- LabelledArcs lb -> PState lb (GraphPartition lb, [LabelledArcs lb])
forall lb.
Eq lb =>
LabelledArcs lb -> PState lb (GraphPartition lb, [LabelledArcs lb])
makeStatements LabelledArcs lb
subs
    [GraphPartition lb]
moreparts <- if [LabelledArcs lb] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LabelledArcs lb]
moresubs
                 then [GraphPartition lb] -> PState lb [GraphPartition lb]
forall (m :: * -> *) a. Monad m => a -> m a
return []
                 else [LabelledArcs lb] -> PState lb [GraphPartition lb]
forall lb.
Eq lb =>
[LabelledArcs lb] -> PState lb [GraphPartition lb]
makePartitions1 [LabelledArcs lb]
moresubs
    [GraphPartition lb] -> PState lb [GraphPartition lb]
forall (m :: * -> *) a. Monad m => a -> m a
return ([GraphPartition lb] -> PState lb [GraphPartition lb])
-> [GraphPartition lb] -> PState lb [GraphPartition lb]
forall a b. (a -> b) -> a -> b
$ GraphPartition lb
partGraphPartition lb -> [GraphPartition lb] -> [GraphPartition lb]
forall a. a -> [a] -> [a]
:[GraphPartition lb]
moreparts

makeStatements :: 
    (Eq lb) =>
    LabelledArcs lb
    -> PState lb (GraphPartition lb, [LabelledArcs lb])
makeStatements :: LabelledArcs lb -> PState lb (GraphPartition lb, [LabelledArcs lb])
makeStatements (lb
sub,NonEmpty (Arc lb)
stmts) = do
    [(LabelledPartition lb, [LabelledArcs lb])]
propmore <- (Arc lb
 -> StateT
      (MakePartitionState lb)
      Identity
      (LabelledPartition lb, [LabelledArcs lb]))
-> [Arc lb]
-> StateT
     (MakePartitionState lb)
     Identity
     [(LabelledPartition lb, [LabelledArcs lb])]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Arc lb
-> StateT
     (MakePartitionState lb)
     Identity
     (LabelledPartition lb, [LabelledArcs lb])
forall lb.
Eq lb =>
Arc lb -> PState lb (LabelledPartition lb, [LabelledArcs lb])
makeStatement (NonEmpty (Arc lb) -> [Arc lb]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty (Arc lb)
stmts)
    let ([LabelledPartition lb]
props,[[LabelledArcs lb]]
moresubs) = [(LabelledPartition lb, [LabelledArcs lb])]
-> ([LabelledPartition lb], [[LabelledArcs lb]])
forall a b. [(a, b)] -> ([a], [b])
unzip [(LabelledPartition lb, [LabelledArcs lb])]
propmore
    (GraphPartition lb, [LabelledArcs lb])
-> PState lb (GraphPartition lb, [LabelledArcs lb])
forall (m :: * -> *) a. Monad m => a -> m a
return (lb -> NonEmpty (LabelledPartition lb) -> GraphPartition lb
forall lb.
lb -> NonEmpty (lb, GraphPartition lb) -> GraphPartition lb
PartSub lb
sub ([LabelledPartition lb] -> NonEmpty (LabelledPartition lb)
forall a. [a] -> NonEmpty a
NE.fromList [LabelledPartition lb]
props), [[LabelledArcs lb]] -> [LabelledArcs lb]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[LabelledArcs lb]]
moresubs)
    -- return (PartSub sub props, concat moresubs)

makeStatement :: 
    (Eq lb) =>
    Arc lb
    -> PState lb (LabelledPartition lb, [LabelledArcs lb])
makeStatement :: Arc lb -> PState lb (LabelledPartition lb, [LabelledArcs lb])
makeStatement (Arc lb
_ lb
prop lb
obj) = do
    [LabelledArcs lb]
intobj <- lb -> PState lb [LabelledArcs lb]
forall lb. Eq lb => lb -> PState lb [LabelledArcs lb]
pickIntSubject lb
obj
    (GraphPartition lb
gpobj, [LabelledArcs lb]
moresubs) <- if [LabelledArcs lb] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LabelledArcs lb]
intobj
                         then do
                             [LabelledArcs lb]
ms <- lb -> PState lb [LabelledArcs lb]
forall lb. Eq lb => lb -> PState lb [LabelledArcs lb]
pickVarSubject lb
obj
                             (GraphPartition lb, [LabelledArcs lb])
-> StateT
     (MakePartitionState lb)
     Identity
     (GraphPartition lb, [LabelledArcs lb])
forall (m :: * -> *) a. Monad m => a -> m a
return (lb -> GraphPartition lb
forall lb. lb -> GraphPartition lb
PartObj lb
obj,[LabelledArcs lb]
ms)
                         else LabelledArcs lb
-> StateT
     (MakePartitionState lb)
     Identity
     (GraphPartition lb, [LabelledArcs lb])
forall lb.
Eq lb =>
LabelledArcs lb -> PState lb (GraphPartition lb, [LabelledArcs lb])
makeStatements ([LabelledArcs lb] -> LabelledArcs lb
forall a. [a] -> a
head [LabelledArcs lb]
intobj)
    (LabelledPartition lb, [LabelledArcs lb])
-> PState lb (LabelledPartition lb, [LabelledArcs lb])
forall (m :: * -> *) a. Monad m => a -> m a
return ((lb
prop,GraphPartition lb
gpobj), [LabelledArcs lb]
moresubs)

pickNextSubject :: PState lb [LabelledArcs lb]
pickNextSubject :: PState lb [LabelledArcs lb]
pickNextSubject = do
    ([LabelledArcs lb]
a1,[LabelledArcs lb]
a2,[LabelledArcs lb]
a3) <- StateT
  ([LabelledArcs lb], [LabelledArcs lb], [LabelledArcs lb])
  Identity
  ([LabelledArcs lb], [LabelledArcs lb], [LabelledArcs lb])
forall s (m :: * -> *). MonadState s m => m s
get
    let ([LabelledArcs lb]
s,([LabelledArcs lb], [LabelledArcs lb], [LabelledArcs lb])
st) = case ([LabelledArcs lb]
a1,[LabelledArcs lb]
a2,[LabelledArcs lb]
a3) of
                   (s1h:s1t,[LabelledArcs lb]
s2,[LabelledArcs lb]
s3) -> ([LabelledArcs lb
s1h],([LabelledArcs lb]
s1t,[LabelledArcs lb]
s2,[LabelledArcs lb]
s3))
                   ([],s2h:s2t,[LabelledArcs lb]
s3) -> ([LabelledArcs lb
s2h],([],[LabelledArcs lb]
s2t,[LabelledArcs lb]
s3))
                   ([],[],s3h:s3t) -> ([LabelledArcs lb
s3h],([],[],[LabelledArcs lb]
s3t))
                   ([],[],[])      -> ([]   ,([],[],[] ))
    ([LabelledArcs lb], [LabelledArcs lb], [LabelledArcs lb])
-> StateT
     ([LabelledArcs lb], [LabelledArcs lb], [LabelledArcs lb])
     Identity
     ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put ([LabelledArcs lb], [LabelledArcs lb], [LabelledArcs lb])
st
    [LabelledArcs lb] -> PState lb [LabelledArcs lb]
forall (m :: * -> *) a. Monad m => a -> m a
return [LabelledArcs lb]
s

pickIntSubject :: (Eq lb) =>
    lb 
    -> PState lb [LabelledArcs lb]
pickIntSubject :: lb -> PState lb [LabelledArcs lb]
pickIntSubject lb
sub = do
    ([LabelledArcs lb]
s1,[LabelledArcs lb]
s2,[LabelledArcs lb]
s3) <- StateT
  ([LabelledArcs lb], [LabelledArcs lb], [LabelledArcs lb])
  Identity
  ([LabelledArcs lb], [LabelledArcs lb], [LabelledArcs lb])
forall s (m :: * -> *). MonadState s m => m s
get
    let varsub :: Maybe (LabelledArcs lb, [LabelledArcs lb])
varsub = (lb -> LabelledArcs lb -> Bool)
-> lb
-> [LabelledArcs lb]
-> Maybe (LabelledArcs lb, [LabelledArcs lb])
forall b a. (b -> a -> Bool) -> b -> [a] -> Maybe (a, [a])
removeBy (\lb
x->(lb
xlb -> lb -> Bool
forall a. Eq a => a -> a -> Bool
==)(lb -> Bool) -> (LabelledArcs lb -> lb) -> LabelledArcs lb -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.LabelledArcs lb -> lb
forall a b. (a, b) -> a
fst) lb
sub [LabelledArcs lb]
s3
    case Maybe (LabelledArcs lb, [LabelledArcs lb])
varsub of
        Just (LabelledArcs lb
vs, [LabelledArcs lb]
s3new) -> ([LabelledArcs lb], [LabelledArcs lb], [LabelledArcs lb])
-> StateT
     ([LabelledArcs lb], [LabelledArcs lb], [LabelledArcs lb])
     Identity
     ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put ([LabelledArcs lb]
s1,[LabelledArcs lb]
s2,[LabelledArcs lb]
s3new) StateT
  ([LabelledArcs lb], [LabelledArcs lb], [LabelledArcs lb])
  Identity
  ()
-> PState lb [LabelledArcs lb] -> PState lb [LabelledArcs lb]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [LabelledArcs lb] -> PState lb [LabelledArcs lb]
forall (m :: * -> *) a. Monad m => a -> m a
return [LabelledArcs lb
vs]
        Maybe (LabelledArcs lb, [LabelledArcs lb])
Nothing          -> [LabelledArcs lb] -> PState lb [LabelledArcs lb]
forall (m :: * -> *) a. Monad m => a -> m a
return []

pickVarSubject :: 
    (Eq lb) =>
    lb -> 
    PState lb [LabelledArcs lb]
pickVarSubject :: lb -> PState lb [LabelledArcs lb]
pickVarSubject lb
sub = do
    ([LabelledArcs lb]
s1,[LabelledArcs lb]
s2,[LabelledArcs lb]
s3) <- StateT
  ([LabelledArcs lb], [LabelledArcs lb], [LabelledArcs lb])
  Identity
  ([LabelledArcs lb], [LabelledArcs lb], [LabelledArcs lb])
forall s (m :: * -> *). MonadState s m => m s
get
    let varsub :: Maybe (LabelledArcs lb, [LabelledArcs lb])
varsub = (lb -> LabelledArcs lb -> Bool)
-> lb
-> [LabelledArcs lb]
-> Maybe (LabelledArcs lb, [LabelledArcs lb])
forall b a. (b -> a -> Bool) -> b -> [a] -> Maybe (a, [a])
removeBy (\lb
x->(lb
xlb -> lb -> Bool
forall a. Eq a => a -> a -> Bool
==)(lb -> Bool) -> (LabelledArcs lb -> lb) -> LabelledArcs lb -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.LabelledArcs lb -> lb
forall a b. (a, b) -> a
fst) lb
sub [LabelledArcs lb]
s2
    case Maybe (LabelledArcs lb, [LabelledArcs lb])
varsub of
        Just (LabelledArcs lb
vs, [LabelledArcs lb]
s2new) -> ([LabelledArcs lb], [LabelledArcs lb], [LabelledArcs lb])
-> StateT
     ([LabelledArcs lb], [LabelledArcs lb], [LabelledArcs lb])
     Identity
     ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put ([LabelledArcs lb]
s1,[LabelledArcs lb]
s2new,[LabelledArcs lb]
s3) StateT
  ([LabelledArcs lb], [LabelledArcs lb], [LabelledArcs lb])
  Identity
  ()
-> PState lb [LabelledArcs lb] -> PState lb [LabelledArcs lb]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [LabelledArcs lb] -> PState lb [LabelledArcs lb]
forall (m :: * -> *) a. Monad m => a -> m a
return [LabelledArcs lb
vs]
        Maybe (LabelledArcs lb, [LabelledArcs lb])
_                -> [LabelledArcs lb] -> PState lb [LabelledArcs lb]
forall (m :: * -> *) a. Monad m => a -> m a
return []

------------------------------------------------------------
--  Other useful functions
------------------------------------------------------------

-- | Create a list of pairs of corresponding Partitions that
--  are unequal.
comparePartitions :: (Label lb) =>
    PartitionedGraph lb 
    -> PartitionedGraph lb
    -> [(Maybe (GraphPartition lb), Maybe (GraphPartition lb))]
comparePartitions :: PartitionedGraph lb
-> PartitionedGraph lb
-> [(Maybe (GraphPartition lb), Maybe (GraphPartition lb))]
comparePartitions (PartitionedGraph [GraphPartition lb]
gp1) (PartitionedGraph [GraphPartition lb]
gp2) =
    [GraphPartition lb]
-> [GraphPartition lb]
-> [(Maybe (GraphPartition lb), Maybe (GraphPartition lb))]
forall lb.
Label lb =>
[GraphPartition lb]
-> [GraphPartition lb]
-> [(Maybe (GraphPartition lb), Maybe (GraphPartition lb))]
comparePartitions1 ([GraphPartition lb] -> [GraphPartition lb]
forall a. [a] -> [a]
reverse [GraphPartition lb]
gp1) ([GraphPartition lb] -> [GraphPartition lb]
forall a. [a] -> [a]
reverse [GraphPartition lb]
gp2)

comparePartitions1 :: (Label lb) =>
    [GraphPartition lb] 
    -> [GraphPartition lb]
    -> [(Maybe (GraphPartition lb),Maybe (GraphPartition lb))]
comparePartitions1 :: [GraphPartition lb]
-> [GraphPartition lb]
-> [(Maybe (GraphPartition lb), Maybe (GraphPartition lb))]
comparePartitions1 [GraphPartition lb]
pg1 [GraphPartition lb]
pg2 =
        [(Maybe (GraphPartition lb), Maybe (GraphPartition lb))]
ds [(Maybe (GraphPartition lb), Maybe (GraphPartition lb))]
-> [(Maybe (GraphPartition lb), Maybe (GraphPartition lb))]
-> [(Maybe (GraphPartition lb), Maybe (GraphPartition lb))]
forall a. [a] -> [a] -> [a]
++ [ (GraphPartition lb -> Maybe (GraphPartition lb)
forall a. a -> Maybe a
Just GraphPartition lb
r1p,Maybe (GraphPartition lb)
forall a. Maybe a
Nothing) | GraphPartition lb
r1p<-[GraphPartition lb]
r1 ]
           [(Maybe (GraphPartition lb), Maybe (GraphPartition lb))]
-> [(Maybe (GraphPartition lb), Maybe (GraphPartition lb))]
-> [(Maybe (GraphPartition lb), Maybe (GraphPartition lb))]
forall a. [a] -> [a] -> [a]
++ [ (Maybe (GraphPartition lb)
forall a. Maybe a
Nothing,GraphPartition lb -> Maybe (GraphPartition lb)
forall a. a -> Maybe a
Just GraphPartition lb
r2p) | GraphPartition lb
r2p<-[GraphPartition lb]
r2 ]
    where
        ([(Maybe (GraphPartition lb), Maybe (GraphPartition lb))]
ds,[GraphPartition lb]
r1,[GraphPartition lb]
r2) = (GraphPartition lb
 -> GraphPartition lb
 -> Maybe [(Maybe (GraphPartition lb), Maybe (GraphPartition lb))])
-> [GraphPartition lb]
-> [GraphPartition lb]
-> ([(Maybe (GraphPartition lb), Maybe (GraphPartition lb))],
    [GraphPartition lb], [GraphPartition lb])
forall a d. (a -> a -> Maybe [d]) -> [a] -> [a] -> ([d], [a], [a])
listDifferences GraphPartition lb
-> GraphPartition lb
-> Maybe [(Maybe (GraphPartition lb), Maybe (GraphPartition lb))]
forall lb.
Label lb =>
GraphPartition lb
-> GraphPartition lb
-> Maybe [(Maybe (GraphPartition lb), Maybe (GraphPartition lb))]
comparePartitions2 [GraphPartition lb]
pg1 [GraphPartition lb]
pg2

--  Compare two graph partitions, with three possible outcomes:
--    Nothing    -> no match
--    Just []    -> total match
--    Just [...] -> partial match, with mismatched sub-partitions listed.
--
--  A partial match occurs when the leading nodes are non-variable and
--  equal, but something else in the partition does not match.
--
--  A complete match can be achieved with variable nodes that have
--  different labels
--
comparePartitions2 :: (Label lb) =>
    GraphPartition lb 
    -> GraphPartition lb
    -> Maybe [(Maybe (GraphPartition lb), Maybe (GraphPartition lb))]
comparePartitions2 :: GraphPartition lb
-> GraphPartition lb
-> Maybe [(Maybe (GraphPartition lb), Maybe (GraphPartition lb))]
comparePartitions2 (PartObj lb
l1) (PartObj lb
l2) =
    if lb -> lb -> Bool
forall lb. Label lb => lb -> lb -> Bool
matchNodes lb
l1 lb
l2 then [(Maybe (GraphPartition lb), Maybe (GraphPartition lb))]
-> Maybe [(Maybe (GraphPartition lb), Maybe (GraphPartition lb))]
forall a. a -> Maybe a
Just [] else Maybe [(Maybe (GraphPartition lb), Maybe (GraphPartition lb))]
forall a. Maybe a
Nothing
comparePartitions2 pg1 :: GraphPartition lb
pg1@(PartSub lb
l1 NonEmpty (lb, GraphPartition lb)
p1s) pg2 :: GraphPartition lb
pg2@(PartSub lb
l2 NonEmpty (lb, GraphPartition lb)
p2s) =
    if Bool
match then Maybe [(Maybe (GraphPartition lb), Maybe (GraphPartition lb))]
comp1 else Maybe [(Maybe (GraphPartition lb), Maybe (GraphPartition lb))]
forall a. Maybe a
Nothing
    where
        comp1 :: Maybe [(Maybe (GraphPartition lb), Maybe (GraphPartition lb))]
comp1  = case lb
-> lb
-> NonEmpty (lb, GraphPartition lb)
-> NonEmpty (lb, GraphPartition lb)
-> Maybe [(Maybe (GraphPartition lb), Maybe (GraphPartition lb))]
forall lb.
Label lb =>
lb
-> lb
-> NonEmpty (LabelledPartition lb)
-> NonEmpty (LabelledPartition lb)
-> Maybe [(Maybe (GraphPartition lb), Maybe (GraphPartition lb))]
comparePartitions3 lb
l1 lb
l2 NonEmpty (lb, GraphPartition lb)
p1s NonEmpty (lb, GraphPartition lb)
p2s of
                    Maybe [(Maybe (GraphPartition lb), Maybe (GraphPartition lb))]
Nothing -> if Bool
matchVar then Maybe [(Maybe (GraphPartition lb), Maybe (GraphPartition lb))]
forall a. Maybe a
Nothing
                                           else [(Maybe (GraphPartition lb), Maybe (GraphPartition lb))]
-> Maybe [(Maybe (GraphPartition lb), Maybe (GraphPartition lb))]
forall a. a -> Maybe a
Just [(GraphPartition lb -> Maybe (GraphPartition lb)
forall a. a -> Maybe a
Just GraphPartition lb
pg1,GraphPartition lb -> Maybe (GraphPartition lb)
forall a. a -> Maybe a
Just GraphPartition lb
pg2)]
                    Just [] -> [(Maybe (GraphPartition lb), Maybe (GraphPartition lb))]
-> Maybe [(Maybe (GraphPartition lb), Maybe (GraphPartition lb))]
forall a. a -> Maybe a
Just []
                    Just [(Maybe (GraphPartition lb), Maybe (GraphPartition lb))]
ps -> {- if matchVar then Nothing else -} [(Maybe (GraphPartition lb), Maybe (GraphPartition lb))]
-> Maybe [(Maybe (GraphPartition lb), Maybe (GraphPartition lb))]
forall a. a -> Maybe a
Just [(Maybe (GraphPartition lb), Maybe (GraphPartition lb))]
ps
        matchVar :: Bool
matchVar = lb -> Bool
forall lb. Label lb => lb -> Bool
labelIsVar lb
l1 Bool -> Bool -> Bool
&& lb -> Bool
forall lb. Label lb => lb -> Bool
labelIsVar lb
l2
        match :: Bool
match    = Bool
matchVar Bool -> Bool -> Bool
|| lb
l1 lb -> lb -> Bool
forall a. Eq a => a -> a -> Bool
== lb
l2
comparePartitions2 GraphPartition lb
pg1 GraphPartition lb
pg2 =
    if Bool -> Bool
not (lb -> Bool
forall lb. Label lb => lb -> Bool
labelIsVar lb
l1) Bool -> Bool -> Bool
&& lb
l1 lb -> lb -> Bool
forall a. Eq a => a -> a -> Bool
== lb
l2
        then [(Maybe (GraphPartition lb), Maybe (GraphPartition lb))]
-> Maybe [(Maybe (GraphPartition lb), Maybe (GraphPartition lb))]
forall a. a -> Maybe a
Just [(GraphPartition lb -> Maybe (GraphPartition lb)
forall a. a -> Maybe a
Just GraphPartition lb
pg1,GraphPartition lb -> Maybe (GraphPartition lb)
forall a. a -> Maybe a
Just GraphPartition lb
pg2)]
        else Maybe [(Maybe (GraphPartition lb), Maybe (GraphPartition lb))]
forall a. Maybe a
Nothing
    where
        l1 :: lb
l1 = GraphPartition lb -> lb
forall lb. GraphPartition lb -> lb
node GraphPartition lb
pg1
        l2 :: lb
l2 = GraphPartition lb -> lb
forall lb. GraphPartition lb -> lb
node GraphPartition lb
pg2

comparePartitions3 :: (Label lb) =>
    lb 
    -> lb 
    -> NonEmpty (LabelledPartition lb)
    -> NonEmpty (LabelledPartition lb)
    -> Maybe [(Maybe (GraphPartition lb),Maybe (GraphPartition lb))]
comparePartitions3 :: lb
-> lb
-> NonEmpty (LabelledPartition lb)
-> NonEmpty (LabelledPartition lb)
-> Maybe [(Maybe (GraphPartition lb), Maybe (GraphPartition lb))]
comparePartitions3 lb
l1 lb
l2 NonEmpty (LabelledPartition lb)
s1s NonEmpty (LabelledPartition lb)
s2s = [(Maybe (GraphPartition lb), Maybe (GraphPartition lb))]
-> Maybe [(Maybe (GraphPartition lb), Maybe (GraphPartition lb))]
forall a. a -> Maybe a
Just ([(Maybe (GraphPartition lb), Maybe (GraphPartition lb))]
 -> Maybe [(Maybe (GraphPartition lb), Maybe (GraphPartition lb))])
-> [(Maybe (GraphPartition lb), Maybe (GraphPartition lb))]
-> Maybe [(Maybe (GraphPartition lb), Maybe (GraphPartition lb))]
forall a b. (a -> b) -> a -> b
$
        [(Maybe (GraphPartition lb), Maybe (GraphPartition lb))]
ds [(Maybe (GraphPartition lb), Maybe (GraphPartition lb))]
-> [(Maybe (GraphPartition lb), Maybe (GraphPartition lb))]
-> [(Maybe (GraphPartition lb), Maybe (GraphPartition lb))]
forall a. [a] -> [a] -> [a]
++ [ (GraphPartition lb -> Maybe (GraphPartition lb)
forall a. a -> Maybe a
Just (lb -> NonEmpty (LabelledPartition lb) -> GraphPartition lb
forall lb.
lb -> NonEmpty (lb, GraphPartition lb) -> GraphPartition lb
PartSub lb
l1 (LabelledPartition lb
r1p LabelledPartition lb
-> [LabelledPartition lb] -> NonEmpty (LabelledPartition lb)
forall a. a -> [a] -> NonEmpty a
:| [])),Maybe (GraphPartition lb)
forall a. Maybe a
Nothing) | LabelledPartition lb
r1p<-[LabelledPartition lb]
r1 ]
           [(Maybe (GraphPartition lb), Maybe (GraphPartition lb))]
-> [(Maybe (GraphPartition lb), Maybe (GraphPartition lb))]
-> [(Maybe (GraphPartition lb), Maybe (GraphPartition lb))]
forall a. [a] -> [a] -> [a]
++ [ (Maybe (GraphPartition lb)
forall a. Maybe a
Nothing,GraphPartition lb -> Maybe (GraphPartition lb)
forall a. a -> Maybe a
Just (lb -> NonEmpty (LabelledPartition lb) -> GraphPartition lb
forall lb.
lb -> NonEmpty (lb, GraphPartition lb) -> GraphPartition lb
PartSub lb
l2 (LabelledPartition lb
r2p LabelledPartition lb
-> [LabelledPartition lb] -> NonEmpty (LabelledPartition lb)
forall a. a -> [a] -> NonEmpty a
:| []))) | LabelledPartition lb
r2p<-[LabelledPartition lb]
r2 ]
    where
        ([(Maybe (GraphPartition lb), Maybe (GraphPartition lb))]
ds,[LabelledPartition lb]
r1,[LabelledPartition lb]
r2) = (LabelledPartition lb
 -> LabelledPartition lb
 -> Maybe [(Maybe (GraphPartition lb), Maybe (GraphPartition lb))])
-> [LabelledPartition lb]
-> [LabelledPartition lb]
-> ([(Maybe (GraphPartition lb), Maybe (GraphPartition lb))],
    [LabelledPartition lb], [LabelledPartition lb])
forall a d. (a -> a -> Maybe [d]) -> [a] -> [a] -> ([d], [a], [a])
listDifferences 
                     (lb
-> lb
-> LabelledPartition lb
-> LabelledPartition lb
-> Maybe [(Maybe (GraphPartition lb), Maybe (GraphPartition lb))]
forall lb.
Label lb =>
lb
-> lb
-> LabelledPartition lb
-> LabelledPartition lb
-> Maybe [(Maybe (GraphPartition lb), Maybe (GraphPartition lb))]
comparePartitions4 lb
l1 lb
l2) 
                     (NonEmpty (LabelledPartition lb) -> [LabelledPartition lb]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty (LabelledPartition lb)
s1s)
                     (NonEmpty (LabelledPartition lb) -> [LabelledPartition lb]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty (LabelledPartition lb)
s2s)

comparePartitions4 :: (Label lb) =>
    lb 
    -> lb 
    -> LabelledPartition lb 
    -> LabelledPartition lb
    -> Maybe [(Maybe (GraphPartition lb),Maybe (GraphPartition lb))]
comparePartitions4 :: lb
-> lb
-> LabelledPartition lb
-> LabelledPartition lb
-> Maybe [(Maybe (GraphPartition lb), Maybe (GraphPartition lb))]
comparePartitions4 lb
_ lb
_ (lb
p1,GraphPartition lb
o1) (lb
p2,GraphPartition lb
o2) =
    if lb -> lb -> Bool
forall lb. Label lb => lb -> lb -> Bool
matchNodes lb
p1 lb
p2 then Maybe [(Maybe (GraphPartition lb), Maybe (GraphPartition lb))]
comp1 else Maybe [(Maybe (GraphPartition lb), Maybe (GraphPartition lb))]
forall a. Maybe a
Nothing
    where
        comp1 :: Maybe [(Maybe (GraphPartition lb), Maybe (GraphPartition lb))]
comp1   = case GraphPartition lb
-> GraphPartition lb
-> Maybe [(Maybe (GraphPartition lb), Maybe (GraphPartition lb))]
forall lb.
Label lb =>
GraphPartition lb
-> GraphPartition lb
-> Maybe [(Maybe (GraphPartition lb), Maybe (GraphPartition lb))]
comparePartitions2 GraphPartition lb
o1 GraphPartition lb
o2 of
                    Maybe [(Maybe (GraphPartition lb), Maybe (GraphPartition lb))]
Nothing -> [(Maybe (GraphPartition lb), Maybe (GraphPartition lb))]
-> Maybe [(Maybe (GraphPartition lb), Maybe (GraphPartition lb))]
forall a. a -> Maybe a
Just [(GraphPartition lb -> Maybe (GraphPartition lb)
forall a. a -> Maybe a
Just GraphPartition lb
o1,GraphPartition lb -> Maybe (GraphPartition lb)
forall a. a -> Maybe a
Just GraphPartition lb
o2)]
                    Maybe [(Maybe (GraphPartition lb), Maybe (GraphPartition lb))]
ds      -> Maybe [(Maybe (GraphPartition lb), Maybe (GraphPartition lb))]
ds

matchNodes :: (Label lb) => lb -> lb -> Bool
matchNodes :: lb -> lb -> Bool
matchNodes lb
l1 lb
l2
    | lb -> Bool
forall lb. Label lb => lb -> Bool
labelIsVar lb
l1 = lb -> Bool
forall lb. Label lb => lb -> Bool
labelIsVar lb
l2
    | Bool
otherwise     = lb
l1 lb -> lb -> Bool
forall a. Eq a => a -> a -> Bool
== lb
l2


------------------------------------------------------------
--  Helpers
------------------------------------------------------------

-- |Collect a list of items by some comparison of a selected component
--  or other derived value.
--
--  cmp     a comparison function that determines if a pair of values
--          should be grouped together
--  sel     a function that selects a value from any item
--
--  Example:    collect fst [(1,'a'),(2,'b'),(1,'c')] =
--                  [(1,[(1,'a'),(1,'c')]),(2,[(2,'b')])]
--
collect :: (Eq b) => (a->b) -> [a] -> [(b, NonEmpty a)]
collect :: (a -> b) -> [a] -> [(b, NonEmpty a)]
collect = (b -> b -> Bool) -> (a -> b) -> [a] -> [(b, NonEmpty a)]
forall b a.
(b -> b -> Bool) -> (a -> b) -> [a] -> [(b, NonEmpty a)]
collectBy b -> b -> Bool
forall a. Eq a => a -> a -> Bool
(==)

collectBy :: (b->b->Bool) -> (a->b) -> [a] -> [(b, NonEmpty a)]
collectBy :: (b -> b -> Bool) -> (a -> b) -> [a] -> [(b, NonEmpty a)]
collectBy b -> b -> Bool
cmp a -> b
sel = ((b, NonEmpty a) -> (b, NonEmpty a))
-> [(b, NonEmpty a)] -> [(b, NonEmpty a)]
forall a b. (a -> b) -> [a] -> [b]
map (b, NonEmpty a) -> (b, NonEmpty a)
forall b a. (b, NonEmpty a) -> (b, NonEmpty a)
reverseCollection ([(b, NonEmpty a)] -> [(b, NonEmpty a)])
-> ([a] -> [(b, NonEmpty a)]) -> [a] -> [(b, NonEmpty a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b -> b -> Bool)
-> (a -> b) -> [(b, NonEmpty a)] -> [a] -> [(b, NonEmpty a)]
forall b a.
(b -> b -> Bool)
-> (a -> b) -> [(b, NonEmpty a)] -> [a] -> [(b, NonEmpty a)]
collectBy1 b -> b -> Bool
cmp a -> b
sel []

collectBy1 :: (b->b->Bool) -> (a->b) -> [(b, NonEmpty a)] -> [a] -> [(b, NonEmpty a)]
collectBy1 :: (b -> b -> Bool)
-> (a -> b) -> [(b, NonEmpty a)] -> [a] -> [(b, NonEmpty a)]
collectBy1 b -> b -> Bool
_   a -> b
_   [(b, NonEmpty a)]
sofar []     = [(b, NonEmpty a)]
sofar
collectBy1 b -> b -> Bool
cmp a -> b
sel [(b, NonEmpty a)]
sofar (a
a:[a]
as) =
    (b -> b -> Bool)
-> (a -> b) -> [(b, NonEmpty a)] -> [a] -> [(b, NonEmpty a)]
forall b a.
(b -> b -> Bool)
-> (a -> b) -> [(b, NonEmpty a)] -> [a] -> [(b, NonEmpty a)]
collectBy1 b -> b -> Bool
cmp a -> b
sel ((b -> b -> Bool)
-> (a -> b) -> a -> [(b, NonEmpty a)] -> [(b, NonEmpty a)]
forall b a.
(b -> b -> Bool)
-> (a -> b) -> a -> [(b, NonEmpty a)] -> [(b, NonEmpty a)]
collectBy2 b -> b -> Bool
cmp a -> b
sel a
a [(b, NonEmpty a)]
sofar) [a]
as

collectBy2 :: (b->b->Bool) -> (a->b) -> a -> [(b, NonEmpty a)] -> [(b, NonEmpty a)]
collectBy2 :: (b -> b -> Bool)
-> (a -> b) -> a -> [(b, NonEmpty a)] -> [(b, NonEmpty a)]
collectBy2 b -> b -> Bool
_   a -> b
sel a
a [] = [(a -> b
sel a
a, a
a a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:| [])]
collectBy2 b -> b -> Bool
cmp a -> b
sel a
a (col :: (b, NonEmpty a)
col@(b
k,NonEmpty a
as) : [(b, NonEmpty a)]
cols)
    | b -> b -> Bool
cmp b
ka b
k  = (b
k, a
a a -> NonEmpty a -> NonEmpty a
forall a. a -> NonEmpty a -> NonEmpty a
<| NonEmpty a
as) (b, NonEmpty a) -> [(b, NonEmpty a)] -> [(b, NonEmpty a)]
forall a. a -> [a] -> [a]
: [(b, NonEmpty a)]
cols
    | Bool
otherwise = (b, NonEmpty a)
col (b, NonEmpty a) -> [(b, NonEmpty a)] -> [(b, NonEmpty a)]
forall a. a -> [a] -> [a]
: (b -> b -> Bool)
-> (a -> b) -> a -> [(b, NonEmpty a)] -> [(b, NonEmpty a)]
forall b a.
(b -> b -> Bool)
-> (a -> b) -> a -> [(b, NonEmpty a)] -> [(b, NonEmpty a)]
collectBy2 b -> b -> Bool
cmp a -> b
sel a
a [(b, NonEmpty a)]
cols
    where
        ka :: b
ka = a -> b
sel a
a

reverseCollection :: (b, NonEmpty a) -> (b, NonEmpty a)
reverseCollection :: (b, NonEmpty a) -> (b, NonEmpty a)
reverseCollection (b
k,NonEmpty a
as) = (b
k, NonEmpty a -> NonEmpty a
forall a. NonEmpty a -> NonEmpty a
NE.reverse NonEmpty a
as)

{-
-- Example/test:
testCollect1 :: [(Int, [(Int, Char)])]
testCollect1 = collect fst [(1,'a'),(2,'b'),(1,'c'),(1,'d'),(2,'d'),(3,'d')]

testCollect2 :: Bool
testCollect2 = testCollect1
                == [ (1,[(1,'a'),(1,'c'),(1,'d')])
                   , (2,[(2,'b'),(2,'d')])
                   , (3,[(3,'d')])
                   ]
-}

-- |Add new values to an existing list of collections.
--  The list of collections is not extended, but each collection is
--  augmented with a further list of values from the supplied list,
--  each of which are related to the existing collection in some way.
--
--  NOTE: the basic pattern of @collect@ and @collectMore@ is similar,
--  and might be generalized into a common set of core functions.
--
collectMore :: (Eq b) => (a->b) -> [a] -> [(b,c)] -> [(b,(c,[a]))]
collectMore :: (a -> b) -> [a] -> [(b, c)] -> [(b, (c, [a]))]
collectMore = (b -> b -> Bool) -> (a -> b) -> [a] -> [(b, c)] -> [(b, (c, [a]))]
forall b a c.
(b -> b -> Bool) -> (a -> b) -> [a] -> [(b, c)] -> [(b, (c, [a]))]
collectMoreBy b -> b -> Bool
forall a. Eq a => a -> a -> Bool
(==)

collectMoreBy ::
    (b->b->Bool) -> (a->b) -> [a] -> [(b,c)] -> [(b,(c,[a]))]
collectMoreBy :: (b -> b -> Bool) -> (a -> b) -> [a] -> [(b, c)] -> [(b, (c, [a]))]
collectMoreBy b -> b -> Bool
cmp a -> b
sel [a]
as [(b, c)]
cols =
    ((b, (c, [a])) -> (b, (c, [a])))
-> [(b, (c, [a]))] -> [(b, (c, [a]))]
forall a b. (a -> b) -> [a] -> [b]
map (b, (c, [a])) -> (b, (c, [a]))
forall b c a. (b, (c, [a])) -> (b, (c, [a]))
reverseMoreCollection ([(b, (c, [a]))] -> [(b, (c, [a]))])
-> [(b, (c, [a]))] -> [(b, (c, [a]))]
forall a b. (a -> b) -> a -> b
$
    (b -> b -> Bool)
-> (a -> b) -> [a] -> [(b, (c, [a]))] -> [(b, (c, [a]))]
forall b a c.
(b -> b -> Bool)
-> (a -> b) -> [a] -> [(b, (c, [a]))] -> [(b, (c, [a]))]
collectMoreBy1 b -> b -> Bool
cmp a -> b
sel [a]
as (((b, c) -> (b, (c, [a]))) -> [(b, c)] -> [(b, (c, [a]))]
forall a b. (a -> b) -> [a] -> [b]
map (\ (b
b,c
cs) -> (b
b,(c
cs,[])) ) [(b, c)]
cols)

collectMoreBy1 ::
    (b->b->Bool) -> (a->b) -> [a] -> [(b,(c,[a]))] -> [(b,(c,[a]))]
collectMoreBy1 :: (b -> b -> Bool)
-> (a -> b) -> [a] -> [(b, (c, [a]))] -> [(b, (c, [a]))]
collectMoreBy1 b -> b -> Bool
_   a -> b
_   []     [(b, (c, [a]))]
cols = [(b, (c, [a]))]
cols
collectMoreBy1 b -> b -> Bool
cmp a -> b
sel (a
a:[a]
as) [(b, (c, [a]))]
cols =
    (b -> b -> Bool)
-> (a -> b) -> [a] -> [(b, (c, [a]))] -> [(b, (c, [a]))]
forall b a c.
(b -> b -> Bool)
-> (a -> b) -> [a] -> [(b, (c, [a]))] -> [(b, (c, [a]))]
collectMoreBy1 b -> b -> Bool
cmp a -> b
sel [a]
as ((b -> b -> Bool)
-> (a -> b) -> a -> [(b, (c, [a]))] -> [(b, (c, [a]))]
forall b a c.
(b -> b -> Bool)
-> (a -> b) -> a -> [(b, (c, [a]))] -> [(b, (c, [a]))]
collectMoreBy2 b -> b -> Bool
cmp a -> b
sel a
a [(b, (c, [a]))]
cols)

collectMoreBy2 ::
    (b->b->Bool) -> (a->b) -> a -> [(b,(c,[a]))] -> [(b,(c,[a]))]
collectMoreBy2 :: (b -> b -> Bool)
-> (a -> b) -> a -> [(b, (c, [a]))] -> [(b, (c, [a]))]
collectMoreBy2 b -> b -> Bool
_   a -> b
_   a
_ [] = []
collectMoreBy2 b -> b -> Bool
cmp a -> b
sel a
a (col :: (b, (c, [a]))
col@(b
k,(c
b,[a]
as)):[(b, (c, [a]))]
cols)
    | b -> b -> Bool
cmp (a -> b
sel a
a) b
k = (b
k,(c
b, a
aa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
as))(b, (c, [a])) -> [(b, (c, [a]))] -> [(b, (c, [a]))]
forall a. a -> [a] -> [a]
:[(b, (c, [a]))]
cols
    | Bool
otherwise     = (b, (c, [a]))
col(b, (c, [a])) -> [(b, (c, [a]))] -> [(b, (c, [a]))]
forall a. a -> [a] -> [a]
:(b -> b -> Bool)
-> (a -> b) -> a -> [(b, (c, [a]))] -> [(b, (c, [a]))]
forall b a c.
(b -> b -> Bool)
-> (a -> b) -> a -> [(b, (c, [a]))] -> [(b, (c, [a]))]
collectMoreBy2 b -> b -> Bool
cmp a -> b
sel a
a [(b, (c, [a]))]
cols

reverseMoreCollection :: (b,(c,[a])) -> (b,(c,[a]))
reverseMoreCollection :: (b, (c, [a])) -> (b, (c, [a]))
reverseMoreCollection (b
k,(c
c,[a]
as)) = (b
k,(c
c,[a] -> [a]
forall a. [a] -> [a]
reverse [a]
as))

{-
-- Example/test:
testCollectMore1 =
    collectMore snd [(111,1),(112,1),(211,2),(311,3),(411,4)] testCollect1

testCollectMore2 :: Bool
testCollectMore2 = testCollectMore1
                == [ (1,([(1,'a'),(1,'c'),(1,'d')],[(111,1),(112,1)]))
                   , (2,([(2,'b'),(2,'d')],[(211,2)]))
                   , (3,([(3,'d')],[(311,3)]))
                   ]
-}

-- |Remove supplied element from a list using the supplied test
--  function, and return Just the element removed and the
--  remaining list, or Nothing if no element was matched for removal.
--
{-
remove :: (Eq a) => a -> [a] -> Maybe (a,[a])
remove = removeBy (==)

testRemove1  = remove 3 [1,2,3,4,5]
testRemove2  = testRemove1 == Just (3,[1,2,4,5])
testRemove3  = remove 3 [1,2,4,5]
testRemove4  = testRemove3 == Nothing
testRemove5  = remove 5 [1,2,4,5]
testRemove6  = testRemove5 == Just (5,[1,2,4])
testRemove7  = remove 1 [1,2,4]
testRemove8  = testRemove7 == Just (1,[2,4])
testRemove9  = remove 2 [2]
testRemove10 = testRemove9 == Just (2,[])

-}

removeBy :: (b->a->Bool) -> b -> [a] -> Maybe (a,[a])
removeBy :: (b -> a -> Bool) -> b -> [a] -> Maybe (a, [a])
removeBy b -> a -> Bool
cmp b
a0 [a]
as = (b -> a -> Bool) -> b -> [a] -> [a] -> Maybe (a, [a])
forall b a. (b -> a -> Bool) -> b -> [a] -> [a] -> Maybe (a, [a])
removeBy1 b -> a -> Bool
cmp b
a0 [a]
as []

removeBy1 :: (b->a->Bool) -> b -> [a] -> [a] -> Maybe (a,[a])
removeBy1 :: (b -> a -> Bool) -> b -> [a] -> [a] -> Maybe (a, [a])
removeBy1 b -> a -> Bool
_   b
_  []     [a]
_     = Maybe (a, [a])
forall a. Maybe a
Nothing
removeBy1 b -> a -> Bool
cmp b
a0 (a
a:[a]
as) [a]
sofar
    | b -> a -> Bool
cmp b
a0 a
a  = (a, [a]) -> Maybe (a, [a])
forall a. a -> Maybe a
Just (a
a,[a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
reverseTo [a]
sofar [a]
as)
    | Bool
otherwise = (b -> a -> Bool) -> b -> [a] -> [a] -> Maybe (a, [a])
forall b a. (b -> a -> Bool) -> b -> [a] -> [a] -> Maybe (a, [a])
removeBy1 b -> a -> Bool
cmp b
a0 [a]
as (a
aa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
sofar)

-- |Reverse first argument, prepending the result to the second argument
--
reverseTo :: [a] -> [a] -> [a]
reverseTo :: [a] -> [a] -> [a]
reverseTo [a]
front [a]
back = ([a] -> a -> [a]) -> [a] -> [a] -> [a]
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((a -> [a] -> [a]) -> [a] -> a -> [a]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (:)) [a]
back [a]
front

-- |Remove each element from a list, returning a list of pairs,
--  each of which is the element removed and the list remaining.
--
removeEach :: [a] -> [(a,[a])]
removeEach :: [a] -> [(a, [a])]
removeEach [] = []
removeEach (a
a:[a]
as) = (a
a,[a]
as)(a, [a]) -> [(a, [a])] -> [(a, [a])]
forall a. a -> [a] -> [a]
:[ (a
a1,a
aa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
a1s) | (a
a1,[a]
a1s) <- [a] -> [(a, [a])]
forall a. [a] -> [(a, [a])]
removeEach [a]
as ]

{-
testRemoveEach1 = removeEach [1,2,3,4,5]
testRemoveEach2 = testRemoveEach1 ==
    [ (1,[2,3,4,5])
    , (2,[1,3,4,5])
    , (3,[1,2,4,5])
    , (4,[1,2,3,5])
    , (5,[1,2,3,4])
    ]
-}

-- |List differences between the members of two lists, where corresponding
--  elements may appear at arbitrary locations in the corresponding lists.
--
--  Elements are compared using the function 'cmp', which returns:
--  * Nothing  if the elements are completely unrelated
--  * Just []  if the elements are identical
--  * Just ds  if the elements are related but not identical, in which case
--             ds is a list of values describing differences between them.
--
--  Returns (ds,u1,u2), where:
--  ds is null if the related elements from each list are identical,
--  otherwise is a list of differences between the related elements.
--  u1 is a list of elements in a1 not related to elements in a2.
--  u2 is a list of elements in a2 not related to elements in a1.
--
listDifferences :: (a->a->Maybe [d]) -> [a] -> [a] -> ([d],[a],[a])
listDifferences :: (a -> a -> Maybe [d]) -> [a] -> [a] -> ([d], [a], [a])
listDifferences a -> a -> Maybe [d]
_   []       [a]
a2s = ([],[],[a]
a2s)
listDifferences a -> a -> Maybe [d]
cmp (a
a1:[a]
a1t) [a]
a2s =
    case Maybe ([d], [a])
mcomp of
        Maybe ([d], [a])
Nothing       -> [d] -> [a] -> [a] -> [a] -> ([d], [a], [a])
morediffs [] [a
a1] [a]
a1t [a]
a2s
        Just ([d]
ds,[a]
a2t) -> [d] -> [a] -> [a] -> [a] -> ([d], [a], [a])
morediffs [d]
ds []   [a]
a1t [a]
a2t
    where
        -- mcomp finds identical match, if there is one, or
        -- the first element in a2s related to a1, or Nothing
        -- [choose was listToMaybe,
        --  but that didn't handle repeated properties well]
        mcomp :: Maybe ([d], [a])
mcomp = [([d], [a])] -> Maybe ([d], [a])
forall a b. [([a], b)] -> Maybe ([a], b)
choose ([([d], [a])] -> Maybe ([d], [a]))
-> [([d], [a])] -> Maybe ([d], [a])
forall a b. (a -> b) -> a -> b
$ ((Maybe [d], [a]) -> Maybe ([d], [a]))
-> [(Maybe [d], [a])] -> [([d], [a])]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Maybe [d], [a]) -> Maybe ([d], [a])
forall a b. (Maybe a, b) -> Maybe (a, b)
maybeResult [(Maybe [d], [a])]
comps
        comps :: [(Maybe [d], [a])]
comps = [ (a -> a -> Maybe [d]
cmp a
a1 a
a2,[a]
a2t) | (a
a2,[a]
a2t) <- [a] -> [(a, [a])]
forall a. [a] -> [(a, [a])]
removeEach [a]
a2s ]
        maybeResult :: (Maybe a, b) -> Maybe (a, b)
maybeResult (Maybe a
Nothing,b
_)   = Maybe (a, b)
forall a. Maybe a
Nothing
        maybeResult (Just a
ds,b
a2t) = (a, b) -> Maybe (a, b)
forall a. a -> Maybe a
Just (a
ds,b
a2t)
        morediffs :: [d] -> [a] -> [a] -> [a] -> ([d], [a], [a])
morediffs [d]
xds [a]
xa1h [a]
xa1t [a]
xa2t  = ([d]
xds[d] -> [d] -> [d]
forall a. [a] -> [a] -> [a]
++[d]
xds1,[a]
xa1h[a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++[a]
xa1r,[a]
xa2r)
            where
                ([d]
xds1,[a]
xa1r,[a]
xa2r) = (a -> a -> Maybe [d]) -> [a] -> [a] -> ([d], [a], [a])
forall a d. (a -> a -> Maybe [d]) -> [a] -> [a] -> ([d], [a], [a])
listDifferences a -> a -> Maybe [d]
cmp [a]
xa1t [a]
xa2t
        choose :: [([a], b)] -> Maybe ([a], b)
choose  []       = Maybe ([a], b)
forall a. Maybe a
Nothing
        choose  ds :: [([a], b)]
ds@(([a], b)
d:[([a], b)]
_) = ([a], b) -> [([a], b)] -> Maybe ([a], b)
forall a b. ([a], b) -> [([a], b)] -> Maybe ([a], b)
choose1 ([a], b)
d [([a], b)]
ds
        choose1 :: ([a], b) -> [([a], b)] -> Maybe ([a], b)
choose1 ([a], b)
_ (d :: ([a], b)
d@([],b
_):[([a], b)]
_)  = ([a], b) -> Maybe ([a], b)
forall a. a -> Maybe a
Just ([a], b)
d
        choose1 ([a], b)
d []            = ([a], b) -> Maybe ([a], b)
forall a. a -> Maybe a
Just ([a], b)
d
        choose1 ([a], b)
d (([a], b)
_:[([a], b)]
ds)        = ([a], b) -> [([a], b)] -> Maybe ([a], b)
choose1 ([a], b)
d [([a], b)]
ds

{-
testcmp (l1,h1) (l2,h2)
    | (l1 >= h2) || (l2 >= h1) = Nothing
    | (l1 == l2) && (h1 == h2) = Just []
    | otherwise                = Just [((l1,h1),(l2,h2))]

testdiff1 = listDifferences testcmp
                [(12,15),(1,2),(3,4),(5,8),(10,11)]
                [(10,11),(0,1),(3,4),(6,9),(13,15)]
testdiff2 = testdiff1 == ([((12,15),(13,15)),((5,8),(6,9))],[(1,2)],[(0,1)])
-}

--------------------------------------------------------------------------------
--
--  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
--
--------------------------------------------------------------------------------