MsgpackTest.hs

module Ribosome.Test.MsgpackTest where

import qualified Data.Map.Strict as Map (fromList)
import Data.MessagePack (Object(..))
import Data.Text.Prettyprint.Doc (Doc, defaultLayoutOptions, layoutPretty)
import Data.Text.Prettyprint.Doc.Render.Terminal (AnsiStyle, renderStrict)
import Hedgehog ((===))
import Path (Abs, Dir, File, Path, Rel, absfile, relfile)
import Test.Tasty (TestTree, testGroup)

import Ribosome.Msgpack.Decode (MsgpackDecode(..), fromMsgpack)
import Ribosome.Msgpack.Encode (MsgpackEncode(..))
import qualified Ribosome.Msgpack.Util as Util (string)
import Ribosome.Test.Run (UnitTest, unitTest)

newtype NT =
  NT Text
  deriving (Eq, Show, Generic)
  deriving newtype (MsgpackEncode, MsgpackDecode)

data Blob =
  Blob {
    key4 :: [[Int]],
    key5 :: Map Int Text,
    key6 :: NT,
    key7 :: (Int, String)
  }
  deriving (Eq, Show, Generic, MsgpackEncode, MsgpackDecode)

data Prod =
  Prod Text Int
  deriving (Eq, Show, Generic, MsgpackEncode, MsgpackDecode)

data Dat =
  Dat {
    key1 :: Blob,
    key2 :: Bool,
    key3 :: Maybe Prod
  }
  deriving (Eq, Show, Generic, MsgpackEncode, MsgpackDecode)

dat :: Dat
dat = Dat (Blob [[1, 2], [3]] (Map.fromList [(1, "1"), (2, "2")]) (NT "nt") (91, "pair")) False (Just $ Prod "dat" 27)

os :: String -> Object
os = Util.string

i :: Int64 -> Object
i = ObjectInt

encodedBlob :: Object
encodedBlob =
  ObjectMap $ Map.fromList [
    (os "key4", ObjectArray [ObjectArray [i 1, i 2], ObjectArray [i 3]]),
    (os "key5", ObjectMap $ Map.fromList [(i 1, os "1"), (i 2, os "2")]),
    (os "key6", os "nt"),
    (os "key7", ObjectArray [ObjectInt 91, ObjectString "pair"])
    ]

encoded :: Object
encoded =
  ObjectMap $ Map.fromList [
    (os "key1", encodedBlob),
    (os "key2", ObjectBool False),
    (ObjectString "key3", ObjectArray [os "dat", i 27])
    ]

test_encode :: UnitTest
test_encode =
  encoded === toMsgpack dat

doc2Text :: Either (Doc AnsiStyle) a -> Either Text a
doc2Text =
  mapLeft (renderStrict . layoutPretty defaultLayoutOptions)

decodeSubject :: Object
decodeSubject =
  ObjectMap $ Map.fromList [
    (os "key1", encodedBlob),
    (os "key2", ObjectBool False),
    (ObjectBinary "key3", ObjectArray [os "dat", i 27])
    ]

test_decodeBasic :: UnitTest
test_decodeBasic =
  Right dat === doc2Text (fromMsgpack decodeSubject)

data Nope =
  Nope {
    present :: Int,
    absent :: Maybe Int
  }
  deriving (Eq, Show, Generic, MsgpackDecode)

encodedNope :: Object
encodedNope =
  ObjectMap $ Map.fromList [(os "present", i 5)]

test_maybeMissing :: UnitTest
test_maybeMissing =
  Right (Nope 5 Nothing) === doc2Text (fromMsgpack encodedNope)

test_decodeEither :: UnitTest
test_decodeEither =
  Right (Left "text" :: Either Text Int) === doc2Text (fromMsgpack (ObjectBinary "text"))

data ST =
  STL {
    stName :: Text,
    stCount :: Int
  }
  |
  STR {
    stName :: Text,
    stDesc :: Text
  }
  deriving (Eq, Show, Generic, MsgpackEncode, MsgpackDecode)

sumName :: Text
sumName =
  "sumName"

sumCount :: Int
sumCount =
  1313

encodedSum :: Object
encodedSum =
  ObjectMap $ Map.fromList [
    (toMsgpack @Text "stName", toMsgpack sumName),
    (toMsgpack @Text "stCount", toMsgpack sumCount)
    ]

test_encodeSum :: UnitTest
test_encodeSum =
  encodedSum === toMsgpack (STL sumName sumCount)

test_decodeSum :: UnitTest
test_decodeSum =
  Right (STL sumName sumCount) === doc2Text (fromMsgpack encodedSum)

encodedPath :: Object
encodedPath =
  ObjectString "/path/to/file"

test_decodePath :: UnitTest
test_decodePath =
  Right [absfile|/path/to/file|] === doc2Text (fromMsgpack @(Path Abs File) encodedPath)

test_failDecodePath :: UnitTest
test_failDecodePath =
  Left "InvalidRelDir \"/path/to/file\"" === doc2Text (fromMsgpack @(Path Rel Dir) encodedPath)

test_encodePath :: UnitTest
test_encodePath =
  ObjectString "path/to/file" === toMsgpack [relfile|path/to/file|]

test_msgpack :: TestTree
test_msgpack =
  testGroup "msgpack" [
    unitTest "encode" test_encode,
    unitTest "decode" test_decodeBasic,
    unitTest "decode Nothing" test_maybeMissing,
    unitTest "decode Right" test_decodeEither,
    unitTest "encode sum type" test_encodeSum,
    unitTest "decode sum type" test_decodeSum,
    unitTest "decode Path" test_decodePath,
    unitTest "decode invalid Path" test_failDecodePath,
    unitTest "encode Path" test_encodePath
  ]