    {-# LANGUAGE CPP #-}

    #if (__GLASGOW_HASKELL__ >= 802)
    {-# LANGUAGE DerivingStrategies #-}
    #endif

    --------------------------------------------------------------------------------
    --  See end of this file for licence information.
    --------------------------------------------------------------------------------
    -- |
    --  Module      :  GraphPartition
    --  Copyright   :  (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011, 2012, 2022, 2024 Douglas Burke
    --  License     :  GPL V2
    --
    --  Maintainer  :  Douglas Burke
    --  Stability   :  experimental
    --  Portability :  CPP, DerivingStrategies
    --
    --  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 qualified Data.List.NonEmpty as NE

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

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

    -- Avoid messages added in GHC 9.10 about foldl' import from Data.List
    -- being redundant.
    import Prelude hiding (Foldable(..))

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

    ------------------------------------------------------------
    --  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
    #if (__GLASGOW_HASKELL__ >= 802)
          stock
    #endif
          (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
    $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
    /= :: 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
    $cshowsPrec :: forall lb. Label lb => Int -> PartitionedGraph lb -> ShowS
    showsPrec :: Int -> PartitionedGraph lb -> ShowS
    $cshow :: forall lb. Label lb => PartitionedGraph lb -> String
    show :: PartitionedGraph lb -> String
    $cshowList :: forall lb. Label lb => [PartitionedGraph lb] -> ShowS
    showList :: [PartitionedGraph lb] -> ShowS
    Show)

    -- | Returns all the arcs in the partitioned graph.
    getArcs :: PartitionedGraph lb -> [Arc lb]
    getArcs :: forall lb. 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 :: forall lb. 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 :: forall lb. 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 :: forall lb. 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 :: forall lb. Label lb => 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 :: forall lb. Label lb => 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
    pref String -> 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
    pref String -> 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
    pref String -> 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 :: forall lb. Label lb => [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 :: forall lb.
    Eq lb =>
    [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 :: forall lb.
    Eq lb =>
    [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 {a}. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [LabelledArcs lb]
    s then [GraphPartition lb] -> PState lb [GraphPartition lb]
    forall a. a -> StateT (MakePartitionState lb) Identity a
    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 a. a -> StateT (MakePartitionState lb) Identity a
    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 :: forall lb.
    Eq lb =>
    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 {a}. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [LabelledArcs lb]
    moresubs
                     then [GraphPartition lb] -> PState lb [GraphPartition lb]
    forall a. a -> StateT (MakePartitionState lb) Identity a
    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 a. a -> StateT (MakePartitionState lb) Identity a
    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 :: forall lb.
    Eq lb =>
    LabelledArcs lb -> PState lb (GraphPartition lb, [LabelledArcs lb])
    makeStatements (lb
    sub,NonEmpty (Arc lb)
    stmts) = do
        [(LabelledPartition lb, [(lb, NonEmpty (Arc lb))])]
    propmore <- (Arc lb
     -> StateT
          (MakePartitionState lb)
          Identity
          (LabelledPartition lb, [(lb, NonEmpty (Arc lb))]))
    -> [Arc lb]
    -> StateT
         (MakePartitionState lb)
         Identity
         [(LabelledPartition lb, [(lb, NonEmpty (Arc lb))])]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM Arc lb
    -> StateT
         (MakePartitionState lb)
         Identity
         (LabelledPartition lb, [(lb, NonEmpty (Arc 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,[[(lb, NonEmpty (Arc lb))]]
    moresubs) = [(LabelledPartition lb, [(lb, NonEmpty (Arc lb))])]
    -> ([LabelledPartition lb], [[(lb, NonEmpty (Arc lb))]])
    forall a b. [(a, b)] -> ([a], [b])
    unzip [(LabelledPartition lb, [(lb, NonEmpty (Arc lb))])]
    propmore
        (GraphPartition lb, [(lb, NonEmpty (Arc lb))])
    -> PState lb (GraphPartition lb, [(lb, NonEmpty (Arc lb))])
    forall a. a -> StateT (MakePartitionState lb) Identity a
    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. HasCallStack => [a] -> NonEmpty a
    NE.fromList [LabelledPartition lb]
    props), [[(lb, NonEmpty (Arc lb))]] -> [(lb, NonEmpty (Arc lb))]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat [[(lb, NonEmpty (Arc lb))]]
    moresubs)
        -- return (PartSub sub props, concat moresubs)

    makeStatement ::
        (Eq lb) =>
        Arc lb
        -> PState lb (LabelledPartition lb, [LabelledArcs lb])
    makeStatement :: forall lb.
    Eq lb =>
    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) <-
          case [LabelledArcs lb]
    intobj of
            (LabelledArcs lb
    h:[LabelledArcs lb]
    _) -> 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
    h
            [] -> 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 a. a -> StateT (MakePartitionState lb) Identity a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (lb -> GraphPartition lb
    forall lb. lb -> GraphPartition lb
    PartObj lb
    obj,[LabelledArcs lb]
    ms)

        (LabelledPartition lb, [LabelledArcs lb])
    -> PState lb (LabelledPartition lb, [LabelledArcs lb])
    forall a. a -> StateT (MakePartitionState lb) Identity a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((lb
    prop,GraphPartition lb
    gpobj), [LabelledArcs lb]
    moresubs)

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

    pickIntSubject :: (Eq lb) =>
        lb
        -> PState lb [LabelledArcs lb]
    pickIntSubject :: forall lb. Eq lb => lb -> PState lb [LabelledArcs lb]
    pickIntSubject lb
    sub = do
        ([LabelledArcs lb]
    s1,[LabelledArcs lb]
    s2,[LabelledArcs lb]
    s3) <- StateT (MakePartitionState lb) Identity (MakePartitionState 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
    x lb -> 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) -> MakePartitionState lb -> StateT (MakePartitionState lb) Identity ()
    forall s (m :: * -> *). MonadState s m => s -> m ()
    put ([LabelledArcs lb]
    s1,[LabelledArcs lb]
    s2,[LabelledArcs lb]
    s3new) StateT (MakePartitionState lb) Identity ()
    -> PState lb [LabelledArcs lb] -> PState lb [LabelledArcs lb]
    forall a b.
    StateT (MakePartitionState lb) Identity a
    -> StateT (MakePartitionState lb) Identity b
    -> StateT (MakePartitionState lb) Identity b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> [LabelledArcs lb] -> PState lb [LabelledArcs lb]
    forall a. a -> StateT (MakePartitionState lb) Identity a
    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 a. a -> StateT (MakePartitionState lb) Identity a
    forall (m :: * -> *) a. Monad m => a -> m a
    return []

    pickVarSubject ::
        (Eq lb) =>
        lb ->
        PState lb [LabelledArcs lb]
    pickVarSubject :: forall lb. Eq lb => lb -> PState lb [LabelledArcs lb]
    pickVarSubject lb
    sub = do
        ([LabelledArcs lb]
    s1,[LabelledArcs lb]
    s2,[LabelledArcs lb]
    s3) <- StateT (MakePartitionState lb) Identity (MakePartitionState 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
    x lb -> 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) -> MakePartitionState lb -> StateT (MakePartitionState lb) Identity ()
    forall s (m :: * -> *). MonadState s m => s -> m ()
    put ([LabelledArcs lb]
    s1,[LabelledArcs lb]
    s2new,[LabelledArcs lb]
    s3) StateT (MakePartitionState lb) Identity ()
    -> PState lb [LabelledArcs lb] -> PState lb [LabelledArcs lb]
    forall a b.
    StateT (MakePartitionState lb) Identity a
    -> StateT (MakePartitionState lb) Identity b
    -> StateT (MakePartitionState lb) Identity b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> [LabelledArcs lb] -> PState lb [LabelledArcs lb]
    forall a. a -> StateT (MakePartitionState lb) Identity a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [LabelledArcs lb
    vs]
            Maybe (LabelledArcs lb, [LabelledArcs lb])
    _                -> [LabelledArcs lb] -> PState lb [LabelledArcs lb]
    forall a. a -> StateT (MakePartitionState lb) Identity a
    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 :: forall lb.
    Label lb =>
    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 :: forall lb.
    Label lb =>
    [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 :: forall lb.
    Label lb =>
    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 :: 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 (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 :: forall lb.
    Label lb =>
    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 :: forall lb. Label lb => 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 :: forall b a. Eq b => (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 :: forall b a.
    (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 :: forall b a.
    (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 :: forall b a.
    (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 :: forall b a. (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 :: forall b a c.
    Eq b =>
    (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 :: forall b a c.
    (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 :: forall b a c.
    (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 :: forall b a c.
    (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 :: forall b c a. (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 :: forall b a. (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 :: forall b a. (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 :: forall a. [a] -> [a] -> [a]
    reverseTo [a]
    front [a]
    back = ([a] -> a -> [a]) -> [a] -> [a] -> [a]
    forall b a. (b -> a -> b) -> b -> [a] -> b
    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 :: forall a. [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 :: forall a d. (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, 2022, 2024 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
    --
    --------------------------------------------------------------------------------