{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE DeriveGeneric #-}
{-# language OverloadedStrings #-}
{-# options_ghc -Wno-unused-imports #-}
{-|
Module      : Algebra.Graph.IO.JSON
Description : 'aeson' instances for algebraic-graphs types
Copyright   : (c) Marco Zocca, 2022
Maintainer  : ocramz
Stability   : experimental
Portability : POSIX

Orphan instances for compatibility between 'algebraic-graphs' and 'aeson'.

Import only if you know what you're doing.
-}
module Algebra.Graph.IO.JSON () where

import Control.Applicative (Alternative(..))
import GHC.Generics (Generic)

-- aeson
import qualified Data.Aeson as A (FromJSON(..), ToJSON(..), encode, eitherDecode, Value, withArray, withText, withObject, (.:), Object)
import qualified Data.Aeson.Types as A (Parser)
import qualified Data.Aeson.Encoding as A (value, fromEncoding)
-- alga
import qualified Algebra.Graph as G (Graph(..), edges, foldg)
import qualified Algebra.Graph.Labelled as GL (Graph(..), edges, foldg)

-- unlabeled edges

instance A.ToJSON a => A.ToJSON (G.Graph a) where
  toJSON :: Graph a -> Value
toJSON = forall a. ToJSON a => Graph a -> Value
graphToValue


graphToValue :: (A.ToJSON t) =>
                G.Graph t -> A.Value
graphToValue :: forall a. ToJSON a => Graph a -> Value
graphToValue = forall a. ToJSON a => Graph a -> Value
go
  where
    go :: Graph a -> Value
go Graph a
G.Empty = forall a. ToJSON a => a -> Value
A.toJSON Empty
Empty
    go (G.Vertex a
x) = forall a. ToJSON a => a -> Value
A.toJSON (forall a. a -> Vertex a
Vertex a
x)
    go (G.Overlay Graph a
x Graph a
y) = forall a. ToJSON a => a -> Value
A.toJSON (forall a. a -> a -> Overlay a
Overlay (Graph a -> Value
go Graph a
x) (Graph a -> Value
go Graph a
y))
    go (G.Connect Graph a
x Graph a
y) = forall a. ToJSON a => a -> Value
A.toJSON (forall a. a -> a -> Connect a
Connect (Graph a -> Value
go Graph a
x) (Graph a -> Value
go Graph a
y))




instance A.FromJSON a => A.FromJSON (G.Graph a) where
  parseJSON :: Value -> Parser (Graph a)
parseJSON Value
x = forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"Graph" forall a. FromJSON a => Object -> Parser (Graph a)
gObj Value
x forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                forall a. Value -> Parser (Graph a)
parseE Value
x

gObj :: A.FromJSON a => A.Object -> A.Parser (G.Graph a)
gObj :: forall a. FromJSON a => Object -> Parser (Graph a)
gObj Object
o = forall a. FromJSON a => Object -> Parser (Graph a)
parseC Object
o forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
         forall a. FromJSON a => Object -> Parser (Graph a)
parseO Object
o forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
         forall a. FromJSON a => Object -> Parser (Graph a)
parseV Object
o

parseE :: A.Value -> A.Parser (G.Graph a)
parseE :: forall a. Value -> Parser (Graph a)
parseE = forall a. String -> (Array -> Parser a) -> Value -> Parser a
A.withArray String
"empty" forall a b. (a -> b) -> a -> b
$ \Array
t -> if forall (t :: * -> *) a. Foldable t => t a -> Bool
null Array
t then forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Graph a
G.Empty else forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"cannot parse Empty"

parseV :: A.FromJSON a => A.Object -> A.Parser (G.Graph a)
parseV :: forall a. FromJSON a => Object -> Parser (Graph a)
parseV Object
o = forall a. a -> Graph a
G.Vertex forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"v"

parseO :: A.FromJSON a => A.Object -> A.Parser (G.Graph a)
parseO :: forall a. FromJSON a => Object -> Parser (Graph a)
parseO Object
o = do
  Graph a
a <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"o1"
  Graph a
b <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"o2"
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. Graph a -> Graph a -> Graph a
G.Overlay Graph a
a Graph a
b

parseC :: A.FromJSON a => A.Object -> A.Parser (G.Graph a)
parseC :: forall a. FromJSON a => Object -> Parser (Graph a)
parseC Object
o = do
  Graph a
a <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"c1"
  Graph a
b <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"c2"
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. Graph a -> Graph a -> Graph a
G.Connect Graph a
a Graph a
b




instance (A.ToJSON a, A.ToJSON e) => A.ToJSON (GL.Graph e a) where
  toJSON :: Graph e a -> Value
toJSON = forall a e. (ToJSON a, ToJSON e) => Graph e a -> Value
graphLToValue

graphLToValue :: (A.ToJSON a, A.ToJSON e) => GL.Graph e a -> A.Value
graphLToValue :: forall a e. (ToJSON a, ToJSON e) => Graph e a -> Value
graphLToValue = forall a e. (ToJSON a, ToJSON e) => Graph e a -> Value
go
  where
    go :: Graph e a -> Value
go Graph e a
GL.Empty = forall a. ToJSON a => a -> Value
A.toJSON Empty
Empty
    go (GL.Vertex a
x) = forall a. ToJSON a => a -> Value
A.toJSON (forall a. a -> Vertex a
Vertex a
x)
    go (GL.Connect e
e Graph e a
x Graph e a
y) = forall a. ToJSON a => a -> Value
A.toJSON (forall e a. e -> a -> a -> LEdge e a
LEdge e
e (Graph e a -> Value
go Graph e a
x) (Graph e a -> Value
go Graph e a
y))


instance (A.FromJSON e, A.FromJSON a) => A.FromJSON (GL.Graph e a) where
  parseJSON :: Value -> Parser (Graph e a)
parseJSON Value
x = forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"Graph (labeled)" forall e a.
(FromJSON e, FromJSON a) =>
Object -> Parser (Graph e a)
gLObj Value
x forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                forall e a. Value -> Parser (Graph e a)
parseEL Value
x

gLObj :: (A.FromJSON e, A.FromJSON a) => A.Object -> A.Parser (GL.Graph e a)
gLObj :: forall e a.
(FromJSON e, FromJSON a) =>
Object -> Parser (Graph e a)
gLObj Object
o = forall e a.
(FromJSON e, FromJSON a) =>
Object -> Parser (Graph e a)
parseCL Object
o forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
          forall a e. FromJSON a => Object -> Parser (Graph e a)
parseVL Object
o

parseEL :: A.Value -> A.Parser (GL.Graph e a)
parseEL :: forall e a. Value -> Parser (Graph e a)
parseEL = forall a. String -> (Array -> Parser a) -> Value -> Parser a
A.withArray String
"empty" forall a b. (a -> b) -> a -> b
$ \Array
t -> if forall (t :: * -> *) a. Foldable t => t a -> Bool
null Array
t then forall (f :: * -> *) a. Applicative f => a -> f a
pure forall e a. Graph e a
GL.Empty else forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"cannot parse Empty"

parseVL :: A.FromJSON a => A.Object -> A.Parser (GL.Graph e a)
parseVL :: forall a e. FromJSON a => Object -> Parser (Graph e a)
parseVL Object
o = forall e a. a -> Graph e a
GL.Vertex forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"v"

parseCL :: (A.FromJSON e, A.FromJSON a) =>
           A.Object -> A.Parser (GL.Graph e a)
parseCL :: forall e a.
(FromJSON e, FromJSON a) =>
Object -> Parser (Graph e a)
parseCL Object
o = do
  e
e <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"l"
  Graph e a
a <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"e1"
  Graph e a
b <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"e2"
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall e a. e -> Graph e a -> Graph e a -> Graph e a
GL.Connect e
e Graph e a
a Graph e a
b


-- | Helper types

-- empty
data Empty = Empty deriving (Empty -> Empty -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Empty -> Empty -> Bool
$c/= :: Empty -> Empty -> Bool
== :: Empty -> Empty -> Bool
$c== :: Empty -> Empty -> Bool
Eq, Int -> Empty -> ShowS
[Empty] -> ShowS
Empty -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Empty] -> ShowS
$cshowList :: [Empty] -> ShowS
show :: Empty -> String
$cshow :: Empty -> String
showsPrec :: Int -> Empty -> ShowS
$cshowsPrec :: Int -> Empty -> ShowS
Show, forall x. Rep Empty x -> Empty
forall x. Empty -> Rep Empty x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Empty x -> Empty
$cfrom :: forall x. Empty -> Rep Empty x
Generic)
instance A.ToJSON Empty
-- vertex
newtype Vertex a = Vertex { forall a. Vertex a -> a
v :: a } deriving (Vertex a -> Vertex a -> Bool
forall a. Eq a => Vertex a -> Vertex a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Vertex a -> Vertex a -> Bool
$c/= :: forall a. Eq a => Vertex a -> Vertex a -> Bool
== :: Vertex a -> Vertex a -> Bool
$c== :: forall a. Eq a => Vertex a -> Vertex a -> Bool
Eq, Int -> Vertex a -> ShowS
forall a. Show a => Int -> Vertex a -> ShowS
forall a. Show a => [Vertex a] -> ShowS
forall a. Show a => Vertex a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Vertex a] -> ShowS
$cshowList :: forall a. Show a => [Vertex a] -> ShowS
show :: Vertex a -> String
$cshow :: forall a. Show a => Vertex a -> String
showsPrec :: Int -> Vertex a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Vertex a -> ShowS
Show, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Vertex a) x -> Vertex a
forall a x. Vertex a -> Rep (Vertex a) x
$cto :: forall a x. Rep (Vertex a) x -> Vertex a
$cfrom :: forall a x. Vertex a -> Rep (Vertex a) x
Generic)
instance A.ToJSON a => A.ToJSON (Vertex a)

