--------------------------------------------------------------------------------
-- |
-- Module      :  Data.PlanarGraph.AdjRep
-- Copyright   :  (C) Frank Staals
-- License     :  see the LICENSE file
-- Maintainer  :  Frank Staals
--
-- Data types that to represent a planar graph as Adjacency Lists. The main
-- purpose is to help encode/decode a PlanarGraph as a JSON/YAML file.
--
--------------------------------------------------------------------------------
module Data.PlanarGraph.AdjRep where

import           Control.Lens   (Bifunctor (..))
import           Data.Aeson
import           Data.Bifunctor (second)
import           GHC.Generics   (Generic)

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

-- | Data type representing the graph in its JSON/Yaml format
data Gr v f = Gr { Gr v f -> [v]
adjacencies :: [v]
                 , Gr v f -> [f]
faces       :: [f]
                 } deriving ((forall x. Gr v f -> Rep (Gr v f) x)
-> (forall x. Rep (Gr v f) x -> Gr v f) -> Generic (Gr v f)
forall x. Rep (Gr v f) x -> Gr v f
forall x. Gr v f -> Rep (Gr v f) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall v f x. Rep (Gr v f) x -> Gr v f
forall v f x. Gr v f -> Rep (Gr v f) x
$cto :: forall v f x. Rep (Gr v f) x -> Gr v f
$cfrom :: forall v f x. Gr v f -> Rep (Gr v f) x
Generic, Int -> Gr v f -> ShowS
[Gr v f] -> ShowS
Gr v f -> String
(Int -> Gr v f -> ShowS)
-> (Gr v f -> String) -> ([Gr v f] -> ShowS) -> Show (Gr v f)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall v f. (Show v, Show f) => Int -> Gr v f -> ShowS
forall v f. (Show v, Show f) => [Gr v f] -> ShowS
forall v f. (Show v, Show f) => Gr v f -> String
showList :: [Gr v f] -> ShowS
$cshowList :: forall v f. (Show v, Show f) => [Gr v f] -> ShowS
show :: Gr v f -> String
$cshow :: forall v f. (Show v, Show f) => Gr v f -> String
showsPrec :: Int -> Gr v f -> ShowS
$cshowsPrec :: forall v f. (Show v, Show f) => Int -> Gr v f -> ShowS
Show, Gr v f -> Gr v f -> Bool
(Gr v f -> Gr v f -> Bool)
-> (Gr v f -> Gr v f -> Bool) -> Eq (Gr v f)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall v f. (Eq v, Eq f) => Gr v f -> Gr v f -> Bool
/= :: Gr v f -> Gr v f -> Bool
$c/= :: forall v f. (Eq v, Eq f) => Gr v f -> Gr v f -> Bool
== :: Gr v f -> Gr v f -> Bool
$c== :: forall v f. (Eq v, Eq f) => Gr v f -> Gr v f -> Bool
Eq)

instance Bifunctor Gr where
  bimap :: (a -> b) -> (c -> d) -> Gr a c -> Gr b d
bimap a -> b
f c -> d
g (Gr [a]
vs [c]
fs) = [b] -> [d] -> Gr b d
forall v f. [v] -> [f] -> Gr v f
Gr ((a -> b) -> [a] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map a -> b
f [a]
vs) ((c -> d) -> [c] -> [d]
forall a b. (a -> b) -> [a] -> [b]
map c -> d
g [c]
fs)

instance (ToJSON v, ToJSON f)     => ToJSON   (Gr v f) where
  toEncoding :: Gr v f -> Encoding
toEncoding = Options -> Gr v f -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
defaultOptions
instance (FromJSON v, FromJSON f) => FromJSON (Gr v f)

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

