{-# LANGUAGE TemplateHaskellQuotes #-}

module Argo.Type.Object where

import qualified Argo.Decoder as Decoder
import qualified Argo.Literal as Literal
import qualified Argo.Type.Pair as Pair
import qualified Argo.Type.String as String
import qualified Control.DeepSeq as DeepSeq
import qualified Data.Array as Array
import qualified Data.ByteString.Builder as Builder
import qualified Language.Haskell.TH.Syntax as TH

newtype Object a
    = Object (Array.Array Int (Pair.Pair String.String a))
    deriving (Object a -> Object a -> Bool
(Object a -> Object a -> Bool)
-> (Object a -> Object a -> Bool) -> Eq (Object a)
forall a. Eq a => Object a -> Object a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Object a -> Object a -> Bool
$c/= :: forall a. Eq a => Object a -> Object a -> Bool
== :: Object a -> Object a -> Bool
$c== :: forall a. Eq a => Object a -> Object a -> Bool
Eq, Int -> Object a -> ShowS
[Object a] -> ShowS
Object a -> String
(Int -> Object a -> ShowS)
-> (Object a -> String) -> ([Object a] -> ShowS) -> Show (Object a)
forall a. Show a => Int -> Object a -> ShowS
forall a. Show a => [Object a] -> ShowS
forall a. Show a => Object a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Object a] -> ShowS
$cshowList :: forall a. Show a => [Object a] -> ShowS
show :: Object a -> String
$cshow :: forall a. Show a => Object a -> String
showsPrec :: Int -> Object a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Object a -> ShowS
Show)

instance TH.Lift a => TH.Lift (Object a) where
    liftTyped :: Object a -> Q (TExp (Object a))
liftTyped (Object Array Int (Pair String a)
x) =
        let
            bounds :: (Int, Int)
bounds = Array Int (Pair String a) -> (Int, Int)
forall i e. Array i e -> (i, i)
Array.bounds Array Int (Pair String a)
x
            elems :: [Pair String a]
elems = Array Int (Pair String a) -> [Pair String a]
forall i e. Array i e -> [e]
Array.elems Array Int (Pair String a)
x
        in [|| Object $ Array.listArray bounds elems ||]

instance DeepSeq.NFData a => DeepSeq.NFData (Object a) where
    rnf :: Object a -> ()
rnf (Object Array Int (Pair String a)
x) = Array Int (Pair String a) -> ()
forall a. NFData a => a -> ()
DeepSeq.rnf Array Int (Pair String a)
x

encode :: (a -> Builder.Builder) -> Object a -> Builder.Builder
encode :: (a -> Builder) -> Object a -> Builder
encode a -> Builder
f (Object Array Int (Pair String a)
x) =
    Word8 -> Builder
Builder.word8 Word8
Literal.leftCurlyBracket
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ((Int, Pair String a) -> Builder)
-> [(Int, Pair String a)] -> Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap
        (\ (Int
i, Pair String a
e) -> (if Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0 then Word8 -> Builder
Builder.word8 Word8
Literal.comma else Builder
forall a. Monoid a => a
mempty)
            Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (String -> Builder) -> (a -> Builder) -> Pair String a -> Builder
forall k v. (k -> Builder) -> (v -> Builder) -> Pair k v -> Builder
Pair.encode String -> Builder
String.encode a -> Builder
f Pair String a
e)
        (Array Int (Pair String a) -> [(Int, Pair String a)]
forall i e. Ix i => Array i e -> [(i, e)]
Array.assocs Array Int (Pair String a)
x)
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word8 -> Builder
Builder.word8 Word8
Literal.rightCurlyBracket

decode :: Decoder.Decoder a -> Decoder.Decoder (Object a)
decode :: Decoder a -> Decoder (Object a)
decode Decoder a
f = do
    Word8 -> Decoder ()
Decoder.word8 Word8
Literal.leftCurlyBracket
    Decoder ()
Decoder.spaces
    Array Int (Pair String a)
xs <- Decoder (Pair String a) -> Decoder (Array Int (Pair String a))
forall a. Decoder a -> Decoder (Array Int a)
Decoder.array (Decoder (Pair String a) -> Decoder (Array Int (Pair String a)))
-> Decoder (Pair String a) -> Decoder (Array Int (Pair String a))
forall a b. (a -> b) -> a -> b
$ Decoder String -> Decoder a -> Decoder (Pair String a)
forall k v. Decoder k -> Decoder v -> Decoder (Pair k v)
Pair.decode Decoder String
String.decode Decoder a
f
    Word8 -> Decoder ()
Decoder.word8 Word8
Literal.rightCurlyBracket
    Decoder ()
Decoder.spaces
    Object a -> Decoder (Object a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Object a -> Decoder (Object a)) -> Object a -> Decoder (Object a)
forall a b. (a -> b) -> a -> b
$ Array Int (Pair String a) -> Object a
forall a. Array Int (Pair String a) -> Object a
Object Array Int (Pair String a)
xs