-- |  This cl
--
-- @since 0.0.1.0
module Prairie.Update where

import Data.Aeson (ToJSON(..), FromJSON(..), object, withObject, (.:), (.=))
import Control.Lens (set)
import Data.Typeable (Typeable, (:~:)(..), eqT)

import Prairie.Class

-- | An operation representing an update against the 'rec' in question.
--
-- This type is partially an example - you may want to have a more
-- sophisticated update type than merely setting fields.
--
-- @since 0.0.1.0
data Update rec where
  SetField :: Field rec a -> a -> Update rec

-- |
--
-- @since 0.0.1.0
instance (forall a. Eq (Field rec a), FieldDict Typeable rec, FieldDict Eq rec) => Eq (Update rec) where
  SetField Field rec a
f0 (a
a0 :: a0) == :: Update rec -> Update rec -> Bool
== SetField Field rec a
f1 (a
a1 :: a1) =
    Field rec a -> (Typeable a => Bool) -> Bool
forall (c :: Type -> Constraint) rec a r.
FieldDict c rec =>
Field rec a -> (c a => r) -> r
withFieldDict @Typeable Field rec a
f0 ((Typeable a => Bool) -> Bool) -> (Typeable a => Bool) -> Bool
forall a b. (a -> b) -> a -> b
$
    Field rec a -> (Typeable a => Bool) -> Bool
forall (c :: Type -> Constraint) rec a r.
FieldDict c rec =>
Field rec a -> (c a => r) -> r
withFieldDict @Typeable Field rec a
f1 ((Typeable a => Bool) -> Bool) -> (Typeable a => Bool) -> Bool
forall a b. (a -> b) -> a -> b
$
    case (Typeable a, Typeable a) => Maybe (a :~: a)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @a0 @a1 of
      Maybe (a :~: a)
Nothing ->
        Bool
False
      Just a :~: a
Refl ->
        Field rec a -> (Eq a => Bool) -> Bool
forall (c :: Type -> Constraint) rec a r.
FieldDict c rec =>
Field rec a -> (c a => r) -> r
withFieldDict @Eq Field rec a
f0 ((Eq a => Bool) -> Bool) -> (Eq a => Bool) -> Bool
forall a b. (a -> b) -> a -> b
$
        Field rec a
f0 Field rec a -> Field rec a -> Bool
forall a. Eq a => a -> a -> Bool
== Field rec a
Field rec a
f1 Bool -> Bool -> Bool
&& a
a0 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
a
a1

-- |
--
-- @since 0.0.1.0
instance (forall a. Show (Field rec a), FieldDict Show rec) => Show (Update rec) where
  showsPrec :: Int -> Update rec -> ShowS
showsPrec Int
d (SetField Field rec a
field a
a) =
    Field rec a -> (Show a => ShowS) -> ShowS
forall (c :: Type -> Constraint) rec a r.
FieldDict c rec =>
Field rec a -> (c a => r) -> r
withFieldDict @Show Field rec a
field ((Show a => ShowS) -> ShowS) -> (Show a => ShowS) -> ShowS
forall a b. (a -> b) -> a -> b
$
      Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10)
        (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"Update "
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Field rec a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Field rec a
field
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" "
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 a
a

-- |  Renders an 'Update' in the following format:
--
-- @
-- {
--    "field": 'toJSON' field,
--    "value": 'toJSON' newValue
--
-- }
-- @
--
-- @since 0.0.1.0
instance (FieldDict ToJSON rec, forall a. ToJSON (Field rec a)) => ToJSON (Update rec) where
  toJSON :: Update rec -> Value
toJSON (SetField Field rec a
field a
newVal) =
    Field rec a -> (ToJSON a => Value) -> Value
forall (c :: Type -> Constraint) rec a r.
FieldDict c rec =>
Field rec a -> (c a => r) -> r
withFieldDict @ToJSON Field rec a
field ((ToJSON a => Value) -> Value) -> (ToJSON a => Value) -> Value
forall a b. (a -> b) -> a -> b
$
      [Pair] -> Value
object [ Text
"field" Text -> Field rec a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Field rec a
field, Text
"value" Text -> a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= a
newVal ]

-- | Parses an 'Update' with the following format:
--
-- @
-- {
--     "field": field,
--     "value": newValue
-- }
-- @
--
--
-- @since 0.0.1.0
instance (FieldDict FromJSON  rec, FieldDict Typeable rec, FromJSON (SomeField rec)) => FromJSON (Update rec) where
  parseJSON :: Value -> Parser (Update rec)
parseJSON = String
-> (Object -> Parser (Update rec)) -> Value -> Parser (Update rec)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Update" ((Object -> Parser (Update rec)) -> Value -> Parser (Update rec))
-> (Object -> Parser (Update rec)) -> Value -> Parser (Update rec)
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    SomeField rec
field <- Object
o Object -> Text -> Parser (SomeField rec)
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"field"
    case SomeField rec
field of
      SomeField Field rec a
field ->
        Field rec a
-> (FromJSON a => Parser (Update rec)) -> Parser (Update rec)
forall (c :: Type -> Constraint) rec a r.
FieldDict c rec =>
Field rec a -> (c a => r) -> r
withFieldDict @FromJSON Field rec a
field ((FromJSON a => Parser (Update rec)) -> Parser (Update rec))
-> (FromJSON a => Parser (Update rec)) -> Parser (Update rec)
forall a b. (a -> b) -> a -> b
$
          Field rec a -> a -> Update rec
forall rec a. Field rec a -> a -> Update rec
SetField Field rec a
field (a -> Update rec) -> Parser a -> Parser (Update rec)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser a
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"value"

-- | Run an 'Update' against the record it is for.
--
-- @
-- >>> let user = User { name = "Bob", age = 30 }
-- >>> updateSingleField (SetField UserName "Alice") user
-- User { name = "Alice", age = 30 }
-- @
--
-- @since 0.0.1.0
updateSingleField :: Record rec => Update rec -> rec -> rec
updateSingleField :: Update rec -> rec -> rec
updateSingleField (SetField Field rec a
field a
newValue) rec
rec =
  ASetter rec rec a a -> a -> rec -> rec
forall s t a b. ASetter s t a b -> b -> s -> t
set (Field rec a -> Lens' rec a
forall rec ty. Record rec => Field rec ty -> Lens' rec ty
recordFieldLens Field rec a
field) a
newValue rec
rec

-- | Perform an list of updates against the 'Record'.
--
-- @since 0.0.1.0
updateRecord :: Record rec => [Update rec] -> rec -> rec
updateRecord :: [Update rec] -> rec -> rec
updateRecord [Update rec]
upds rec
rec = (Update rec -> rec -> rec) -> rec -> [Update rec] -> rec
forall (t :: Type -> Type) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Update rec -> rec -> rec
forall rec. Record rec => Update rec -> rec -> rec
updateSingleField rec
rec [Update rec]
upds