module Ribosome.Msgpack.Util where

import Data.Map.Strict ((!?))
import qualified Data.Map.Strict as Map (fromList)
import Data.MessagePack (Object(..))
import Data.Text.Prettyprint.Doc (Doc, pretty, viaShow, (<+>))
import Data.Text.Prettyprint.Doc.Render.Terminal (AnsiStyle)

type Err = Doc AnsiStyle

string :: ConvertUtf8 a ByteString => a -> Object
string :: a -> Object
string = ByteString -> Object
ObjectString (ByteString -> Object) -> (a -> ByteString) -> a -> Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ByteString
forall a b. ConvertUtf8 a b => a -> b
encodeUtf8

binary :: ConvertUtf8 a ByteString => a -> Object
binary :: a -> Object
binary = ByteString -> Object
ObjectBinary (ByteString -> Object) -> (a -> ByteString) -> a -> Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ByteString
forall a b. ConvertUtf8 a b => a -> b
encodeUtf8

text :: Text -> Object
text :: Text -> Object
text = ByteString -> Object
ObjectString (ByteString -> Object) -> (Text -> ByteString) -> Text -> Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
forall a b. ConvertUtf8 a b => a -> b
encodeUtf8

assembleMap :: [(String, Object)] -> Object
assembleMap :: [(String, Object)] -> Object
assembleMap =
  Map Object Object -> Object
ObjectMap (Map Object Object -> Object)
-> ([(String, Object)] -> Map Object Object)
-> [(String, Object)]
-> Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Object, Object)] -> Map Object Object
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Object, Object)] -> Map Object Object)
-> ([(String, Object)] -> [(Object, Object)])
-> [(String, Object)]
-> Map Object Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (((String, Object) -> (Object, Object))
-> [(String, Object)] -> [(Object, Object)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((String, Object) -> (Object, Object))
 -> [(String, Object)] -> [(Object, Object)])
-> ((String -> Object) -> (String, Object) -> (Object, Object))
-> (String -> Object)
-> [(String, Object)]
-> [(Object, Object)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Object) -> (String, Object) -> (Object, Object)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first) String -> Object
forall a. ConvertUtf8 a ByteString => a -> Object
string

invalid :: Text -> Object -> Either Err a
invalid :: Text -> Object -> Either Err a
invalid Text
msg Object
obj =
  Err -> Either Err a
forall a b. a -> Either a b
Left (Err -> Either Err a) -> Err -> Either Err a
forall a b. (a -> b) -> a -> b
$ Text -> Err
forall a ann. Pretty a => a -> Doc ann
pretty (Text
msg Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": ") Err -> Err -> Err
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Object -> Err
forall a ann. Show a => a -> Doc ann
viaShow Object
obj

missingRecordKey :: String -> Object -> Either Err a
missingRecordKey :: String -> Object -> Either Err a
missingRecordKey String
key =
  Text -> Object -> Either Err a
forall a. Text -> Object -> Either Err a
invalid (Text -> Object -> Either Err a) -> Text -> Object -> Either Err a
forall a b. (a -> b) -> a -> b
$ Text
"missing record key " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a. ToText a => a -> Text
toText String
key Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" in ObjectMap"

illegalType :: Text -> Object -> Either Err a
illegalType :: Text -> Object -> Either Err a
illegalType Text
tpe =
  Text -> Object -> Either Err a
forall a. Text -> Object -> Either Err a
invalid (Text -> Object -> Either Err a) -> Text -> Object -> Either Err a
forall a b. (a -> b) -> a -> b
$ Text
"illegal type for " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
tpe

lookupObjectMap ::
  ConvertUtf8 a ByteString =>
  a ->
  Map Object Object ->
  Maybe Object
lookupObjectMap :: a -> Map Object Object -> Maybe Object
lookupObjectMap a
key Map Object Object
o =
  (Map Object Object
o Map Object Object -> Object -> Maybe Object
forall k a. Ord k => Map k a -> k -> Maybe a
!? a -> Object
forall a. ConvertUtf8 a ByteString => a -> Object
string a
key) Maybe Object -> Maybe Object -> Maybe Object
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Map Object Object
o Map Object Object -> Object -> Maybe Object
forall k a. Ord k => Map k a -> k -> Maybe a
!? a -> Object
forall a. ConvertUtf8 a ByteString => a -> Object
binary a
key)