{-# LANGUAGE OverloadedStrings #-}
module Store
(
  Modification (..),
  Path,
  Value,
  modificationPath,
  applyModification,
  delete,
  insert,
  lookup,
  lookupOrNull,
)
where

import Data.Aeson (Value (..), (.=), (.:))
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import Prelude hiding (lookup)

import qualified Data.Aeson as Aeson
import qualified Data.Aeson.Types as Aeson
import qualified Data.HashMap.Strict as HashMap

type Path = [Text]

-- A modification operation.
data Modification
  = Put Path Value
  | Delete Path
  deriving (Modification -> Modification -> Bool
(Modification -> Modification -> Bool)
-> (Modification -> Modification -> Bool) -> Eq Modification
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Modification -> Modification -> Bool
$c/= :: Modification -> Modification -> Bool
== :: Modification -> Modification -> Bool
$c== :: Modification -> Modification -> Bool
Eq, Int -> Modification -> ShowS
[Modification] -> ShowS
Modification -> String
(Int -> Modification -> ShowS)
-> (Modification -> String)
-> ([Modification] -> ShowS)
-> Show Modification
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Modification] -> ShowS
$cshowList :: [Modification] -> ShowS
show :: Modification -> String
$cshow :: Modification -> String
showsPrec :: Int -> Modification -> ShowS
$cshowsPrec :: Int -> Modification -> ShowS
Show)

instance Aeson.ToJSON Modification where
  toJSON :: Modification -> Value
toJSON (Put Path
path Value
value) = [Pair] -> Value
Aeson.object
    [ Text
"op" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (Text
"put" :: Text)
    , Text
"path" Text -> Path -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Path
path
    , Text
"value" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Value
value
    ]
  toJSON (Delete Path
path) = [Pair] -> Value
Aeson.object
    [ Text
"op" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (Text
"delete" :: Text)
    , Text
"path" Text -> Path -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Path
path
    ]

instance Aeson.FromJSON Modification where
  parseJSON :: Value -> Parser Modification
parseJSON = String
-> (Object -> Parser Modification) -> Value -> Parser Modification
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"Modification" ((Object -> Parser Modification) -> Value -> Parser Modification)
-> (Object -> Parser Modification) -> Value -> Parser Modification
forall a b. (a -> b) -> a -> b
$ \Object
v -> do
    Value
op <- Object
v Object -> Text -> Parser Value
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"op"
    case Value
op of
      Value
"put" -> Path -> Value -> Modification
Put (Path -> Value -> Modification)
-> Parser Path -> Parser (Value -> Modification)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser Path
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"path" Parser (Value -> Modification)
-> Parser Value -> Parser Modification
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Value
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"value"
      Value
"delete" -> Path -> Modification
Delete (Path -> Modification) -> Parser Path -> Parser Modification
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser Path
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"path"
      Value
other -> String -> Value -> Parser Modification
forall a. String -> Value -> Parser a
Aeson.typeMismatch String
"Op" Value
other

-- | Return the path that is touched by a modification.
modificationPath :: Modification -> Path
modificationPath :: Modification -> Path
modificationPath Modification
op = case Modification
op of
  Put Path
path Value
_ -> Path
path
  Delete Path
path -> Path
path

lookup :: Path -> Value -> Maybe Value
lookup :: Path -> Value -> Maybe Value
lookup Path
path Value
value =
  case Path
path of
    [] -> Value -> Maybe Value
forall a. a -> Maybe a
Just Value
value
    Text
key : Path
pathTail -> case Value
value of
      Object Object
dict -> Text -> Object -> Maybe Value
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Text
key Object
dict Maybe Value -> (Value -> Maybe Value) -> Maybe Value
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Path -> Value -> Maybe Value
lookup Path
pathTail
      Value
_notObject -> Maybe Value
forall a. Maybe a
Nothing

-- Look up a value, returning null if the path does not exist.
lookupOrNull :: Path -> Value -> Value
lookupOrNull :: Path -> Value -> Value
lookupOrNull Path
path = Value -> Maybe Value -> Value
forall a. a -> Maybe a -> a
fromMaybe Value
Null (Maybe Value -> Value) -> (Value -> Maybe Value) -> Value -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path -> Value -> Maybe Value
lookup Path
path

-- | Execute a modification.
applyModification :: Modification -> Value -> Value
applyModification :: Modification -> Value -> Value
applyModification (Delete Path
path) Value
value = Path -> Value -> Value
Store.delete Path
path Value
value
applyModification (Put Path
path Value
newValue) Value
value = Path -> Value -> Value -> Value
Store.insert Path
path Value
newValue Value
value

-- Overwrite a value at the given path, and create the path leading up to it if
-- it did not exist.
insert :: Path -> Value -> Value -> Value
insert :: Path -> Value -> Value -> Value
insert Path
path Value
newValue Value
value =
  case Path
path of
    [] -> Value
newValue
    Text
key : Path
pathTail -> Object -> Value
Object (Object -> Value) -> Object -> Value
forall a b. (a -> b) -> a -> b
$ case Value
value of
      Object Object
dict -> (Maybe Value -> Maybe Value) -> Text -> Object -> Object
forall k v.
(Eq k, Hashable k) =>
(Maybe v -> Maybe v) -> k -> HashMap k v -> HashMap k v
HashMap.alter (Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value)
-> (Maybe Value -> Value) -> Maybe Value -> Maybe Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Path -> Value -> Value -> Value
insert Path
pathTail Value
newValue) (Value -> Value) -> (Maybe Value -> Value) -> Maybe Value -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Maybe Value -> Value
forall a. a -> Maybe a -> a
fromMaybe Value
Null) Text
key Object
dict
      Value
_notObject  -> Text -> Value -> Object
forall k v. Hashable k => k -> v -> HashMap k v
HashMap.singleton Text
key (Value -> Object) -> Value -> Object
forall a b. (a -> b) -> a -> b
$ Path -> Value -> Value -> Value
insert Path
pathTail Value
newValue Value
Null

-- Delete key at the given path. If the path is empty, return null.
delete :: Path -> Value -> Value
delete :: Path -> Value -> Value
delete Path
path Value
value =
  case Path
path of
    [] -> Value
Null
    Text
key : [] -> case Value
value of
      Object Object
dict -> Object -> Value
Object (Object -> Value) -> Object -> Value
forall a b. (a -> b) -> a -> b
$ Text -> Object -> Object
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> HashMap k v
HashMap.delete Text
key Object
dict
      Value
notObject   -> Value
notObject
    Text
key : Path
pathTail -> case Value
value of
      Object Object
dict -> Object -> Value
Object (Object -> Value) -> Object -> Value
forall a b. (a -> b) -> a -> b
$ (Value -> Value) -> Text -> Object -> Object
forall k v.
(Eq k, Hashable k) =>
(v -> v) -> k -> HashMap k v -> HashMap k v
HashMap.adjust (Path -> Value -> Value
delete Path
pathTail) Text
key Object
dict
      Value
notObject   -> Value
notObject