module Rattletrap.Decode.Dictionary
  ( decodeDictionary
  )
where

import Rattletrap.Decode.Common
import Rattletrap.Decode.Str
import Rattletrap.Type.Dictionary
import Rattletrap.Type.Str

decodeDictionary :: Decode a -> Decode (Dictionary a)
decodeDictionary :: Decode a -> Decode (Dictionary a)
decodeDictionary Decode a
decodeValue = do
  Str
key <- Decode Str
decodeStr
  case (Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\x00') (Str -> [Char]
fromStr Str
key) of
    [Char]
"None" -> Dictionary a -> Decode (Dictionary a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Str -> Dictionary a
forall a. Str -> Dictionary a
DictionaryEnd Str
key)
    [Char]
_ ->
      Str -> a -> Dictionary a -> Dictionary a
forall a. Str -> a -> Dictionary a -> Dictionary a
DictionaryElement Str
key (a -> Dictionary a -> Dictionary a)
-> Decode a -> Get (Dictionary a -> Dictionary a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decode a
decodeValue Get (Dictionary a -> Dictionary a)
-> Decode (Dictionary a) -> Decode (Dictionary a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decode a -> Decode (Dictionary a)
forall a. Decode a -> Decode (Dictionary a)
decodeDictionary Decode a
decodeValue