module Rattletrap.Type.Dictionary where

import qualified Data.Bifunctor as Bifunctor
import qualified Data.Map as Map
import qualified Data.Text as Text
import qualified Rattletrap.ByteGet as ByteGet
import qualified Rattletrap.BytePut as BytePut
import qualified Rattletrap.Schema as Schema
import qualified Rattletrap.Type.List as RList
import qualified Rattletrap.Type.Str as Str
import qualified Rattletrap.Utility.Json as Json

data Dictionary a = Dictionary
  { forall a. Dictionary a -> List (Str, a)
elements :: RList.List (Str.Str, a),
    forall a. Dictionary a -> Str
lastKey :: Str.Str
  }
  deriving (Dictionary a -> Dictionary a -> Bool
(Dictionary a -> Dictionary a -> Bool)
-> (Dictionary a -> Dictionary a -> Bool) -> Eq (Dictionary a)
forall a. Eq a => Dictionary a -> Dictionary a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Dictionary a -> Dictionary a -> Bool
== :: Dictionary a -> Dictionary a -> Bool
$c/= :: forall a. Eq a => Dictionary a -> Dictionary a -> Bool
/= :: Dictionary a -> Dictionary a -> Bool
Eq, Int -> Dictionary a -> ShowS
[Dictionary a] -> ShowS
Dictionary a -> String
(Int -> Dictionary a -> ShowS)
-> (Dictionary a -> String)
-> ([Dictionary a] -> ShowS)
-> Show (Dictionary a)
forall a. Show a => Int -> Dictionary a -> ShowS
forall a. Show a => [Dictionary a] -> ShowS
forall a. Show a => Dictionary a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Dictionary a -> ShowS
showsPrec :: Int -> Dictionary a -> ShowS
$cshow :: forall a. Show a => Dictionary a -> String
show :: Dictionary a -> String
$cshowList :: forall a. Show a => [Dictionary a] -> ShowS
showList :: [Dictionary a] -> ShowS
Show)

instance (Json.FromJSON a) => Json.FromJSON (Dictionary a) where
  parseJSON :: Value -> Parser (Dictionary a)
parseJSON = String
-> (Object -> Parser (Dictionary a))
-> Value
-> Parser (Dictionary a)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Json.withObject String
"Dictionary" ((Object -> Parser (Dictionary a))
 -> Value -> Parser (Dictionary a))
-> (Object -> Parser (Dictionary a))
-> Value
-> Parser (Dictionary a)
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    [Text]
keys <- Object -> String -> Parser [Text]
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
o String
"keys"
    Str
lastKey_ <- Object -> String -> Parser Str
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
o String
"last_key"
    Map Text a
value <- Object -> String -> Parser (Map Text a)
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
o String
"value"
    let build ::
          (MonadFail m) =>
          Map.Map Text.Text a ->
          Int ->
          [(Int, (Str.Str, a))] ->
          [Text.Text] ->
          m (RList.List (Str.Str, a))
        build :: forall (m :: * -> *) a.
MonadFail m =>
Map Text a
-> Int -> [(Int, (Str, a))] -> [Text] -> m (List (Str, a))
build Map Text a
m Int
i [(Int, (Str, a))]
xs [Text]
ks = case [Text]
ks of
          [] -> List (Str, a) -> m (List (Str, a))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (List (Str, a) -> m (List (Str, a)))
-> ([(Str, a)] -> List (Str, a)) -> [(Str, a)] -> m (List (Str, a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Str, a)] -> List (Str, a)
forall a. [a] -> List a
RList.fromList ([(Str, a)] -> List (Str, a))
-> ([(Str, a)] -> [(Str, a)]) -> [(Str, a)] -> List (Str, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Str, a)] -> [(Str, a)]
forall a. [a] -> [a]
reverse ([(Str, a)] -> m (List (Str, a)))
-> [(Str, a)] -> m (List (Str, a))
forall a b. (a -> b) -> a -> b
$ ((Int, (Str, a)) -> (Str, a)) -> [(Int, (Str, a))] -> [(Str, a)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int, (Str, a)) -> (Str, a)
forall a b. (a, b) -> b
snd [(Int, (Str, a))]
xs
          Text
k : [Text]
t -> case Text -> Map Text a -> Maybe a
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
k Map Text a
m of
            Maybe a
Nothing -> String -> m (List (Str, a))
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m (List (Str, a))) -> String -> m (List (Str, a))
forall a b. (a -> b) -> a -> b
$ String
"missing required key " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a. Show a => a -> String
show Text
k
            Just a
