{-# LANGUAGE RecordWildCards #-}

module Potato.Flow.Serialization.SnakeWrangler where

import           Relude

import           Potato.Flow.Types
import Potato.Flow.Controller.Types

import qualified Data.Aeson               as Aeson
import qualified Data.Aeson.Encode.Pretty as PrettyAeson
import qualified Data.Binary as Binary
import qualified Data.ByteString.Lazy as LBS
import qualified Data.Text.Encoding as Text



-- | list of all version supported
versions :: [Int]
versions :: [Int]
versions = [Int
1]

-- | version of the current build
currentVersion :: Int
currentVersion :: Int
currentVersion = Int
1

data Snake = Snake {
  Snake -> Int
_snake_version :: Int
  -- string instead of enum type to ensure compatibility if new formats are ever added
  -- currently supports "binary" and "json"
  , Snake -> String
_snake_format :: String
  , Snake -> Text
_snake_data :: Text
} deriving (Snake -> Snake -> Bool
(Snake -> Snake -> Bool) -> (Snake -> Snake -> Bool) -> Eq Snake
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Snake -> Snake -> Bool
== :: Snake -> Snake -> Bool
$c/= :: Snake -> Snake -> Bool
/= :: Snake -> Snake -> Bool
Eq, (forall x. Snake -> Rep Snake x)
-> (forall x. Rep Snake x -> Snake) -> Generic Snake
forall x. Rep Snake x -> Snake
forall x. Snake -> Rep Snake x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Snake -> Rep Snake x
from :: forall x. Snake -> Rep Snake x
$cto :: forall x. Rep Snake x -> Snake
to :: forall x. Rep Snake x -> Snake
Generic, Int -> Snake -> ShowS
[Snake] -> ShowS
Snake -> String
(Int -> Snake -> ShowS)
-> (Snake -> String) -> ([Snake] -> ShowS) -> Show Snake
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Snake -> ShowS
showsPrec :: Int -> Snake -> ShowS
$cshow :: Snake -> String
show :: Snake -> String
$cshowList :: [Snake] -> ShowS
showList :: [Snake] -> ShowS
Show)

instance Aeson.FromJSON Snake
instance Aeson.ToJSON Snake
instance Binary.Binary Snake
instance NFData Snake

data SnakeFormat = SF_Json | SF_Binary

serialize :: SnakeFormat -> (SPotatoFlow, ControllerMeta) -> LBS.ByteString
serialize :: SnakeFormat -> (SPotatoFlow, ControllerMeta) -> ByteString
serialize SnakeFormat
f (SPotatoFlow, ControllerMeta)
x = ByteString
r where
  (ByteString
inner, String
format) = case SnakeFormat
f of
    SnakeFormat
SF_Json -> ((SPotatoFlow, ControllerMeta) -> ByteString
forall a. ToJSON a => a -> ByteString
PrettyAeson.encodePretty (SPotatoFlow, ControllerMeta)
x, String
"json")
    SnakeFormat
SF_Binary -> ((SPotatoFlow, ControllerMeta) -> ByteString
forall a. Binary a => a -> ByteString
Binary.encode (SPotatoFlow, ControllerMeta)
x, String
"binary")
  outer :: Snake
outer = Snake {
    _snake_version :: Int
_snake_version = Int
currentVersion
    , _snake_format :: String
_snake_format = String
format
    , _snake_data :: Text
_snake_data = ByteString -> Text
Text.decodeUtf8 (ByteString -> ByteString
LBS.toStrict ByteString
inner)
  }
  r :: ByteString
r = Snake -> ByteString
forall a. ToJSON a => a -> ByteString
PrettyAeson.encodePretty Snake
outer

deserialize :: LBS.ByteString -> Either String (SPotatoFlow, ControllerMeta)
deserialize :: ByteString -> Either String (SPotatoFlow, ControllerMeta)
deserialize ByteString
lbs = case ByteString -> Either String Snake
forall a. FromJSON a => ByteString -> Either String a
Aeson.eitherDecode ByteString
lbs of
  Left String
e -> String -> Either String (SPotatoFlow, ControllerMeta)
forall a b. a -> Either a b
Left (String -> Either String (SPotatoFlow, ControllerMeta))
-> String -> Either String (SPotatoFlow, ControllerMeta)
forall a b. (a -> b) -> a -> b
$ String
"failed to decode Snake with error " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
e
  Right Snake
vso -> Snake -> Either String (SPotatoFlow, ControllerMeta)
deserialize_internal Snake
vso


deserialize_internal :: Snake -> Either String (SPotatoFlow, ControllerMeta)
deserialize_internal :: Snake -> Either String (SPotatoFlow, ControllerMeta)
deserialize_internal Snake {Int
String
Text
_snake_version :: Snake -> Int
_snake_format :: Snake -> String
_snake_data :: Snake -> Text
_snake_version :: Int
_snake_format :: String
_snake_data :: Text
..} = do
  if Int
_snake_version Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
currentVersion 
    then String -> Either String ()
forall a b. a -> Either a b
Left (String -> Either String ()) -> String -> Either String ()
forall a b. (a -> b) -> a -> b
$ String
"version mismatch, got: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall b a. (Show a, IsString b) => a -> b
show Int
_snake_version String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" expected: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall b a. (Show a, IsString b) => a -> b
show Int
currentVersion
    else () -> Either String ()
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  case String
_snake_format of
    String
"json" -> ByteString -> Either String (SPotatoFlow, ControllerMeta)
forall a. FromJSON a => ByteString -> Either String a
Aeson.eitherDecodeStrict (Text -> ByteString
Text.encodeUtf8 Text
_snake_data)
    String
"binary" -> case ByteString -> Maybe (SPotatoFlow, ControllerMeta)
forall a. Binary a => ByteString -> a
Binary.decode (ByteString -> ByteString
LBS.fromStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
Text.encodeUtf8 Text
_snake_data) of
      Just (SPotatoFlow, ControllerMeta)
x -> (SPotatoFlow, ControllerMeta)
-> Either String (SPotatoFlow, ControllerMeta)
forall a b. b -> Either a b
Right (SPotatoFlow, ControllerMeta)
x
      Maybe (SPotatoFlow, ControllerMeta)
Nothing -> String -> Either String (SPotatoFlow, ControllerMeta)
forall a b. a -> Either a b
Left String
"failed to decode binary"
    String
x -> String -> Either String (SPotatoFlow, ControllerMeta)
forall a b. a -> Either a b
Left (String -> Either String (SPotatoFlow, ControllerMeta))
-> String -> Either String (SPotatoFlow, ControllerMeta)
forall a b. (a -> b) -> a -> b
$ String
"unrecognized fromat" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS
forall b a. (Show a, IsString b) => a -> b
show String
x


decodeFile :: FilePath -> IO (Either String (SPotatoFlow, ControllerMeta))
decodeFile :: String -> IO (Either String (SPotatoFlow, ControllerMeta))
decodeFile String
fp = do
  ByteString
vsobs <- String -> IO ByteString
LBS.readFile String
fp
  return $ ByteString -> Either String (SPotatoFlow, ControllerMeta)
deserialize ByteString
vsobs


decodeFileMaybe :: FilePath -> IO (Maybe (SPotatoFlow, ControllerMeta))
decodeFileMaybe :: String -> IO (Maybe (SPotatoFlow, ControllerMeta))
decodeFileMaybe String
fp = do
  Either String (SPotatoFlow, ControllerMeta)
x <- String -> IO (Either String (SPotatoFlow, ControllerMeta))
decodeFile String
fp
  case Either String (SPotatoFlow, ControllerMeta)
x of
    Left String
_ -> Maybe (SPotatoFlow, ControllerMeta)
-> IO (Maybe (SPotatoFlow, ControllerMeta))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (SPotatoFlow, ControllerMeta)
forall a. Maybe a
Nothing
    Right (SPotatoFlow, ControllerMeta)
x -> Maybe (SPotatoFlow, ControllerMeta)
-> IO (Maybe (SPotatoFlow, ControllerMeta))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((SPotatoFlow, ControllerMeta)
-> Maybe (SPotatoFlow, ControllerMeta)
forall a. a -> Maybe a
Just (SPotatoFlow, ControllerMeta)
x)