-- | A vertex, represented by an id, its adjacencies, and its data.
data Vtx v e = Vtx { Vtx v e -> Int
id    :: Int
                   , Vtx v e -> [(Int, e)]
adj   :: [(Int,e)] -- ^ adjacent vertices + data
                                        -- on the edge. Some
                                        -- functions, like
                                        -- 'fromAdjRep' may assume
                                        -- that the adjacencies are
                                        -- given in counterclockwise
                                        -- order around the
                                        -- vertices. This is not (yet)
                                        -- enforced by the data type.
                   , Vtx v e -> v
vData :: v
                   } deriving ((forall x. Vtx v e -> Rep (Vtx v e) x)
-> (forall x. Rep (Vtx v e) x -> Vtx v e) -> Generic (Vtx v e)
forall x. Rep (Vtx v e) x -> Vtx v e
forall x. Vtx v e -> Rep (Vtx v e) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall v e x. Rep (Vtx v e) x -> Vtx v e
forall v e x. Vtx v e -> Rep (Vtx v e) x
$cto :: forall v e x. Rep (Vtx v e) x -> Vtx v e
$cfrom :: forall v e x. Vtx v e -> Rep (Vtx v e) x
Generic, Int -> Vtx v e -> ShowS
[Vtx v e] -> ShowS
Vtx v e -> String
(Int -> Vtx v e -> ShowS)
-> (Vtx v e -> String) -> ([Vtx v e] -> ShowS) -> Show (Vtx v e)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall v e. (Show e, Show v) => Int -> Vtx v e -> ShowS
forall v e. (Show e, Show v) => [Vtx v e] -> ShowS
forall v e. (Show e, Show v) => Vtx v e -> String
showList :: [Vtx v e] -> ShowS
$cshowList :: forall v e. (Show e, Show v) => [Vtx v e] -> ShowS
show :: Vtx v e -> String
$cshow :: forall v e. (Show e, Show v) => Vtx v e -> String
showsPrec :: Int -> Vtx v e -> ShowS
$cshowsPrec :: forall v e. (Show e, Show v) => Int -> Vtx v e -> ShowS
Show, Vtx v e -> Vtx v e -> Bool
(Vtx v e -> Vtx v e -> Bool)
-> (Vtx v e -> Vtx v e -> Bool) -> Eq (Vtx v e)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall v e. (Eq e, Eq v) => Vtx v e -> Vtx v e -> Bool
/= :: Vtx v e -> Vtx v e -> Bool
$c/= :: forall v e. (Eq e, Eq v) => Vtx v e -> Vtx v e -> Bool
== :: Vtx v e -> Vtx v e -> Bool
$c== :: forall v e. (Eq e, Eq v) => Vtx v e -> Vtx v e -> Bool
Eq)

instance Bifunctor Vtx where
  bimap :: (a -> b) -> (c -> d) -> Vtx a c -> Vtx b d
bimap a -> b
f c -> d
g (Vtx Int
i [(Int, c)]
as a
x) = Int -> [(Int, d)] -> b -> Vtx b d
forall v e. Int -> [(Int, e)] -> v -> Vtx v e
Vtx Int
i (((Int, c) -> (Int, d)) -> [(Int, c)] -> [(Int, d)]
forall a b. (a -> b) -> [a] -> [b]
map ((c -> d) -> (Int, c) -> (Int, d)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second c -> d
g) [(Int, c)]
as) (a -> b
f a
x)

instance (ToJSON v, ToJSON e)     => ToJSON   (Vtx v e) where
  toEncoding :: Vtx v e -> Encoding
toEncoding = Options -> Vtx v e -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
defaultOptions
instance (FromJSON v, FromJSON e) => FromJSON (Vtx v e)

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

-- | Faces
data Face f = Face { Face f -> (Int, Int)
incidentEdge :: (Int,Int) -- ^ an edge (u,v) s.t. the face
                                               -- is right from (u,v)
                   , Face f -> f
fData        :: f
                   } deriving ((forall x. Face f -> Rep (Face f) x)
-> (forall x. Rep (Face f) x -> Face f) -> Generic (Face f)
forall x. Rep (Face f) x -> Face f
forall x. Face f -> Rep (Face f) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall f x. Rep (Face f) x -> Face f
forall f x. Face f -> Rep (Face f) x
$cto :: forall f x. Rep (Face f) x -> Face f
$cfrom :: forall f x. Face f -> Rep (Face f) x
Generic,a -> Face b -> Face a
(a -> b) -> Face a -> Face b
(forall a b. (a -> b) -> Face a -> Face b)
-> (forall a b. a -> Face b -> Face a) -> Functor Face
forall a b. a -> Face b -> Face a
forall a b. (a -> b) -> Face a -> Face b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Face b -> Face a
$c<$ :: forall a b. a -> Face b -> Face a
fmap :: (a -> b) -> Face a -> Face b
$cfmap :: forall a b. (a -> b) -> Face a -> Face b
Functor, Int -> Face f -> ShowS
[Face f] -> ShowS
Face f -> String
(Int -> Face f -> ShowS)
-> (Face f -> String) -> ([Face f] -> ShowS) -> Show (Face f)
forall f. Show f => Int -> Face f -> ShowS
forall f. Show f => [Face f] -> ShowS
forall f. Show f => Face f -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Face f] -> ShowS
$cshowList :: forall f. Show f => [Face f] -> ShowS
show :: Face f -> String
$cshow :: forall f. Show f => Face f -> String
showsPrec :: Int -> Face f -> ShowS
$cshowsPrec :: forall f. Show f => Int -> Face f -> ShowS
Show, Face f -> Face f -> Bool
(Face f -> Face f -> Bool)
-> (Face f -> Face f -> Bool) -> Eq (Face f)
forall f. Eq f => Face f -> Face f -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Face f -> Face f -> Bool
$c/= :: forall f. Eq f => Face f -> Face f -> Bool
== :: Face f -> Face f -> Bool
$c== :: forall f. Eq f => Face f -> Face f -> Bool
Eq)

instance ToJSON f   => ToJSON   (Face f) where
  toEncoding :: Face f -> Encoding
toEncoding = Options -> Face f -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
defaultOptions

instance FromJSON f => FromJSON (Face f)


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