import "Simantics/Model"
import "http://www.simantics.org/DistrictNetwork-1.0" as DN
import "Map" as Map
import "MMap" as MMap

import "Comparator"

@private
importJava "org.simantics.utils.strings.AlphanumComparator" where
    @JavaName CASE_INSENSITIVE_COMPARATOR
    alphanumericComparator :: Comparator String

type Subgraph = ([Resource], [Resource])
type Subgraphs = (Resource, [Subgraph])
type ElementFilter = (Resource -> <ReadGraph> Boolean)

@private
floodFill :: ElementFilter -> Resource -> <ReadGraph, Proc> Subgraph
floodFill edgeFilter fromVertex = do
    processVertex fromVertex
    (MSet.toList vertices, MSet.toList edges)
  where
    edgesOf vertex = (vertex # DN.HasStartVertex_Inverse, vertex # DN.HasEndVertex_Inverse)
    vertices              = MSet.create ()
    edges                 = MSet.create ()
    processVertex vertex  = if MSet.add vertices vertex then do
                                (starts, ends) = edgesOf vertex
                                for starts processEdgeStart
                                for ends processEdgeEnd
                            else ()
    processEdgeStart edge = if MSet.add edges edge && edgeFilter edge then
                                for (edge # DN.HasEndVertex) processVertex
                            else ()
    processEdgeEnd edge   = if MSet.add edges edge && edgeFilter edge then
                                for (edge # DN.HasStartVertex) processVertex
                            else ()

@private
findDisconnectedSubnetworksFromDiagram :: ElementFilter -> Resource -> <ReadGraph, Proc> Subgraphs
findDisconnectedSubnetworksFromDiagram edgeFilter networkDiagram = let
    all       = networkDiagram # L0.ConsistsOf
    vertices  = filter (flip isInstanceOf DN.Vertex) all
    edges     = filter (flip isInstanceOf DN.Edge) all
    vertexSet = MSet.fromList vertices
    edgeSet   = MSet.fromList edges
    result    = MList.create ()
    take1 set = MSet.mapFirst Just vertexSet

    loop Nothing       = ()
    loop (Just vertex) = do
        subgraph = floodFill edgeFilter vertex
        MList.add result subgraph
        (vs, es) = subgraph
        MSet.removeAll vertexSet vs
        MSet.removeAll edgeSet   es
        if not (MSet.isEmpty vertexSet) then
            loop (take1 vertexSet)
        else ()
  in do
    //print "Total number of vertices: \(length vertices)"
    //print "Total number of edges:    \(length edges)"
    loop (take1 vertexSet)
    if MSet.size edgeSet > 0 then
        MList.add result ([], MSet.toList edgeSet)
    else ()
    //print "Found \(MList.size result) disconnected sub-networks"
    (networkDiagram, (MList.freeze result))

"""
Finds disconnected district subnetworks from the provided district network diagram.
The input can be either the network diagram resource or the configuration composite
resource of the network diagram.

See [reportDisconnectedSubnetworks](#reportDisconnectedSubnetworks) for reporting the
result by printing.
"""
findDisconnectedSubnetworks :: ElementFilter -> Resource -> <ReadGraph, Proc> Subgraphs
findDisconnectedSubnetworks edgeFilter networkDiagramOrComposite = findDisconnectedSubnetworksFromDiagram edgeFilter (toDiagram networkDiagramOrComposite)
  where
    toDiagram d = if isInstanceOf d DN.Diagram then d
                  else match (possibleObject d MOD.CompositeToDiagram) with
                      Just dia -> toDiagram dia
                      Nothing  -> fail "Provided diagram is not a district network diagram or configuration composite: \(possibleUriOf d)"

reportDisconnectedSubnetworks :: Integer -> Subgraphs -> <ReadGraph, Proc> ()
reportDisconnectedSubnetworks vertexThreshold (diagram, subgraphs) = do
    print "## Disconnected sub-network analysis of district network \(relativeUri diagram)"
    print "* Detailed reporting vertex count threshold is <= \(vertexThreshold)"
    for subgraphs reportGraph
  where
    rootUri = match possibleIndexRoot diagram with
                  Nothing -> ""
                  Just root -> uriOf (parent root)
    relativeUri r = drop (length rootUri) (uriOf r)

    showVertex v = nameOf v

    edgeEnds e = (possibleObject e DN.HasStartVertex, possibleObject e DN.HasEndVertex)
    showEdgeEnds (Nothing, Nothing) = "(null, null)"
    showEdgeEnds (Just s, Nothing)  = "(\(nameOf s), null)"
    showEdgeEnds (Nothing, Just e)  = "(null, \(nameOf e))"
    showEdgeEnds (Just s, Just e)   = "(\(nameOf s), \(nameOf e))"
    showEdge e = (nameOf e) + " - " + (showEdgeEnds (edgeEnds e))
    sortStrings l = sortWithComparator alphanumericComparator l

    reportGraph (vs, es) | length vs > vertexThreshold = reportShort vs es
                         | otherwise                   = reportFull vs es
    reportSubgraphTitle vs es = print "\n### Disconnected sub-network of \(length vs) vertices and \(length es) edges"
    reportShort vs es = do
        reportSubgraphTitle vs es
        print "* Details not reported because vertex count exceeds threshold"
        mapFirst (\s -> do print "* v0: \(s)"; Just s)
                 (sortStrings (map showVertex vs))
        print "* ..."
    reportFull vs es = do
        reportSubgraphTitle vs es
        forI (sortStrings (map showVertex vs)) (\i s -> print "* v\(i): \(s)")
        print ""
        forI (sortStrings (map showEdge es)) (\i s -> print "* e\(i): \(s)")

"""
Get a set of vertices that acts as break points between network branches.
"""
branchPoints :: Resource -> <ReadGraph> [Resource]
branchPoints networkDiagram = runProc let
  in  
    filter isBranchPoint vertices
  where 
    all       = if isInstanceOf networkDiagram DIA.Diagram
                then networkDiagram # L0.ConsistsOf
                else singleObject networkDiagram MOD.CompositeToDiagram # L0.ConsistsOf
    vertices = filter (flip isInstanceOf DN.Vertex) all
    isBranchPoint v = length (v # DN.HasEndVertex_Inverse) != 1 || length (v # DN.HasStartVertex_Inverse) != 1

"""
Get a set of the edges that are at the middle points of each span between branch points.
"""
midBranchEdges :: Resource -> <ReadGraph> [Resource]
midBranchEdges networkDiagram = runProc let
    for edges storeDistance
  in
    filter isMiddle edges
  where
    all       = if isInstanceOf networkDiagram DIA.Diagram
                then networkDiagram # L0.ConsistsOf
                else singleObject networkDiagram MOD.CompositeToDiagram # L0.ConsistsOf
    vertices  = filter (flip isInstanceOf DN.Vertex) all
    edges     = filter (flip isInstanceOf DN.Edge) all
    edgeLen   = fromJust . (index $ flip map edges \e -> do
         v1 = singleObject e DN.HasStartVertex
         v2 = singleObject e DN.HasEndVertex
         [x1, y1] = relatedValue v1 DIA.HasLocation :: [Double]
         [x2, y2] = relatedValue v2 DIA.HasLocation :: [Double]
         (e, sqrt ((x2 - x1)^2 + (y2 - y1)^2)))
    distances = runProc $ MMap.create () :: MMap.T Resource Double
    isBranchPoint v = length (v # DN.HasEndVertex_Inverse) != 1 || length (v # DN.HasStartVertex_Inverse) != 1
    setDistance e d = MMap.put distances e d
    getDistance e = fromJust $ MMap.get distances e
    forward r1 r2 e cont = do
        v = singleObject e r1
        l = edgeLen e
        if isBranchPoint v
            then do
                setDistance e (l / 2)
                cont l
            else do
                e2 = singleObject v r2
                forward r1 r2 e2 (\d2 -> do
                    setDistance e (d2 + l/2)
                    cont (d2 + l))
    backward r1 r2 e d = do
        l = edgeLen e
        setDistance e $ min (d + l/2) (getDistance e)
        v = singleObject e r1
        if isBranchPoint v then () else backward r1 r2 (singleObject v r2) (d + l)
    storeDistance e = if MMap.containsKey distances e
        then ()
        else do
            l = edgeLen e
            forwardTo e (const ())
            d1 = getDistance e
            forwardFrom e (const ())
            d2 = getDistance e
            setDistance e (min d1 d2)
            backwardFrom e (d1 - l/2)
            backwardTo e (d2 - l/2)
      where
        forwardTo = forward DN.HasEndVertex DN.HasStartVertex_Inverse
        forwardFrom = forward DN.HasStartVertex DN.HasEndVertex_Inverse
        backwardTo = backward DN.HasEndVertex DN.HasStartVertex_Inverse
        backwardFrom = backward DN.HasStartVertex DN.HasEndVertex_Inverse
    isMiddle e = let
        v1 = singleObject e DN.HasStartVertex
        v2 = singleObject e DN.HasEndVertex
        d = getDistance e
      in
        (isBranchPoint v1 || d > getDistance (singleObject v1 DN.HasEndVertex_Inverse)) &&
        (isBranchPoint v2 || d > getDistance (singleObject v2 DN.HasStartVertex_Inverse))