{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE LambdaCase #-}
{-|
Module      : Algebra.Graph.IO.Serialise
Description : 'serialise' instances for algebraic-graphs types
Copyright   : (c) Marco Zocca, 2022
Maintainer  : ocramz
Stability   : experimental
Portability : POSIX

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

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

-- alga
import qualified Algebra.Graph as G (Graph(..), edges, foldg)
import qualified Algebra.Graph.Labelled as GL (Graph(..), edges, foldg)
-- serialise
import qualified Codec.Serialise as CS (Serialise(..), serialise, serialiseIncremental, deserialiseOrFail, DeserialiseFailure)
import qualified Codec.Serialise.Encoding as CS (encodeListLen, encodeListLenIndef, encodeWord)
import qualified Codec.Serialise.Decoding as CS (decodeListLen, decodeListLenIndef, decodeWord)


instance CS.Serialise a => CS.Serialise (G.Graph a) where
  encode :: Graph a -> Encoding
encode = \case
    Graph a
G.Empty -> Word -> Encoding
CS.encodeListLen Word
1 forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
CS.encodeWord Word
0
    G.Vertex a
x -> Word -> Encoding
CS.encodeListLen Word
2 forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
CS.encodeWord Word
1 forall a. Semigroup a => a -> a -> a
<> forall a. Serialise a => a -> Encoding
CS.encode a
x
    G.Overlay Graph a
a Graph a
b -> Word -> Encoding
CS.encodeListLen Word
3 forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
CS.encodeWord Word
2 forall a. Semigroup a => a -> a -> a
<> forall a. Serialise a => a -> Encoding
CS.encode Graph a
a forall a. Semigroup a => a -> a -> a
<> forall a. Serialise a => a -> Encoding
CS.encode Graph a
b
    G.Connect Graph a
a Graph a
b -> Word -> Encoding
CS.encodeListLen Word
3 forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
CS.encodeWord Word
3 forall a. Semigroup a => a -> a -> a
<> forall a. Serialise a => a -> Encoding
CS.encode Graph a
a forall a. Semigroup a => a -> a -> a
<> forall a. Serialise a => a -> Encoding
CS.encode Graph a
b
  decode :: forall s. Decoder s (Graph a)
decode = do
    Int
n <- forall s. Decoder s Int
CS.decodeListLen
    Word
t <- forall s. Decoder s Word
CS.decodeWord -- constructor tag
    case (Word
t, Int
n) of
      (Word
0, Int
1) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. Graph a
G.Empty
      (Word
1, Int
2) -> do
        !a
x <- forall a s. Serialise a => Decoder s a
CS.decode
        forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> Graph a
G.Vertex a
x
      (Word
2, Int
3) -> do
        !Graph a
x <- forall a s. Serialise a => Decoder s a
CS.decode
        !Graph a
y <- forall a s. Serialise a => Decoder s a
CS.decode
        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
x Graph a
y
      (Word
3, Int
3) -> do
        !Graph a
x <- forall a s. Serialise a => Decoder s a
CS.decode
        !Graph a
y <- forall a s. Serialise a => Decoder s a
CS.decode
        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
x Graph a
y
      (Word, Int)
e -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords [String
"unknown tag", forall a. Show a => a -> String
show (Word, Int)
e]

instance (CS.Serialise e, CS.Serialise a) => CS.Serialise (GL.Graph e a) where
  encode :: Graph e a -> Encoding
encode = \case
    Graph e a
GL.Empty -> Word -> Encoding
CS.encodeListLen Word
1 forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
CS.encodeWord Word
0
    GL.Vertex a
x -> Word -> Encoding
CS.encodeListLen Word
2 forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
CS.encodeWord Word
1 forall a. Semigroup a => a -> a -> a
<> forall a. Serialise a => a -> Encoding
CS.encode a
x
    GL.Connect e
e Graph e a
a Graph e a
b -> Word -> Encoding
CS.encodeListLen Word
4 forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
CS.encodeWord Word
2 forall a. Semigroup a => a -> a -> a
<> forall a. Serialise a => a -> Encoding
CS.encode e
e forall a. Semigroup a => a -> a -> a
<> forall a. Serialise a => a -> Encoding
CS.encode Graph e a
a forall a. Semigroup a => a -> a -> a
<> forall a. Serialise a => a -> Encoding
CS.encode Graph e a
b
  decode :: forall s. Decoder s (Graph e a)
decode = do
    Int
n <- forall s. Decoder s Int
CS.decodeListLen
    Word
t <- forall s. Decoder s Word
CS.decodeWord -- constructor tag
    case (Word
t, Int
n) of
      (Word
0, Int
1) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall e a. Graph e a
GL.Empty
      (Word
1, Int
2) -> do
        !a
x <- forall a s. Serialise a => Decoder s a
CS.decode
        forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall e a. a -> Graph e a
GL.Vertex a
x
      (Word
2, Int
4) -> do
        !e
e <- forall a s. Serialise a => Decoder s a
CS.decode
        !Graph e a
x <- forall a s. Serialise a => Decoder s a
CS.decode
        !Graph e a
y <- forall a s. Serialise a => Decoder s a
CS.decode
        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
x Graph e a
y
      (Word, Int)
e -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords [String
"unknown tag", forall a. Show a => a -> String
show (Word, Int)
e]