v -> Map Text a
-> Int -> [(Int, (Str, a))] -> [Text] -> m (List (Str, a))
forall (m :: * -> *) a.
MonadFail m =>
Map Text a
-> Int -> [(Int, (Str, a))] -> [Text] -> m (List (Str, a))
build Map Text a
m (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) ((Int
i, (Text -> Str
Str.fromText Text
k, a
v)) (Int, (Str, a)) -> [(Int, (Str, a))] -> [(Int, (Str, a))]
forall a. a -> [a] -> [a]
: [(Int, (Str, a))]
xs) [Text]
t
    List (Str, a)
elements_ <- Map Text a
-> Int -> [(Int, (Str, a))] -> [Text] -> Parser (List (Str, a))
forall (m :: * -> *) a.
MonadFail m =>
Map Text a
-> Int -> [(Int, (Str, a))] -> [Text] -> m (List (Str, a))
build Map Text a
value Int
0 [] [Text]
keys
    Dictionary a -> Parser (Dictionary a)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Dictionary {elements :: List (Str, a)
elements = List (Str, a)
elements_, lastKey :: Str
lastKey = Str
lastKey_}

instance (Json.ToJSON a) => Json.ToJSON (Dictionary a) where
  toJSON :: Dictionary a -> Value
toJSON Dictionary a
x =
    [(Key, Value)] -> Value
Json.object
      [ String -> [Str] -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"keys" ([Str] -> (Key, Value))
-> (List (Str, a) -> [Str]) -> List (Str, a) -> (Key, Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Str, a) -> Str) -> [(Str, a)] -> [Str]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Str, a) -> Str
forall a b. (a, b) -> a
fst ([(Str, a)] -> [Str])
-> (List (Str, a) -> [(Str, a)]) -> List (Str, a) -> [Str]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. List (Str, a) -> [(Str, a)]
forall a. List a -> [a]
RList.toList (List (Str, a) -> (Key, Value)) -> List (Str, a) -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ Dictionary a -> List (Str, a)
forall a. Dictionary a -> List (Str, a)
elements Dictionary a
x,
        String -> Str -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"last_key" (Str -> (Key, Value)) -> Str -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ Dictionary a -> Str
forall a. Dictionary a -> Str
lastKey Dictionary a
x,
        String -> Map Text a -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"value"
          (Map Text a -> (Key, Value))
-> (List (Str, a) -> Map Text a) -> List (Str, a) -> (Key, Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Text, a)] -> Map Text a
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
          ([(Text, a)] -> Map Text a)
-> (List (Str, a) -> [(Text, a)]) -> List (Str, a) -> Map Text a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Str, a) -> (Text, a)) -> [(Str, a)] -> [(Text, a)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Str -> Text) -> (Str, a) -> (Text, a)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
Bifunctor.first Str -> Text
Str.toText)
          ([(Str, a)] -> [(Text, a)])
