{-# LANGUAGE RecordWildCards #-}

module Potato.Flow.Serialization.Snake where

import           Relude

import           Potato.Flow.Types
import           Potato.Flow.SElts
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           System.FilePath
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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Snake -> Snake -> Bool
$c/= :: Snake -> Snake -> Bool
== :: Snake -> Snake -> Bool
$c== :: Snake -> Snake -> Bool
Eq, 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
$cto :: forall x. Rep Snake x -> Snake
$cfrom :: forall x. Snake -> Rep Snake x
Generic, Int -> Snake -> ShowS
[Snake] -> ShowS
Snake -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Snake] -> ShowS
$cshowList :: [Snake] -> ShowS
show :: Snake -> String
$cshow :: Snake -> String
showsPrec :: Int -> Snake -> ShowS
$cshowsPrec :: Int -> 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 -> (forall a. ToJSON a => a -> ByteString
PrettyAeson.encodePretty (SPotatoFlow, ControllerMeta)
x, String
"json")
    SnakeFormat
SF_Binary -> (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 = 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 forall a. FromJSON a => ByteString -> Either String a
Aeson.eitherDecode ByteString
lbs of
  Left String
e -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String
"failed to decode Snake with error " 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_data :: Text
_snake_format :: String
_snake_version :: Int
_snake_data :: Snake -> Text
_snake_format :: Snake -> String
_snake_version :: Snake -> Int
..} = do
  if Int
_snake_version forall a. Eq a => a -> a -> Bool
/= Int
currentVersion 
    then forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String
"version mismatch, got: " forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show Int
_snake_version forall a. Semigroup a => a -> a -> a
<> String
" expected: " forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show Int
currentVersion
    else forall (m :: * -> *) a. Monad m => a -> m a
return ()
  case String
_snake_format of
    String
"json" -> forall a. FromJSON a => ByteString -> Either String a
Aeson.eitherDecodeStrict (Text -> ByteString
Text.encodeUtf8 Text
_snake_data)
    String
"binary" -> case forall a. Binary a => ByteString -> a
Binary.decode (ByteString -> ByteString
LBS.fromStrict forall a b. (a -> b) -> a -> b
$ Text -> ByteString
Text.encodeUtf8 Text
_snake_data) of
      Just (SPotatoFlow, ControllerMeta)
x -> forall a b. b -> Either a b
Right (SPotatoFlow, ControllerMeta)
x
      Maybe (SPotatoFlow, ControllerMeta)
Nothing -> forall a b. a -> Either a b
Left String
"failed to decode binary"
    String
x -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String
"unrecognized fromat" forall a. Semigroup a => a -> a -> a
<> 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
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
    Right (SPotatoFlow, ControllerMeta)
x -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just (SPotatoFlow, ControllerMeta)
x)