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
  { Dictionary a -> List (Str, a)
elements :: List.List (Str.Str, 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
/= :: 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
[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
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 = 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 (List.List (Str.Str, a))
      build :: 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 (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
List.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 (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 (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 (f :: * -> *) a. Applicative f => a -> f a
pure Dictionary :: forall a. List (Str, a) -> Str -> Dictionary a
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 = [Pair] -> Value
Json.object
    [ String -> [Str] -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"keys" ([Str] -> Pair)
-> (List (Str, a) -> [Str]) -> List (Str, a) -> Pair
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Str, a) -> Str) -> [(Str, a)] -> [Str]
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]
List.toList (List (Str, a) -> Pair) -> List (Str, a) -> Pair
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 -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"last_key" (Str -> Pair) -> Str -> Pair
forall a b. (a -> b) -> a -> b
$ Dictionary a -> Str
forall a. Dictionary a -> Str
lastKey Dictionary a
x
    , String -> Map Text a -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"value"
    (Map Text a -> Pair)
-> (List (Str, a) -> Map Text a) -> List (Str, a) -> Pair
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 (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Str -> Text) -> (Str, a) -> (Text, a)
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]
List.toList
    (List (Str, a) -> Pair) -> List (Str, a) -> Pair
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
$ [(Pair, Bool)] -> Value
Schema.object
    [ (String -> Value -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"keys" (Value -> Pair) -> (Schema -> Value) -> Schema -> Pair
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Schema -> Value
Schema.json (Schema -> Pair) -> Schema -> Pair
forall a b. (a -> b) -> a -> b
$ Schema -> Schema
Schema.array Schema
Str.schema, Bool
True)
    , (String -> Value -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"last_key" (Value -> Pair) -> Value -> Pair
forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
Str.schema, Bool
True)
    , ( String -> Value -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"value" (Value -> Pair) -> Value -> Pair
forall a b. (a -> b) -> a -> b
$ [Pair] -> Value
Json.object
        [ String -> String -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"type" String
"object"
        , String -> Value -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"additionalProperties" (Value -> Pair) -> Value -> Pair
forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
s
        ]
      , Bool
True
      )
    ]

lookup :: Str.Str -> Dictionary a -> Maybe a
lookup :: 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]
List.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 :: (a -> BytePut) -> Dictionary a -> BytePut
bytePut a -> BytePut
f Dictionary a
x =
  ((Str, a) -> BytePut) -> [(Str, a)] -> BytePut
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]
List.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 :: 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 :: 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 (f :: * -> *) a. Applicative f => a -> f a
pure Dictionary :: forall a. List (Str, a) -> Str -> Dictionary a
Dictionary
      { elements :: List (Str, a)
elements = [(Str, a)] -> List (Str, a)
forall a. [a] -> List a
List.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 (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