{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# OPTIONS_HADDOCK hide #-}

{- |
   Module      : Data.Graph.Planar.Internal
   Description : Internals of planar graph data structures.
   Copyright   : (c) Ivan Lazar Miljenovic
   License     : 3-Clause BSD-style
   Maintainer  : Ivan.Miljenovic@gmail.com

   As suggested by
   <https://plus.google.com/115372308262579808851/posts/YXVKy2NinK9>,
   expose the data structure internals for people willing to suffer
   breaking everything.

   It is highly recommended that you do /not/ use this module, as
   there are no guarantees made as to the stability of the API.

   Furthermore, an attempt to manually construct a 'PlanarGraph' is
   highly likely to break invariants that are assumed to hold true.

  -}
module Data.Graph.Planar.Internal where

import Data.CircularList
import qualified Data.Map as M
import Data.Map(Map, (!))
import Data.Maybe(fromJust)
import Data.Word(Word)
import Control.Arrow((***))
import Control.DeepSeq(NFData(..))

import Text.Read(Lexeme(Ident), lexP, parens, readPrec)
import Text.ParserCombinators.ReadPrec(ReadPrec, lift, prec)
import Text.ParserCombinators.ReadP(string, char, readS_to_P)

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

-- | The overall planar graph data structure.
data PlanarGraph n e = PG { _nodes :: !(NodeMap n)
                          , _edges :: !(EdgeMap e)
                          }
                       deriving (Eq)

instance Functor (PlanarGraph n) where
  fmap = mapEdges

instance (Show n, Show e) => Show (PlanarGraph n e) where
  showsPrec d pg = showParen (d > 10) $
                   showString "deserialise " . shows (serialise pg)

instance (Read n, Read e) => Read (PlanarGraph n e) where
  readPrec = parens . prec 10
             $ do Ident "deserialise" <- lexP
                  lst <- readPrec
                  return $ deserialise lst

instance (NFData n, NFData e) => NFData (PlanarGraph n e) where
  rnf (PG ns es) = rnf ns `seq` rnf es

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

type NodeMap n = Map Node (NodeInfo n)

-- | An abstract representation of a node.
newtype Node = Node { node :: Word }
               deriving (Eq, Ord, NFData)

-- | This instance of 'Show' does not produce valid Haskell code;
--   however, the 'Node' type is abstract and not designed to be
--   directly accessed.
instance Show Node where
  showsPrec = showsFrom node "Node"

-- | Note that this instance of 'Read' only works when directly
--   applied to a 'String'; it is supplied solely to assist with
--   debugging.
instance Read Node where
  readPrec = readsFrom Node "Node"

data NodeInfo n = NInfo { outgoing :: !(CList Edge)
                        , nodeInfo :: !n
                        }
                  deriving (Eq, Show, Read)

instance (NFData n) => NFData (NodeInfo n) where
  rnf (NInfo out inf) = rnf out `seq` rnf inf

withNodes      :: (NodeMap n -> NodeMap n') -> PlanarGraph n e -> PlanarGraph n' e
withNodes f pg = pg { _nodes = f $ _nodes pg }

{-# INLINE withNodes #-}

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

type EdgeMap e = Map Edge (EdgeInfo e)

-- | An abstract representation of an edge.  Note that an explicit
--   identifier is used for each edge rather than just using the two
--   nodes that the edge connects.  This is required in case more than
--   one edge connects two nodes as we need to be able to distinguish
--   them.
newtype Edge = Edge { edge :: Word }
               deriving (Eq, Ord, NFData)

-- | This instance of 'Show' does not produce valid Haskell code;
--   however, the 'Edge' type is abstract and not designed to be
--   directly accessed.
instance Show Edge where
  showsPrec = showsFrom edge "Edge"

-- | Note that this instance of 'Read' only works when directly
--   applied to a 'String'; it is supplied solely to assist with
--   debugging.
instance Read Edge where
  readPrec = readsFrom Edge "Edge"

data EdgeInfo e = EInfo { -- | The 'Node' which this 'Edge' is coming from.
                          _fromNode :: !Node
                          -- | The 'Node' this 'Edge' is going to.
                        , _toNode   :: !Node

                          -- | The previous 'Edge' going clockwise around the '_fromNode'.
                        , _prevEdge :: !Edge
                          -- | The next 'Edge' going clockwise around the '_fromNode'.
                        , _nextEdge :: !Edge

                          -- | The 'Edge' that is an inverse to this one; i.e.:
                          --
                          --   > _fromNode ei == _toNode $ inverse ei
                          --   > _toNode ei == _fromNode $ inverse ei
                        , inverse   :: !Edge

                          -- | The stored information for this 'Edge'.
                        , edgeInfo  :: !e
                        }
                deriving (Eq, Ord, Show, Read)

instance (NFData e) => NFData (EdgeInfo e) where
  rnf (EInfo f t p n i l) = rnf f `seq` rnf t
                            `seq` rnf p `seq` rnf n
                            `seq` rnf i `seq` rnf l

withEdges      :: (EdgeMap e -> EdgeMap e') -> PlanarGraph n e -> PlanarGraph n e'
withEdges f pg = pg { _edges = f $ _edges pg }

{-# INLINE withEdges #-}

-- | Apply a mapping function over the edge labels.
mapEdges   :: (e -> e') -> PlanarGraph n e -> PlanarGraph n e'
mapEdges f = withEdges (M.map mf)
  where
    mf ei = ei { edgeInfo  = f $ edgeInfo ei }

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

-- | Information about the faces in a planar graph.
type FaceMap = Map Face FaceInfo

type EdgeFaceMap = Map Edge Face

-- | An abstract representation of a face.
newtype Face = Face { face :: Word }
               deriving (Eq, Ord, NFData)

-- | This instance of 'Show' does not produce valid Haskell code;
--   however, the 'Face' type is abstract and not designed to be
--   directly accessed.
instance Show Face where
  showsPrec = showsFrom face "Face"

-- | Note that this instance of 'Read' only works when directly
--   applied to a 'String'; it is supplied solely to assist with
--   debugging.
instance Read Face where
  readPrec = readsFrom Face "Face"

-- | Information about a particular 'Face'.
data FaceInfo = FInfo { -- | The 'Node's that make up the face.
                        faceNodes     :: !(CList Node)

                        -- | The 'Edge's that make up the face, its
                        --   inverse and the 'Face' on the other side
                        --   of that 'Edge'.
                      , edgeCrossings :: !(CList ((Edge,Edge), Face))
                      }
              deriving (Eq, Show, Read)

instance NFData FaceInfo where
  rnf (FInfo ns ecs) = rnf ns `seq` rnf ecs

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

-- | The definition of a more compact, serialised form of a planar
--   graph.  The various fields correspond to:
--
--   > [( node index
--   >  , node label
--   >  , [( edge index
--   >     , node index that this edge points to
--   >     , edge label
--   >     , inverse edge index
--   >    )]
--   > )]
--   >
--
--   The list of edges should be in clockwise order around the node.
--
--   Note that there will be twice as many edges lists as the /size/;
--   that's because each edge is listed twice.
type SerialisedGraph n e = [(Word, n, [(Word, Word, e, Word)])]

type SerialisedNode n e = (Word, n, [SerialisedEdge e])

type SerialisedEdge e = (Word, Word, e, Word)

-- | Create the serialised form of this graph.
serialise    :: PlanarGraph n e -> SerialisedGraph n e
serialise pg = map serialiseN . M.assocs $ _nodes pg
  where
    serialiseN (n,ni) = (node n, nodeInfo ni, getEs ni)

    es = _edges pg
    getEs = map serialiseE . toList . outgoing
    serialiseE e = (edge e, node $ _toNode ei, edgeInfo ei, edge $ inverse ei)
      where
        ei = es ! e

-- | Creates the graph from its serialised form.  Assumes that the
--   graph is valid.
deserialise :: SerialisedGraph n e -> PlanarGraph n e
deserialise = uncurry PG . (M.fromList *** M.unions)
              . unzip . map deserialiseNode

deserialiseNode          :: SerialisedNode n e -> ((Node, NodeInfo n), EdgeMap e)
deserialiseNode (n,l,es) = (nd, M.fromList $ map mkE es)
  where
    nd = (n', NInfo { outgoing = os, nodeInfo = l })
    n' = Node n
    -- Outgoing edges
    os = fromList $ map (\(e,_,_,_) -> Edge e) es

    mkE (e,t,el,i) = (e', EInfo { _fromNode = n'
                                , _toNode   = Node t
                                , _prevEdge = prevElem os'
                                , _nextEdge = nextElem os'
                                , inverse   = Edge i
                                , edgeInfo  = el
                                })
      where
        os' = fromJust $ rotateTo e' os
        e' = Edge e

-- -----------------------------------------------------------------------------
-- Utility functions

showsFrom :: (a -> Word) -> String -> Int -> a -> ShowS
showsFrom f nm _ a = showString nm . showChar '_' . shows (f a)

readsFrom :: (Word -> a) -> String -> ReadPrec a
readsFrom f nm = lift $ do _ <- string nm
                           _ <- char '_'
                           n <- readS_to_P reads
                           return $ f n

-- Get the previous element in the CList; assumes non-empty
prevElem :: CList a -> a
prevElem = fromJust . focus . rotL

nextElem :: CList a -> a
nextElem = fromJust . focus . rotR