{-# LANGUAGE BangPatterns #-}

module Json.Context
  ( Context (..)

    -- * Encoding
  , builderUtf8

    -- * Conversion
  , toPath
  ) where

import Data.Bytes.Builder (Builder)
import Data.Text.Short (ShortText)
import Json.Path (Path)

import qualified Json.Path as Path

{- | A finger into a json value indicating where a parser is
currently operating. When a parser focuses on a key-value
pair in a map, it adds 'Key' constructor to the context, and
when it focuses on an element of an array, it adds an 'Index'
constructor. Like all zipper-like data structures, it is, in
a sense, reversed, which makes it cheap to construct while
parsing.
-}
data Context
  = Top
  | Key !ShortText !Context
  | Index !Int !Context
  deriving (Context -> Context -> Bool
(Context -> Context -> Bool)
-> (Context -> Context -> Bool) -> Eq Context
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Context -> Context -> Bool
== :: Context -> Context -> Bool
$c/= :: Context -> Context -> Bool
/= :: Context -> Context -> Bool
Eq, Int -> Context -> ShowS
[Context] -> ShowS
Context -> String
(Int -> Context -> ShowS)
-> (Context -> String) -> ([Context] -> ShowS) -> Show Context
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Context -> ShowS
showsPrec :: Int -> Context -> ShowS
$cshow :: Context -> String
show :: Context -> String
$cshowList :: [Context] -> ShowS
showList :: [Context] -> ShowS
Show)

{- | Reverse the context, converting it to a 'Path'.
For example, toPath performs this conversion:

> 12.bar.foo.Top ==> foo.bar.12.Nil
-}
toPath :: Context -> Path
toPath :: Context -> Path
toPath = Path -> Context -> Path
go Path
Path.Nil
 where
  go :: Path -> Context -> Path
go !Path
acc Context
Top = Path
acc
  go !Path
acc (Key ShortText
k Context
xs) = Path -> Context -> Path
go (ShortText -> Path -> Path
Path.Key ShortText
k Path
acc) Context
xs
  go !Path
acc (Index Int
i Context
xs) = Path -> Context -> Path
go (Int -> Path -> Path
Path.Index Int
i Path
acc) Context
xs

{- | Convert 'Context' to textual representation using UTF-8 as the encoding
scheme. This reverses the context to present it in the expected order.
-}
builderUtf8 :: Context -> Builder
builderUtf8 :: Context -> Builder
builderUtf8 Context
ctx0 = Path -> Builder
Path.builderUtf8 (Context -> Path
toPath Context
ctx0)