-- overlay
data Overlay a = Overlay { forall a. Overlay a -> a
o1 :: a, forall a. Overlay a -> a
o2 :: a} deriving (Overlay a -> Overlay a -> Bool
forall a. Eq a => Overlay a -> Overlay a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Overlay a -> Overlay a -> Bool
$c/= :: forall a. Eq a => Overlay a -> Overlay a -> Bool
== :: Overlay a -> Overlay a -> Bool
$c== :: forall a. Eq a => Overlay a -> Overlay a -> Bool
Eq, Int -> Overlay a -> ShowS
forall a. Show a => Int -> Overlay a -> ShowS
forall a. Show a => [Overlay a] -> ShowS
forall a. Show a => Overlay a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Overlay a] -> ShowS
$cshowList :: forall a. Show a => [Overlay a] -> ShowS
show :: Overlay a -> String
$cshow :: forall a. Show a => Overlay a -> String
showsPrec :: Int -> Overlay a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Overlay a -> ShowS
Show, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Overlay a) x -> Overlay a
forall a x. Overlay a -> Rep (Overlay a) x
$cto :: forall a x. Rep (Overlay a) x -> Overlay a
$cfrom :: forall a x. Overlay a -> Rep (Overlay a) x
Generic)
instance A.ToJSON a => A.ToJSON (Overlay a)

