-- |  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) =
    forall (c :: Type -> Constraint) rec a r.
FieldDict c rec =>
Field rec a -> (c a => r) -> r
withFieldDict @Typeable Field rec a
f0 forall a b. (a -> b) -> a -> b
$
    forall (c :: Type -> Constraint) rec a r.
FieldDict c rec =>
Field rec a -> (c a => r) -> r
withFieldDict @Typeable Field rec a
f1 forall a b. (a -> b) -> a -> b
$
    case 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 ->
        forall (c :: Type -> Constraint) rec a r.
FieldDict c rec =>
Field rec a -> (c a => r) -> r
withFieldDict @Eq Field rec a
f0 forall a b. (a -> b) -> a -> b
$
        Field rec a
f0 forall a. Eq a => a -> a -> Bool
== Field rec a
f1 Bool -> Bool -> Bool
&& a
a0 forall a. Eq a => a -> a -> Bool
== 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) =
    forall (c :: Type -> Constraint) rec a r.
FieldDict c rec =>
Field rec a -> (c a => r) -> r
withFieldDict @Show Field rec a
field forall a b. (a -> b) -> a -> b
$
      Bool -> ShowS -> ShowS
showParen (Int
d forall a. Ord a => a -> a -> Bool
> Int
10)
        forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"Update "
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Field rec a
field
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" "
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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) =
    forall (c :: Type -> Constraint) rec a r.
FieldDict c rec =>
Field rec a -> (c a => r) -> r
withFieldDict @ToJSON Field rec a
field forall a b. (a -> b) -> a -> b
$
      [Pair] -> Value
object [ Key
"field" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Field rec a
field, Key
"value" forall kv v. (KeyValue kv, ToJSON v) => Key -> 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 = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Update" forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    SomeField rec
field <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"field"
    case SomeField rec
field of
      SomeField Field rec a
field ->
        forall (c :: Type -> Constraint) rec a r.
FieldDict c rec =>
Field rec a -> (c a => r) -> r
withFieldDict @FromJSON Field rec a
field forall a b. (a -> b) -> a -> b
$
          forall rec a. Field rec a -> a -> Update rec
SetField Field rec a
field forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"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 :: forall rec. Record rec => Update rec -> rec -> rec
updateSingleField (SetField Field rec a
field a
newValue) rec
rec =
  forall s t a b. ASetter s t a b -> b -> s -> t
set (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 :: forall rec. Record rec => [Update rec] -> rec -> rec
updateRecord [Update rec]
upds rec
rec = forall (t :: Type -> Type) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall rec. Record rec => Update rec -> rec -> rec
updateSingleField rec
rec [Update rec]
upds