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 List
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 :: List.List (Str.Str, a),
    forall a. Dictionary a -> Str
lastKey :: Str.Str
  }
  deriving (Dictionary a -> Dictionary a -> Bool
forall a. Eq a => Dictionary a -> Dictionary a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Dictionary a -> Dictionary a -> Bool
$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
Eq, Int -> Dictionary a -> ShowS
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
showList :: [Dictionary a] -> ShowS
$cshowList :: forall a. Show a => [Dictionary a] -> ShowS
show :: Dictionary a -> String
$cshow :: forall a. Show a => Dictionary a -> String
showsPrec :: Int -> Dictionary a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Dictionary a -> ShowS
Show)

instance (Json.FromJSON a) => Json.FromJSON (Dictionary a) where
  parseJSON :: Value -> Parser (Dictionary a)
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
Json.withObject String
"Dictionary" forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    [Text]
keys <- forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
o String
"keys"
    Str
lastKey_ <- forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
o String
"last_key"
    Map Text a
value <- 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 (List.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
          [] -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> List a
List.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd [(Int, (Str, a))]
xs
          Text
k : [Text]
t -> case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
k Map Text a
m of
            Maybe a
Nothing -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"missing required key " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Text
k
            Just a
v -> forall (m :: * -> *) a.
MonadFail m =>
Map Text a
-> Int -> [(Int, (Str, a))] -> [Text] -> m (List (Str, a))
build Map Text a
m (Int
i forall a. Num a => a -> a -> a
+ Int
1) ((Int
i, (Text -> Str
Str.fromText Text
k, a
v)) forall a. a -> [a] -> [a]
: [(Int, (Str, a))]
xs) [Text]
t
    List (Str, a)
elements_ <- 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
    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
      [ forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"keys" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. List a -> [a]
List.toList forall a b. (a -> b) -> a -> b
$ forall a. Dictionary a -> List (Str, a)
elements Dictionary a
x,
        forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"last_key" forall a b. (a -> b) -> a -> b
$ forall a. Dictionary a -> Str
lastKey Dictionary a
x,
        forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"value"
          forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
          forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
Bifunctor.first Str -> Text
Str.toText)
          forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. List a -> [a]
List.toList
          forall a b. (a -> b) -> a -> b
$ 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-" forall a. Semigroup a => a -> a -> a
<> Text -> String
Text.unpack (Schema -> Text
Schema.name Schema
s)) forall a b. (a -> b) -> a -> b
$
    [((Key, Value), Bool)] -> Value
Schema.object
      [ (forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"keys" forall b c a. (b -> c) -> (a -> b) -> a -> c
. Schema -> Value
Schema.json forall a b. (a -> b) -> a -> b
$ Schema -> Schema
Schema.array Schema
Str.schema, Bool
True),
        (forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"last_key" forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
Str.schema, Bool
True),
        ( forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"value" forall a b. (a -> b) -> a -> b
$
            [(Key, Value)] -> Value
Json.object
              [ forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"type" String
"object",
                forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"additionalProperties" 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 = forall a b. Eq a => a -> [(a, b)] -> Maybe b
Prelude.lookup Str
k forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. List a -> [a]
List.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 =
  forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\(Str
k, a
v) -> Str -> BytePut
Str.bytePut Str
k forall a. Semigroup a => a -> a -> a
<> a -> BytePut
f a
v) (forall a. List a -> [a]
List.toList forall a b. (a -> b) -> a -> b
$ forall a. Dictionary a -> List (Str, a)
elements Dictionary a
x)
    forall a. Semigroup a => a -> a -> a
<> Str -> BytePut
Str.bytePut (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 = forall a. String -> ByteGet a -> ByteGet a
ByteGet.label String
"Dictionary" forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 <- forall a. String -> ByteGet a -> ByteGet a
ByteGet.label (String
"key (" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int
i forall a. Semigroup a => a -> a -> a
<> String
")") ByteGet Str
Str.byteGet
  if Str -> Bool
isNone Str
k
    then
      forall (f :: * -> *) a. Applicative f => a -> f a
pure
        Dictionary
          { elements :: List (Str, a)
elements = forall a. [a] -> List a
List.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd [(Int, (Str, a))]
xs,
            lastKey :: Str
lastKey = Str
k
          }
    else do
      a
v <- forall a. String -> ByteGet a -> ByteGet a
ByteGet.label (String
"value (" forall a. Semigroup a => a -> a -> a
<> Str -> String
Str.toString Str
k forall a. Semigroup a => a -> a -> a
<> String
")") ByteGet a
f
      forall a.
Int -> [(Int, (Str, a))] -> ByteGet a -> ByteGet (Dictionary a)
byteGetWith (Int
i forall a. Num a => a -> a -> a
+ Int
1) ((Int
i, (Str
k, a
v)) forall a. a -> [a] -> [a]
: [(Int, (Str, a))]
xs) ByteGet a
f

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