-- connect
data Connect a = Connect { forall a. Connect a -> a
c1 :: a, forall a. Connect a -> a
c2 :: a} deriving (Connect a -> Connect a -> Bool
forall a. Eq a => Connect a -> Connect a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Connect a -> Connect a -> Bool
$c/= :: forall a. Eq a => Connect a -> Connect a -> Bool
== :: Connect a -> Connect a -> Bool
$c== :: forall a. Eq a => Connect a -> Connect a -> Bool
Eq, Int -> Connect a -> ShowS
forall a. Show a => Int -> Connect a -> ShowS
forall a. Show a => [Connect a] -> ShowS
forall a. Show a => Connect a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Connect a] -> ShowS
$cshowList :: forall a. Show a => [Connect a] -> ShowS
show :: Connect a -> String
$cshow :: forall a. Show a => Connect a -> String
showsPrec :: Int -> Connect a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Connect a -> ShowS
Show, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Connect a) x -> Connect a
forall a x. Connect a -> Rep (Connect a) x
$cto :: forall a x. Rep (Connect a) x -> Connect a
$cfrom :: forall a x. Connect a -> Rep (Connect a) x
Generic)
instance A.ToJSON a => A.ToJSON (Connect a)




data LEdge e a = LEdge { forall e a. LEdge e a -> e
l :: e, forall e a. LEdge e a -> a
e1 :: a, forall e a. LEdge e a -> a
e2 :: a } deriving (LEdge e a -> LEdge e a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall e a. (Eq e, Eq a) => LEdge e a -> LEdge e a -> Bool
/= :: LEdge e a -> LEdge e a -> Bool
$c/= :: forall e a. (Eq e, Eq a) => LEdge e a -> LEdge e a -> Bool
== :: LEdge e a -> LEdge e a -> Bool
$c== :: forall e a. (Eq e, Eq a) => LEdge e a -> LEdge e a -> Bool
Eq, Int -> LEdge e a -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall e a. (Show e, Show a) => Int -> LEdge e a -> ShowS
forall e a. (Show e, Show a) => [LEdge e a] -> ShowS
forall e a. (Show e, Show a) => LEdge e a -> String
showList :: [LEdge e a] -> ShowS
$cshowList :: forall e a. (Show e, Show a) => [LEdge e a] -> ShowS
show :: LEdge e a -> String
$cshow :: forall e a. (Show e, Show a) => LEdge e a -> String
showsPrec :: Int -> LEdge e a -> ShowS
$cshowsPrec :: forall e a. (Show e, Show a) => Int -> LEdge e a -> ShowS
Show, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall e a x. Rep (LEdge e a) x -> LEdge e a
forall e a x. LEdge e a -> Rep (LEdge e a) x
$cto :: forall e a x. Rep (LEdge e a) x -> LEdge e a
$cfrom :: forall e a x. LEdge e a -> Rep (LEdge e a) x
Generic)
instance (A.ToJSON e, A.ToJSON a) => A.ToJSON (LEdge e a)