{-# OPTIONS_HADDOCK hide #-}

{- |
   Module      : Data.GraphViz.Algorithms.Clustering
   Description : Definition of the clustering types for Graphviz.
   Copyright   : (c) Matthew Sackman, Ivan Lazar Miljenovic
   License     : 3-Clause BSD-style
   Maintainer  : Ivan.Miljenovic@gmail.com

   This module defines types for creating clusters.
-}
module Data.GraphViz.Algorithms.Clustering
    ( NodeCluster(..)
    , clustersToNodes
    ) where

import Data.GraphViz.Types.Canonical
import Data.GraphViz.Attributes.Complete(Attributes)

import Data.Either(partitionEithers)
import Data.List(groupBy, sortBy)

-- -----------------------------------------------------------------------------

-- | Define into which cluster a particular node belongs.
--   Clusters can be nested to arbitrary depth.
data NodeCluster c a = N a -- ^ Indicates the actual Node in the Graph.
                     | C c (NodeCluster c a) -- ^ Indicates that the
                                             --   'NodeCluster' is in
                                             --   the Cluster /c/.
                        deriving (Int -> NodeCluster c a -> ShowS
[NodeCluster c a] -> ShowS
NodeCluster c a -> String
(Int -> NodeCluster c a -> ShowS)
-> (NodeCluster c a -> String)
-> ([NodeCluster c a] -> ShowS)
-> Show (NodeCluster c a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall c a. (Show a, Show c) => Int -> NodeCluster c a -> ShowS
forall c a. (Show a, Show c) => [NodeCluster c a] -> ShowS
forall c a. (Show a, Show c) => NodeCluster c a -> String
$cshowsPrec :: forall c a. (Show a, Show c) => Int -> NodeCluster c a -> ShowS
showsPrec :: Int -> NodeCluster c a -> ShowS
$cshow :: forall c a. (Show a, Show c) => NodeCluster c a -> String
show :: NodeCluster c a -> String
$cshowList :: forall c a. (Show a, Show c) => [NodeCluster c a] -> ShowS
showList :: [NodeCluster c a] -> ShowS
Show)

-- | Extract the clusters and nodes from the list of nodes.
clustersToNodes :: (Ord c) => ((n,a) -> NodeCluster c (n,l))
                  -> (c -> Bool) -> (c -> GraphID) -> (c -> [GlobalAttributes])
                  -> ((n,l) -> Attributes) -> [(n,a)]
                  -> ([DotSubGraph n], [DotNode n])
clustersToNodes :: forall c n a l.
Ord c =>
((n, a) -> NodeCluster c (n, l))
-> (c -> Bool)
-> (c -> GraphID)
-> (c -> [GlobalAttributes])
-> ((n, l) -> Attributes)
-> [(n, a)]
-> ([DotSubGraph n], [DotNode n])
clustersToNodes (n, a) -> NodeCluster c (n, l)
clusterBy c -> Bool
isC c -> GraphID
cID c -> [GlobalAttributes]
fmtCluster (n, l) -> Attributes
fmtNode
    = (c -> Bool)
-> (c -> GraphID)
-> (c -> [GlobalAttributes])
-> ((n, l) -> Attributes)
-> [ClusterTree c (n, l)]
-> ([DotSubGraph n], [DotNode n])
forall c n a.
(c -> Bool)
-> (c -> GraphID)
-> (c -> [GlobalAttributes])
-> ((n, a) -> Attributes)
-> [ClusterTree c (n, a)]
-> ([DotSubGraph n], [DotNode n])
treesToDot c -> Bool
isC c -> GraphID
cID c -> [GlobalAttributes]
fmtCluster (n, l) -> Attributes
fmtNode
      ([ClusterTree c (n, l)] -> ([DotSubGraph n], [DotNode n]))
-> ([(n, a)] -> [ClusterTree c (n, l)])
-> [(n, a)]
-> ([DotSubGraph n], [DotNode n])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ClusterTree c (n, l)] -> [ClusterTree c (n, l)]
forall c a. Ord c => [ClusterTree c a] -> [ClusterTree c a]
collapseNClusts
      ([ClusterTree c (n, l)] -> [ClusterTree c (n, l)])
-> ([(n, a)] -> [ClusterTree c (n, l)])
-> [(n, a)]
-> [ClusterTree c (n, l)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((n, a) -> ClusterTree c (n, l))
-> [(n, a)] -> [ClusterTree c (n, l)]
forall a b. (a -> b) -> [a] -> [b]
map (NodeCluster c (n, l) -> ClusterTree c (n, l)
forall c a. NodeCluster c a -> ClusterTree c a
clustToTree (NodeCluster c (n, l) -> ClusterTree c (n, l))
-> ((n, a) -> NodeCluster c (n, l))
-> (n, a)
-> ClusterTree c (n, l)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (n, a) -> NodeCluster c (n, l)
clusterBy)

-- -----------------------------------------------------------------------------

-- | A tree representation of a cluster.
data ClusterTree c a = NT a
                     | CT c [ClusterTree c a]
                     deriving (Int -> ClusterTree c a -> ShowS
[ClusterTree c a] -> ShowS
ClusterTree c a -> String
(Int -> ClusterTree c a -> ShowS)
-> (ClusterTree c a -> String)
-> ([ClusterTree c a] -> ShowS)
-> Show (ClusterTree c a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall c a. (Show a, Show c) => Int -> ClusterTree c a -> ShowS
forall c a. (Show a, Show c) => [ClusterTree c a] -> ShowS
forall c a. (Show a, Show c) => ClusterTree c a -> String
$cshowsPrec :: forall c a. (Show a, Show c) => Int -> ClusterTree c a -> ShowS
showsPrec :: Int -> ClusterTree c a -> ShowS
$cshow :: forall c a. (Show a, Show c) => ClusterTree c a -> String
show :: ClusterTree c a -> String
$cshowList :: forall c a. (Show a, Show c) => [ClusterTree c a] -> ShowS
showList :: [ClusterTree c a] -> ShowS
Show)

-- | Convert a single node cluster into its tree representation.
clustToTree          :: NodeCluster c a -> ClusterTree c a
clustToTree :: forall c a. NodeCluster c a -> ClusterTree c a
clustToTree (N a
ln)   = a -> ClusterTree c a
forall c a. a -> ClusterTree c a
NT a
ln
clustToTree (C c
c NodeCluster c a
nc) = c -> [ClusterTree c a] -> ClusterTree c a
forall c a. c -> [ClusterTree c a] -> ClusterTree c a
CT c
c [NodeCluster c a -> ClusterTree c a
forall c a. NodeCluster c a -> ClusterTree c a
clustToTree NodeCluster c a
nc]

-- | Two nodes are in the same "default" cluster; otherwise check if they
--   are in the same cluster.
sameClust :: (Eq c) => ClusterTree c a -> ClusterTree c a -> Bool
sameClust :: forall c a. Eq c => ClusterTree c a -> ClusterTree c a -> Bool
sameClust (NT a
_)    (NT a
_)    = Bool
True
sameClust (CT c
c1 [ClusterTree c a]
_) (CT c
c2 [ClusterTree c a]
_) = c
c1 c -> c -> Bool
forall a. Eq a => a -> a -> Bool
== c
c2
sameClust ClusterTree c a
_         ClusterTree c a
_         = Bool
False

-- | Singleton nodes come first, and then ordering based upon the cluster.
clustOrder :: (Ord c) => ClusterTree c a -> ClusterTree c a -> Ordering
clustOrder :: forall c a. Ord c => ClusterTree c a -> ClusterTree c a -> Ordering
clustOrder (NT a
_)    (NT a
_)    = Ordering
EQ
clustOrder (NT a
_)    (CT c
_ [ClusterTree c a]
_)  = Ordering
LT
clustOrder (CT c
_ [ClusterTree c a]
_)  (NT a
_)    = Ordering
GT
clustOrder (CT c
c1 [ClusterTree c a]
_) (CT c
c2 [ClusterTree c a]
_) = c -> c -> Ordering
forall a. Ord a => a -> a -> Ordering
compare c
c1 c
c2

-- | Extract the sub-trees.
getNodes           :: ClusterTree c a -> [ClusterTree c a]
getNodes :: forall c a. ClusterTree c a -> [ClusterTree c a]
getNodes n :: ClusterTree c a
n@(NT a
_)  = [ClusterTree c a
n]
getNodes (CT c
_ [ClusterTree c a]
ns) = [ClusterTree c a]
ns

-- | Combine clusters.
collapseNClusts :: (Ord c) => [ClusterTree c a] -> [ClusterTree c a]
collapseNClusts :: forall c a. Ord c => [ClusterTree c a] -> [ClusterTree c a]
collapseNClusts = ([ClusterTree c a] -> [ClusterTree c a])
-> [[ClusterTree c a]] -> [ClusterTree c a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap [ClusterTree c a] -> [ClusterTree c a]
forall c a. Ord c => [ClusterTree c a] -> [ClusterTree c a]
grpCls
                  ([[ClusterTree c a]] -> [ClusterTree c a])
-> ([ClusterTree c a] -> [[ClusterTree c a]])
-> [ClusterTree c a]
-> [ClusterTree c a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ClusterTree c a -> ClusterTree c a -> Bool)
-> [ClusterTree c a] -> [[ClusterTree c a]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy ClusterTree c a -> ClusterTree c a -> Bool
forall c a. Eq c => ClusterTree c a -> ClusterTree c a -> Bool
sameClust
                  ([ClusterTree c a] -> [[ClusterTree c a]])
-> ([ClusterTree c a] -> [ClusterTree c a])
-> [ClusterTree c a]
-> [[ClusterTree c a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ClusterTree c a -> ClusterTree c a -> Ordering)
-> [ClusterTree c a] -> [ClusterTree c a]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ClusterTree c a -> ClusterTree c a -> Ordering
forall c a. Ord c => ClusterTree c a -> ClusterTree c a -> Ordering
clustOrder
  where
    grpCls :: [ClusterTree c a] -> [ClusterTree c a]
grpCls []              = []
    grpCls ns :: [ClusterTree c a]
ns@(NT a
_ : [ClusterTree c a]
_)   = [ClusterTree c a]
ns
    grpCls cs :: [ClusterTree c a]
cs@(CT c
c [ClusterTree c a]
_ : [ClusterTree c a]
_) = [c -> [ClusterTree c a] -> ClusterTree c a
forall c a. c -> [ClusterTree c a] -> ClusterTree c a
CT c
c ([ClusterTree c a] -> [ClusterTree c a]
forall c a. Ord c => [ClusterTree c a] -> [ClusterTree c a]
collapseNClusts ([ClusterTree c a] -> [ClusterTree c a])
-> [ClusterTree c a] -> [ClusterTree c a]
forall a b. (a -> b) -> a -> b
$ (ClusterTree c a -> [ClusterTree c a])
-> [ClusterTree c a] -> [ClusterTree c a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ClusterTree c a -> [ClusterTree c a]
forall c a. ClusterTree c a -> [ClusterTree c a]
getNodes [ClusterTree c a]
cs)]

-- | Convert the cluster representation of the trees into 'DotNode's
--   and 'DotSubGraph's (with @'isCluster' = 'True'@, and
--   @'subGraphID' = 'Nothing'@).
treesToDot :: (c -> Bool) -> (c -> GraphID) -> (c -> [GlobalAttributes])
              -> ((n,a) -> Attributes) -> [ClusterTree c (n,a)]
              -> ([DotSubGraph n], [DotNode n])
treesToDot :: forall c n a.
(c -> Bool)
-> (c -> GraphID)
-> (c -> [GlobalAttributes])
-> ((n, a) -> Attributes)
-> [ClusterTree c (n, a)]
-> ([DotSubGraph n], [DotNode n])
treesToDot c -> Bool
isC c -> GraphID
cID c -> [GlobalAttributes]
fmtCluster (n, a) -> Attributes
fmtNode
    = [Either (DotSubGraph n) (DotNode n)]
-> ([DotSubGraph n], [DotNode n])
forall a b. [Either a b] -> ([a], [b])
partitionEithers
      ([Either (DotSubGraph n) (DotNode n)]
 -> ([DotSubGraph n], [DotNode n]))
-> ([ClusterTree c (n, a)] -> [Either (DotSubGraph n) (DotNode n)])
-> [ClusterTree c (n, a)]
-> ([DotSubGraph n], [DotNode n])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ClusterTree c (n, a) -> Either (DotSubGraph n) (DotNode n))
-> [ClusterTree c (n, a)] -> [Either (DotSubGraph n) (DotNode n)]
forall a b. (a -> b) -> [a] -> [b]
map ((c -> Bool)
-> (c -> GraphID)
-> (c -> [GlobalAttributes])
-> ((n, a) -> Attributes)
-> ClusterTree c (n, a)
-> Either (DotSubGraph n) (DotNode n)
forall c n a.
(c -> Bool)
-> (c -> GraphID)
-> (c -> [GlobalAttributes])
-> ((n, a) -> Attributes)
-> ClusterTree c (n, a)
-> Either (DotSubGraph n) (DotNode n)
treeToDot c -> Bool
isC c -> GraphID
cID c -> [GlobalAttributes]
fmtCluster (n, a) -> Attributes
fmtNode)

-- | Convert this 'ClusterTree' into its /Dot/ representation.
treeToDot :: (c -> Bool) -> (c -> GraphID) -> (c -> [GlobalAttributes])
             -> ((n,a) -> Attributes) -> ClusterTree c (n,a)
             -> Either (DotSubGraph n) (DotNode n)
treeToDot :: forall c n a.
(c -> Bool)
-> (c -> GraphID)
-> (c -> [GlobalAttributes])
-> ((n, a) -> Attributes)
-> ClusterTree c (n, a)
-> Either (DotSubGraph n) (DotNode n)
treeToDot c -> Bool
_ c -> GraphID
_ c -> [GlobalAttributes]
_ (n, a) -> Attributes
fmtNode (NT (n, a)
ln)
    = DotNode n -> Either (DotSubGraph n) (DotNode n)
forall a b. b -> Either a b
Right DotNode { nodeID :: n
nodeID         = (n, a) -> n
forall a b. (a, b) -> a
fst (n, a)
ln
                    , nodeAttributes :: Attributes
nodeAttributes = (n, a) -> Attributes
fmtNode (n, a)
ln
                    }
treeToDot c -> Bool
isC c -> GraphID
cID c -> [GlobalAttributes]
fmtCluster (n, a) -> Attributes
fmtNode (CT c
c [ClusterTree c (n, a)]
nts)
    = DotSubGraph n -> Either (DotSubGraph n) (DotNode n)
forall a b. a -> Either a b
Left DotSG { isCluster :: Bool
isCluster     = c -> Bool
isC c
c
                 , subGraphID :: Maybe GraphID
subGraphID    = GraphID -> Maybe GraphID
forall a. a -> Maybe a
Just (GraphID -> Maybe GraphID) -> GraphID -> Maybe GraphID
forall a b. (a -> b) -> a -> b
$ c -> GraphID
cID c
c
                 , subGraphStmts :: DotStatements n
subGraphStmts = DotStatements n
stmts
                 }
  where
    stmts :: DotStatements n
stmts = DotStmts { attrStmts :: [GlobalAttributes]
attrStmts = c -> [GlobalAttributes]
fmtCluster c
c
                     , subGraphs :: [DotSubGraph n]
subGraphs = [DotSubGraph n]
cs
                     , nodeStmts :: [DotNode n]
nodeStmts = [DotNode n]
ns
                     , edgeStmts :: [DotEdge n]
edgeStmts = []
                     }
    ([DotSubGraph n]
cs, [DotNode n]
ns) = (c -> Bool)
-> (c -> GraphID)
-> (c -> [GlobalAttributes])
-> ((n, a) -> Attributes)
-> [ClusterTree c (n, a)]
-> ([DotSubGraph n], [DotNode n])
forall c n a.
(c -> Bool)
-> (c -> GraphID)
-> (c -> [GlobalAttributes])
-> ((n, a) -> Attributes)
-> [ClusterTree c (n, a)]
-> ([DotSubGraph n], [DotNode n])
treesToDot c -> Bool
isC c -> GraphID
cID c -> [GlobalAttributes]
fmtCluster (n, a) -> Attributes
fmtNode [ClusterTree c (n, a)]
nts