-> (List (Str, a) -> [(Str, a)]) -> List (Str, a) -> [(Text, a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. List (Str, a) -> [(Str, a)]
forall a. List a -> [a]
RList.toList
          (List (Str, a) -> (Key, Value)) -> List (Str, a) -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ Dictionary a -> List (Str, a)
forall a. Dictionary a -> List (Str, a)
elements Dictionary a
x
      ]

schema :: Schema.Schema -> Schema.Schema
schema :: Schema -> Schema
schema Schema
s =
  String -> Value -> Schema
Schema.named (String
"dictionary-" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
Text.unpack (Schema -> Text
Schema.name Schema
s)) (Value -> Schema) -> Value -> Schema
forall a b. (a -> b) -> a -> b
$
    [((Key, Value), Bool)] -> Value
Schema.object
      [ (String -> Value -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"keys" (Value -> (Key, Value))
-> (Schema -> Value) -> Schema -> (Key, Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Schema -> Value
Schema.json (Schema -> (Key, Value)) -> Schema -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ Schema -> Schema
Schema.array Schema
Str.schema, Bool
True),
        (String -> Value -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"last_key" (Value -> (Key, Value)) -> Value -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
Str.schema, Bool
True),
        ( String -> Value -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"value" (Value -> (Key, Value)) -> Value -> (Key, Value)
forall a b. (a -> b) -> a -> b
$
            [(Key, Value)] -> Value
Json.object
              [ String -> String -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"type" String
"object",
                String -> Value -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"additionalProperties" (Value -> (Key, Value)) -> Value -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
s
              ],
          Bool
True
        )
      ]

lookup :: Str.Str -> Dictionary a -> Maybe a
lookup :: forall a. Str -> Dictionary a -> Maybe a
lookup Str
k = Str -> [(Str, a)] -> Maybe a
forall a b. Eq a => a -> [(a, b)] -> Maybe b
Prelude.lookup Str
k ([(Str, a)] -> Maybe a)
-> (Dictionary a -> [(Str, a)]) -> Dictionary a -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. List (Str, a) -> [(Str, a)]
forall a. List a -> [a]
RList.toList (List (Str, a) -> [(Str, a)])
-> (Dictionary a -> List (Str, a)) -> Dictionary a -> [(Str, a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dictionary a -> List (Str, a)
forall a. Dictionary a -> List (Str, a)
elements

bytePut :: (a -> BytePut.BytePut) -> Dictionary a -> BytePut.BytePut
bytePut :: forall a. (a -> BytePut) -> Dictionary a -> BytePut
bytePut a -> BytePut
f Dictionary a
x =
  ((Str, a) -> BytePut) -> [(Str, a)] -> BytePut
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\(Str
k, a
v) -> Str -> BytePut
Str.bytePut Str
k BytePut -> BytePut -> BytePut
forall a. Semigroup a => a -> a -> a
<> a -> BytePut
f a
v) (List (Str, a) -> [(Str, a)]
forall a. List a -> [a]
RList.toList (List (Str, a) -> [(Str, a)]) -> List (Str, a) -> [(Str, a)]
forall a b. (a -> b) -> a -> b
$ Dictionary a -> List (Str, a)
forall a. Dictionary a -> List (Str, a)
elements Dictionary a
x)
    BytePut -> BytePut -> BytePut
forall a. Semigroup a => a -> a -> a
<> Str -> BytePut
Str.bytePut (Dictionary a -> Str
forall a. Dictionary a -> Str
lastKey Dictionary a
x)

byteGet :: ByteGet.ByteGet a -> ByteGet.ByteGet (Dictionary a)
byteGet :: forall a. ByteGet a -> ByteGet (Dictionary a)
byteGet = String -> ByteGet (Dictionary a) -> ByteGet (Dictionary a)
forall a. String -> ByteGet a -> ByteGet a
ByteGet.label String
"Dictionary" (ByteGet (Dictionary a) -> ByteGet (Dictionary a))
-> (ByteGet a -> ByteGet (Dictionary a))
-> ByteGet a
-> ByteGet (Dictionary a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [(Int, (Str, a))] -> ByteGet a -> ByteGet (Dictionary a)
forall a.
Int -> [(Int, (Str, a))] -> ByteGet a -> ByteGet (Dictionary a)
byteGetWith Int
0 []

byteGetWith ::
  Int ->
  [(Int, (Str.Str, a))] ->
  ByteGet.ByteGet a ->
  ByteGet.ByteGet (Dictionary a)
byteGetWith :: forall a.
Int -> [(Int, (Str, a))] -> ByteGet a -> ByteGet (Dictionary a)
byteGetWith Int
i [(Int, (Str, a))]
xs ByteGet a
f = do
  Str
k <- String -> ByteGet Str -> ByteGet Str
forall a. String -> ByteGet a -> ByteGet a
ByteGet.label (String
"key (" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
i String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
")") ByteGet Str
Str.byteGet
  if Str -> Bool
isNone Str
k
    then
      Dictionary a -> ByteGet (Dictionary a)
forall a. a -> Get ByteString Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
        Dictionary
          { elements :: List (Str, a)
elements = [(Str, a)] -> List (Str, a)
forall a. [a] -> List a
RList.fromList ([(Str, a)] -> List (Str, a))
-> ([(Str, a)] -> [(Str, a)]) -> [(Str, a)] -> List (Str, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Str, a)] -> [(Str, a)]
forall a. [a] -> [a]
reverse ([(Str, a)] -> List (Str, a)) -> [(Str, a)] -> List (Str, a)
forall a b. (a -> b) -> a -> b
$ ((Int, (Str, a)) -> (Str, a)) -> [(Int, (Str, a))] -> [(Str, a)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int, (Str, a)) -> (Str, a)
forall a b. (a, b) -> b
snd [(Int, (Str, a))]
xs,
            lastKey :: Str
lastKey = Str
k
          }
    else do
      a
v <- String -> ByteGet a -> ByteGet a
forall a. String -> ByteGet a -> ByteGet a
ByteGet.label (String
"value (" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Str -> String
Str.toString Str
k String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
")") ByteGet a
f
      Int -> [(Int, (Str, a))] -> ByteGet a -> ByteGet (Dictionary a)
forall a.
Int -> [(Int, (Str, a))] -> ByteGet a -> ByteGet (Dictionary a)
byteGetWith (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) ((Int
i, (Str
k, a
v)) (Int, (Str, a)) -> [(Int, (Str, a))] -> [(Int, (Str, a))]
forall a. a -> [a] -> [a]
: [(Int, (Str, a))]
xs) ByteGet a
f

isNone :: Str.Str -> Bool
isNone :: Str -> Bool
isNone = (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Text
Text.pack String
"None") (Text -> Bool) -> (Str -> Text) -> Str -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> Text
Text.filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\x00') (Text -> Text) -> (Str -> Text) -> Str -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Str -> Text
Str.toText